Power-Programmierung/CD1.mdf/modula2/compiler/m2mmdemo/isinst/module/listdemo.mod

Text File | 1989-02-27 | 8.4 KB | 286 lines

MODULE ListDemo;
  (*---------------------------------------------------------------------*)
  (*                          L I S T - D E M O                          *)
  (*                           M 2 P R O L I B                           *)
  (*  Copyright (C) 1988    Bühlmann Computer Software   CH-8636 WALD    *)
  (*                     -- All Rights Reserved --                       *)
  (*---------------------------------------------------------------------*)
  (*  Author: X. Bühlmann                                                *)
  (*                                                                     *)
  (*  Version 1.0      Date: 30/05/88                                    *)
  (*  Version 1.1      Date: 03/10/88       Angepasst auf M2Prolib V3.03 *)
  (*---------------------------------------------------------------------*)
  FROM SYSTEM IMPORT ADR, SIZE, WORD;
  IMPORT Ascii, SystemDef, Files, Screen, String, ByteString, NumConv;
  FROM SystemDef IMPORT aFileName;
  FROM Random IMPORT SetRandomSeed, RandomCard;
  FROM Keyboard IMPORT KeyPressed, Key;
  FROM PrintSupport IMPORT aKeyTable, KeyTable, TableFile, ReadTable;
  FROM PrintGround IMPORT PrinterInstall, aPrinterCode;
  FROM PrintOut IMPORT PrnError, ePrnError, PrinterReset, ConnectPRN,
      InterfaceTp, Interface, KeyConvert;
  FROM ListDriver IMPORT eFieldType, bFuncGroup, bFields, OpenList,
      CloseList, DefineFields, PrintList, eListStatus, LStatus;
  FROM DateCalc IMPORT aDateType, rCardDateTp, aBtrvDate, BuildToDate,
      DateToBtrvDate;
  CONST
    cPageLen = 50;
    cPort = 'PRN';
  TYPE
    listRec =
      RECORD
        s : ARRAY [0..100] OF CHAR;
        c : CARDINAL;
        i : INTEGER;
        l : LONGINT;
        r : REAL;
        d : aDateType;
        Bd : aBtrvDate;
      END;
  VAR
    ProgramHalt : BOOLEAN;
    Handle : WORD;
    EOF : BOOLEAN;
  (**)
  PROCEDURE read(VAR c : CHAR);
    VAR
      n : CARDINAL;
    BEGIN
      c := 0c;
      n := 1;
      IF Files.FRead(Handle,ADR(c),n) THEN
      END;
      IF (n=0) OR (c=0c) THEN
        c := 12c;
        EOF := TRUE;
      END;
    END read;
  PROCEDURE readStr(VAR s : ARRAY OF CHAR);
    VAR
      xInd : CARDINAL;
      c : CHAR;
    BEGIN
      xInd := 0;
      LOOP
        read(c);
        IF (c>=40c) & (xInd<=HIGH(s)) THEN
          s[xInd] := c;
          INC(xInd);
        END;
        IF c=12c THEN
          EXIT;
        END;
      END;
    END readStr;
  PROCEDURE ReadAsciiFirst(fileName : aFileName; VAR Line : ARRAY OF
      CHAR): BOOLEAN;
    BEGIN
      ByteString.FillBytes(ADR(Line), SIZE(Line), 0c);
      EOF := FALSE;
      IF Files.FOpen(fileName,Files.readAccess,Files.compatibility,
          Files.inherit,Handle) THEN
        readStr(Line);
        RETURN NOT EOF;
      END;
      RETURN FALSE;
    END ReadAsciiFirst;
  PROCEDURE ReadAsciiNext(VAR Line : ARRAY OF CHAR): BOOLEAN;
    BEGIN
      ByteString.FillBytes(ADR(Line), SIZE(Line), 0c);
      readStr(Line);
      RETURN NOT EOF;
    END ReadAsciiNext;
  PROCEDURE CloseAsciiFile();
    BEGIN
      IF Files.FClose(Handle) THEN
        EOF := FALSE;
      END;
    END CloseAsciiFile;
  (*
    *)
  PROCEDURE Handler(error : ePrnError): BOOLEAN;
    VAR
      l :
        RECORD
          chr : CARDINAL;
        END;
    BEGIN
      CASE error OF
      | outOfPaper :
        Screen.ScrPutString(' Printer out of Paper');
        Screen.ScrWriteLn();
      | notBusy :
        Screen.ScrPutString(' Printer not ready ');
        Screen.ScrWriteLn();
      ELSE
        Screen.ScrPutString(' Printer not online or other error ');
        Screen.ScrWriteLn();
      END;
      Screen.ScrPutString(' Esc = abort  /  Return = continue ');
      Screen.ScrWriteLn();
      LOOP
        l.chr := Key();
        CASE l.chr OF
        | ORD(Ascii.cCR) :
          ProgramHalt := FALSE;
          RETURN TRUE;
        | ORD(Ascii.cESC) :
          ProgramHalt := TRUE;
          RETURN FALSE;
        ELSE
        END;
      END;
    END Handler;
  PROCEDURE End(): BOOLEAN;
    BEGIN
      IF KeyPressed() OR ProgramHalt THEN
        IF (Key()#0) OR ProgramHalt THEN
          RETURN TRUE;
        END;
      END;
      RETURN FALSE;
    END End;
  PROCEDURE list();
    VAR
      random, Page, xInd : CARDINAL;
      dbRec : listRec;
    PROCEDURE ListDef();
      BEGIN
        DefineFields(ADR(Page), SIZE(Page), 1, Card, 0);
        WITH dbRec DO
          DefineFields(ADR(s), SIZE(s), 11, Str, 0);
          DefineFields(ADR(c), SIZE(c), 11, Card, 0);
          DefineFields(ADR(i), SIZE(i), 11, int, 0);
          DefineFields(ADR(l), SIZE(l), 11, long, 0);
          DefineFields(ADR(r), SIZE(r), 11, Real, 3);
          DefineFields(ADR(d), SIZE(d), 11, date, 0);
          DefineFields(ADR(Bd), SIZE(Bd), 11, Bdate, 0);
        END;
      END ListDef;
    PROCEDURE RandomNumbers();
      VAR
        xDate : rCardDateTp;
      BEGIN
        IF random<32769 THEN
          random := RandomCard(random);
        ELSE
          random := RandomCard(32000);
        END;
        SetRandomSeed(random);
        WITH dbRec DO
          c := random;
          i := INTEGER(random MOD RandomCard(32000));
          l := LONGINT(random) * LONGINT(10);
          r := FLOAT(random) * FLOAT(random MOD RandomCard(32000)) /
               100.0;
          (**)
          WITH xDate DO
            day := RandomCard(28);
            month := RandomCard(12);
            year := RandomCard(2200);
          END;
          BuildToDate(xDate, d);
          IF DateToBtrvDate(d,Bd) THEN
          END;
          (**)
          WITH xDate DO
            day := RandomCard(28);
            month := RandomCard(12);
            year := RandomCard(2200);
          END;
          BuildToDate(xDate, d);
        END;
      END RandomNumbers;
    BEGIN
      random := 32000;
      ProgramHalt := FALSE;
      TableFile := 'KeyTable.PRN';
      PrinterInstall(cPort);
      ConnectPRN(Interface, TRUE);
      KeyConvert(TRUE);
      IF End() THEN
        ConnectPRN(Interface, FALSE);
        RETURN;
      END;
      (**)
      ListDef();
      IF OpenList('DEMO.LST') THEN
        Page := 1;
        xInd := 0;
        PrintList(1);
        PrintList(6);
        INC(xInd, 6);
        ByteString.FillBytes(ADR(dbRec), SIZE(dbRec), 0c);
        IF ReadAsciiFirst('DEMO.DB',dbRec.s) THEN
          RandomNumbers();
          PrintList(11);
          LOOP
            ByteString.FillBytes(ADR(dbRec), SIZE(dbRec), 0c);
            IF ReadAsciiNext(dbRec.s) THEN
              RandomNumbers();
              PrintList(11);
              INC(xInd, 2);
              IF xInd>cPageLen THEN
                xInd := 6;
                INC(Page);
                PrintList(21);
                PrintList(26);
                PrintList(1);
                PrintList(6);
              END;
            ELSE
              EXIT;
            END;
            IF End() THEN
              EXIT;
            END;
          END;
        ELSE
          Screen.ScrWriteLn();
          Screen.ScrPutString('Data-Base-File DEMO.DB not found');
          Screen.ScrWriteLn();
        END;
        CloseAsciiFile();
        PrintList(21);
        PrintList(26);
        IF CloseList() THEN
        END;
      ELSE
        Screen.ScrWriteLn();
        Screen.ScrPutString('List-File DEMO.LST not found');
        Screen.ScrWriteLn();
      END;
    END list;
  PROCEDURE Copyright();
    BEGIN
      Screen.ClearScrBound();
      Screen.ScrWriteLn();
      Screen.ScrPutString(
          '                L I S T - D E M O    Version 1.1   ');
      Screen.ScrWriteLn();
      Screen.ScrPutString(
          '                           1 9 8 8                 ');
      Screen.ScrWriteLn();
      Screen.ScrWriteLn();
      Screen.ScrPutString(
          '                         Copyright by           ');
      Screen.ScrWriteLn();
      Screen.ScrPutString(
          '                 (c) Bühlmann Computer Software    ');
      Screen.ScrWriteLn();
      Screen.ScrPutString(
          '                         CH-8636 Wald              ');
      Screen.ScrWriteLn();
      Screen.ScrWriteLn();
      Screen.ScrWriteLn();
      Screen.ScrPutString('  Esc = abort ');
      Screen.ScrWriteLn();
    END Copyright;
  BEGIN
    SetRandomSeed(3327);
    EOF := FALSE;
    Copyright();
    list();
  END ListDemo.