DataMuseum.dk

top - download

    Length: 2528 (0x9e0)
    Types: TextFile
    Notes: Mikados_K
    Names: »HENRAMME.K«

└─⟦510f10af2⟧ Bits:30009011 Apn
    └─⟦this⟧ »HENRAMME.K« 

Mikados K File

PROCEDURE HENTRAMME(VAR RAM:ARAMMETYP;KA:AKARMTYP;
                    GLA:AGLASTYP;FA:AFARVTYP;HÆNG:AR14;
                    MONT:INTEGER;ORAM:AR13);
 
TYPE RAMMEZONE=RECORD
               H:ISFHEAD;
               T:ARRAY(1..MRAMMEZ) OF INTEGER;
     END;
 
     RAMMEPOST=RECORD
               AA:ARAR;
               A:AR;
               AAA:RAR;
               NR,
               TYPE:INTEGER;
               ØFORSTÆRK
               NFORSTÆRK
               FFORSTÆRK
               BFORSTÆRK:AR13;
               ØBESLAG,
               NBESLAG,
               FBESLAG,
               BBESLAG:DOBBTAL;
               TÆTGUM:INTEGER;
               TEKST:TEK;
      END;
 
VAR  RAMF:ISF;
     RAMZ:RAMMEZONE;
     RAMME:RAMMEPOST;
     I1,I:INTEGER;
 
FUNCTION OMK(J,X:INTEGER):INTEGER;
 
BEGIN
  WHILE(RAM(I+J*X).NR=I) AND (J<4) THEN J:=J+1;
  IF J<4 THEN
    IF RAM(I+J*X).NR=0 THEN J:=4;
  OMK:=J;
END;
FUNCTION FPOST:INTEGER;
 
VAR J,J1:INTEGER;
 
BEGIN
  J:=1;J1:=3-(I1 DIV 3)*2;
  WHILE((KA(J).PLACE<>RAM(I).OMKREDS(I1)) OR (KA(J).GÅFRA>
        RAM(I).OMKREDS(J1)) OR (KA(J).GÅTIL<RAM(I).
        OMKREDS(J1+1))) AND (J<20) DO J:=J+1;
  FPOST:=J;
END;
BEGIN
  WITH RAMME DO
  BEGIN
    OWRITE(RAMZ.H,RAMF,10,LÆS);
    FOR I:=1 TO 16 DO
    BEGIN
      NR:=RAM(I).NR;
      IF NR>19 THEN
      BEGIN
        GETREC(TAMZ.H,RAMF,A);
        IF IER<>0 THEN IOF(RAMZ.H.FILNAME);
        RAM(I).TÆTGUM;=TÆTGUM;
        RAM(I).TYPE:=TYPE;
        I1:=1;
        WHILE (I<>ORAM(I1)) AND (I1<3) DO I1:=I1+1;
        RAM(I).GLASKODE:=GLA(I).KODE;
        I1:=3;
        IF MONT=0 THEN
        BEGIN
          I1:=2;
          IF FA(2).KODE=0 THEN I1:=1;
        END;
        RAM(I).FORSTÆRK(1):=ØFORSTÆRK(I1);
        RAM(I).FORSTÆRK(2):=NFORSTÆRK(I1);
        RAM(I).FORSTÆRK(3):=FFORSTÆRK(I1);
        RAM(I).FORSTÆRK(4):=BFORSTÆRK(I1);
        I1:=HÆNG((I-1) MOD 4+1);
        RAM(I).BESLAG(1):=ØBESLAG(I1);
        RAM(I).BESLAG(2):=NBESLAG(I1);
        RAM(I).BESLAG(3):=FBESLAG(I1);
        RAM(I).BESLAG(4):=BBESLAG(I1);
        RAM(I).OMKREDS(1):=(I-1) DIV 4;
        RAM(I).OMKREDS(2):=OMK((I+3)DIV4,4);
        RAM(I).OMKREDS(3):=(I-1) MOD 4;
        RAM(I).OMKREDS(4):=OMK((I-1) MOD 4+1,1);
        FOR I1:=1 TO 4 DO RAM(I).POST(I1):=FPOST;
      END;
    END;
    ICLOSE(RAMZ.H,RAMF);
  END;
END;