|
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: 20224 (0x4f00)
Notes: Mikados TextFile, Mikados_K
Names: »TIME«
└─⟦73057b25a⟧ Bits:30003619 MIKADOS start diskette (flerbruger)
└─⟦this⟧ »TIME«
PROGRAM MCCOPY(RBCFILE);
(***********************************************************
UDVÆLGER DE(N) "RBCFILE(S)" SOM SKAL KONVERTERES OG PRINTES
DANNER/ÆNDRER FILES: RBCFILE
WORKFILE
KOMFILE
201186 / BS - Fjernet overflødigt check af LEGO-headers.
Indlagt kald af "START"-programmet, hvor
SPC1'erens dato og klokkeslet kan ændres.
*************************************************************)
(*$P*)
CONST
TXT1 = '** ERROR ** NO FILE !';
TXT2 = '** ERROR ** END-RECORD NOT FOUND !';
TYPE
PARAMETER = ARRAY (1..39) OF CHAR;
KLOKKEN = RECORD
QDATE : PACKED ARRAY (1..10) OF CHAR;
QTIME : PACKED ARRAY (1..8) OF CHAR;
END;
DIRECTBUF = PACKED ARRAY (1..10) OF CHAR;
VAR
PARM :^PARAMETER;
UR : ^KLOKKEN;
PCB : ^INTEGER;
RBCFILE : TEXT;
KOMFILE : TEXT;
HEADERTAB : ARRAY (1..200) OF STRING(73);
RESULTTAB : ARRAY (1..200) OF STRING(69);
REC : STRING(77);
RECBACK : STRING(77);
FILDREV : STRING(11);
INVERS : STRING(2);
ENDINVERS : STRING(2);
IOVÆRDI : INTEGER;
X : INTEGER;
Y : INTEGER;
CURSORY : INTEGER;
RECNUMBER : INTEGER;
RECNO : INTEGER;
FILENUMBER : INTEGER;
NIVEAU : INTEGER;
TIMEOK : BOOLEAN;
DOCHECK : BOOLEAN;
ERRORSWITCH : BOOLEAN;
ANSWER : STRING(1);
PROCEDURE SETUP(VAR BUFFER: DIRECTBUF; LENGTH: INTEGER);EXTERNAL;
FUNCTION AVAIL: BOOLEAN;EXTERNAL;
FUNCTION NEXT: CHAR;EXTERNAL;
PROCEDURE FINIS;EXTERNAL;
(*$P*)
SEGMENT PROCEDURE SETTIME;
BEGIN
CLEARSCREEN;
BEGIN
GOTOXY(1,5);
WRITE(' ');
WRITELN('******************************');
WRITE(' ');
WRITELN('* *');
WRITE(' ');
WRITELN('* Spc1-clock: *');
WRITE(' ');
WRITE('* ',UR^.QDATE,' - ');
WRITE(LIST,UR^.QTIME(1));
WRITE(LIST,UR^.QTIME(2));
WRITE('.');
WRITE(LIST,UR^.QTIME(4));
WRITE(LIST,UR^.QTIME(5));
WRITELN(' *');
WRITE(' ');
WRITELN('* *');
WRITE(' ');
WRITELN('******************************');
END;
ANSWER:='N';
REPEAT
GOTOXY(24,20);
WRITE('Is the date and time ok (Y/N) ? ');
EDIT(ANSWER:1);
UNTIL ANSWER(1) IN (.'Y','y','n','N'.);
CLEARSCREEN;
IF ANSWER(1) IN (.'Y','y'.) THEN TIMEOK:=TRUE;
END;
SEGMENT PROCEDURE CHOSEFILES;
PROCEDURE WRITEHEAD;
BEGIN
CLEARSCREEN;
GOTOXY(8,1);
WRITELN('$$ $$ $$$$ $$$$ $$$$ $$$$$ $ $');
GOTOXY(8,2);
WRITELN('$ $ $ $ $ $ $ $ $ $ $');
GOTOXY(8,3);
WRITELN('$ $ $ $ $ $ $$$$$ $');
GOTOXY(8,4);
WRITELN('$ $ $$$$ $$$$ $$$$ $ $');
END;
PROCEDURE WRITEFILES(FNO: INTEGER);
VAR
TABNO : INTEGER;
CURSORY : INTEGER;
CURSORX : INTEGER;
BEGIN
TABNO:=(FNO*2)-1;
CURSORY:=7;
REPEAT
IF HEADERTAB(TABNO,1)=' ' THEN
CURSORX:=7
ELSE
CURSORX:=8;
GOTOXY(1,CURSORY);
WRITE('<Z>',FNO:4);
GOTOXY(CURSORX,CURSORY);
WRITELN(HEADERTAB(TABNO));
GOTOXY(CURSORX,CURSORY+1);
WRITELN('<Z>',HEADERTAB(TABNO+1));
CURSORY:=CURSORY+3;
TABNO:=TABNO+2;
FNO:=FNO+1;
UNTIL CURSORY>19;
END;
PROCEDURE INDEXERROR;
VAR
CHECKSTR : STRING(5);
BACKCHECKSTR : STRING(5);
BEGIN
GOTOXY(11,13);
WRITELN('INDEX ERROR IN TABLE ''HEADERTAB'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
PROCEDURE FINDHEADER;
VAR
CHECKSTR : STRING(5);
BACKCHECKSTR : STRING(5);
BEGIN
GOTOXY(11,12);
WRITE(CHR(27),'^WAIT ! - SEARCHING FOR RBC-FILES',CHR(27),'q');
FILDREV:='RBCFILE:P3';
RESET(RBCFILE,FILDREV);
IF IORESULT<>0 THEN
BEGIN
FILDREV:='RBCFILE:P4';
RESET(RBCFILE,FILDREV);
END;
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(11,13);
WRITELN('ERROR NO.',IOVÆRDI:3,' IN FILE ''RBCFILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
READLN(RBCFILE);READ(RBCFILE,REC);
IF EOF(RBCFILE) THEN
BEGIN
GOTOXY(11,13);
WRITE('NO RECORDS IN ''RBCFILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
HEADERTAB(1):=CONCAT(' ',COPY(REC,1,69),ENDINVERS);
RECBACK :=REC;
READLN(RBCFILE);READ(RBCFILE,REC);
X:=2;
WHILE NOT EOF(RBCFILE) DO
BEGIN
CHECKSTR:=COPY(REC,10,5);
BACKCHECKSTR:=COPY(RECBACK,10,5);
IF (CHECKSTR='START') AND
(BACKCHECKSTR<>'STOP ') THEN
BEGIN
HEADERTAB(X):=CONCAT(' ',COPY(RECBACK,1,69),ENDINVERS);
X:=X+1;
HEADERTAB(X):=CONCAT(' ',COPY(REC,1,69),ENDINVERS);
X:=X+1;
IF ((X DIV 2) * 2) <> X THEN INDEXERROR;
END;
IF (BACKCHECKSTR='STOP ') AND
(CHECKSTR<>'START') THEN
BEGIN
HEADERTAB(X):=CONCAT(' ',COPY(RECBACK,1,69),ENDINVERS);
X:=X+1;
HEADERTAB(X):=CONCAT(' ',COPY(REC,1,69),ENDINVERS);
X:=X+1;
IF ((X DIV 2) * 2) <> X THEN INDEXERROR;
END;
IF (COPY(REC,2,7)='BC LEGO') AND
(COPY(RECBACK,2,7)='BC LEGO') THEN
BEGIN
HEADERTAB(X):=CONCAT(' ',COPY(RECBACK,1,69),ENDINVERS);
X:=X+1;
HEADERTAB(X):=CONCAT(' ',COPY(REC,1,69),ENDINVERS);
X:=X+1;
IF (CHECKSTR='START')
AND (((X DIV 2) * 2) <> X) THEN INDEXERROR;
IF (CHECKSTR='STOP ')
AND (((X DIV 2) * 2) = X) THEN INDEXERROR;
END;
RECBACK:=REC;
READLN(RBCFILE);READ(RBCFILE,REC);
END;
HEADERTAB(X):=CONCAT(' ',COPY(REC,1,69),ENDINVERS);
CLOSE(RBCFILE);
(* FJERNER ALLE HEADERS - STARTENDE MED STJENE *)
X:=1;NIVEAU:=0;
REPEAT
IF HEADERTAB(X,3)='*' THEN
NIVEAU:=NIVEAU-1
ELSE
HEADERTAB(X+NIVEAU):=HEADERTAB(X);
X:=X+1;
UNTIL (X>200) OR (HEADERTAB(X)=' ');
FOR Y:=X+NIVEAU TO 200 DO HEADERTAB(Y):=' ';
END;
PROCEDURE FINDFILES;
VAR
DATBUF : DIRECTBUF;
XCHAR : CHAR;
NCHAR : INTEGER;
FILENO : INTEGER;
TABNO : INTEGER;
CURSORY : INTEGER;
BEGIN
FILENO:=1;
CURSORY:=7;
GOTOXY(1,5);
WRITELN(CHR(27),'Y');
WRITEFILES(FILENO);
GOTOXY(1,21);
WRITELN('USE FOLLOWING KEYS : ^ v (arrows up/down)');
GOTOXY(23,22);
WRITELN('S (select)');
GOTOXY(23,23);
WRITELN('C (continue)');
GOTOXY(23,24);
WRITE ('Q (quit)');
GOTOXY(4,CURSORY);
ERRORSWITCH:=FALSE;
SETUP(DATBUF,8);
REPEAT
WHILE NOT AVAIL DO;
XCHAR:=NEXT;
IF ERRORSWITCH THEN
BEGIN
GOTOXY(51,21);
WRITELN('<Z>');
ERRORSWITCH:=FALSE;
END;
NCHAR:=ORD(XCHAR);
CASE NCHAR OF
11 : BEGIN
FILENO:=FILENO-1;
CURSORY:=CURSORY-3;
IF FILENO < 1 THEN
BEGIN
FILENO:=1;
CURSORY:=7;
END
ELSE
IF CURSORY<7 THEN
BEGIN
CURSORY:=7;
WRITEFILES(FILENO);
END;
GOTOXY(4,CURSORY);
END;
10 : BEGIN
CURSORY:=CURSORY+3;
FILENO:=FILENO+1;
IF FILENO > 100 THEN
BEGIN
FILENO:=100;
CURSORY:=19;
END
ELSE
IF CURSORY>19 THEN
BEGIN
CURSORY:=19;
WRITEFILES(FILENO-4);
END;
GOTOXY(4,CURSORY);
END;
83,115 : BEGIN
TABNO:=(FILENO-1)+FILENO;
IF HEADERTAB(TABNO)=' ' THEN
BEGIN
GOTOXY(51,21);
WRITELN(CHR(7),CHR(27),'^',TXT1,CHR(27),'q');
GOTOXY(4,CURSORY);
ERRORSWITCH:=TRUE;
END
ELSE
BEGIN
INVERS:=' ';
IF HEADERTAB(TABNO,2)=' ' THEN
BEGIN
INVERS(1):=CHR(27);
INVERS(2):='j';
END;
HEADERTAB(TABNO,1):=INVERS(1);
HEADERTAB(TABNO,2):=INVERS(2);
HEADERTAB(TABNO+1,1):=INVERS(1);
HEADERTAB(TABNO+1,2):=INVERS(2);
X:=(CURSORY-7) DIV 3;
WRITEFILES(FILENO-X);
GOTOXY(4,CURSORY);
END;
END;
27,81,113 : BEGIN
FINIS;
GOTOXY(1,5);
WRITELN(CHR(27),'Y');
GOTOXY(1,22);
WRITELN('NO CHANGE IS MADE');
WRITELN('END OF MCCOPY');
EXIT(PROGRAM);
END;
END;
UNTIL (XCHAR='C') OR (XCHAR='c');
GOTOXY(1,5);
WRITELN(CHR(27),'Y');
FINIS;
END;
BEGIN
ENDINVERS :=' ';
ENDINVERS(1):=CHR(27);
ENDINVERS(2):='k';
FOR IOVÆRDI:=1 TO 200 DO HEADERTAB(IOVÆRDI):=' ';
WRITEHEAD;
FINDHEADER;
FINDFILES;
END;
(*$P*)
SEGMENT PROCEDURE FILECOPY;
VAR
DATBUF : DIRECTBUF;
XCHAR : CHAR;
PROCEDURE CHECKHEADER(STR : STRING);
VAR
TALSTR : STRING(8);
TAL1 : REAL;
TAL2 : REAL;
EXP : REAL;
ERROR1 : BOOLEAN;
ERROR2 : BOOLEAN;
ERROR3 : BOOLEAN;
BEGIN
ERROR1:=FALSE;
ERROR2:=FALSE;
ERROR3:=FALSE;
IF COPY(REC,10,5) <> STR THEN ERROR1:=TRUE;
IF COPY(REC,16,21) <> 'TO SPC/1 FROM NCR ' THEN ERROR2:=TRUE;
IF STR='STOP ' THEN
BEGIN
TALSTR:=COPY(REC,70,8);
TAL1 :=0;
TAL2 :=0;
EXP :=1;
FOR Y:=8 DOWNTO 1 DO
BEGIN
TAL1:=TAL1+((ORD(TALSTR(Y))-48)*EXP);
EXP :=EXP*10;
END;
TAL2:=RECNO;
IF TAL1<>TAL2 THEN ERROR3:=TRUE;
END;
IF ERROR1 THEN WRITELN
('** ERROR ** THIS IS NOT A ',STR,'-HEADER');
IF ERROR2 THEN WRITELN
('** ERROR ** THIS FILE IS NOT ''TO SPC/1 FROM NCR''');
IF ERROR3 THEN WRITELN
('** ERROR ** NUMBER OF RECORDS DOESN''T FIT');
IF ERROR1 OR ERROR2 OR ERROR3 THEN
BEGIN
WRITELN(REC);
GOTOXY(1,23);
WRITELN('PROGRAM ABORTED');
EXIT(MCCOPY);
END;
END;
PROCEDURE FILECOP1;
BEGIN
IF DOCHECK THEN CHECKHEADER('START');
RECNO:=1;
WRITELN(KOMFILE,REC);
REPEAT
READLN(RBCFILE);READ(RBCFILE,REC);
WRITELN(KOMFILE,REC);
RECNO:=RECNO+1;
UNTIL (COPY(REC,1,69)=RESULTTAB(X+1)) OR (EOF(RBCFILE));
IF EOF(RBCFILE) THEN
BEGIN
GOTOXY(11,12);
WRITELN(CHR(27),'^',TXT2,CHR(27),'q');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
IF DOCHECK THEN CHECKHEADER('STOP ');
RECNUMBER:=RECNUMBER+RECNO;
END;
BEGIN
GOTOXY(1,5);
WRITELN(CHR(27),'Y');
RECNUMBER:=0;
FILENUMBER:=0;
RESET(RBCFILE,FILDREV);
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(11,12);
WRITELN('ERROR NO.',IOVÆRDI:3,' IN FILE ''RBC-FILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
REWRITE(KOMFILE,'KOMFILE:P2:5:K');
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(11,13);
WRITELN('ERROR NO.',IOVÆRDI:3,' IN FILE ''RBCFILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
(* Overflødigt check fjernet nov 86 /bs
SETUP(DATBUF,8);
GOTOXY(1,7);
WRITE('CHECK OF LEGO-HEADERS ? (Y/N) ');
REPEAT
WHILE NOT AVAIL DO ;
XCHAR:=NEXT;
UNTIL XCHAR IN (.'Y','y','n','N'.);
GOTOXY(33,7);
IF XCHAR IN (.'Y','y'.) THEN
WRITELN('Yes')
ELSE
WRITELN('No ');
FINIS;
IF XCHAR IN (.'Y','y'.) THEN
DOCHECK:=TRUE
ELSE
DOCHECK:=FALSE;
*)
DOCHECK:=FALSE;
GOTOXY(1,10);
WRITELN('COPYING FILES FROM ''RBCFILE'' TO ''KOMFILE''');
FOR X:=1 TO 200 DO
RESULTTAB(X):=' ';
X:=1;Y:=1;
WHILE HEADERTAB(X)<>' ' DO
BEGIN
IF HEADERTAB(X,1)=CHR(27) THEN
BEGIN
RESULTTAB(Y):=COPY(HEADERTAB(X),3,69);
Y:=Y+1;
END;
X:=X+1;
END;
X:=1;
READLN(RBCFILE);READ(RBCFILE,REC);
REPEAT
IF COPY(REC,1,69)=RESULTTAB(X) THEN
BEGIN
FILENUMBER:=FILENUMBER+1;
RECNO:=1;
FILECOP1;
X:=X+2;
END;
READLN(RBCFILE);READ(RBCFILE,REC);
UNTIL EOF(RBCFILE) OR (RESULTTAB(X)=' ');
GOTOXY(1,12);
WRITELN('NUMBER OF RECORDS COPIED ',RECNUMBER:4);
WRITELN('NUMBER OF FILES COPIED ',FILENUMBER:4);
CLOSE(RBCFILE);
CLOSE(KOMFILE);
END;
(*$P*)
SEGMENT PROCEDURE COMPRBCFILE;
VAR
WORKFILE : TEXT;
BEGIN
RESET(RBCFILE,FILDREV);
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(1,16);
WRITELN('ERROR NO.',IOVÆRDI,' IN ''RBCFILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
REWRITE(WORKFILE,'WORKFIL:P2:10:K');
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(1,16);
WRITELN('ERROR NO.',IOVÆRDI:3,' IN FILE ''W-FILE'' - ABORTED');
GOTOXY(1,23);
EXIT(MCCOPY);
END;
(* FILERNE ER ÅBNE *)
X:=1;Y:=1;
REPEAT
IF HEADERTAB(X,1)=CHR(27) THEN
BEGIN
RESULTTAB(X):=COPY(HEADERTAB(X),3,69);
Y:=Y+1;
END;
X:=X+1;
UNTIL (X>200) OR (HEADERTAB(X)=' ');
(* --RESULTATTAB-- INDEHOLDER DE FILES, SOM SKAL MARKERES *)
X:=1;
READLN(RBCFILE);READ(RBCFILE,REC);
REPEAT
IF COPY(REC,1,69)=RESULTTAB(X) THEN
BEGIN
REC(1):='*';
X:=X+1;
END;
WRITELN(WORKFILE,REC);
READLN(RBCFILE);READ(RBCFILE,REC);
UNTIL EOF(RBCFILE);
CLOSE(RBCFILE);
CLOSE(WORKFILE);
(* --WORKFILE-- INDEHOLDER DEN KORREKTE RBCFILE *)
RESET(WORKFILE,'WORKFIL:P2');
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(1,16);
WRITELN('ERROR NO.',IOVÆRDI,' IN ''WORKFILE'' - ABORRTED');
GOTOXY(1,23);
EXIT(PROGRAM);
END;
REWRITE(RBCFILE,FILDREV);
IF IORESULT<>0 THEN
BEGIN
IOVÆRDI:=IORESULT;
GOTOXY(1,16);
WRITELN('ERROR NO.',IOVÆRDI,' IN ''RBCFILE'' - ABORRTED');
GOTOXY(1,23);
EXIT(PROGRAM);
END;
READLN(WORKFILE);READ(WORKFILE,REC);
REPEAT
WRITELN(RBCFILE,REC);
READLN(WORKFILE);READ(WORKFILE,REC);
UNTIL EOF(WORKFILE);
CLOSE(RBCFILE);
CLOSE(WORKFILE);
(* MARKERING AF FILE-HEADERS I RBCFILE OK *)
END;
(*$P*)
(*$P*)
BEGIN
TIMEOK:=FALSE;
SETTIME;
(* "TIMEOK" kan sættes til true i proceduren "SETTIME" *)
IF TIMEOK THEN
BEGIN
CHOSEFILES;
FILECOPY;
COMPRBCFILE;
GOTOXY(1,23);
WRITELN('END OF MCCOPY');
END;
IF NOT TIMEOK THEN
BEGIN
CHAIN('START *1',' ',PCB);
CHAIN('MCCOPY *1',' ',PCB);
END;
END.