|
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: 2496 (0x9c0)
Types: TextFile
Notes: Mikados_K
Names: »ISFVAR.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »ISFVAR.K«
PROGRAM OPRETVAR;
LABEL 1000;
(*$G+*)
(*$IISFHEAD*)
VPOST=RECORD
A :AR;
VARENR1 :INTEGER;
VARENAVN,LEVNAVN:PACKED ARRAY(1..30) OF CHAR;
PRIS :REAL;
KOSTPRIS:REAL;
LVRNDØR :INTEGER;
OPRLAND:INTEGER;
TOLDPNR :REAL;
PAKENHED:INTEGER;
FYSLAGER:REAL;
PRIMOLAG:REAL;
MINLAGER:REAL;
RESAFLAG:REAL;
IORDRE :REAL;
RAIORDRE:REAL;
FORVLEVU:INTEGER;
STASBEST:REAL;
DATSBES1,DATSBES2:INTEGER;
DATSORD1,DATSORD2:INTEGER;
ASOLGTIÅ,ASOLGTSÅ:REAL;
OMSIÅR,OMSSÅR:REAL;
DÆKBIDTD:REAL;
DÆKGRASÅ:INTEGER;
ANAFTILG:INTEGER
END;
ZONE= RECORD
H:ISFHEAD;
T:ARRAY(1..1000) OF INTEGER
END;
INFILE=FILE OF CHAR;
VAR F:ISF;
VZ:ZONE;
INDFIL:INFILE;
INDPOST:STRING(80);
FILNAVN1,FILNAVN2:STRING(20);
AV,IER,I:INTEGER;
R:REAL;
VARE:VPOST;
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IINITIATE*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IREPORT*)
(*$R+*)
FUNCTION UNPACK(FBYTE1,FBYTE2:INTEGER):REAL;
VAR RES:REAL;
BEGIN
RES:=0;
REPEAT
RES:=RES*100+ORD(INDPOST(FBYTE1))-32;
FBYTE1:=FBYTE1+1
UNTIL FBYTE1>FBYTE2;
UNPACK:=RES
END;
PROCEDURE PRVAROPL;
BEGIN
CLEARSCREEN;
WITH VARE DO
BEGIN
GOTOXY(1,1);WRITE('1 VARENR');GOTOXY(30,1);WRITELN(VARENR1:10);
GOTOXY(1,2);WRITE('2 VARENAVN');GOTOXY(30,2);WRITELN(VARENAVN);
GOTOXY(1,3);WRITE('3 NAVN HOS LEVERANDØR');GOTOXY(30,3);WRITELN(LEVNAVN);
GOTOXY(1,4);WRITE('4 PRIS');GOTOXY(30,4);WRITELN(PRIS/100:10:2);
GOTOXY(1,5);WRITE('5 KOSTPRIS');GOTOXY(30,5);WRITELN(KOSTPRIS/100:10:2);
GOTOXY(1,6);WRITE('6 LEVERANDØRNR');GOTOXY(30,6);WRITELN(LVRNDØR:10);
GOTOXY(1,7);WRITE('7 OPRINDELSESLAND');GOTOXY(30,7);WRITELN(OPRLAND:10);
GOTOXY(1,8);WRITE('8 TOLDPOSITIONSNR');GOTOXY(30,8);
WRITELN(TOLDPNR/1000:10:3);
GOTOXY(1,9);WRITE('9 PAKNINGSENHED');GOTOXY(30,9);WRITELN(PAKENHED:10);
GOTOXY(1,10);WRITE('10 FYSISK LAGER');GOTOXY(30,10);
WRITE(TRUNC(FYSLAGER):10);
GOTOXY(50,10);WRITE(' PRIMOLAGER');GOTOXY(67,10);
WRITELN(TRUNC(PRIMOLAG):10);
GOTOXY(1,11);WRITE('11 RESERVERET, FYSISK LAGER');GOTOXY(30,11);WRITELN(
TRUNC(RESAFLAG):10);
GOTOXY(1,12);WRITE('12 MINIMUMSLAGER');GOTOXY(30,12);
0x000…013 Line {l1=0x11, l2=»PROGRAM OPRETVAR;«, l3=0x11}
0x013…020 Line {l1=0x0b, l2=»LABEL 1000;«, l3=0x0b}
0x020…029 Line {l1=0x07, l2=»(*$G+*)«, l3=0x07}
0x029…038 Line {l1=0x0d, l2=»(*$IISFHEAD*)«, l3=0x0d}
0x038…046 Line {l1=0x0c, l2=»VPOST=RECORD«, l3=0x0c}
0x046…05b Line {l1=0x13, l2=» A :AR;«, l3=0x13}
0x05b…075 Line {l1=0x18, l2=» VARENR1 :INTEGER;«, l3=0x18}
0x075…0ab Line {l1=0x34, l2=» VARENAVN,LEVNAVN:PACKED ARRAY(1..30) OF CHAR;«, l3=0x34}
0x0ab…0c2 Line {l1=0x15, l2=» PRIS :REAL;«, l3=0x15}
0x0c2…0d9 Line {l1=0x15, l2=» KOSTPRIS:REAL;«, l3=0x15}
0x0d9…0f3 Line {l1=0x18, l2=» LVRNDØR :INTEGER;«, l3=0x18}
0x0f3…10c Line {l1=0x17, l2=» OPRLAND:INTEGER;«, l3=0x17}
0x10c…123 Line {l1=0x15, l2=» TOLDPNR :REAL;«, l3=0x15}
0x123…13d Line {l1=0x18, l2=» PAKENHED:INTEGER;«, l3=0x18}
0x13d…154 Line {l1=0x15, l2=» FYSLAGER:REAL;«, l3=0x15}
0x154…16b Line {l1=0x15, l2=» PRIMOLAG:REAL;«, l3=0x15}
0x16b…182 Line {l1=0x15, l2=» MINLAGER:REAL;«, l3=0x15}
0x182…199 Line {l1=0x15, l2=» RESAFLAG:REAL;«, l3=0x15}
0x199…1b0 Line {l1=0x15, l2=» IORDRE :REAL;«, l3=0x15}
0x1b0…1c7 Line {l1=0x15, l2=» RAIORDRE:REAL;«, l3=0x15}
0x1c7…1e1 Line {l1=0x18, l2=» FORVLEVU:INTEGER;«, l3=0x18}
0x1e1…1f8 Line {l1=0x15, l2=» STASBEST:REAL;«, l3=0x15}
0x1f8…21b Line {l1=0x21, l2=» DATSBES1,DATSBES2:INTEGER;«, l3=0x21}
0x21b…23e Line {l1=0x21, l2=» DATSORD1,DATSORD2:INTEGER;«, l3=0x21}
0x23e…25e Line {l1=0x1e, l2=» ASOLGTIÅ,ASOLGTSÅ:REAL;«, l3=0x1e}
0x25e…27a Line {l1=0x1a, l2=» OMSIÅR,OMSSÅR:REAL;«, l3=0x1a}
0x27a…291 Line {l1=0x15, l2=» DÆKBIDTD:REAL;«, l3=0x15}
0x291…2ab Line {l1=0x18, l2=» DÆKGRASÅ:INTEGER;«, l3=0x18}
0x2ab…2c4 Line {l1=0x17, l2=» ANAFTILG:INTEGER«, l3=0x17}
0x2c4…2cb Line {l1=0x05, l2=» END;«, l3=0x05}
0x2cb…2d9 Line {l1=0x0c, l2=»ZONE= RECORD«, l3=0x0c}
0x2d9…2ec Line {l1=0x11, l2=» H:ISFHEAD;«, l3=0x11}
0x2ec…310 Line {l1=0x22, l2=» T:ARRAY(1..1000) OF INTEGER«, l3=0x22}
0x310…317 Line {l1=0x05, l2=» END;«, l3=0x05}
0x317…32d Line {l1=0x14, l2=»INFILE=FILE OF CHAR;«, l3=0x14}
0x32d…33c Line {l1=0x0d, l2=»VAR F:ISF;«, l3=0x0d}
0x33c…34d Line {l1=0x0f, l2=» VZ:ZONE;«, l3=0x0f}
0x34d…364 Line {l1=0x15, l2=» INDFIL:INFILE;«, l3=0x15}
0x364…380 Line {l1=0x1a, l2=» INDPOST:STRING(80);«, l3=0x1a}
0x380…3a6 Line {l1=0x24, l2=» FILNAVN1,FILNAVN2:STRING(20);«, l3=0x24}
0x3a6…3bc Line {l1=0x14, l2=» AV,IER,I:INTEGER;«, l3=0x14}
0x3bc…3cc Line {l1=0x0e, l2=» R:REAL;«, l3=0x0e}
0x3cc…3e0 Line {l1=0x12, l2=» VARE:VPOST;«, l3=0x12}
0x3e0…3f3 Line {l1=0x11, l2=»(*$R-,IEXCOMCOP*)«, l3=0x11}
0x3f3…400 Line {l1=0x0b, l2=»(*$IIOPEN*)«, l3=0x0b}
0x400…410 Line {l1=0x0e, l2=»(*$IINITIATE*)«, l3=0x0e}
0x410…41d Line {l1=0x0b, l2=»(*$ISÆTØG*)«, l3=0x0b}
0x41d…42d Line {l1=0x0e, l2=»(*$IREADPROC*)«, l3=0x0e}
0x42d…43d Line {l1=0x0e, l2=»(*$IFINDPOST*)«, l3=0x0e}
0x43d…44c Line {l1=0x0d, l2=»(*$IFORSKYD*)«, l3=0x0d}
0x44c…45a Line {l1=0x0c, l2=»(*$IICLOSE*)«, l3=0x0c}
0x45a…468 Line {l1=0x0c, l2=»(*$IPUTGET*)«, l3=0x0c}
0x468…476 Line {l1=0x0c, l2=»(*$IINSERT*)«, l3=0x0c}
0x476…485 Line {l1=0x0d, l2=»(*$INEXTREC*)«, l3=0x0d}
0x485…493 Line {l1=0x0c, l2=»(*$IDELETE*)«, l3=0x0c}
0x493…4a1 Line {l1=0x0c, l2=»(*$IREPORT*)«, l3=0x0c}
0x4a1…4aa Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x4aa…4d8 Line {l1=0x2c, l2=»FUNCTION UNPACK(FBYTE1,FBYTE2:INTEGER):REAL;«, l3=0x2c}
0x4d8…4e7 Line {l1=0x0d, l2=»VAR RES:REAL;«, l3=0x0d}
0x4e7…4ee Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x4ee…4f9 Line {l1=0x09, l2=» RES:=0;«, l3=0x09}
0x4f9…503 Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x503…52e Line {l1=0x29, l2=» RES:=RES*100+ORD(INDPOST(FBYTE1))-32;«, l3=0x29}
0x52e…544 Line {l1=0x14, l2=» FBYTE1:=FBYTE1+1«, l3=0x14}
0x544…55c Line {l1=0x16, l2=» UNTIL FBYTE1>FBYTE2;«, l3=0x16}
0x55c…56b Line {l1=0x0d, l2=» UNPACK:=RES«, l3=0x0d}
0x56b…571 Line {l1=0x04, l2=»END;«, l3=0x04}
0x571…586 Line {l1=0x13, l2=»PROCEDURE PRVAROPL;«, l3=0x13}
0x586…58d Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x58d…59d Line {l1=0x0e, l2=» CLEARSCREEN;«, l3=0x0e}
0x59d…5ab Line {l1=0x0c, l2=»WITH VARE DO«, l3=0x0c}
0x5ab…5b2 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x5b2…5f3 Line {l1=0x3f, l2=»GOTOXY(1,1);WRITE('1 VARENR');GOTOXY(30,1);WRITELN(VARENR1:10);«, l3=0x3f}
0x5f3…634 Line {l1=0x3f, l2=»GOTOXY(1,2);WRITE('2 VARENAVN');GOTOXY(30,2);WRITELN(VARENAVN);«, l3=0x3f}
0x634…67f Line {l1=0x49, l2=»GOTOXY(1,3);WRITE('3 NAVN HOS LEVERANDØR');GOTOXY(30,3);WRITELN(LEVNAVN);«, l3=0x49}
0x67f…6c1 Line {l1=0x40, l2=»GOTOXY(1,4);WRITE('4 PRIS');GOTOXY(30,4);WRITELN(PRIS/100:10:2);«, l3=0x40}
0x6c1…70b Line {l1=0x48, l2=»GOTOXY(1,5);WRITE('5 KOSTPRIS');GOTOXY(30,5);WRITELN(KOSTPRIS/100:10:2);«, l3=0x48}
0x70b…752 Line {l1=0x45, l2=»GOTOXY(1,6);WRITE('6 LEVERANDØRNR');GOTOXY(30,6);WRITELN(LVRNDØR:10);«, l3=0x45}
0x752…79c Line {l1=0x48, l2=»GOTOXY(1,7);WRITE('7 OPRINDELSESLAND');GOTOXY(30,7);WRITELN(OPRLAND:10);«, l3=0x48}
0x79c…7d2 Line {l1=0x34, l2=»GOTOXY(1,8);WRITE('8 TOLDPOSITIONSNR');GOTOXY(30,8);«, l3=0x34}
0x7d2…7ef Line {l1=0x1b, l2=»WRITELN(TOLDPNR/1000:10:3);«, l3=0x1b}
0x7ef…838 Line {l1=0x47, l2=»GOTOXY(1,9);WRITE('9 PAKNINGSENHED');GOTOXY(30,9);WRITELN(PAKENHED:10);«, l3=0x47}
0x838…86e Line {l1=0x34, l2=»GOTOXY(1,10);WRITE('10 FYSISK LAGER');GOTOXY(30,10);«, l3=0x34}
0x86e…88a Line {l1=0x1a, l2=»WRITE(TRUNC(FYSLAGER):10);«, l3=0x1a}
0x88a…8bf Line {l1=0x33, l2=»GOTOXY(50,10);WRITE(' PRIMOLAGER');GOTOXY(67,10);«, l3=0x33}
0x8bf…8dd Line {l1=0x1c, l2=»WRITELN(TRUNC(PRIMOLAG):10);«, l3=0x1c}
0x8dd…927 Line {l1=0x48, l2=»GOTOXY(1,11);WRITE('11 RESERVERET, FYSISK LAGER');GOTOXY(30,11);WRITELN(«, l3=0x48}
0x927…973 Line {l1=0x4a, l2=» TRUNC(RESAFLAG):10);«, l3=0x4a}
0x973…9aa Line {l1=0x35, l2=»GOTOXY(1,12);WRITE('12 MINIMUMSLAGER');GOTOXY(30,12);«, l3=0x35}
0x9aa…9c0 1c 57 52 49 54 45 4c 4e 28 54 52 55 4e 43 28 4d 49 4e 4c 41 47 00 ┆ WRITELN(TRUNC(MINLAG ┆