|
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: »READINFO.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »READINFO.K«
PROCEDURE READINFO;
TYPE
NFELT=^FELTBESKRIVELSE;
SKÆRMPOS=RECORD
X,Y:INTEGER
END;
BESKRIVELSESTYPE=(FELTDESC,VALIDESC);
FELTBESKRIVELSE=RECORD
NÆSTEVAL:NFELT;
FELTNAVN:STRING(8);
CASE DESCTYPE:BESKRIVELSESTYPE OF
FELTDESC:
(INDPOS,UDPOS:SKÆRMPOS;
KIKKENIVEAU,ÆNDRENIVEAU:NIVEAU;
EDITERING:INTEGER;
LEDETEKST,FØLGETEKST:STRING;
INDEKS:INTEGER;
LÆNGDE:INTEGER;
FORAN0:INTEGER;
CASE FELTTYPE:FTYPE OF
REEL:(DEC:INTEGER);
HELTAL,DOBBTAL,TEKST:());
VALIDESC:
(CASE VALIDITYTYPE:VTYPE OF
HINTERVAL:(MIN,MAX:INTEGER);
DINTERVAL:(MIN1,MIN2,MAX1,MAX2:INTEGER);
RINTERVAL:(RMIN,RMAX:REAL);
DATO,CPR:())
END;
FELTFIL=FILE OF FELTBESKRIVELSE;
FILDESC=RECORD
FILNAVN:STRING(18); (*ISF-FILENS NAVN*)
DESCNAVN:STRING(18); (*NAVNET PÅ DEN ENKELTE ISF-FILS BESKRIVELSESFIL*)
POSTNAVN: STRING(18); (*NAVNET PÅ ET INDIVID I FILEN*)
REGNAVN:STRING(18); (*FILENS BETEGNELSE*)
VEDLNIVEAU:NIVEAU;(*ADGANGSNIVEAU FOR GENERELT VEDLIGEHOLDELSESPROGRAM*)
ZONESIZE:INTEGER
END;
FILEDESC=FILE OF FILDESC;(*FORTEGNELSE OVER ALLE ISF-FILER*)
VAR FFIL:FELTFIL;
ISFFILES:FILEDESC;
FILNAVN:STRING(18);
FELTNR,FILNR:INTEGER;
BEGIN
WITH FILINFO(0) DO
BEGIN
USENR:=0;
POSTNAVN:='NULPOST';
FOR FELTNR:=0 TO MAXFELT DO
BEGIN
FELTINF(FELTNR).FELTNAVN:='@';
FELTINF(FELTNR).INDEKS:=0;
FELTINF(FELTNR).FELTTYPE:=HELTAL
END
END;
FOR FILNR:=1 TO 250 DO POST(0).CONTENTS(FILNR):=0;
POST(0).A(-4):=NULINT;
POST(0).AAA(0):=NULREAL;
POST(0).AA(-11):=CHR(NULCHAR DIV 100);
POST(0).AA(-10):=CHR(NULCHAR MOD 100);
FILNAVN:='ISFFILES:P2:0000:S';
RESET(ISFFILES,FILNAVN);IOC;
FILNR:=0;
GET(ISFFILES);IOC;
WHILE (ISFFILES^.FILNAVN(1)<>'@') AND (FILNR<MAXFILES) DO
BEGIN
FILNR:=FILNR+1;
WITH FILINFO(FILNR) DO
BEGIN
USENR:=0;
POSTNAVN:=ISFFILES^.POSTNAVN;
FELTNR:=0;
FELTINF(FELTNR).FELTNAVN:='IER';
FELTINF(FELTNR).INDEKS:=-4;
FELTINF(FELTNR).FELTTYPE:=HELTAL;
FILNAVN:=ISFFILES^.DESCNAVN;
RESET(FFIL,FILNAVN);IOC;
GET(FFIL);IOC;
WHILE (FFIL^.INDPOS.X>0) AND (FELTNR<MAXFELT) DO
BEGIN
FELTNR:=FELTNR+1;
FELTINF(FELTNR).FELTNAVN:=FFIL^.FELTNAVN;
FELTINF(FELTNR).INDEKS:=FFIL^.INDEKS;
FELTINF(FELTNR).FELTTYPE:=FFIL^.FELTTYPE;
REPEAT
GET(FFIL);IOC
UNTIL FFIL^.DESCTYPE=FELTDESC
END;
IF FELTNR<MAXFELT THEN FELTINF(FELTNR+1).FELTNAVN:='@';
CLOSE(FFIL)
END;
IF FILNR<MAXFILES THEN FILINFO(FILNR+1).POSTNAVN:='@';
GET(ISFFILES);IOC
END;
CLOSE(ISFFILES)
END;
(*$P*)
PROCEDURE UDLISTDEF;
VAR LISTER:LISTFILE;
LISTENR:INTEGER;
BEGIN
FNAVN:='LISTDEFS:P2:0000:S';
REWRITE(LISTER,FNAVN);IOC;
LISTENR:=0;
REPEAT
LISTENR:=LISTENR+1;
GET(LISTER);IOC
UNTIL LISTER^.NAVN(1)='@';
AKTULIST.ZPOSTNR:=LISTENR;
CLEARSCREEN;
AKTULIST.NAVN:=' ';
WRITELN('Listens betegnelse');
GOTOXY(20,1);
EDIT(AKTULIST.NAVN);
AKTULIST.DESCLIST:=' :P2:0030:J';
WRITELN('Listedefinitionsfilens navn');
gotoxy(30,2);
EDIT(AKTULIST.DESCLIST);
REPEAT
GOTOXY(1,3);
WRITELN('Listens adgangsniveau 0-8');
GOTOXY(27,3);
READLN;READ(I)
UNTIL (IORESULT=0) AND (I>=0) AND (I<=8);
AKTULIST.LISTENIVEAU:=MENIG;
WHILE I>0 DO
BEGIN
AKTULIST.LISTENIVEAU:=SUCC(AKTULIST.LISTENIVEAU);
I:=I-1
END;
REPEAT
GOTOXY(1,4);
WRITE('Blankettype >=0 ');
READLN;READ(AKTULIST.BLANKTYP)
UNTIL (IORESULT=0) AND (AKTULIST.BLANKTYP>=0);
SEEK(LISTER,LISTENR);IOC;
LISTER^:=AKTULIST;
PUT(LISTER);IOC;
LISTER^.NAVN(1):='@';
PUT(LISTER);IOC
END;
(*$P*)
PROCEDURE VÆLGLISTE;
VAR LISTER:LISTFILE;
I,LISTENR:INTEGER;
BEGIN
(*VALG AF UDSKRIFT*)
FNAVN:='LISTDEFS:P2:0000:S';
REWRITE(LISTER,FNAVN);IOC;
CLEARSCREEN;
SEEK(LISTER,1);IOC;
LISTENR:=0;
REPEAT
GET(LISTER);IOC;
IF LISTER^.NAVN(1)<>'@' THEN
BEGIN
GOTOXY(LISTENR MOD 2*38+1,LISTENR DIV 2+1);
LISTENR:=LISTENR+1;
WRITELN(LISTENR:3,' ',LISTER^.NAVN)
END
UNTIL LISTER^.NAVN(1)='@';
REPEAT
GOTOXY(1,23);
WRITELN('Listenummer, 0 for færdig');
GOTOXY(27,23);READLN;READ(I)
UNTIL (IORESULT=0) AND (I>=0) AND (I<=LISTENR);
IF I>0 THEN
BEGIN
SEEK(LISTER,I);IOC;
GET(LISTER);IOC;
AKTULIST:=LISTER^
END
ELSE AKTULIST.NAVN(1):='@'
END;
(*$P*)
(*Problemer med navne på hjælpevariable (summer o.lign.), der er ikke
noget sted at gemme navnet.
Evt: Speciel DESCFIL for hver nulfil,
Fælles DESCFIL for alle nulfiler, altså kun een nulfil (fælles)*)
PROCEDURE INDELEMENT;
VAR FFIL:ELEMENTFIL;
PROCEDURE INDNUL;
VAR FIL0:ZEROFIL;
BEGIN
FNAVN:='ZEROFILE:P2:0000:S';
REWRITE(FIL0,FNAVN);IOC;
SEEK(FIL0,AKTULIST.ZPOSTNR);IOC;
GET(FIL0);IOC;
POST(0):=FIL0^
END;
FUNCTION NÆSTE:ELEMENT;
VAR I:INTEGER;
THIS:ELEMENT;
BEGIN
GET(FFIL);IOC;
CASE FFIL^.ELEMENTTYPE OF
LISTEDESC:BEGIN
NEW(THIS,LISTEDESC);
THIS^:=FFIL^;
(*
THIS^.ELEMENTTYPE:=LISTEDESC;
FOR I:=1 TO 8 DO THIS^.FILES(I):=FFIL^.FILES(I);
IF FFIL^.NEXTELEMENT<>NIL THEN
THIS^.NEXTELEMENT:=NÆSTE
ELSE
THIS^.NEXTELEMENT:=NIL
*)
END;
PICTURE: BEGIN
NEW(THIS,PICTURE);
THIS^:=FFIL^;
(*
THIS^.ELEMENTTYPE:=PICTURE;
THIS^.PICTPOS:=FFIL^.PICTPOS;
THIS^.NEXTELEMENT:=FFIL^.NEXTELEMENT;
*)
IF THIS^.FØRSTFELT<>NIL THEN
THIS^.FØRSTFELT:=NÆSTE
END;
INDKOMMANDO:BEGIN
NEW(THIS,INDKOMMANDO);
THIS^:=FFIL^;
IF THIS^.FØRSTNØGL<>NIL THEN THIS^.FØRSTNØGL:=NÆSTE;
END;
UDKOMMANDO:BEGIN
NEW(THIS,UDKOMMANDO);
THIS^:=FFIL^
END;
NØGLE:BEGIN
NEW(THIS,NØGLE);
THIS^:=FFIL^
END;
GENTAG:BEGIN
NEW(THIS,GENTAG);
THIS^:=FFIL^;
IF THIS^.FIRSTFELT<>NIL THEN THIS^.FIRSTFELT:=NÆSTE;
IF THIS^.BETINGELSE<>NIL THEN THIS^.BETINGELSE:=NÆSTE
END;
BEREGN:BEGIN
NEW(THIS,BEREGN);
THIS^:=FFIL^;
IF THIS^.UDTRYK<>NIL THEN THIS^.UDTRYK:=NÆSTE
END;
VALIDITET:BEGIN
CASE FFIL^.VALIDITYTYPE OF
HINTERVAL:NEW(THIS,VALIDITET,HINTERVAL);
DINTERVAL:NEW(THIS,VALIDITET,DINTERVAL);
RINTERVAL:NEW(THIS,VALIDITET,RINTERVAL);
DATO,CPR :NEW(THIS,VALIDITET,DATO)
END;
THIS^:=FFIL^
END;
FELT:BEGIN
CASE FFIL^.FELTTYPE OF
REEL:NEW(THIS,FELT,REEL);
HELTAL,DOBBTAL,TEKST:NEW(THIS,FELT,HELTAL)
END;
THIS^:=FFIL^
END;
KSLOP:BEGIN
CASE FFIL^.POLISH OF
EXPRESSION:NEW(THIS,KSLOP,EXPRESSION);
SIMPLEX :NEW(THIS,KSLOP,SIMPLEX);
TERM :NEW(THIS,KSLOP,TERM);
FACTOR :CASE FFIL^.FACTTYPE OF
CONSTVAR:NEW(THIS,KSLOP,FACTOR,CONSTVAR);
LPEXPRP,NOTFACT:NEW(THIS,KSLOP,FACTOR,LPEXPRP)
END
END;
THIS^:=FFIL^;
IF THIS^.SECOND<>NIL THEN THIS^.SECOND:=NÆSTE
END
END;
IF THIS^.NEXTELEMENT<>NIL THEN THIS^.NEXTELEMENT:=NÆSTE;
NÆSTE:=THIS
END;
BEGIN
INDNUL;
REWRITE(FFIL,AKTULIST.DESCLIST);IOC;
LISTEHOVED:=NÆSTE
(*INDLÆS NEXTELEMENT, SÆT REFERENCE*)
END;
(*$P*)
PROCEDURE UDELEMENT;
VAR FFIL:ELEMENTFIL;
PROCEDURE UDNUL;
VAR FIL0:ZEROFIL;
BEGIN
FNAVN:='ZEROFILE:P2:0000:S';
REWRITE(FIL0,FNAVN);IOC;
SEEK(FIL0,AKTULIST.ZPOSTNR);IOC;
FIL0^:=POST(0);
PUT(FIL0);IOC
END;
PROCEDURE UD(VAR EL:ELEMENT);
BEGIN
FFIL^:=EL^;
PUT(FFIL);IOC;
CASE EL^.ELEMENTTYPE OF
PICTURE:IF EL^.FØRSTFELT<>NIL THEN UD(EL^.FØRSTFELT);
INDKOMMANDO:IF EL^.FØRSTNØGL<>NIL THEN UD(EL^.FØRSTNØGL);
GENTAG:BEGIN
IF EL^.FIRSTFELT<>NIL THEN UD(EL^.FIRSTFELT);
IF EL^.BETINGELSE<>NIL THEN UD(EL^.BETINGELSE)
END;
BEREGN:IF EL^.UDTRYK<>NIL THEN UD(EL^.UDTRYK);
KSLOP:IF EL^.SECOND<>NIL THEN UD(EL^.SECOND)
END;
IF EL^.NEXTELEMENT<>NIL THEN UD(EL^.NEXTELEMENT)
END;
BEGIN
UDNUL;
REWRITE(FFIL,AKTULIST.DESCLIST);IOC;
UD(LISTEHOVED)
END;
(*$P*)