Topspeed_JPI/TS-V3/MODBASE/PRINTERU.LST

Listing:

    1  IMPLEMENTATION MODULE PrinterUtils;
    2  (*
    3   *  ModBase
    4   *  Release 3.0
    5   *  (c) Copyright 1986 - 1991 PMI
    6   *  P.O. Box 8402
    7   *  Green Bay Wi 53308
    8   *  All Rights Reserved
    9   *  by Ed Ross  
   10   *)
   11  
   12  FROM SYSTEM IMPORT BYTE,ADR;
   13  FROM DateFunctions IMPORT Date,DateToStr;
   14  FROM StrConv IMPORT RealToStr,CardinalToStr,IntegerToStr,LongIntegerToStr;
   15  FROM StringIO IMPORT WriteEol;
   16  FROM M2Strings IMPORT Length,Assign;
   17  FROM StrEdit IMPORT Center,RightJustify,CrunchBlanks,Append,MakeCurrency;
   18  FROM Storage  IMPORT ALLOCATE,DEALLOCATE;
   19  FROM NumTypes IMPORT Real8;
   20  FROM LowLevel IMPORT Fill;
   21  
   22  TYPE DisplayLine = POINTER TO DisplayRec;
*****                                ^ undeclared identifier
   23  
   24  DisplayRec =  RECORD
   25    Str : POINTER TO ARRAY[0..300] OF CHAR;
*****                              ^ not supported yet
*****                                      ^ not supported yet
   26    NbrBytes : CARDINAL;
   27  END;
*****  ^ not supported yet
   28  
   29  PROCEDURE OverWrite(obj : ARRAY OF CHAR; VAR targ : ARRAY OF CHAR; Pos : CARDINAL);
*****                                     ^ not supported yet
*****                                                               ^ not supported yet
   30  
   31  VAR
   32   J : CARDINAL;
   33   K : CARDINAL;
   34  BEGIN
   35   K := Length(obj) + Pos;
*****        ^ not supported yet
*****               ^ not supported yet
   36   IF K > Length(targ)
*****          ^ not supported yet
*****                 ^ not supported yet
   37     THEN K := Length(targ)
*****               ^ not supported yet
*****                      ^ not supported yet
   38     ELSE K := Length(obj)
*****               ^ not supported yet
*****                      ^ not supported yet
   39     END;
   40   FOR J := 0 TO Length(obj) -1 DO
*****                 ^ not supported yet
*****                        ^ not supported yet
*****                              ^ FOR needs integer variable and bounds
   41     targ[Pos + J] := obj[J];
*****     ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
*****                           ^ not supported yet
   42   END;
   43  
   44  END OverWrite;
*****      ^ not supported yet
   45  
   46  PROCEDURE SetupDisplayLine(VAR PL : DisplayLine; NbrOfCols:CARDINAL);
   47  BEGIN
   48    ALLOCATE(PL,SIZE(PL^));
*****    ^ not supported yet
*****             ^ not supported yet
*****                ^ undeclared identifier
*****                     ^ not supported yet
   49    PL^.NbrBytes := NbrOfCols + 2;
*****    ^ not supported yet
*****        ^ not supported yet
   50    ALLOCATE(PL^.Str,PL^.NbrBytes);
*****    ^ not supported yet
*****             ^ not supported yet
*****                 ^ not supported yet
*****                     ^ not supported yet
*****                         ^ not supported yet
   51  
   52    ClearDisplayLine(PL);
*****    ^ undeclared identifier
*****                     ^ not supported yet
   53  END SetupDisplayLine;
*****      ^ not supported yet
   54  
   55  
   56  PROCEDURE RemoveDisplayLine(VAR PL : DisplayLine);
   57  BEGIN
   58    DEALLOCATE(PL^.Str,PL^.NbrBytes);
*****    ^ not supported yet
*****               ^ not supported yet
*****                   ^ not supported yet
*****                       ^ not supported yet
*****                           ^ not supported yet
   59    DEALLOCATE(PL,SIZE(PL^));
*****    ^ not supported yet
*****               ^ not supported yet
*****                  ^ undeclared identifier
*****                       ^ not supported yet
   60    PL := NIL;
*****    ^ not supported yet
   61  END RemoveDisplayLine;
*****      ^ not supported yet
   62  
   63  
   64  PROCEDURE AddPrintElemt(VAR PL: DisplayLine; elemt: ARRAY OF BYTE; PT : CHAR;
*****                                                               ^ not supported yet
   65            ColNbr, NbrCols : CARDINAL; Justification : CHAR);
   66  TYPE
   67    DTypes  = RECORD
   68      CASE : CHAR OF
*****      ^ not supported yet
*****                  ^ 'POINTER' expected
   69       'R' : R : Real8;
   70      |'I' : I : INTEGER;
   71      |'L' : L : LONGINT;
   72      |'C' : C : CARDINAL;
   73      |'D' : D : Date;
   74      |'S' : S : ARRAY[0..300] OF CHAR; (* string *)
   75      |'$' : Dollar : Real8;   (* Prefix with $ dollar type *)
   76      |'%' : Percent :Real8;   (* percent type  suffix with '%'*)
   77     END;
   78   END;
   79   CharSet = SET OF CHAR;
   80  VAR
   81    P : POINTER TO DTypes;
   82    S : ARRAY [0..300] OF CHAR;
   83    ok : BOOLEAN;
   84  BEGIN	
   85    P := ADR(elemt);
   86    P^.S[NbrCols] :=0C;
   87    CASE PT OF (* first go through the conversions *)
   88     'R','%','$' : RealToStr(P^.R,2,NbrCols,S);
   89    |'I' : IntegerToStr(P^.I,NbrCols,S);
   90    |'C' : CardinalToStr(P^.C,NbrCols,S);
   91    |'L' : LongIntegerToStr(P^.L,NbrCols,S);
   92    |'D' : DateToStr(P^.D,S,ok);
   93           IF NOT ok
   94  	   THEN S:= '?????'
   95  	   END;
   96    END;
   97    IF PT IN CharSet{'R','I','C','L','D','%'}
   98      THEN
   99        Assign( S,P^.S);
  100       END;
  101    IF PT = '%'
  102        THEN  Append(P^.S,'%');
  103      ELSIF PT = 'R'
  104        THEN
  105          MakeCurrency('$',P^.S);
  106  	Assign( P^.S,S);  (* kluge here *)
  107          RightJustify(S,NbrCols);	
  108  	Assign(S,P^.S );
  109  
  110    END;
  111  
  112    CASE Justification OF
  113     'C' : Center(P^.S,NbrCols);
  114    |'R' : RightJustify(P^.S,10);
  115    END;
  116    OverWrite(P^.S,PL^.Str^,ColNbr);
  117    S := S;  (* debug stop *)
  118  END AddPrintElemt;
  119  	
  120  PROCEDURE PrintDisplayLine(PL : DisplayLine; Handle : CARDINAL);
  121  BEGIN
  122    WriteEol(Handle,PL^.Str^);
  123  END PrintDisplayLine;
  124  
  125  PROCEDURE GetDisplayLine(PL : DisplayLine; VAR Display : ARRAY OF CHAR);
  126  BEGIN
  127    Assign(PL^.Str^,Display );
  128  END GetDisplayLine;
  129  
  130  PROCEDURE ClearDisplayLine(VAR PL : DisplayLine);	
  131  BEGIN
  132    Fill(ADR(PL^.Str^),PL^.NbrBytes-1,' ');
  133    PL^.Str^[PL^.NbrBytes-1] := CHR(0);
  134  END ClearDisplayLine;
  135  
  136  END PrinterUtils.

   50 errors