|
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: 9984 (0x2700)
Types: TextFile
Notes: Mikados_K
Names: »NBTPROC1.K«
└─⟦a3d38fea3⟧ Bits:30008985 PRODUKTION NBT.
└─⟦this⟧ »NBTPROC1.K«
PROCEDURE OWRITE(VAR OWZH:ISFHEAD;VAR OWF:ISF;NR1,NR2:INTEGER);
BEGIN
REWRITE(OWF,FILEN(NR1));
OWZH.FILENAME:=FILER(NR1);
IOPEN(OWZH,OWF,NR2);
IF IER<>0 THEN OFEJL(OWZH.FILENAME);
END;
PROCEDURE ÅBEN;
BEGIN
CLEARSCREEN;
FNAVN:=':P2:0000:I';
FILEN(1):=CONCAT('KOMBINAT',FNAVN);
FILEN(2):=CONCAT('VINDUE',FNAVN);
FILEN(3):=CONCAT('KARME',FNAVN);
FILEN(4):=CONCAT('FARVE',FNAVN);
FILEN(5):=CONCAT('OLINIE',FNAVN);
FILEN(6):=CONCAT('OPSPLIT',FNAVN);
FILEN(7):=CONCAT('GLAS',FNAVN);
FILEN(8):=CONCAT('PROFIL',FNAVN);
FILEN(9):=CONCAT('TILBEHØR',FNAVN);
FILEN(10):=CONCAT('RAMME',FNAVN);
FILEN(11):=CONCAT('POSTER',FNAVN);
FILEN(12):=CONCAT('FORSTÆRK',FNAVN);
FILEN(13):=CONCAT('BREGEL',FNAVN);
FILER(1):='KOMBINAT';
FILER(2):='VINDUE ';
FILER(3):='KARME ';
FILER(4):='FARVE ';
FILER(5):='OLINIE ';
FILER(6):='OPSPLIT ';
FILER(7):='GLAS ';
FILER(8):='PROFIL ';
FILER(9):='TILBEHØR';
FILER(10):='RAMME ';
FILER(11):='POSTER ';
FILER(12):='FORSTÆRK';
FILER(13):='BREGEL ';
OWRITE(OLIZ.H,OLIF,5,LÆS);
OWRITE(GLAZ.H,GLAF,7,LÆS);
OWRITE(PROZ.H,PROF,8,LÆS);
OWRITE(TILZ.H,TILF,9,LÆS);
OWRITE(RAMZ.H,RAMF,10,LÆS);
OWRITE(POSZ.H,POSF,11,LÆS);
OWRITE(FORZ.H,FORF,12,LÆS);
OWRITE(BREZ.H,BREF,13,LÆS);
END;
PROCEDURE CHECKBH (VAR BH:AR13);
BEGIN
IF(BH(3)>0)AND((BH(2)=0)OR(BH(1)=0)) THEN FEJL (1);
IF((BH(2)>0)AND(BH(1)=0)) THEN FEJL (1)
END;
PROCEDURE INITPOST;
BEGIN
WITH OPSPLIT DO
BEGIN
ORDRENR:=OLINIE.ORDRENR;
TYP:=0;
POSITION:=OLINIE.POSITION;
RAMMENR:=0;
PLACER:=0;
ANTAL:=OLINIE.ANTAL;
TYPENR:=NULLER;
FARVE:=0;
FTYPE:=NULLER;
FLÆNGDE:=0;
SLÆNGDE:=0;
BESLAGNR:=0;
HÆNGSEL:=0;
GUMMI1:=NULLER;
GUMMI2:=NULLER;
STATUS:=OLINIE.STATUS;
END;
END;
PROCEDURE BESTEMFARVE(VAR FAK1,FAK2,FAN1,FAN2:INTEGER;VAR FIL:FILNAVN);
TYPE FARVEZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MFARVEZ) OF INTEGER;
END;
FARVEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
KODE:INTEGER;
TEKST:TEK;
END;
VAR FARF:ISF;
FARZ:FARVEZONE;
FARVE:FARVEPOST;
BEGIN
WITH FARVE DO
BEGIN
OWRITE(FARZ.H,FARF,4,LÆS);
NR:=OLINIE.FARVE1;
GETREC(FARZ.H,FARF,A);
IF IER <> 0 THEN IOF(FARZ.H.FILENAME);
FAK1:=KODE;FAN1:=NR;
IF OLINIE.FARVE1<>OLINIE.FARVE2 THEN
BEGIN
NR:=OLINIE.FARVE2;
GETREC(FARZ.H,FARF,A);
IF IER<>0 THEN IOF(FARZ.H.FILENAME)
END;
FAK2:=KODE;FAN2:=NR;
ICLOSE(FARZ.H,FARF);
END;
END;
PROCEDURE BESTEMFORSTÆRKNING;
BEGIN
REGELNR:=3;
IF OLINIE.MONTER=0 THEN
BEGIN
REGELNR:=2;
IF FAKODE=0 THEN REGELNR:=1
END;
END;
PROCEDURE STÆRKNING;
TYPE STÆRKPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
GRÆNSE,
TYP:AR15;
FRADRAG,
KONSTANT,
AFRUND:INTEGER;
END;
VAR STÆRK:STÆRKPOST;
BEGIN
WITH STÆRK DO
BEGIN
NR:=STÆRKR;
GETREC(FORZ.H,FORF,A);
IF IER<>0 THEN IOF(FORZ.H.FILENAME);
I:=1;
WHILE (GRÆNSE(I)<MÅL) AND (I<5) DO I:=I+1;
LÆNGDE:=((MÅL - FRADRAG) DIV AFRUND) * AFRUND;
IF I=1 THEN LÆNGDE:= KONSTANT;
TYPER:=TYP(I)
END;
END;
PROCEDURE BESLAGNING (VAR NR1:INTEGER);
TYPE BREGELPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
GRÆNSE,
PAKKE:AR19;
TEKST:TEK;
END;
VAR BREGEL:BREGELPOST;
BEGIN
WITH BREGEL DO
BEGIN
NR:=NR1;
GETREC(BREZ.H,BREF,A);
IF IER <> 0 THEN IOF(BREZ.H. FILENAME);
I:=1;
WHILE (GRÆNSE(I) <MÅL) AND (I<9) DO I:=I+1;
TYPE2:=PAKKE(I)
END;
END;
PROCEDURE BESTEMGLAS;
TYPE GLASPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
KODE:INTEGER;
TEKST:TEK;
END;
VAR GLAS:GLASPOST;
BEGIN
WITH OLINIE DO
BEGIN
IF I1=RAMMENR1 THEN
GLASNR:=GLASART1
ELSE
IF I1=RAMMENR2 THEN
GLASNR:=GLASART2
ELSE
GLASNR:=GLASART3;
GLAS.NR:=GLASNR;
GETREC(GLAZ.H,GLAF,GLAS.A);
IF IER=0 THEN
GLASKODE:=GLAS.KODE
ELSE
IOF(GLAZ.H.FILENAME)
END;
END;
PROCEDURE GENER(TYP1,TYP2,TYP3,FL,SL,HÆ:INTEGER;VAR GU1,GU2:DOBBTAL);
TYPE OPSPLITZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MOPSPLIZ) OF INTEGER;
END;
OPSPLITPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ORDRENR,
TYP,
POSITION,
RAMMENR,
PLACER,
ANTAL:INTEGER;
TYPENR:DOBBTAL;
FARVE:INTEGER;
FTYPE:DOBBTAL;
FLÆNGDE,
SLÆNGDE,
BESLAGNR,
HÆNGSEL:INTEGER;
GUMMI1,
GUMMI2:DOBBTAL;
STATUS:INTEGER;
END;
VAR OPSF:ISF;
OPSZ:OPSPLITZONE;
OPSPLIT:OPSPLITPOST;
BEGIN
WITH OPSPLIT DO
BEGIN
ORDRENR:=OLINIE.ORDRENR;
TYP:=TYP1;
RAMMENR:=I1;
TYPENR(1):=TYP2;
TYPENR(2):=TYP3;
POSITION:=OLINIE.POSITION;
PLACER:=PLACERING;
ANTAL:=OLINIE.ANTAL;
FARVE:=0;
FTYPE:=NULLER;
FLÆNGDE:=FL;
SLÆNGDE:=SL;
BESLAGNR:=0;
HÆNGSEL:=HÆ;
GUMMI1:=GU1;
GUMMI2:=GU2;
STATUS:=OLINIE.STATUS;
IF TYP1=1 THEN
BEGIN
FARVE:=FANR;
FTYPE:=TYPE1;
BESLAGNR:=TYPE2;
END;
OWRITE(OPSZ.H,OPSF,6,SKRIV);
INSERT(OPSZ.H,OPSF,A);
IF IER <> 0 THEN IOF(OPSZ.H.FILENAME);
ICLOSE(OPSZ.H,OPSF);
IF IER <> 0 THEN IOF(OPSZ.H.FILENAME);
END;
END;
PROCEDURE HENTKOMBI(VAR KKA:INTEGER;VAR KRA:INTEGER;VAR KPO:INTEGER;
VAR FIL:FILNAVN);
TYPE KOMBIZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MKOMBIZ) OF INTEGER;
END;
KOMBIPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
KARMPROFIL,
POST1,
POST2,
RAMMEPROFIL,
F3PROFIL:INTEGER;
END;
VAR KOMF:ISF;
KOMZ:KOMBIZONE;
KOMBI:KOMBIPOST;
BEGIN
WITH KOMBI DO
BEGIN
NR:=OLINIE.VINDUENR DIV 1000;
OWRITE(KOMZ.H,KOMF,1,LÆS);
GETREC(KOMZ.H,KOMF,A);
IF IER<>0 THEN IOF(KOMZ.H.FILENAME);
KKA:=KARMPROFIL;KRA:=RAMMEPROFIL;KPO:=POST1;
ICLOSE(KOMZ.H,KOMF);
END;
END;
PROCEDURE HENTVINDUE(VAR VKA:INTEGER;VAR RAM:AR116;VAR VBE:AR14;VAR VBR:AR13;
VAR VHØ:AR13;VAR FIL:FILNAVN);
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;
BEGIN
WITH VINDUE DO
BEGIN
NR:=OLINIE.VINDUENR MOD 1000;
OWRITE(VINZ.H,VINF,2,LÆS);
GETREC(VINZ.H,VINF,A);
IF IER<>0 THEN IOF(VINZ.H.FILENAME);
VKA:=KARMNR;RAM:=RAMME;VBE:=BESLAG;VBR:=BREDDE;VHØ:=HØJDE;
ICLOSE(VINZ.H,VINF);
END;
END;
PROCEDURE PROFILBEHANDLING(HØJDE:INTEGER;VAR FORSTÆRK:AR14;VAR PROFILSTÆRK:
ADOBTAL;VAR BESLAG:AR14; VAR PROFIL:
INTEGER;VAR GUM1:DOBBTAL;VAR GUM2:DOBBTAL);
BEGIN
FOR PLACERING:=1 TO 4 DO
BEGIN
TYPE1:=NULLER;TYPE2:=0;LÆNGDE:=0;
IF PLACERING=3 THEN
BEGIN
MÅL:=HØJDE;
STÆRKR:=STÆRKR2;
END;
IF FORSTÆRK(PLACERING)=1 THEN
BEGIN
STÆRKNING;
TYPE1:=PROFILSTÆRK(TYPER);
GENER(4,TYPE1(1),TYPE1(2),0,LÆNGDE,0,NULLER,NULLER);
END;
IF BESLAG(PLACERING)>0 THEN
BEGIN
BESLAGNING(BESLAG(PLACERING));
GENER(5,0,TYPE2,0,0,0,NULLER,NULLER)
END;
GENER(1,0,PROFIL,LÆNGDE,MÅL,0,GUM1,GUM2);
END;
END;
PROCEDURE HENTKARM(NR1:INTEGER;VAR KBE,KFO:AR14;VAR KVR,KLR:AR13;VAR FIL:
FILNAVN);
TYPE KARMZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MKARMEZ) OF INTEGER;
END;
KARMPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR:INTEGER;
FORSTÆRK,
BESLAG:AR14;
TÆTGUM:INTEGER;
VREGEL,
LREGEL:AR13;
TEKST:TEK;
END;
VAR KARF:ISF;
KARZ:KARMZONE;
KARM:KARMPOST;
BEGIN
WITH KARM DO
BEGIN
OWRITE(KARZ.H,KARF,3,LÆS);
NR:=NR1;
GETREC(KARZ.H,KARF,A);
IF IER<>0 THEN IOF(FIL);
KBE:=BESLAG;KFO:=FORSTÆRK;KVR:=VREGEL;KLR:=LREGEL;
ICLOSE(KARZ.H,KARF);
END;
END;