DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Types: TextFile
    Notes: Mikados_K
    Names: »SØGPOST.K«

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »SØGPOST.K« 
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
    └─⟦this⟧ »SØGPOST.K« 

Mikados K File

PROCEDURE SÆTHÆGTE;
BEGIN
  CASE HÆGTER(HNR)^.FELTTYPE OF                                  (*$R-*)
  HELTAL :HÆGTEREC(HNR).A(1):=POST.A(HÆGTER(HNR)^.INDEKS);
  DOBBTAL:BEGIN
            HÆGTEREC(HNR).A(1):=POST.A(HÆGTER(HNR)^.INDEKS);
            HÆGTEREC(HNR).A(2):=POST.A(HÆGTER(HNR)^.INDEKS+1) 
          END;
  TEKST  :FOR HINDEKS:=1 TO HÆGTER(HNR)^.FORAN0 DO
          HÆGTEREC(HNR).AA(HINDEKS):=POST.AA(HÆGTER(HNR)^.INDEKS-1+HINDEKS)
  END                                                            (*$R+*)
END;
(*$P*)
PROCEDURE SÆTNØGLE;
BEGIN
  CASE HÆGTER(HNR)^.FELTTYPE OF            
  HELTAL :HINDEKS:=1;
  DOBBTAL:HINDEKS:=2;
  TEKST  :HINDEKS:=HÆGTER(HNR)^.FORAN0 DIV 2
  END;
  FOR NØGLENR:=1 TO ANTALNØGLER DO
  IF NØGLER(NØGLENR)^.HÆGTE<>HÆGTER(HNR)^.HÆGTE THEN
  CASE NØGLER(NØGLENR)^.FELTTYPE OF
  HELTAL :BEGIN                                                  (*$R-*)   
            HINDEKS:=HINDEKS+1;
            HÆGTEREC(HNR).A(HINDEKS):=POST.A(NØGLER(NØGLENR)^.INDEKS)
          END;
  DOBBTAL:BEGIN
            HINDEKS:=HINDEKS+1;
            HÆGTEREC(HNR).A(HINDEKS):=POST.A(NØGLER(NØGLENR)^.INDEKS);
            HÆGTEREC(HNR).A(HINDEKS+1):=POST.A(NØGLER(NØGLENR)^.INDEKS+1);
            HINDEKS:=HINDEKS+1
          END;
  TEKST  :BEGIN
            HINDEKS:=2*HINDEKS;
            FOR I:=1 TO NØGLER(NØGLENR)^.LÆNGDE DO
            HÆGTEREC(HNR).AA(HINDEKS+I):=POST.AA(NØGLER(NØGLENR)^.INDEKS-1+I);
            HINDEKS:=(HINDEKS+NØGLER(NØGLENR)^.LÆNGDE) DIV 2
          END                                                    (*$R+*)
  END
END;
(*$P*)
PROCEDURE OMVNØGLE;
BEGIN
  CASE HÆGTER(HNR)^.FELTTYPE OF            
  HELTAL :BEGIN
            HINDEKS:=1;                                          (*$R-*)
            POST.A(HÆGTER(HNR)^.INDEKS):=HÆGTEREC(HNR).A(1);  
          END;
  DOBBTAL:BEGIN
            HINDEKS:=2;
            POST.A(HÆGTER(HNR)^.INDEKS):=HÆGTEREC(HNR).A(1);  
            POST.A(HÆGTER(HNR)^.INDEKS+1):=HÆGTEREC(HNR).A(2)   
          END;
  TEKST  :BEGIN
            FOR HINDEKS:=1 TO HÆGTER(HNR)^.FORAN0 DO
           POST.AA(HÆGTER(HNR)^.INDEKS-1+HINDEKS):=HÆGTEREC(HNR).AA(HINDEKS); 
            HINDEKS:=HÆGTER(HNR)^.FORAN0 DIV 2                   (*$R+*)
          END;
  END;
  FOR NØGLENR:=1 TO ANTALNØGLER DO
  IF NØGLER(NØGLENR)^.HÆGTE<>HÆGTER(HNR)^.HÆGTE THEN
  CASE NØGLER(NØGLENR)^.FELTTYPE OF
  HELTAL :BEGIN                                                  (*$R-*)   
            HINDEKS:=HINDEKS+1;
            POST.A(NØGLER(NØGLENR)^.INDEKS):=HÆGTEREC(HNR).A(HINDEKS)  
          END;
  DOBBTAL:BEGIN
            HINDEKS:=HINDEKS+1;
            POST.A(NØGLER(NØGLENR)^.INDEKS):=HÆGTEREC(HNR).A(HINDEKS); 
            POST.A(NØGLER(NØGLENR)^.INDEKS+1):=HÆGTEREC(HNR).A(HINDEKS+1);  
            HINDEKS:=HINDEKS+1
          END;
  TEKST  :BEGIN
            HINDEKS:=2*HINDEKS;
            FOR I:=1 TO NØGLER(NØGLENR)^.LÆNGDE DO
            POST.AA(NØGLER(NØGLENR)^.INDEKS-1+I):=HÆGTEREC(HNR).AA(HINDEKS+I);
            HINDEKS:=(HINDEKS+NØGLER(NØGLENR)^.LÆNGDE) DIV 2
          END                                                    (*$R+*)
  END
