|
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: »MOVETOLI.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »MOVETOLI.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »MOVETOLI.K«
PROCEDURE MOVETOLINE(VAR F:NFELT);
VAR CH:STRING(1);
TAL,DECS,I:INTEGER;
RESULT,DM,DD:REAL;
BEGIN
CH:=' ';
CASE F^.FELTTYPE OF
HELTAL:BEGIN
LINE:=''; (*$R-*)
TAL:=ABS(POST.A(F^.INDEKS)); (*$R+*)
REPEAT
CH(1):=CHR(TAL MOD 10+48);
LINE:=CONCAT(CH,LINE);
TAL:=TAL DIV 10
UNTIL TAL=0;
WHILE LENGTH(LINE)<F^.FORAN0 DO LINE:=CONCAT('0',LINE); (*$R-*)
IF POST.A(F^.INDEKS)<0 THEN LINE:=CONCAT('-',LINE) (*$R+*)
END;
DOBBTAL:BEGIN
LINE:=''; (*$R-*)
RESULT:=ABS(POST.A(F^.INDEKS)*10000.0+POST.A(F^.INDEKS+1));
(*$R+*)
DM:=100000000.0;
REPEAT
I:=TRUNC(RESULT/DM)+48;
RESULT:=RESULT-DM*(I-48);
DM:=DM/10
UNTIL (I>48) OR (DM<1.0);
REPEAT
CH(1):=CHR(I);
LINE:=CONCAT(LINE,CH);
I:=TRUNC(RESULT/DM)+48;
RESULT:=RESULT-DM*(I-48);
DM:=DM/10.0
UNTIL DM<0.09;
WHILE LENGTH(LINE)<F^.FORAN0 DO LINE:=CONCAT('0',LINE);
(*$R-*)
IF POST.A(F^.INDEKS)*10000.0+POST.A(F^.INDEKS+1)<0.0 THEN
LINE:=CONCAT('-',LINE) (*$R+*)
END;
TEKST:BEGIN
LINE:='';
FOR I:=F^.INDEKS TO F^.INDEKS+F^.LÆNGDE-1 DO
BEGIN (*$R-*)
CH(1):=POST.AA(I); (*$R+*)
LINE:=CONCAT(LINE,CH)
END
END;
REEL:BEGIN (*$R-*)
RESULT:=ABS(POST.AAA(F^.INDEKS)); (*$R+*)
DECS:=F^.DEC;
IF DECS=0 THEN
DD:=0.0
ELSE
BEGIN
DD:=0.1;
FOR I:=1 TO DECS DO BEGIN RESULT:=RESULT*10.0;DD:=DD*10 END
END;
LINE:='';
IF F^.FORAN0=0 THEN
BEGIN
DM:=100000000000.0;
REPEAT
I:=TRUNC(RESULT/DM)+48;
RESULT:=RESULT-DM*(I-48);
DM:=DM/10.0
UNTIL (I>48) OR (DM<1.0) OR (DM=DD)
END
ELSE
BEGIN
DM:=1.0;
FOR I:=2 TO F^.FORAN0 DO DM:=DM*10.0;
I:=TRUNC(RESULT/DM)+48;
RESULT:=RESULT-DM*(I-48);
DM:=DM/10.0
END;
REPEAT
CH(1):=CHR(I);
LINE:=CONCAT(LINE,CH);
IF DM=DD THEN LINE:=CONCAT(LINE,'.');
I:=TRUNC(RESULT/DM)+48;
RESULT:=RESULT-DM*(I-48);
DM:=DM/10.0
UNTIL DM<0.09; (*$R-*)
IF POST.AAA(F^.INDEKS)<0.0 THEN LINE:=CONCAT('-',LINE) (*$R+*)
END
END
END;
(*$P*)
PROCEDURE NULPOST;
VAR I,J:INTEGER;
BEGIN
FOR J:=1 TO ANTALFELTER DO WITH PICTURE(J)^ DO
BEGIN
CASE FELTTYPE OF (*$R-*)
HELTAL:POST.A(INDEKS):=0;
DOBBTAL:BEGIN
POST.A(INDEKS):=0;
POST.A(INDEKS+1):=0
END;
REEL:POST.AAA(INDEKS):=0.0;
TEKST:FOR I:=INDEKS TO LÆNGDE+INDEKS-1 DO
POST.AA(I):=' '; (*$R+*)
END
END
END;
PROCEDURE SKRIVFELT(VAR F:NFELT);
BEGIN
IF USERNIVEAU>=F^.KIKKENIVEAU THEN
BEGIN
GOTOXY(F^.UDPOS.X,F^.UDPOS.Y);
WRITE(F^.LEDETEKST,' ');
IF (F^.FELTTYPE=REEL) AND (F^.EDITERING=0) THEN
(*$R-*)
IF F^.DEC>0 THEN
WRITELN(POST.AAA(F^.INDEKS):F^.LÆNGDE:F^.DEC)
ELSE
WRITELN(POST.AAA(F^.INDEKS):F^.LÆNGDE:-2)
(*$R+*)
ELSE
BEGIN
MOVETOLINE(F);
WRITELN(LINE)
END
END
END;
PROCEDURE SKRIVPOST;
VAR I:INTEGER;
BEGIN
CLEARSCREEN;
FOR I:=1 TO ANTALFELTER DO SKRIVFELT(PICTURE(I));
END;
PROCEDURE PRINTPOST;
VAR I:INTEGER;
BEGIN
FOR I:=1 TO ANTALFELTER DO
IF USERNIVEAU>=PICTURE(I)^.KIKKENIVEAU THEN
BEGIN
WRITE(LIST,PICTURE(I)^.LEDETEKST,' ');
MOVETOLINE(PICTURE(I));
LINES:=LINES+1;
WRITELN(LIST,LINE)
END
END;
(*$P*)
PROCEDURE LÆSFELT(VAR F:NFELT);
VAR I,TAL,TAL1:INTEGER;
VAL:NFELT;
RESULT:REAL;
BUMMED:BOOLEAN;
(*$P*)
PROCEDURE LÆSLINIE;
VAR OK:BOOLEAN;
DECS,I,FORTEGN:INTEGER;
DM:REAL;
BEGIN
REPEAT
OK:=FALSE;
RESULT:=0.0;
TAL:=0;
TAL1:=0;
GOTOXY(F^.INDPOS.X,F^.INDPOS.Y);
IF (F^.INDPOS.Y=23) AND (F^.INDPOS.X=1) THEN
BEGIN
WRITELN(' ':79);
GOTOXY(F^.INDPOS.X,F^.INDPOS.Y)
END;
WRITE(' ':LENGTH(F^.LEDETEKST)+LENGTH(F^.FØLGETEKST)+F^.LÆNGDE+2);
GOTOXY(F^.INDPOS.X,F^.INDPOS.Y);
WRITE(F^.LEDETEKST,' ':F^.LÆNGDE+2,F^.FØLGETEKST);
GOTOXY(F^.INDPOS.X+LENGTH(F^.LEDETEKST)+1,F^.INDPOS.Y);
IF F^.EDITERING=0 THEN
BEGIN
READLN;READ(LINE)
END
ELSE
BEGIN
MOVETOLINE(F);
EDIT(LINE:F^.LÆNGDE); (*$R-*)
WHILE LINE(LENGTH(LINE))=' ' DO LINE(0):=CHR(ORD(LINE(0))-1) (*$R+*)
END;
CASE F^.FELTTYPE OF
TEKST:
IF LENGTH(LINE)<=F^.LÆNGDE THEN
BEGIN
OK:=TRUE;
WHILE LENGTH(LINE)<F^.LÆNGDE DO
IF F^.FORAN0>=0 THEN
LINE:=CONCAT(LINE,' ')
ELSE
LINE:=CONCAT(' ',LINE)
END;
HELTAL,DOBBTAL:
IF LENGTH(LINE)>0 THEN
BEGIN
I:=0;
FORTEGN:=1;
IF LINE(1)='-' THEN
BEGIN
FORTEGN:=-1;
I:=1
END;
WHILE LENGTH(LINE)>I DO
BEGIN
OK:=TRUE;
I:=I+1;
IF NOT (LINE(I) IN (.'0'..'9'.)) THEN
BEGIN
OK:=FALSE;
I:=LENGTH(LINE)
END;
RESULT:=10*RESULT+ORD(LINE(I))-48
END;
RESULT:=RESULT*FORTEGN;
IF OK THEN
CASE F^.FELTTYPE OF
HELTAL:IF ABS(RESULT)<=32767 THEN TAL:=TRUNC(RESULT) ELSE OK:=FALSE;
DOBBTAL:IF ABS(RESULT)<=327679999.0 THEN
BEGIN
TAL:=TRUNC(RESULT/10000.0);
TAL1:=TRUNC(RESULT-10000.0*TAL)
END
ELSE OK:=FALSE
END
END ELSE OK:=TRUE;
REEL:
IF LENGTH(LINE)>0 THEN
BEGIN
I:=0;
FORTEGN:=1;
DECS:=-1;
IF LINE(1)='-' THEN
BEGIN
FORTEGN:=-1;
I:=1
END;
WHILE (LENGTH(LINE)>I) AND (DECS<0) DO
BEGIN
OK:=TRUE;
I:=I+1;
IF LINE(I) IN (.'0'..'9'.) THEN
RESULT:=10*RESULT+ORD(LINE(I))-48
ELSE
IF (LINE(I)='.') OR (LINE(I)=',') THEN
DECS:=0
ELSE
BEGIN
OK:=FALSE;
I:=LENGTH(LINE)
END
END;
DM:=1.0;
WHILE LENGTH(LINE)>I DO
BEGIN
I:=I+1;
DM:=DM/10.0;
IF LINE(I) IN (.'0'..'9'.) THEN
BEGIN
RESULT:=RESULT+DM*(ORD(LINE(I))-48);
DECS:=DECS+1
END
ELSE
BEGIN
OK:=FALSE;
I:=LENGTH(LINE)
END
END;
RESULT:=FORTEGN*RESULT;
IF DECS>F^.DEC THEN OK:=FALSE
END
ELSE OK:=TRUE
END
UNTIL OK
END;
(*$P*)
PROCEDURE CHECKVAL;
VAR I,DAT0,MÅNED,ÅR,MODULC:INTEGER;
CPN:ARRAY (1..10) OF INTEGER;
BEGIN
CASE VAL^.VALIDITETSTYPE OF
HINTERVAL:
BUMMED:=((TAL<VAL^.MIN) OR (TAL>VAL^.MAX));
DINTERVAL:
BUMMED:=((TAL*10000.0+TAL1<VAL^.MIN1*10000.0+VAL^.MIN2) OR
(TAL*10000.0+TAL1>VAL^.MAX1*10000.0+VAL^.MAX2));
RINTERVAL:
BUMMED:=((RESULT<VAL^.RMIN) OR (RESULT>VAL^.RMAX));
DATO:
IF LENGTH(LINE)=6 THEN
BEGIN
ÅR:=10*(ORD(LINE(1))-48)+ORD(LINE(2))-48;
MÅNED:=10*(ORD(LINE(3))-48)+ORD(LINE(4))-48;
DAT0:=10*(ORD(LINE(5))-48)+ORD(LINE(6))-48;
IF (DAT0<1) OR (MÅNED<1) OR (MÅNED>12) OR (DAT0>31) THEN BUMMED:=TRUE;
IF NOT BUMMED THEN
CASE MÅNED OF
4,6,9,11: IF DAT0>30 THEN BUMMED:=TRUE;
2: IF (DAT0>29) OR ((DAT0=29) AND (ÅR MOD 4 <>0)) THEN BUMMED:=TRUE
END
END
ELSE BUMMED:=TRUE;
CPR:
IF LENGTH(LINE)=10 THEN
BEGIN
FOR I:=1 TO 10 DO CPN(I):=ORD(LINE(I))-48;
DAT0:=CPN(1)*10+CPN(2);
MÅNED:=CPN(3)*10+CPN(4);
ÅR:=CPN(5)*10+CPN(6);
IF (DAT0<1) OR (MÅNED<1) OR (MÅNED>12) OR (DAT0>31) THEN BUMMED:=TRUE;
IF NOT BUMMED THEN
CASE MÅNED OF
4,6,9,11: IF DAT0>30 THEN BUMMED:=TRUE;
2: IF (DAT0>29) OR ((DAT0=29) AND (ÅR MOD 4<>0)) THEN BUMMED:=TRUE
END;
IF NOT BUMMED THEN
BEGIN
MODULC:=CPN(1)*4+CPN(2)*3+CPN(3)*2+CPN(4)*7+CPN(5)*6+CPN(6)*5+CPN(7)*4+
CPN(8)*3+CPN(9)*2+CPN(10);
IF MODULC MOD 11<>0 THEN BUMMED:=TRUE
END
END
ELSE BUMMED:=TRUE;
END
END;
(*$P*)
(*PROCEDURE LÆSFELT*)
BEGIN
IF USERNIVEAU>=F^.ÆNDRENIVEAU THEN
BEGIN
REPEAT
LÆSLINIE;
VAL:=F^.NÆSTEVAL;
BUMMED:=FALSE;
WHILE (VAL<>NIL) AND (NOT BUMMED) DO
BEGIN
CHECKVAL;
VAL:=VAL^.NÆSTEVAL
END
UNTIL NOT BUMMED;
CASE F^.FELTTYPE OF (*$R-*)
HELTAL:POST.A(F^.INDEKS):=TAL;
DOBBTAL:BEGIN
POST.A(F^.INDEKS):=TAL;
POST.A(F^.INDEKS+1):=TAL1
END;
REEL:POST.AAA(F^.INDEKS):=RESULT;
TEKST:FOR I:=1 TO F^.LÆNGDE DO
POST.AA(I+F^.INDEKS-1):=LINE(I) (*$R+*)
END
END
END;
(*$P*)