|
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: 32864 (0x8060)
Types: TextFile
Notes: Mikados_K
Names: »LISTEGEN.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »LISTEGEN.K«
PROGRAM LISTEGEN;
CONST MAXFELT=30;
MAXFILES=20;
NULREAL=1.0;
NULINT=41; (*10 REALS*)
NULCHAR=101; (*10 INTEGERS, 400 CHARS*)
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
ELEMENT=^ELEMENTBESKRIVELSE;
POSITION=RECORD
X,Y:INTEGER
END;
FTYPE=(HELTAL,DOBBTAL,REEL,TEKST);
VTYPE=(HINTERVAL,DINTERVAL,RINTERVAL,DATO,CPR);
ETYPE=(LISTEDESC,PICTURE,FELT,INDKOMMANDO,UDKOMMANDO,VALIDITET,GENTAG,BEREGN,
NØGLE,KSLOP);
REPTYPE=(REPETE,WAILE);
FACTTYP=(CONSTVAR,LPEXPRP,NOTFACT);
SYMBOLTYPE=(PERIOD,EQL,LSS,GTR,NEQ,LEQ,GEQ,LPAREN,RPAREN,OTHERSYM,
PLUS,MINUS,OROP,CONSTSYM,POSTSYM,IDENTSYM,NOTOP,TEKSTSYM,
TIMES,SLASH,DIVOP,MODOP,ANDOP,SLUTSYM);
KSLOPTYPE=(EXPRESSION,SIMPLEX,TERM,FACTOR);
ELEMENTBESKRIVELSE=RECORD
NEXTELEMENT :ELEMENT;
CASE ELEMENTTYPE:ETYPE OF
LISTEDESC:
(FILES :ARRAY (.1..8.) OF INTEGER;
LINESPP :INTEGER
);
PICTURE:
(PICTPOS :POSITION;
FØRSTFELT :ELEMENT;
PICTNAVN :STRING(8)
);
INDKOMMANDO:
(GETFILREF,
GETMODE :INTEGER;
FØRSTNØGL :ELEMENT
);
UDKOMMANDO:
(PUTFILREF,
PUTMODE :INTEGER
);
NØGLE:
(NØGLETYPE :FTYPE;
NØGLEREF,
PINDEKS,
GINDEKS :INTEGER
);
GENTAG:
(LØKKETYPE :REPTYPE;
FIRSTFELT,
BETINGELSE :ELEMENT;
POSINCR :POSITION
);
BEREGN:
(UDTRYK :ELEMENT;
GEMREF, (*<0 => UDSKRIFT JVNF. FOREGÅENDE UDFELT*)
GEMINDEKS :INTEGER;
UDTRYKTYPE :FTYPE
);
VALIDITET:
(CASE VALIDITYTYPE:VTYPE OF
HINTERVAL:(MIN,MAX:INTEGER);
DINTERVAL:(MIN1,MIN2,MAX1,MAX2:INTEGER);
RINTERVAL:(RMIN,RMAX:REAL);
DATO,CPR:()
);
FELT:
(INDPOS :POSITION;
EDITERING, (*<0 => UDFELT*)
POSTREF, (*VÆRDI FÅS FRA NEXTELEMENT, BEREGNING*)
INDEKS, (*NÅR POSTREF=0 OG INDEKS<0*)
LÆNGDE,
FORAN0 :INTEGER;
CASE FELTTYPE:FTYPE OF
REEL:(DEC:INTEGER);
HELTAL,DOBBTAL,TEKST:()
);
KSLOP:
(SECOND :ELEMENT;
CASE POLISH:KSLOPTYPE OF
EXPRESSION:(EXPOP:SYMBOLTYPE);
SIMPLEX :(SIMOP1,SIMOP2:SYMBOLTYPE);
TERM :(TRMOP:SYMBOLTYPE);
FACTOR :(CASE FACTTYPE:FACTTYP OF
CONSTVAR:(CVREF,CVDEKS:INTEGER;
CVTYPE :FTYPE);
LPEXPRP,NOTFACT:())
);
END;
ELEMENTFIL=FILE OF ELEMENTBESKRIVELSE;
AR=ARRAY (-4..-4) OF INTEGER;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
PPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
CONTENTS: ARRAY (1..250) OF INTEGER
END;
LISTTYPE=RECORD
NAVN:STRING(30); (*LISTENS BETEGNELSE*)
DESCLIST:STRING(18); (*NAVN PÅ LISTEDEFINITIONSFILEN*)
LISTENIVEAU:NIVEAU; (*ADGANGSNIVEAUET TIL LISTEN*)
BLANKTYP, (*BLANKETTYPE*)
ZPOSTNR:INTEGER (*KONSTANTPOSTENS NR*)
END;
LISTFILE=FILE OF LISTTYPE; (*FORTEGNELSE OVER ALLE DEFINEREDE LISTER*)
ZEROFIL=FILE OF PPOST;
FELTINFO=RECORD
FELTNAVN:STRING(8);
INDEKS:INTEGER;
FELTTYPE:FTYPE
END;
FILEINFO=RECORD
USENR:INTEGER;
POSTNAVN:STRING(18);
FELTINF:ARRAY (0..MAXFELT) OF FELTINFO
END;
VAR
PARM:^PARMARRAY;
QUQ:^INTEGER;
LISTEHOVED,LISTEELEMENT: ELEMENT;
PRNIVEAU,NROFFILES,LINES,OPTION,IER,I,J,CDECS,CLÆNG,FORAN0:INTEGER;
CONSTANT:REAL;
SYM:STRING;
SCH:STRING(1);
SYMBOL:SYMBOLTYPE;
LINE:STRING;
LISTENAVN:STRING(8);
POST:ARRAY (0..0) OF PPOST;
FILINFO:ARRAY (0..MAXFILES) OF FILEINFO;
FNAVN:STRING(18);
AKTULIST:LISTTYPE;
FELTYPE:ARRAY (0..3) OF PACKED ARRAY (1..7) OF CHAR;
ELTYPE:ARRAY (0..9) OF PACKED ARRAY (1..11) OF CHAR;
GENTYPE:ARRAY (0..1) OF PACKED ARRAY (1..6) OF CHAR;
CH:CHAR;
CHGTYPE:ARRAY (1..5) OF PACKED ARRAY (1..16) OF CHAR;
OKSET:ARRAY (1..5) OF INTEGER;
SINGLE,CHANGING:BOOLEAN;
SAVE:ARRAY (0..10) OF ELEMENT;
(*$P*)
PROCEDURE IOC;
VAR IOR:INTEGER;
BEGIN
IOR:=IORESULT;
IF IOR<>0 THEN
BEGIN
CLEARSCREEN;
GOTOXY(1,10);
WRITELN('Pladefejl ',IOR:5,' RETURN');
SCH:=' ';
EDIT(SCH);
IF SCH<>'R' THEN EXIT(LISTEGEN)
END
END;
(*$P*)
PROCEDURE INITTEXT;
BEGIN
FELTYPE(0):='HELTAL ';
FELTYPE(1):='DOBBTAL';
FELTYPE(2):='REEL ';
FELTYPE(3):='TEKST ';
ELTYPE(0):='LISTEDESC ';
ELTYPE(1):='PICTURE ';
ELTYPE(2):='FELT ';
ELTYPE(3):='INDKOMMANDO';
ELTYPE(4):='UDKOMMANDO ';
ELTYPE(5):='VALIDITET ';
ELTYPE(6):='GENTAG ';
ELTYPE(7):='BEREGN ';
ELTYPE(8):='NØGLE ';
ELTYPE(9):='KSLOP ';
GENTYPE(0):='REPEAT';
GENTYPE(1):='WHILE ';
CHGTYPE(1):='Fortsæt vandret ';
CHGTYPE(2):='Fortsæt lodret ';
CHGTYPE(3):='Tilbage (afstak)';
CHGTYPE(4):='Oplys ';
CHGTYPE(5):='Ændring '
END;
(*$P*)
PROCEDURE PRINTEL(VAR EL:ELEMENT);
VAR I:INTEGER;
PROCEDURE PRINT1;
BEGIN
WITH EL^ DO
CASE ELEMENTTYPE OF
LISTEDESC:BEGIN
WRITE(LIST,'FILES');
FOR I:=1 TO 8 DO WRITE(LIST,FILES(I):3);
WRITELN(LIST);
WRITELN(LIST,' ':PRNIVEAU+3,'LINESPP',LINESPP:4)
END;
PICTURE: BEGIN
WRITELN(LIST,'NAVN ',PICTNAVN,' POSITION',
PICTPOS.X:3,PICTPOS.Y:3);
WRITELN(LIST,' ':PRNIVEAU+3,'FØRSTFELT');
PRINTEL(FØRSTFELT);
END;
INDKOMMANDO:
BEGIN
WRITELN(LIST,'GETFILREF',GETFILREF:3,
' GETMODE',GETMODE:3);
WRITELN(LIST,' ':PRNIVEAU+3,'FØRSTNØGL');
PRINTEL(FØRSTNØGL)
END;
UDKOMMANDO:WRITELN(LIST,'PUTFILREF',PUTFILREF:3,
' PUTMODE',PUTMODE:3);
NØGLE: WRITELN(LIST,'NØGLETYPE ',FELTYPE(ORD(NØGLETYPE)),
' NØGLEREF',NØGLEREF:3,
' PINDEKS',PINDEKS:3,
' GINDEKS',GINDEKS:3);
GENTAG: BEGIN
WRITELN(LIST,'LØKKETYPE ',GENTYPE(ORD(LØKKETYPE)),
' POSINCR',POSINCR.X:6,POSINCR.Y:6);
WRITELN(LIST,' ':PRNIVEAU+3,'BETINGELSE');
PRINTEL(BETINGELSE);
WRITELN(LIST,' ':PRNIVEAU+3,'FIRSTFELT');
PRINTEL(FIRSTFELT)
END;
BEREGN :BEGIN
WRITELN(LIST,'GEMREF',GEMREF:3,
' GEMINDEKS',GEMINDEKS:4,
' UDTRYKTYPE ',FELTYPE(ORD(UDTRYKTYPE)));
WRITELN(LIST,' ':PRNIVEAU+3,'UDTRYK');
PRINTEL(UDTRYK)
END;
VALIDITET:BEGIN
CASE VALIDITYTYPE OF
HINTERVAL:WRITELN(LIST,'HINTERVAL MIN MAX',MIN:8,MAX:8);
DINTERVAL:WRITELN(LIST,'DINTERVAL MIN MAX',
MIN1*10000.0+MIN2:10:-2,
MAX1*10000.0+MAX2:10:-2);
RINTERVAL:WRITELN(LIST,'RINTERVAL MIN MAX',RMIN:10:-2,
RMAX:10:-2);
DATO:WRITELN(LIST,'DATO');
CPR:WRITELN(LIST,'CPR')
END
END;
END
END;
BEGIN
IF EL<>NIL THEN
WITH EL^ DO
BEGIN
PRNIVEAU:=PRNIVEAU+1;
WRITELN(LIST,PRNIVEAU:3,' ':PRNIVEAU,'Elementtype ',
ELTYPE(ORD(ELEMENTTYPE)));
WRITE(LIST,' ':PRNIVEAU+3);
CASE ELEMENTTYPE OF
FELT : BEGIN
WRITELN(LIST,'INDPOS',INDPOS.X:5,INDPOS.Y:5,
' EDITERING',EDITERING:2,
' POSTREF',POSTREF:3,
' INDEKS',INDEKS:4,
' LÆNGDE',LÆNGDE:3,
' FORAN0',FORAN0:3);
WRITE(LIST,' ':PRNIVEAU+3,'FELTTYPE ',
FELTYPE(ORD(FELTTYPE)));
IF FELTTYPE=REEL THEN WRITELN(LIST,' DEC',DEC:3)
ELSE WRITELN(LIST)
END;
KSLOP : BEGIN
CASE POLISH OF
EXPRESSION:BEGIN
WRITELN(LIST,'EXPRESSION');
PRINTEL(NEXTELEMENT);
PRINTEL(SECOND);
WRITELN(LIST,ORD(EXPOP))
END;
SIMPLEX: BEGIN
WRITELN(LIST,'SIMPLEX');
IF SIMOP1<>OROP THEN
WRITELN(LIST,ORD(SIMOP1));
PRINTEL(NEXTELEMENT);
IF SIMOP2<>OROP THEN
BEGIN
PRINTEL(SECOND);
WRITELN(LIST,ORD(SIMOP2))
END
END;
TERM: BEGIN
WRITELN(LIST,'TERM');
PRINTEL(NEXTELEMENT);
PRINTEL(SECOND);
WRITELN(LIST,ORD(TRMOP))
END;
FACTOR: BEGIN
WRITE(LIST,'FACTOR ');
CASE FACTTYPE OF
LPEXPRP:BEGIN
WRITELN(LIST,'LPEXPRP (');
PRINTEL(NEXTELEMENT);
WRITELN(LIST,')')
END;
NOTFACT:BEGIN
WRITELN(LIST,'NOTFACT NOT');
PRINTEL(NEXTELEMENT)
END;
CONSTVAR:BEGIN
WRITELN(LIST,'CONSTVAR');
WRITELN(LIST,' ':PRNIVEAU+3,
CVREF:5,
CVDEKS:5,' ':5,
FELTYPE(ORD(CVTYPE)))
END
OTHERWISE WRITELN('HOV ',ORD(FACTTYPE))
END
END
END
OTHERWISE PRINT1;
IF ELEMENTTYPE<>KSLOP THEN
BEGIN
WRITELN(LIST,' ':PRNIVEAU+3,'NEXTELEMENT');
PRNIVEAU:=PRNIVEAU-1;
IF NEXTELEMENT<>NIL THEN
PRINTEL(NEXTELEMENT)
ELSE WRITELN(LIST,' ':PRNIVEAU+4,'NIL');
PRNIVEAU:=PRNIVEAU+1
END;
PRNIVEAU:=PRNIVEAU-1
END
ELSE WRITELN(LIST,' ':PRNIVEAU+3,'NIL')
END;
(*$P*)
PROCEDURE OPLYS;
VAR I,OPTION:INTEGER;
NÅET:BOOLEAN;
BEGIN
CLEARSCREEN;
WRITE('Poster/felter:1, Listestruktur:2');
REPEAT
GOTOXY(40,1);READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=2);
CASE OPTION OF
1:BEGIN
CLEARSCREEN;
I:=0;
NÅET:=FALSE;
REPEAT
IF FILINFO(I).POSTNAVN(1)<>'@' THEN
BEGIN
WRITELN(I:3,' ':3,FILINFO(I).POSTNAVN);
I:=I+1
END
ELSE NÅET:=TRUE
UNTIL (NÅET) OR (I>MAXFILES);
I:=I-1;
REPEAT
GOTOXY(1,23);
WRITE('Vælg post ');READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=0) AND (OPTION<=I);
CLEARSCREEN;
WITH FILINFO(OPTION) DO
BEGIN
WRITELN('Postnavn ',POSTNAVN,' Usenr',USENR:3);
I:=0;
NÅET:=FALSE;
REPEAT
IF FELTINF(I).FELTNAVN(1)<>'@' THEN
WITH FELTINF(I) DO
BEGIN
WRITELN(FELTNAVN,INDEKS:5,' ',FELTYPE(ORD(FELTTYPE)));
I:=I+1
END
ELSE NÅET:=TRUE
UNTIL (NÅET) OR (I>MAXFELT);
WRITE('RETURN');READLN
END
END;
2:BEGIN
PRNIVEAU:=0;
IF LISTEHOVED^.ELEMENTTYPE=LISTEDESC THEN
PRINTEL(LISTEHOVED)
END
END
END;
(*$P*)
(*$IREADINFO*)
PROCEDURE GETSYM;
VAR DECFACTOR:REAL;
I:INTEGER;
PROCEDURE NEXTCH;
BEGIN
IF (CH<>' ') AND (EOLN) THEN
CH:='ü'
ELSE
BEGIN
WHILE EOLN DO READLN;
READ(CH)
END
END;
BEGIN (*GETSYM*)
WHILE CH=' ' DO NEXTCH;
SCH:=' ';
IF CH='ü' THEN
BEGIN
SYMBOL:=SLUTSYM;
CH:=' '
END
ELSE
BEGIN
IF CH IN (.'0'..'9'.) THEN
BEGIN
CONSTANT:=0.0;
SYMBOL:=CONSTSYM;
CDECS:=0;
CLÆNG:=0;
IF CH='0' THEN FORAN0:=1 ELSE FORAN0:=0;
REPEAT
CONSTANT:=10.0*CONSTANT+ORD(CH)-ORD('0');
CLÆNG:=CLÆNG+1;
NEXTCH
UNTIL NOT (CH IN (.'0'..'9'.));
IF CH='.' THEN
BEGIN
CLÆNG:=CLÆNG+1;
DECFACTOR:=1.0;
NEXTCH;
WHILE CH IN (.'0'..'9'.) DO
BEGIN
DECFACTOR:=DECFACTOR*0.1;
CONSTANT:=CONSTANT+DECFACTOR*(ORD(CH)-ORD('0'));
CDECS:=CDECS+1;
CLÆNG:=CLÆNG+1;
NEXTCH
END
END;
FORAN0:=FORAN0*CLÆNG
END
ELSE
IF CH IN (.'A'..'Å','a'..'å'.) THEN
BEGIN
SYM:='';
REPEAT
SCH(1):=CH;
SYM:=CONCAT(SYM,SCH);
NEXTCH
UNTIL NOT (CH IN (.'0'..'9','A'..'Å','a'..'å'.));
IF CH='.' THEN SYMBOL:=POSTSYM ELSE SYMBOL:=IDENTSYM;
IF SYM='OR' THEN SYMBOL:=OROP;
IF SYM='AND' THEN SYMBOL:=ANDOP;
IF SYM='MOD' THEN SYMBOL:=MODOP;
IF SYM='DIV' THEN SYMBOL:=DIVOP;
IF SYM='NOT' THEN SYMBOL:=NOTOP
END
ELSE
CASE CH OF
'''':BEGIN
SYMBOL:=TEKSTSYM;
CLÆNG:=0;
SYM:='';
NEXTCH;
WHILE CH<>'''' DO
BEGIN
SCH(1):=CH;
SYM:=CONCAT(SYM,SCH);
CLÆNG:=CLÆNG+1;
NEXTCH
END;
NEXTCH
END;
'+':BEGIN SYMBOL:=PLUS;NEXTCH END;
'-':BEGIN SYMBOL:=MINUS;NEXTCH END;
'*':BEGIN SYMBOL:=TIMES;NEXTCH END;
'/':BEGIN SYMBOL:=SLASH;NEXTCH END;
'(':BEGIN SYMBOL:=LPAREN;NEXTCH END;
')':BEGIN SYMBOL:=RPAREN;NEXTCH END;
'.':BEGIN SYMBOL:=PERIOD;NEXTCH END;
'<':BEGIN
NEXTCH;
IF CH='=' THEN
BEGIN SYMBOL:=LEQ; NEXTCH END ELSE
IF CH='>' THEN
BEGIN SYMBOL:=NEQ; NEXTCH END ELSE
SYMBOL:=LSS
END;
'>':BEGIN
NEXTCH;
IF CH='=' THEN
BEGIN SYMBOL:=GEQ; NEXTCH END ELSE
IF CH='<' THEN
BEGIN SYMBOL:=NEQ; NEXTCH END ELSE
SYMBOL:=GTR
END;
'=':BEGIN
NEXTCH;
IF CH='<' THEN
BEGIN SYMBOL:=LEQ; NEXTCH END ELSE
IF CH='>' THEN
BEGIN SYMBOL:=GEQ; NEXTCH END ELSE
SYMBOL:=EQL
END
OTHERWISE
BEGIN
SYMBOL:=OTHERSYM;
NEXTCH
END
END;
WRITELN('SYMTYPE ',ORD(SYMBOL):5,' SYMBOL ',SYM);DELAY(100)
END;
(*$P*)
PROCEDURE INDSYM;
BEGIN
READLN;
CH:=' ';
GETSYM
END;
PROCEDURE SYNTFEJL(EXPECSYM:SYMBOLTYPE);
BEGIN
WRITELN('SYNTAKSFEJL',ORD(EXPECSYM):5);
REPEAT
INDSYM
UNTIL SYMBOL=EXPECSYM
(*SKAL UDBYGGES*)
END;
(*$P*)
FUNCTION LODRET:ELEMENT;
FORWARD;
FUNCTION VANDRET:ELEMENT;
FORWARD;
FUNCTION EXPR:ELEMENT;
FORWARD;
(*$P*)
FUNCTION GENTAGELSE:ELEMENT;
VAR THIS:ELEMENT;
OPTION:INTEGER;
BEGIN
NEW(THIS,GENTAG);
THIS^.ELEMENTTYPE:=GENTAG;
CLEARSCREEN;
REPEAT
GOTOXY(1,2);
WRITELN('RELATIV POSITIONSÆNDRING DX DY');
GOTOXY(32,2);
READLN;READ(THIS^.POSINCR.X,THIS^.POSINCR.Y)
(*CHECK*)
UNTIL IORESULT=0;
REPEAT
GOTOXY(1,3);
WRITELN('LØKKETYPE: REPEAT:1, WHILE:2');
GOTOXY(32,3);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=2);
IF OPTION=1 THEN THIS^.LØKKETYPE:=REPETE ELSE THIS^.LØKKETYPE:=WAILE;
THIS^.FIRSTFELT:=NIL;THIS^.NEXTELEMENT:=NIL;
GOTOXY(1,4);
WRITELN('Betingelse ');
GOTOXY(12,4);
INDSYM;
THIS^.BETINGELSE:=EXPR;
THIS^.FIRSTFELT:=VANDRET;
THIS^.NEXTELEMENT:=LODRET;
GENTAGELSE:=THIS
END;
(*$P*)
FUNCTION BILLEDE:ELEMENT;
VAR THIS:ELEMENT;
OPTION:INTEGER;
BEGIN
NEW(THIS,PICTURE);
THIS^.ELEMENTTYPE:=PICTURE;
CLEARSCREEN;
GOTOXY(1,2);
WRITELN('Billednavn');
GOTOXY(12,2);
THIS^.PICTNAVN:=' ';
EDIT(THIS^.PICTNAVN);
REPEAT
GOTOXY(1,3);
WRITELN('Relativ positionsændring X Y');
GOTOXY(32,3);
READLN;READ(THIS^.PICTPOS.X,THIS^.PICTPOS.Y)
(*CHECK*)
UNTIL IORESULT=0;
THIS^.FØRSTFELT:=NIL;THIS^.NEXTELEMENT:=NIL;
THIS^.FØRSTFELT:=VANDRET;
THIS^.NEXTELEMENT:=LODRET;
BILLEDE:=THIS
END;
(*$P*)
FUNCTION FIELD:ELEMENT;
VAR THIS:ELEMENT;
OPTION:INTEGER;
BEGIN
CLEARSCREEN;
REPEAT
GOTOXY(1,2);
WRITELN('Felttype: REEL:1, HELTAL:2, DOBBTAL:3, TEKST:4');
GOTOXY(48,2);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=4);
IF OPTION=1 THEN NEW(THIS,FELT,REEL) ELSE NEW(THIS,FELT,HELTAL);
THIS^.NEXTELEMENT:=NIL;
THIS^.ELEMENTTYPE:=FELT;
CASE OPTION OF
1:THIS^.FELTTYPE:=REEL;
2:THIS^.FELTTYPE:=HELTAL;
3:THIS^.FELTTYPE:=DOBBTAL;
4:THIS^.FELTTYPE:=TEKST
END;
REPEAT
GOTOXY(1,3);
WRITELN('Relativ position X Y');
GOTOXY(23,3);
READLN;READ(THIS^.INDPOS.X,THIS^.INDPOS.Y)
(*CHECK*)
UNTIL IORESULT=0;
REPEAT
GOTOXY(1,4);
WRITELN('Udskrivning -1, Indlæsning 0, Editering 1');
GOTOXY(43,4);
READLN;READ(THIS^.EDITERING)
UNTIL (IORESULT=0) AND (THIS^.EDITERING>=-1) AND (THIS^.EDITERING<=1);
REPEAT
GOTOXY(1,5);
WRITELN('Længde');
GOTOXY(8,5);READLN;READ(THIS^.LÆNGDE)
UNTIL IORESULT=0;
REPEAT
GOTOXY(1,6);
WRITELN('FORAN0');
GOTOXY(8,6);READLN;READ(THIS^.FORAN0)
UNTIL IORESULT=0;
IF THIS^.FELTTYPE=REEL THEN
REPEAT
GOTOXY(1,7);
WRITELN('Decimaler');
GOTOXY(11,7);READLN;READ(THIS^.DEC)
UNTIL IORESULT=0;
GOTOXY(1,8);
WRITELN('Indlæs felt');
GOTOXY(13,8);
INDSYM;
IF SYMBOL=TEKSTSYM THEN
BEGIN
WRITELN(ORD(POST(0).AA(-11)):10,ORD(POST(0).AA(-10)):10);DELAY(100);
THIS^.INDEKS:=100*ORD(POST(0).AA(-11))+ORD(POST(0).AA(-10));
WRITELN(THIS^.INDEKS:10,CLÆNG:10);DELAY(100);
MOVELEFT(SYM(1),POST(0).AA(THIS^.INDEKS),CLÆNG);
THIS^.POSTREF:=0;
POST(0).AA(-11):=CHR((THIS^.INDEKS+CLÆNG) DIV 100);
POST(0).AA(-10):=CHR((THIS^.INDEKS+CLÆNG) MOD 100);
THIS^.NEXTELEMENT:=VANDRET
END
ELSE
BEGIN
THIS^.NEXTELEMENT:=EXPR;
IF (THIS^.NEXTELEMENT^.NEXTELEMENT=NIL) OR (THIS^.EDITERING>=0) THEN
BEGIN
THIS^.INDEKS:=THIS^.NEXTELEMENT^.CVDEKS;
THIS^.POSTREF:=THIS^.NEXTELEMENT^.CVREF;
THIS^.NEXTELEMENT:=VANDRET
END
ELSE
BEGIN
THIS^.POSTREF:=0;
CASE THIS^.FELTTYPE OF
REEL:THIS^.INDEKS:=0;
HELTAL,DOBBTAL:THIS^.INDEKS:=-4
END
END
END;
FIELD:=THIS
END;
(*$P*)
FUNCTION FACTØR:ELEMENT;
VAR THIS:ELEMENT;
FILNR,POSTNR:INTEGER;
BEGIN
CASE SYMBOL OF
LPAREN:BEGIN
NEW(THIS,KSLOP,FACTOR,LPEXPRP);
THIS^.FACTTYPE:=LPEXPRP;
GETSYM;
THIS^.NEXTELEMENT:=EXPR;
IF SYMBOL<>RPAREN THEN SYNTFEJL(RPAREN);
GETSYM
END;
NOTOP: BEGIN
NEW(THIS,KSLOP,FACTOR,NOTFACT);
THIS^.FACTTYPE:=NOTFACT;
GETSYM;
THIS^.NEXTELEMENT:=FACTØR
END;
CONSTSYM:
BEGIN
NEW(THIS,KSLOP,FACTOR,CONSTVAR);
THIS^.FACTTYPE:=CONSTVAR;
THIS^.CVREF:=0;
THIS^.NEXTELEMENT:=NIL;
IF CDECS>0 THEN
BEGIN
THIS^.CVTYPE:=REEL;
THIS^.CVDEKS:=TRUNC(POST(0).AAA(0));
POST(0).AAA(THIS^.CVDEKS):=CONSTANT;
POST(0).AAA(0):=POST(0).AAA(0)+1.0
END
ELSE
IF CONSTANT<=32767.0 THEN
BEGIN
THIS^.CVTYPE:=HELTAL;
THIS^.CVDEKS:=POST(0).A(-4);
POST(0).A(THIS^.CVDEKS):=TRUNC(CONSTANT);
POST(0).A(-4):=POST(0).A(-4)+1
END
ELSE
BEGIN
THIS^.CVTYPE:=DOBBTAL;
THIS^.CVDEKS:=POST(0).A(-4);
POST(0).A(THIS^.CVDEKS):=TRUNC(CONSTANT/10000.0);
POST(0).A(THIS^.CVDEKS+1):=TRUNC(CONSTANT-10000.0*
POST(0).A(THIS^.CVDEKS));
POST(0).A(-4):=POST(0).A(-4)+2
END;
GETSYM
END;
POSTSYM:
BEGIN
REPEAT
FILNR:=0;
REPEAT
FILNR:=FILNR+1
UNTIL (FILNR=MAXFILES) OR (FILINFO(FILNR).POSTNAVN=SYM);
IF FILINFO(FILNR).POSTNAVN<>SYM THEN SYNTFEJL(POSTSYM)
UNTIL FILINFO(FILNR).POSTNAVN=SYM;
NEW(THIS,KSLOP,FACTOR,CONSTVAR);
THIS^.FACTTYPE:=CONSTVAR;
THIS^.NEXTELEMENT:=NIL;
IF FILINFO(FILNR).USENR=0 THEN
BEGIN
REPEAT
FILINFO(FILNR).USENR:=FILINFO(FILNR).USENR+1
UNTIL LISTEHOVED^.FILES(FILINFO(FILNR).USENR)=0;
LISTEHOVED^.FILES(FILINFO(FILNR).USENR):=FILNR
END;
THIS^.CVREF:=FILINFO(FILNR).USENR;
GETSYM; IF SYMBOL<>PERIOD THEN SYNTFEJL(PERIOD);
GETSYM; IF SYMBOL<>IDENTSYM THEN SYNTFEJL(IDENTSYM);
REPEAT
POSTNR:=-1;
REPEAT
POSTNR:=POSTNR+1
UNTIL (POSTNR=MAXFELT) OR
(FILINFO(FILNR).FELTINF(POSTNR).FELTNAVN=SYM);
IF FILINFO(FILNR).FELTINF(POSTNR).FELTNAVN<>SYM THEN
SYNTFEJL(IDENTSYM)
UNTIL FILINFO(FILNR).FELTINF(POSTNR).FELTNAVN=SYM;
THIS^.CVDEKS:=FILINFO(FILNR).FELTINF(POSTNR).INDEKS;
THIS^.CVTYPE:=FILINFO(FILNR).FELTINF(POSTNR).FELTTYPE;
GETSYM
END;
IDENTSYM:
BEGIN (*HJÆLPEVARIABEL, FELT I NULPOSTEN*)
REPEAT
POSTNR:=-1;
REPEAT
POSTNR:=POSTNR+1
UNTIL (POSTNR=MAXFELT) OR
(FILINFO(0).FELTINF(POSTNR).FELTNAVN=SYM);
IF FILINFO(0).FELTINF(POSTNR).FELTNAVN<>SYM THEN SYNTFEJL(IDENTSYM)
UNTIL FILINFO(0).FELTINF(POSTNR).FELTNAVN=SYM;
NEW(THIS,KSLOP,FACTOR,CONSTVAR);
THIS^.FACTTYPE:=CONSTVAR;
THIS^.NEXTELEMENT:=NIL;
THIS^.CVREF:=0;
THIS^.CVDEKS:=FILINFO(0).FELTINF(POSTNR).INDEKS;
THIS^.CVTYPE:=FILINFO(0).FELTINF(POSTNR).FELTTYPE;
GETSYM
END
END;
THIS^.ELEMENTTYPE:=KSLOP;
THIS^.POLISH:=FACTOR;
THIS^.SECOND:=NIL;
FACTØR:=THIS
END;
(*$P*)
FUNCTION TÆRM:ELEMENT;
VAR THIS,NEXT:ELEMENT;
BEGIN
NEXT:=FACTØR;
IF SYMBOL IN (.TIMES..ANDOP.) THEN
BEGIN
NEW(THIS,KSLOP,TERM);
THIS^.NEXTELEMENT:=NEXT;
THIS^.POLISH:=TERM;
THIS^.TRMOP:=SYMBOL;
GETSYM;
THIS^.SECOND:=FACTØR;
TÆRM:=THIS
END
ELSE TÆRM:=NEXT
END;
(*$P*)
(*$L+*)
FUNCTION SIMPLEEXPR:ELEMENT;
VAR THIS,NEXT:ELEMENT;
BEGIN
IF SYMBOL IN (.PLUS,MINUS.) THEN
BEGIN
NEW(THIS,KSLOP,SIMPLEX);
THIS^.ELEMENTTYPE:=KSLOP;
THIS^.POLISH:=SIMPLEX;
THIS^.SIMOP1:=SYMBOL;
GETSYM
END ELSE THIS:=NIL;
NEXT:=TÆRM;
IF SYMBOL IN (.PLUS,MINUS,OROP.) THEN
BEGIN
IF THIS=NIL THEN
BEGIN
NEW(THIS,KSLOP,SIMPLEX);
THIS^.ELEMENTTYPE:=KSLOP;
THIS^.POLISH:=SIMPLEX;
THIS^.SIMOP1:=OROP (*INGEN 1. OPERATOR*)
END;
THIS^.SIMOP2:=SYMBOL;
THIS^.NEXTELEMENT:=NEXT;
GETSYM;
THIS^.SECOND:=TÆRM;
SIMPLEEXPR:=THIS
END
ELSE
BEGIN
IF THIS=NIL THEN SIMPLEEXPR:=NEXT
ELSE
BEGIN
THIS^.NEXTELEMENT:=NEXT;
THIS^.SECOND:=NIL;
THIS^.SIMOP2:=OROP; (*INGEN 2. OPERATOR*)
SIMPLEEXPR:=THIS
END
END
END;
(*$P*)
FUNCTION EXPR; (*:ELEMENT*)
VAR THIS,NEXT:ELEMENT;
BEGIN
NEXT:=SIMPLEEXPR;
IF SYMBOL IN (.EQL..GEQ.) THEN
BEGIN
NEW(THIS,KSLOP,EXPRESSION);
THIS^.ELEMENTTYPE:=KSLOP;
THIS^.POLISH:=EXPRESSION;
THIS^.NEXTELEMENT:=NEXT;
THIS^.EXPOP:=SYMBOL;
GETSYM;
THIS^.SECOND:=SIMPLEEXPR;
EXPR:=THIS
END
ELSE
EXPR:=NEXT
END;
(*$P*)
FUNCTION BEREGNING:ELEMENT;
VAR THIS:ELEMENT;
OPTION,POSTNR:INTEGER;
BEGIN
NEW(THIS,BEREGN);
THIS^.ELEMENTTYPE:=BEREGN;
CLEARSCREEN;
REPEAT
WRITELN('Hvilket felt skal beregnes?');
GOTOXY(29,1);INDSYM
UNTIL SYMBOL IN (.POSTSYM..IDENTSYM.);
IF SYMBOL=IDENTSYM THEN
BEGIN
POSTNR:=0;
REPEAT
POSTNR:=POSTNR+1
UNTIL (FILINFO(0).FELTINF(POSTNR).FELTNAVN=SYM) OR
(FILINFO(0).FELTINF(POSTNR).FELTNAVN='@');
IF FILINFO(0).FELTINF(POSTNR).FELTNAVN='@' THEN
WITH FILINFO(0).FELTINF(POSTNR) DO
BEGIN
FELTNAVN:=SYM;
REPEAT
GOTOXY(1,2);
WRITELN('Felttype: REEL:1, HELTAL:2, DOBBTAL:3');
GOTOXY(48,2);READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=3);
CASE OPTION OF
1:BEGIN
FELTTYPE:=REEL;
INDEKS:=TRUNC(POST(0).AAA(0));
POST(0).AAA(0):=POST(0).AAA(0)+1.0
END;
2:BEGIN
FELTTYPE:=HELTAL;
INDEKS:=POST(0).A(-4);
POST(0).A(-4):=POST(0).A(-4)+1
END;
3:BEGIN
FELTTYPE:=DOBBTAL;
INDEKS:=POST(0).A(-4);
POST(0).A(-4):=POST(0).A(-4)+2
END
END
END
END;
THIS^.NEXTELEMENT:=FACTØR;
THIS^.GEMREF:=THIS^.NEXTELEMENT^.CVREF;
THIS^.GEMINDEKS:=THIS^.NEXTELEMENT^.CVDEKS;
THIS^.UDTRYKTYPE:=THIS^.NEXTELEMENT^.CVTYPE;
WRITELN('Udtryk');
GOTOXY(10,2);
INDSYM;
THIS^.UDTRYK:=EXPR;
THIS^.NEXTELEMENT:=NIL;
THIS^.NEXTELEMENT:=VANDRET;
BEREGNING:=THIS
END;
(*$P*)
FUNCTION IOKOMM:ELEMENT;
VAR FILNR,OPTION,MODE:INTEGER;
THIS:ELEMENT;
BEGIN
CLEARSCREEN;
WRITELN('Læs: 1, Skriv: 2');
REPEAT
GOTOXY(18,1);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=2);
WRITELN('MODE (se behandling af INDKOMMANDO i UDFØR i LISTE)');
REPEAT
GOTOXY(54,2);
READLN;READ(MODE)
UNTIL (IORESULT=0) AND (MODE MOD 10>=1) AND (MODE MOD 10<=3) AND
(MODE DIV 10<=5);
REPEAT
GOTOXY(1,3);
WRITELN('Post');
GOTOXY(6,3);
INDSYM;
IF SYMBOL<>IDENTSYM THEN SYNTFEJL(IDENTSYM);
FILNR:=0;
REPEAT
FILNR:=FILNR+1
UNTIL (FILNR=MAXFILES) OR (FILINFO(FILNR).POSTNAVN=SYM);
IF FILINFO(FILNR).POSTNAVN<>SYM THEN SYNTFEJL(IDENTSYM)
UNTIL FILINFO(FILNR).POSTNAVN=SYM;
IF FILINFO(FILNR).USENR=0 THEN
BEGIN
REPEAT
FILINFO(FILNR).USENR:=FILINFO(FILNR).USENR+1
UNTIL LISTEHOVED^.FILES(FILINFO(FILNR).USENR)=0;
LISTEHOVED^.FILES(FILINFO(FILNR).USENR):=FILNR
END;
IF OPTION=1 THEN
BEGIN
NEW(THIS,INDKOMMANDO);
THIS^.ELEMENTTYPE:=INDKOMMANDO;
THIS^.GETFILREF:=FILINFO(FILNR).USENR;
THIS^.GETMODE:=MODE;
THIS^.FØRSTNØGL:=NIL (*KAN EVT. UDVIDES*)
END
ELSE
BEGIN
NEW(THIS,UDKOMMANDO);
THIS^.ELEMENTTYPE:=UDKOMMANDO;
THIS^.PUTFILREF:=FILINFO(FILNR).USENR;
THIS^.PUTMODE:=MODE
END;
THIS^.NEXTELEMENT:=NIL;
THIS^.NEXTELEMENT:=VANDRET;
IOKOMM:=THIS
END;
(*$P*)
FUNCTION VANDRET; (*:ELEMENT*)
VAR OPTION:INTEGER;
BEGIN
IF CHANGING THEN VANDRET:=NIL ELSE
REPEAT
IF SINGLE THEN CHANGING:=TRUE;
CLEARSCREEN;
WRITELN('1 Gentagelse');
WRITELN('2 Billede');
WRITELN('3 Felt');
WRITELN('4 Beregning');
WRITELN('5 I/O-kommando');
WRITELN('6 Afslut');
WRITELN('7 Oplys');
REPEAT
GOTOXY(1,15);
WRITELN('Vælg 1-7');
GOTOXY(10,15);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=7);
CASE OPTION OF
1:VANDRET:=GENTAGELSE;
2:VANDRET:=BILLEDE;
3:VANDRET:=FIELD;
4:VANDRET:=BEREGNING;
5:VANDRET:=IOKOMM;
6:VANDRET:=NIL;
7:OPLYS
END
UNTIL OPTION<>7
END;
(*$P*)
FUNCTION LODRET; (*:ELEMENT*)
VAR OPTION:INTEGER;
BEGIN
IF CHANGING THEN LODRET:=NIL ELSE
REPEAT
IF SINGLE THEN CHANGING:=TRUE;
CLEARSCREEN;
WRITELN('1 Gentagelse');
WRITELN('2 Billede');
WRITELN('3 Afslut');
WRITELN('4 Oplys');
REPEAT
GOTOXY(1,15);
WRITELN('Vælg 1-4');
GOTOXY(10,15);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=1) AND (OPTION<=4);
CASE OPTION OF
1:LODRET:=GENTAGELSE;
2:LODRET:=BILLEDE;
3:LODRET:=NIL;
4:OPLYS
END
UNTIL OPTION<>4
END;
(*$P*)
(*$ICHANGE*)
(*$P*)
BEGIN
CHANGING:=FALSE;
SINGLE:=FALSE;
READINFO;
INITTEXT;
AKTULIST.NAVN:='@';
REPEAT
CLEARSCREEN;
WRITELN('Valg af funktion');
GOTOXY(1,5);
WRITELN('0 Færdig');
WRITELN('1 Definition af ny liste');
WRITELN('2 Ændring af eksisterende liste (listeoversigt)');
WRITELN('3 Gem listedefinition');
WRITELN('4 Oplys');
REPEAT
OPTION:=0;
GOTOXY(1,15);
WRITELN('Vælg 0-4');
GOTOXY(10,15);
READLN;READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION>=0) AND (OPTION<=4);
CASE OPTION OF
1:BEGIN
NEW(LISTEHOVED,LISTEDESC);
LISTEHOVED^.ELEMENTTYPE:=LISTEDESC;
FOR I:=1 TO 8 DO LISTEHOVED^.FILES(I):=0;
REPEAT
GOTOXY(1,17);WRITE('Linier pr. side ');READLN;
READ(LISTEHOVED^.LINESPP)
UNTIL (IORESULT=0) AND (LISTEHOVED^.LINESPP>0) AND
(LISTEHOVED^.LINESPP<73);
LISTEHOVED^.NEXTELEMENT:=NIL;
LISTEHOVED^.NEXTELEMENT:=LODRET
END;
2:BEGIN
VÆLGLISTE;
IF AKTULIST.NAVN(1)<>'@' THEN
BEGIN
MOVELEFT(AKTULIST.NAVN,LISTENAVN,8);
INDELEMENT;
CHANGE(LISTEHOVED,LISTENAVN)
END
END;
3:BEGIN
IF AKTULIST.NAVN(1)='@' THEN UDLISTDEF; (*NY LISTE*)
UDELEMENT
END;
4:OPLYS
END
UNTIL OPTION=0;
FNAVN:=' ';
FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);
IF FNAVN(1) IN (.'0'..'8'.) THEN
CHAIN('L *1',CONCAT('HOVED:P1,',FNAVN),QUQ);
IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.