END;
(*$P*)
PROCEDURE SØGPOST;
VAR LINIE:INTEGER;
    FOUND:BOOLEAN;
    HUSKHÆGT:ARRAY (1..20) OF HPOST;
(*$P*)
FUNCTION CHECKHÆGT:BOOLEAN;
VAR I:INTEGER;
BEGIN 
  CHECKHÆGT:=TRUE;                                               (*$R-*)
  CASE HÆGTER(HNR)^.FELTTYPE OF
  HELTAL :CHECKHÆGT:=(HÆGTEREC(HNR).A(1)=POST.A(HÆGTER(HNR)^.INDEKS));
  DOBBTAL:CHECKHÆGT:=((HÆGTEREC(HNR).A(1)=POST.A(HÆGTER(HNR)^.INDEKS)) AND
                      (HÆGTEREC(HNR).A(2)=POST.A(HÆGTER(HNR)^.INDEKS+1)));
  TEKST  :FOR I:=1 TO HÆGTER(HNR)^.FORAN0 DO
          IF HÆGTEREC(HNR).AA(I)<>POST.AA(HÆGTER(HNR)^.INDEKS-1+I) THEN
            CHECKHÆGT:=FALSE
  END                                                            (*$R+*)
END;
(*$P*)
PROCEDURE SKRIVHÆGT;
VAR I:INTEGER;
BEGIN
  IF LINIE=0 THEN
  BEGIN
    CLEARSCREEN;
    WRITE('Nr  ');
    FOR I:=1 TO ANTALHÆGTER DO WRITE(HÆGTER(I)^.LEDETEKST,
            ' ':HÆGTER(I)^.LÆNGDE-LENGTH(HÆGTER(I)^.LEDETEKST)+1);
    FOR I:=1 TO ANTALIDENT DO WRITE(IDENT(I)^.LEDETEKST, 
                               ' ':IDENT(I)^.LÆNGDE)
  END;
  LINIE:=LINIE+1;
  HUSKHÆGT(LINIE):=HÆGTEREC(HNR);
  GOTOXY(1,LINIE+1);
  WRITE(LINIE:3,' ':3);
  FOR I:=1 TO ANTALHÆGTER DO
  BEGIN
    MOVETOLINE(HÆGTER(I));
    WRITE(' ',LINE,' ':HÆGTER(I)^.LÆNGDE-LENGTH(LINE))
  END;
  FOR I:=1 TO ANTALIDENT DO
  BEGIN
    MOVETOLINE(IDENT(I));
    WRITE(LINE)
  END 
END;
(*$P*)
PROCEDURE VÆLG;
VAR I:INTEGER;
BEGIN
  REPEAT
    I:=-2;
    GOTOXY(1,23);
    WRITE('Tast: 0 for færdig, RETURN for flere eller valgt NR ');
    READLN;
    IF EOLN THEN
      I:=-1
    ELSE
      READ(I)
  UNTIL (I>=-1) AND (I<=LINIE);
  IF I>=0 THEN 
  BEGIN
    FOUND:=TRUE;
    IF I>0 THEN
    BEGIN
      HÆGTEREC(HNR):=HUSKHÆGT(I);
      OMVNØGLE;
      CH:='R';
      IF OPTION IN (.1,5.) THEN
        GETRECX(POST.A)
      ELSE
        GETREC(POST.A);
      IF IER<>0 THEN ERROR(POST.A);
      SKRIVPOST 
    END;
  END;
  LINIE:=0
END;
(*$P*)
BEGIN (*SØGPOST*)
  WRITELN('Søgning via');
  WRITELN(' ':10,'  0 ',NØGLER(1)^.LEDETEKST);
  FOR HNR:=1 TO ANTALHÆGTER DO
    WRITELN(' ':10,HNR:3,' ',HÆGTER(HNR)^.LEDETEKST);
  REPEAT
    GOTOXY(1,23);
    WRITE('Vælg 0-',ANTALHÆGTER,' ');
    READLN;IF EOLN THEN HNR:=0
    ELSE READ(HNR)
  UNTIL (IORESULT=0) AND (HNR>=0) AND (HNR<=ANTALHÆGTER);
  IF HNR>0 THEN
  BEGIN
    HÆGTSØG:=TRUE;
    CLEARSCREEN;
    LÆSFELT(HÆGTER(HNR));
    USERNIVEAU:=HUSKNIV;
    SÆTHÆGTE;
    SÆTNØGLE;
    LINIE:=0;
    FOUND:=FALSE;
    CH:='S';
    REPEAT
      NEXTREC(HÆGTEREC(HNR).A);
      IF NOT (-IER IN (.0..2,9.)) THEN ERROR(HÆGTEREC(HNR).A);
      IF IER=-1 THEN IER:=0;
      IF (IER=0) AND CHECKHÆGT THEN
      BEGIN
        OMVNØGLE;
        GETREC(POST.A);
        IF IER<>0 THEN ERROR(POST.A);
        SKRIVHÆGT;
        IF LINIE=20 THEN VÆLG 
      END
      ELSE
      BEGIN
        IF LINIE>0 THEN VÆLG;
        FOUND:=TRUE
      END 
    UNTIL FOUND;
  END
END;
(*$P*)