home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / compiler / m2mmdemo / isinst / module / odrvdemo.mod < prev    next >
Encoding:
Text File  |  1989-02-27  |  9.0 KB  |  274 lines
  1.  
  2. MODULE ODrvDemo;
  3.   (*---------------------------------------------------------------------*)
  4.   (*                   O C C U R  - D R I V E R - D E M O                *)
  5.   (*  for                      M 2 P R O L I B                           *)
  6.   (*  Copyright (C) 1987    Bühlmann Computer Software   CH-8636 WALD    *)
  7.   (*                     -- All Rights Reserved --                       *)
  8.   (*---------------------------------------------------------------------*)
  9.   (*  Author: X. Bühlmann                                                *)
  10.   (*                                                                     *)
  11.   (*  Version 1.0      Date: 05/02/88                                    *)
  12.   (*  Version 2.0      Date: 10/07/88                                    *)
  13.   (*  Version 2.1      Date: 28/09/88       Angepasst auf M2Prolib V3.03 *)
  14.   (*---------------------------------------------------------------------*)
  15.   FROM SYSTEM IMPORT ADR, SIZE;
  16.   IMPORT Ascii, Screen, ByteString, HelpDriver;
  17.   FROM KeyDriver IMPORT Further, eDirection, FKeys, DirecOnOff;
  18.   FROM OccurDriver IMPORT OccurColor, DefineOccurField, CreateOccur, 
  19.       CloseOccurMask;
  20.   FROM OccurMask IMPORT userFunc, bFieldNum, eLineMode, SetEditMode, 
  21.       CurLine, LastLine, FieldOK, SetField, GetField, LineOK, eEditMode, 
  22.       rFieldDescrip, rOccurDescrip, ActivateOccur, DefineField, 
  23.       TransferLines, InsertLine, EditFields, RestoreFields, EndOccur, 
  24.       eInputMode, InputMode, DisplayInputMode;
  25.   FROM NumConv IMPORT CardToStr, StrToCard;
  26.   FROM String IMPORT Move;
  27.   (*[-CSYS
  28.   FROM WinSupport IMPORT StatuslineColor;
  29.   ]*)
  30.   FROM SpecSupport IMPORT cOccurFields, MonitorType, eMonitorType;
  31.   FROM SystemDef IMPORT eSwitch, eColor, rColor;
  32.   FROM Windows IMPORT eActivate, rWinDescrip, tWindow, ActivateWindow, 
  33.       ActiveWindow, CreateWindow, ChangeWindowPos, DeleteWindow, 
  34.       ResetWindows;
  35.   CONST
  36.     cArrayLen = 25;
  37.   TYPE
  38.     aText = ARRAY [0..80] OF CHAR;
  39.     rData = ARRAY [1..cOccurFields] OF aText;
  40.   VAR
  41.     PosY : INTEGER;
  42.     Data : ARRAY [1..cArrayLen] OF rData;
  43.     Ind, ActualPage, CursorSave, OccurFields, OccurLines : CARDINAL;
  44.     editMode : BOOLEAN;
  45.   (*
  46.     *)
  47.   PROCEDURE Funktion(w : eDirection; VAR W : eDirection): CARDINAL;
  48.     VAR
  49.       Ch : CARDINAL;
  50.     BEGIN
  51.       Ch := 0;
  52.       W := not;
  53.       CASE w OF
  54.       | F1 :
  55.         IF HelpDriver.CreateHelp('Ocr-HELP.HLP',1) THEN
  56.         END;
  57.       ELSE
  58.         Ch := 0;
  59.         W := w;
  60.       END;
  61.       RETURN Ch;
  62.     END Funktion;
  63.   PROCEDURE CharOK(fieldNum : bFieldNum; VAR ch : CHAR): BOOLEAN;
  64.     VAR
  65.       Flag : BOOLEAN;
  66.     BEGIN
  67.       RETURN TRUE;
  68.     END CharOK;
  69.   (*---------------------------------------------------------------------*)
  70.   PROCEDURE fieldOK(fieldNum : bFieldNum; VAR field : ARRAY OF CHAR): 
  71.       BOOLEAN;
  72.     VAR
  73.       C : CARDINAL;
  74.     BEGIN
  75.       RETURN TRUE;
  76.     END fieldOK;
  77.   (*---------------------------------------------------------------------*)
  78.   PROCEDURE lineOK(lineNum : CARDINAL): BOOLEAN;
  79.     BEGIN
  80.       RETURN TRUE;
  81.     END lineOK;
  82.   (*---------------------------------------------------------------------*)
  83.   PROCEDURE GetComment(fieldNum : bFieldNum; VAR comment : ARRAY OF 
  84.       CHAR);
  85.     BEGIN
  86.       Move('│ F1 Help │', comment);
  87.     END GetComment;
  88.   (*---------------------------------------------------------------------*)
  89.   PROCEDURE InsertProc(LineNum, CurLine : CARDINAL);
  90.     VAR
  91.       Ind : CARDINAL;
  92.     BEGIN
  93.       InsertLine(TRUE, CurLine, Data[LineNum][1]);
  94.       FOR Ind := 2 TO OccurFields DO
  95.         InsertLine(FALSE, CurLine, Data[LineNum][Ind]);
  96.       END;
  97.     END InsertProc;
  98.   PROCEDURE TransferProc(LineNum, CurLine : CARDINAL);
  99.     VAR
  100.       Ind : CARDINAL;
  101.     BEGIN
  102.       TransferLines(TRUE, LineNum, CurLine, Data[LineNum][1]);
  103.       FOR Ind := 2 TO OccurFields DO
  104.         TransferLines(FALSE, LineNum, CurLine, Data[LineNum][Ind]);
  105.       END;
  106.     END TransferProc;
  107.   PROCEDURE line(LineMode : eLineMode; CurLine, LineNum, PageNum : 
  108.       CARDINAL): BOOLEAN;
  109.     VAR
  110.       Ind, firstLine, lastLine : CARDINAL;
  111.     BEGIN
  112.       IF LineNum>cArrayLen THEN
  113.         RETURN FALSE;
  114.       END;
  115.       CASE LineMode OF
  116.       | nextLine, prevLine :
  117.         TransferProc(LineNum, CurLine);
  118.         RETURN TRUE;
  119.       | prevPage :
  120.         firstLine := (PageNum-1)*OccurLines;
  121.         lastLine := OccurLines;
  122.         IF (LastLine DIV OccurLines)<PageNum THEN
  123.           lastLine := LastLine MOD OccurLines;
  124.         END;
  125.         FOR Ind := 1 TO lastLine DO
  126.           InsertProc(Ind+firstLine, Ind);
  127.         END;
  128.         TransferProc(LineNum, CurLine);
  129.         RETURN TRUE;
  130.       | nextPage :
  131.         firstLine := (PageNum-1)*OccurLines;
  132.         lastLine := OccurLines;
  133.         IF (LastLine DIV OccurLines)<PageNum THEN
  134.           lastLine := LastLine MOD OccurLines;
  135.         END;
  136.         FOR Ind := 1 TO lastLine DO
  137.           InsertProc(Ind+firstLine, Ind);
  138.         END;
  139.         TransferProc(LineNum, CurLine);
  140.         RETURN TRUE;
  141.       | newPage :
  142.         INC(LastLine);
  143.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  144.         TransferProc(LineNum, CurLine);
  145.         RETURN TRUE;
  146.       | insLineAbove :
  147.         INC(LastLine);
  148.         IF LineNum<LastLine THEN
  149.           FOR Ind := LastLine TO LineNum+1 BY -1 DO
  150.             Data[Ind] := Data[Ind-1];
  151.           END;
  152.         END;
  153.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  154.         TransferProc(LineNum, CurLine);
  155.         RETURN TRUE;
  156.       | insLineBelow :
  157.         INC(LastLine);
  158.         IF LineNum<LastLine THEN
  159.           FOR Ind := LastLine TO LineNum+1 BY -1 DO
  160.             Data[Ind] := Data[Ind-1];
  161.           END;
  162.         END;
  163.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  164.         TransferProc(LineNum, CurLine);
  165.         RETURN TRUE;
  166.       | delLine :
  167.         FOR Ind := LineNum+1 TO LastLine DO
  168.           Data[Ind-1] := Data[Ind];
  169.         END;
  170.         DEC(LastLine);
  171.         RETURN TRUE;
  172.       | updateCurPage :
  173.         firstLine := (PageNum-1)*OccurLines;
  174.         lastLine := OccurLines;
  175.         IF (LastLine DIV OccurLines)<PageNum THEN
  176.           lastLine := LastLine MOD OccurLines;
  177.         END;
  178.         FOR Ind := 1 TO lastLine DO
  179.           InsertProc(Ind+firstLine, Ind);
  180.         END;
  181.         TransferProc(LineNum, CurLine);
  182.         RETURN TRUE;
  183.       ELSE
  184.       END;
  185.       RETURN FALSE;
  186.     END line;
  187.   PROCEDURE displayInputMode();
  188.     BEGIN
  189.       IF InputMode=overtype THEN
  190.         Screen.SetCursorType(CursorSave);
  191.       ELSE
  192.         Screen.SetCursorType(0DH);
  193.       END;
  194.     END displayInputMode;
  195.   (*-----------------------------------------------------------------------*)
  196.   PROCEDURE ActualLine(line : CARDINAL);
  197.     VAR
  198.       LinePos : ARRAY [0..10] OF CHAR;
  199.     BEGIN
  200.       Screen.SetCursor(26, 3);
  201.       CardToStr(line, 10, LinePos);
  202.       Screen.ScrPutString('        ');
  203.       Screen.SetCursor(26, 3);
  204.       Screen.ScrPutString(LinePos);
  205.     END ActualLine;
  206.   PROCEDURE Colors();
  207.     BEGIN
  208.       CASE MonitorType OF
  209.       | color :
  210.         (*[-CSYS
  211.         StatuslineColor(black, green);
  212.         ]*)
  213.         OccurColor(black, white, ltWhite, white, ltWhite, blue);
  214.       | mono :
  215.         (*[-CSYS
  216.         StatuslineColor(black, white);
  217.         ]*)
  218.         OccurColor(white, black, ltWhite, black, black, white);
  219.       | spec :
  220.         (*[-CSYS
  221.         StatuslineColor(black, white);
  222.         ]*)
  223.         OccurColor(white, black, ltWhite, black, black, white);
  224.       END;
  225.     END Colors;
  226.   PROCEDURE Copyright();
  227.     BEGIN
  228.       Screen.ClearScrBound();
  229.       Screen.ScrWriteLn();
  230.       Screen.ScrPutString(
  231.           '           O C C U R - D R I V E R - D E M O    Version 2.1  ');
  232.       Screen.ScrWriteLn();
  233.       Screen.ScrPutString(
  234.           '                           1 9 8 8                 ');
  235.       Screen.ScrWriteLn();
  236.       Screen.ScrWriteLn();
  237.       Screen.ScrPutString(
  238.           '                         Copyright by           ');
  239.       Screen.ScrWriteLn();
  240.       Screen.ScrPutString(
  241.           '                 (c) Bühlmann Computer Software    ');
  242.       Screen.ScrWriteLn();
  243.       Screen.ScrPutString(
  244.           '                         CH-8636 Wald              ');
  245.       Screen.ScrWriteLn();
  246.     END Copyright;
  247.   BEGIN
  248.     Copyright();
  249.     DisplayInputMode := displayInputMode;
  250.     CursorSave := Screen.CursorType();
  251.     CurLine := ActualLine;
  252.     ByteString.FillBytes(ADR(Data), SIZE(Data), 0C);
  253.     editMode := TRUE;
  254.     LastLine := 1;
  255.     ActualPage := 1;
  256.     DirecOnOff := TRUE;
  257.     FKeys := Funktion;
  258.     LineOK := lineOK;
  259.     FieldOK := fieldOK;
  260.     Colors();
  261.     (**)
  262.     IF CreateOccur('DEMO.OCR',
  263.         1,OccurFields,OccurLines) & (OccurFields>0) & (OccurLines>1) THEN
  264.       FOR Ind := 1 TO OccurFields DO
  265.         DefineOccurField(80);
  266.       END;
  267.       (**)
  268.       TransferProc(1, 1);
  269.       EditFields(userFunc, CharOK, line, GetComment);
  270.       CloseOccurMask();
  271.     ELSE
  272.     END;
  273.   END ODrvDemo.
  274.