DataMuseum.dk

top - metrics - download

    Length: 3105 (0xc21)
    Notes: Mikados TextFile, Mikados_K
    Names: »1EDITFIL«

└─⟦8b7ba91bd⟧ Bits:30003596 MIK/MIKADOS diskette DDE COMAL-80 version 2.2, Pascal kildetekster
    └─⟦this⟧ »1EDITFIL« 

Text

PROGRAM CONVERT;
(*OUTPUT,LIST,RBCFILE,WORKFILE*) 
CONST
  TXT1ERROR             = 'TRANSMITTING FROM NCR TO SPC/1 - NOT TRUE';
  TXT2ERROR             = 'RBC-FILE IS NOT A 572 - SYSTEMFILE';
  TXT3ERROR             = 'TYPE - SUPPOSED TO BE ''10''';
  TXT4ERROR             = 'THE FIRST RECORD IS NOT A LEGO-HEADER';
  TXT5ERROR             = 'THE FIRST RECORD IS NOT A START-HEADER';
  TXT6ERROR             = 'TWO START/STOP HEADERS FOLLOWING';
  TXT7ERROR             = 'NUMBER OF RECORDS DOESN''T FIT';
  TYPEKORT              = '11';
  TIMESTK               = 0.05;
  PROGRAMNAVN           = 'system 572';
  EOFMARK               = 19999;
                                                                 (*$P*)
TYPE
  KSTAT                 = (PRINTED,NOTPRINTED);
  TID                   = RECORD
                            DATO        : PACKED ARRAY (1..10) OF CHAR;
                            KLOKKEN     : PACKED ARRAY (1..8)  OF CHAR;
                          END;
  PARAMETER             = PACKED ARRAY (1..39) OF CHAR;
  RECPOST               = RECORD           
                             START      : INTEGER;
                             SLUT       : INTEGER;
                             PSTATUS    : KSTAT;
                             RSTART     : INTEGER;
                             RSLUT      : INTEGER;
                          END;
VAR
  PARM                  :^PARAMETER;
  UR                    :^TID;
  WORKFIL               : FILE OF RECPOST;
  RBCFIL                : TEXT;
  POST                  : STRING;
  LAND                  : STRING;
  TESTFØLGE             : STRING;
  INIT                  : STRING(4);
  SVAR                  : STRING(1);
  RECTV                 : REAL;
  SIDE                  : INTEGER;
  I                     : INTEGER;
                                                                 (*$P*)
FUNCTION KONV4(TAL:STRING):INTEGER;
VAR      SUMFELT       :INTEGER;
         EXPONENT      :INTEGER;
         X             :INTEGER;
BEGIN
       SUMFELT:=0;
       EXPONENT:=1;
       FOR X:=4 DOWNTO 1 DO
         BEGIN
           SUMFELT:=SUMFELT+(ORD(TAL(X))-48)*EXPONENT;
           EXPONENT:=EXPONENT*10;
         END;
         KONV4:=SUMFELT;
END;
 
FUNCTION K8NV(TAL:STRING):REAL;
VAR
  SUMFELT               : REAL;
  EXPONENT              : REAL;
  X                     : INTEGER;
BEGIN
  SUMFELT:=0;
  EXPONENT:=1;
  FOR X:=8 DOWNTO 1 DO
    BEGIN
      SUMFELT:=SUMFELT+((ORD(TAL(X))-48)*EXPONENT);
      EXPONENT:=EXPONENT*10;
    END;
  K8NV:=SUMFELT;
END;
                                                                 (*$P*)
PROCEDURE IOFAULT(STR: STRING);
VAR
  IOVÆRDI               : INTEGER;
BEGIN
  IOVÆRDI:=IORESULT;
  WRITELN('ERROR NO.  ',IOVÆRDI,'   IN FILE  ',STR);
  WRITELN('PROGRAM ABORTED');
  EXIT(PROGRAM);
END;
 
PROCEDURE NUMASC(VAR STR: STRING; NX : INTEGER);
BEGIN
  STR:='    ';
  STR(1):=CHR((NX DIV 1000)+48);
  STR(2):=CHR(((NX DIV 100) MOD 10)+48);
  STR(3):=CHR(((NX DIV 10) MOD 100)+48);
  STR(4):=CHR((NX MOD 10)+48);
END;
                                                                 (*$P*)
FUNCTION ERROR1:BOOLEAN;
VAR
  CHECKSTRING           : STRING;
BEGIN
  CHECKSTRING:=COPY(POST,16,3400