|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11232 (0x2be0)
Types: TextFile
Notes: Mikados_K
Names: »HENT1.K«
└─⟦510f10af2⟧ Bits:30009011 Apn
└─⟦this⟧ »HENT1.K«
SEGMENT PROCEDURE HENT;
PROCEDURE HENTKOMBI(NR1:INTEGER;VAR PR:APROFILTYP);
TYPE KOMBIZONE=RECORD
H:ISFHEAD;
T:ARRAY(I..MKOMBIZ) OF INTEGER;
END;
KOMBIPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
PROFIL TYPE:AR16;
END;
VAR KOMF:ISF;
KOMZ:KOMBIZONE;
KOMBI:KOMBIPOST;
I:INTEGER
BEGIN
WITH KOMBI DO
BEGIN
OWRITE(KOMZ.H,KOMF,1,LÆS);
NR=NR1;
GETREC(KOMZ.H,KOMF,A);
IF IER<>0 THEN IOF(KOMZ.H.FILENAME);
FOR I:=1 TO 6 DO PR(I).NR=PROFILTYPE(I).
ICLOSE(KOMZ.H.KOMF);
END;
END;
PROCEDURE HENTVINDUE(NR1:INTEGER;VAR RAM ARAMMETYP;VAR VKA INTEGER)
TYPE VINDUEZONE=RECORD
H:ISFHEAD;
T:ARRAY (1..MVINDUEZ) OF INTEGER;
END;
VINDUEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
KARMNR,
MAXMÅL:INTEGER;
RAMME:AR116;
BESLAG:AR14;
BREDDE,
HØJDE:AR13;
TEKST:TEK;
END;
VAR VINF:ISF;
VINZ:VINDUEZONE
VINDUE:VINDUEPOST;
I:INTEGER;
BEGIN
WITH VINDUE DO
BEGIN
OWRITE(VINZ.H,VINF,2,LÆS);
NR:=NR1;
GETREC(VINZ.H,VINF,A);
IF IER<>0 THEN IOF(VINZ.H.FILENAME);
VKA:=KARMNR;
FOR I:=1 TO 16 DO RAM(I) NR:=RAMME(I);
ICLOSE(VINZ.H,VINF);
END;
END;
PROCEDURE HENTFARVE(VAR FA:AFARVTYP;OFA:DOBBTAL);
TYPE FARVEZONE=RECORD
H=ISFHEAD;
T:ARRAY(1..MFARVEZ) OF INTEGER;
END;
FARVEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
FARVE:GLASTYP;
TEKST:TEK;
END;
VAR FARF:ISF;
FARZ:FARVEZONE;
FARVX:FARVEPOST;
BEGIN
WITH FARVX DO
BEGIN
OWRITE(FARVZ.H,FARF,4,LÆS);
FARVE.NR:=OFA(1);
GETREC(FARVZ.H,FARF,A);
IF IER<>0 THEN IOF(FARZ.H.FILENAME);
FA(1):=FARVE;
IF OFA(1)<>OFA(2) THEN
BEGIN
FARVE.NR:=OFA(2);
GETREC(FARZ.H,FARF,A);
IF IER<>0 THEN IOF(FARZ.H.FILENAME)
END;
FA(2):=FARVE;
ICLOSE(FARZ.H,FARF);
END;
END;
PROCEDURE HENTGLAS(VAR GL:AGLASTYP;ART:AR13);
TYPE GLASZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MGLASZ) OF INTEGER;
END;
GLASPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
GLAS:GLASTYP;
TEKST:TEK;
END;
VAR GLAF:ISF;
GLAZ:GLASZONE;
GLAX:GLASPOST;
I:INTEGER;
BEGIN
OWRITE(GLAZ.H,GLAF,7,LÆS);
FOR I:=1 TO 3 DO
BEGIN
GL(I).NR:=0,GL(I).KODE:=0;
IF ART(I)<>0 THEN
BEGIN
GLAX.GLAS.NR:=ART(I);
GETREC(GLAZ.H,GLAF,GLAX.A);
IF IER<>0 THEN IOF(GLAZ.H.FILENAME);
GL(I)=GLAX.GLAS;
END;
END;
ICLOSE(GLAZ.H,GLAF);
END;
PROCEDURE HENTKARM(NR1,KFA,KMONT:INTEGER;VAR AKA:AKARMTYP);
TYPE KARMZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MKARMEZ) OF INTEGER;
END;
POSTZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MPOSTERZ) OF INTEGER;
END;
KARMPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
ØFORSTÆRK,
NFORSTÆRK
FFORSTÆRK,
BFOSTÆRK:AR13;
TYPE:AR14;
TÆTGUM:INTEGER;
TEKST:TEK;
END;
POSTPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KARMNR,
NR,
VANDLOD,
GÅFRA,
GÅTIL,
PLACE:INTEGER;
FORSTÆRK:AR13;
TYP:INTEGER;
END;
VAR KARF,POSF:ISF;
KARZ:KARMZONE;
POSZ:POSTZONE;
KARM:KARMPOST;
POST:POSTPOST;
REGEL:INTEGER;
I1,I:INTEGER;
BEGIN
REGEL:=3;
IF KMONT=0 THEN
BEGIN
REGEL:=2
IF KFA=0 THEN REGEL:=1;
END;
WITH KARM DO
BEGIN
OWRITE(KARZ.H,KARF,3,LÆS);
NR:=NR1;
GETREC(KARZ.H,KARF,A);
IF IER<>0 THEN IOF(KARZ.H.FILENAME);
FOR I:=1 TO 4 DO
BEGIN
AKA(I).PLACE:=((I+1)MOD 2)*4;
AKA(I).FRA:=0;
AKA(I).TIL:=4;
AKA(I).TYPE:=TYPE(I);
AKA(I).VANDLOD:=I DIV 3;
FOR I1:=1 TO 8 DO AKA(I).BESLAG(I1):=0;
END;
AKA(1).FORSTÆRK:=ØFORSTÆRK(REGEL);
AKA(2).FORSTÆRK:=NFORSTÆRK(REGEL);
AKA(3).FORSTÆRK:=FFORSTÆRK(REGEL);
AKA(4).FORSTÆRK:=BFORSTÆRK(REGEL);
ICLOSE(KARZ.H,KARF);
END;
WITH POST DO
BEGIN
OWRITE(POSZ.H,POSF,11,LÆS);
KARMNR:=NR1;
FOR NR:=1 TO 15 DO
BEGIN
GETREC(POSZ.H,POSF,A);
IF (IER<>0) AND (IER<>-6) THEN IOF(POSZ.H.FILENAME);
IF IER=0 THEN
BEGIN
AKA(NR+4).FORSTÆRK:=FORSTÆRK(REGEL);
AKA(NR+4).PLACE:=PLACE;
AKA(NR+4).FRA:=GÅFRA;
AKA(NR+4).TIL:=GÅTIL;
AKA(NR+4).TYPE:=TYP+2;
AKA(NR+4).VANDLOD:=VANDLOD;
FORI1:=1 TO 8 DO AKA(NR+4).BESLAG(I1):=0;
END
ELSE
BEGIN
AKA(NR+4).TYPE:=0;IER:=0;
END;
END;
ICLOSE(POSZ.H,POSF);
END;
END;
PROCEDURE HENTTILBEHØR(VAR PR:APROFILTYP;GL:AGLASTYP;VAR ATI:
ATILBEHØRTYP);
TYPE TILBEHZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MTIBEHZ) OF INTEGER;
END;
TILBEHPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
GLASKODE,
GLASLIST:INTEGER;
GLASGUMMI,
GLASLISTGUMMI:DOBBTAL;
END;
VAR TILF:ISF;
TILZ:TILBEHZONE;
TILBEHØR:TILBEHPOST;
I1,I:INTEGER;
PROCEDURE HTIL
BEGIN
WITH TILBEHØR DO
BEGIN
FOR I:=1 TO 3 DO
BEGIN
GLASKODE:=GL(I).KODE;
IF GLASKODE<>0 THEN
BEGIN
GETREC(TILZ.H,TILF,A);
IF IER<>0 THEN IOF(TILZ.H.FILENAME);
ATI(I+I1).GLASLIST:=GLASLIST;
ATI(I+I1).GLASGUMMI:=GLASGUMMI;
ATI(I+I1).GLASLISTGUMMI:=GLASLISTGUMMI;
PR(I+I1+6).NR:=GLASLIST;
END
ELSE
BEGIN
ATI(I+I1).GLASLIST:=0;PR(I+I1+6).NR:=0;
END;
END;
END;
END;
BEGIN
OWRITE(TILZ.H,TILF,9,LÆS);
TILBEHØR.NR:=PR(1).NR;I1:=0;
HTIL;
TILBEHØR.NR:=PR(5).NR;I1:=3;
HTIL;
ICLOSE(TILZ.H,TILF);
END;
PROCEDURE HENTPROFIL(VAR PR:APROFILTYP);
TYPE PROFILZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MPROFILZ) OF INTEGER;
END;
PROFILPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
DIM:AR13;
TÆTGUM:DOBBTAL;
FORSTÆRK:ADOBBTAL;
TEKST:TEK;
END;
VAR PROF:ISF;
PROZ:PROFILZONE;
PROFIL:PROFILPOST;
I:INTEGER;
BEGIN
WITH PROFIL DO
BEGIN
OWRITE(PROZ.H,PROF,8,LÆS);
FOR I:=1 TO 12 DO
BEGIN
NR:=PR(I).NR;
IF NR<>0 THEN
BEGIN
GETREC(PROZ.H,PROF,A);
IF IER<>0 THEN IOF(PROZ.H.FILENAME);
PR(I).DIM:=DIM;
PR(I).TÆTGUM:=TÆTGUM;
PR(I).FORSTÆRK:=FORSTÆRK;
END;
END;
ICLOSE(PROZ.H,PROF);
END;
END;
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;
BEGIN
HENTKOMBI(OLINIE.VINDUENR DIV 1000,PROFIL);
HENTVINDUE(OLINIE.VINDUENR MOD 1000,RAMME,VKARM);
HENTFARVE(FARVE,OLINIE.FARVE);
HENTGLAS(GLAS,OLINIE.GLASART);
HENTKARM(VKARM,FARVE(1).KODE,OLINIE.MONTER,VKARM);
HENTTILBEHØR(PROFIL,GLAS,TILBEHØR);
HENTPROFIL(PROFIL);
HENTRAMME(RAMME,KARM,GLAS,FARVE,OLINIE.HÆNGSEL,OLINIE.
MONTER,OLINIE.RAMMENR);
END;