home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / compiler / m2mmdemo / isinst / module / occurdem.mod < prev    next >
Encoding:
Text File  |  1989-02-27  |  12.4 KB  |  390 lines
  1.  
  2. MODULE OccurDemo;
  3.   (*---------------------------------------------------------------------*)
  4.   (*                         O C C U R - D E M O                         *)
  5.   (*                           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: 30/01/88                                    *)
  12.   (*  Version 2.0      Date: 02/07/88                                    *)
  13.   (*  Version 2.1      Date: 28/09/88       Angepasst auf M2Prolib V3.03 *)
  14.   (*                                        und neue Funktionen eingebaut*)
  15.   (*---------------------------------------------------------------------*)
  16.   FROM SYSTEM IMPORT ADR, SIZE;
  17.   IMPORT Ascii, Screen, ByteString, HelpDriver;
  18.   FROM KeyDriver IMPORT Further, eDirection, FKeys, DirecOnOff;
  19.   FROM OccurMask IMPORT userFunc, bFieldNum, eLineMode, SetEditMode, 
  20.       CurLine, LastLine, FieldOK, SetField, GetField, LineOK, eEditMode, 
  21.       rFieldDescrip, rOccurDescrip, ActivateOccur, DefineField, 
  22.       TransferLines, InsertLine, EditFields, RestoreFields, EndOccur, 
  23.       eInputMode, InputMode, DisplayInputMode;
  24.   FROM NumConv IMPORT CardToStr, StrToCard;
  25.   FROM String IMPORT Move;
  26.   FROM SystemDef IMPORT eSwitch, eColor, rColor;
  27.   FROM Windows IMPORT eActivate, rWinDescrip, tWindow, ActivateWindow, 
  28.       ActiveWindow, CreateWindow, ChangeWindowPos, DeleteWindow, 
  29.       ResetWindows;
  30.   CONST
  31.     cLinien = 17;
  32.     cArrayLen = 40;
  33.   TYPE
  34.     DataRec = 
  35.       RECORD
  36.         a : ARRAY [0..4] OF CHAR;
  37.         b : ARRAY [0..30] OF CHAR;
  38.         c : ARRAY [0..10] OF CHAR;
  39.         d : ARRAY [0..60] OF CHAR;
  40.       END;
  41.   VAR
  42.     PosY : INTEGER;
  43.     OccurDesc : rOccurDescrip;
  44.     FieldDesc : rFieldDescrip;
  45.     Data : ARRAY [1..cArrayLen] OF DataRec;
  46.     ActualPage, CursorSave : CARDINAL;
  47.     editMode : BOOLEAN;
  48.   (*
  49.     *)
  50.   PROCEDURE Funktion(w : eDirection; VAR W : eDirection): CARDINAL;
  51.     VAR
  52.       Ch : CARDINAL;
  53.       string : ARRAY [0..40] OF CHAR;
  54.       x, y : INTEGER;
  55.     BEGIN
  56.       Ch := 0;
  57.       W := not;
  58.       CASE w OF
  59.       | ESC :
  60.         RestoreFields();
  61.         Ch := 0;
  62.         W := w;
  63.       | F1 :
  64.         IF HelpDriver.CreateHelp('Ocr-HELP.HLP',1) THEN
  65.         END;
  66.       | F2 :
  67.         SetField(4, 'Bühlmann Computer Software & Co.');
  68.       | F3 :
  69.         Screen.InqCursorPos(x, y);
  70.         GetField(4, string);
  71.         Screen.SetCursor(1, 20);
  72.         Screen.ScrPutString('                                          ');
  73.         Screen.SetCursor(1, 20);
  74.         Screen.ScrPutString(string);
  75.         Screen.SetCursor(x, y);
  76.       | F4 :
  77.         Screen.InqCursorPos(x, y);
  78.         IF editMode THEN
  79.           editMode := FALSE;
  80.           Screen.SetCursor(45, 20);
  81.           Screen.ScrPutString(' Field 2 : no edit ');
  82.           SetEditMode(2, noEdit);
  83.         ELSE
  84.           editMode := TRUE;
  85.           Screen.SetCursor(45, 20);
  86.           Screen.ScrPutString(' Field 2 : edit    ');
  87.           SetEditMode(2, optional);
  88.         END;
  89.         Screen.SetCursor(x, y);
  90.       ELSE
  91.         Ch := 0;
  92.         W := w;
  93.       END;
  94.       RETURN Ch;
  95.     END Funktion;
  96.   PROCEDURE CharOK(fieldNum : bFieldNum; VAR ch : CHAR): BOOLEAN;
  97.     VAR
  98.       Flag : BOOLEAN;
  99.     BEGIN
  100.       CASE fieldNum OF
  101.       | 1, 3 :
  102.         RETURN (ch>='0')&(ch<='9');
  103.       | 2 :
  104.         ch := CAP(ch);
  105.       ELSE
  106.       END;
  107.       RETURN TRUE;
  108.     END CharOK;
  109.   (*---------------------------------------------------------------------*)
  110.   PROCEDURE fieldOK(fieldNum : bFieldNum; VAR field : ARRAY OF CHAR): 
  111.       BOOLEAN;
  112.     VAR
  113.       C : CARDINAL;
  114.     BEGIN
  115.       CASE fieldNum OF
  116.       | 1 :
  117.         IF (field[0]>0C)&NOT StrToCard(field,10,C) THEN
  118.           RETURN FALSE;
  119.         END;
  120.       ELSE
  121.       END;
  122.       RETURN TRUE;
  123.     END fieldOK;
  124.   (*---------------------------------------------------------------------*)
  125.   PROCEDURE lineOK(lineNum : CARDINAL): BOOLEAN;
  126.     BEGIN
  127.       RETURN TRUE;
  128.     END lineOK;
  129.   (*---------------------------------------------------------------------*)
  130.   PROCEDURE GetComment(fieldNum : bFieldNum; VAR comment : ARRAY OF 
  131.       CHAR);
  132.     BEGIN
  133.       CASE fieldNum OF
  134.       | 1 :
  135.         Move(
  136.             '│F1 Help│F2 Set Field│F3 Get Field│F4 Edit Mode Field 2│ [0-9]', comment);
  137.       | 2 :
  138.         Move(
  139.             '│F1 Help│F2 Set Field│F3 Get Field│F4 Edit Mode Field 2│ [a->A]', comment);
  140.       | 3 :
  141.         Move(
  142.             '│F1 Help│F2 Set Field│F3 Get Field│F4 Edit Mode Field 2│ [0-9] obligatory', comment);
  143.       | 4 :
  144.         Move('│F1 Help│F2 Set Field│F3 Get Field│F4 Edit Mode Field 2│', comment);
  145.       ELSE
  146.       END;
  147.     END GetComment;
  148.   (*---------------------------------------------------------------------*)
  149.   PROCEDURE InsertProc(LineNum, CurLine : CARDINAL);
  150.     BEGIN
  151.       WITH Data[LineNum] DO
  152.         InsertLine(TRUE, CurLine, a);
  153.         InsertLine(FALSE, CurLine, b);
  154.         InsertLine(FALSE, CurLine, c);
  155.         InsertLine(FALSE, CurLine, d);
  156.       END;
  157.     END InsertProc;
  158.   PROCEDURE TransferProc(LineNum, CurLine : CARDINAL);
  159.     BEGIN
  160.       WITH Data[LineNum] DO
  161.         TransferLines(TRUE, LineNum, CurLine, a);
  162.         TransferLines(FALSE, LineNum, CurLine, b);
  163.         TransferLines(FALSE, LineNum, CurLine, c);
  164.         TransferLines(FALSE, LineNum, CurLine, d);
  165.       END;
  166.     END TransferProc;
  167.   PROCEDURE line(LineMode : eLineMode; CurLine, LineNum, PageNum : 
  168.       CARDINAL): BOOLEAN;
  169.     VAR
  170.       Ind, firstLine, lastLine : CARDINAL;
  171.     BEGIN
  172.       CASE LineMode OF
  173.       | nextLine, prevLine :
  174.         TransferProc(LineNum, CurLine);
  175.         RETURN TRUE;
  176.       | prevPage :
  177.         firstLine := (PageNum-1)*cLinien;
  178.         lastLine := cLinien;
  179.         IF (LastLine DIV cLinien)<PageNum THEN
  180.           lastLine := LastLine MOD cLinien;
  181.         END;
  182.         FOR Ind := 1 TO lastLine DO
  183.           InsertProc(Ind+firstLine, Ind);
  184.         END;
  185.         TransferProc(LineNum, CurLine);
  186.         RETURN TRUE;
  187.       | nextPage :
  188.         firstLine := (PageNum-1)*cLinien;
  189.         lastLine := cLinien;
  190.         IF (LastLine DIV cLinien)<PageNum THEN
  191.           lastLine := LastLine MOD cLinien;
  192.         END;
  193.         FOR Ind := 1 TO lastLine DO
  194.           InsertProc(Ind+firstLine, Ind);
  195.         END;
  196.         TransferProc(LineNum, CurLine);
  197.         RETURN TRUE;
  198.       | newPage :
  199.         INC(LastLine);
  200.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  201.         TransferProc(LineNum, CurLine);
  202.         RETURN TRUE;
  203.       | insLineAbove :
  204.         INC(LastLine);
  205.         IF LineNum<LastLine THEN
  206.           FOR Ind := LastLine TO LineNum+1 BY -1 DO
  207.             Data[Ind] := Data[Ind-1];
  208.           END;
  209.         END;
  210.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  211.         TransferProc(LineNum, CurLine);
  212.         RETURN TRUE;
  213.       | insLineBelow :
  214.         INC(LastLine);
  215.         IF LineNum<LastLine THEN
  216.           FOR Ind := LastLine TO LineNum+1 BY -1 DO
  217.             Data[Ind] := Data[Ind-1];
  218.           END;
  219.         END;
  220.         ByteString.FillBytes(ADR(Data[LineNum]), SIZE(Data[LineNum]), 0C);
  221.         TransferProc(LineNum, CurLine);
  222.         RETURN TRUE;
  223.       | delLine :
  224.         FOR Ind := LineNum+1 TO LastLine DO
  225.           Data[Ind-1] := Data[Ind];
  226.         END;
  227.         DEC(LastLine);
  228.         RETURN TRUE;
  229.       | updateCurPage :
  230.         firstLine := (PageNum-1)*cLinien;
  231.         lastLine := cLinien;
  232.         IF (LastLine DIV cLinien)<PageNum THEN
  233.           lastLine := LastLine MOD cLinien;
  234.         END;
  235.         FOR Ind := 1 TO lastLine DO
  236.           InsertProc(Ind+firstLine, Ind);
  237.         END;
  238.         TransferProc(LineNum, CurLine);
  239.         RETURN TRUE;
  240.       ELSE
  241.       END;
  242.       RETURN FALSE;
  243.     END line;
  244.   PROCEDURE MakeScreen();
  245.     VAR
  246.       Ind : INTEGER;
  247.     BEGIN
  248.       Screen.SetCursor(0, 1);
  249.       FOR Ind := 1 TO 78 DO
  250.         Screen.ScrPutChar('─');
  251.       END;
  252.       Screen.SetCursor(5, 1);
  253.       Screen.ScrPutChar('┬');
  254.       Screen.SetCursor(26, 1);
  255.       Screen.ScrPutChar('┬');
  256.       Screen.SetCursor(37, 1);
  257.       Screen.ScrPutChar('┬');
  258.       (**)
  259.       FOR Ind := 2 TO 18 DO
  260.         Screen.SetCursor(5, Ind);
  261.         Screen.ScrPutChar('│');
  262.         Screen.SetCursor(26, Ind);
  263.         Screen.ScrPutChar('│');
  264.         Screen.SetCursor(37, Ind);
  265.         Screen.ScrPutChar('│');
  266.       (**)
  267.       END;
  268.       Screen.SetCursor(0, 19);
  269.       FOR Ind := 1 TO 78 DO
  270.         Screen.ScrPutChar('─');
  271.       END;
  272.       Screen.SetCursor(5, 19);
  273.       Screen.ScrPutChar('┴');
  274.       Screen.SetCursor(26, 19);
  275.       Screen.ScrPutChar('┴');
  276.       Screen.SetCursor(37, 19);
  277.       Screen.ScrPutChar('┴');
  278.     END MakeScreen;
  279.   PROCEDURE displayInputMode();
  280.     BEGIN
  281.       IF InputMode=overtype THEN
  282.         Screen.SetCursorType(CursorSave);
  283.       ELSE
  284.         Screen.SetCursorType(0DH);
  285.       END;
  286.     END displayInputMode;
  287.   (*-----------------------------------------------------------------------*)
  288.   PROCEDURE ActualLine(line : CARDINAL);
  289.     VAR
  290.       LinePos : ARRAY [0..10] OF CHAR;
  291.     BEGIN
  292.       Screen.SetCursor(18, 0);
  293.       CardToStr(line, 10, LinePos);
  294.       Screen.ScrPutString('        ');
  295.       Screen.SetCursor(18, 0);
  296.       Screen.ScrPutString(LinePos);
  297.     END ActualLine;
  298.   PROCEDURE WriteScreen();
  299.     VAR
  300.       Ind : CARDINAL;
  301.     BEGIN
  302.       FOR Ind := 1 TO LastLine DO
  303.         Screen.ScrPutString(Data[Ind].a);
  304.         Screen.ScrPutChar(' ');
  305.         Screen.ScrPutString(Data[Ind].b);
  306.         Screen.ScrPutChar(' ');
  307.         Screen.ScrPutString(Data[Ind].c);
  308.         Screen.ScrPutChar(' ');
  309.         Screen.ScrPutString(Data[Ind].d);
  310.         Screen.ScrPutChar(' ');
  311.         Screen.ScrWriteLn();
  312.       END;
  313.     END WriteScreen;
  314.   PROCEDURE Copyright();
  315.     BEGIN
  316.       Screen.ClearScrBound();
  317.       Screen.ScrWriteLn();
  318.       Screen.ScrPutString(
  319.           '          O C C U R - M A S K - D E M O    Version 2.1  ');
  320.       Screen.ScrWriteLn();
  321.       Screen.ScrPutString(
  322.           '                           1 9 8 8                 ');
  323.       Screen.ScrWriteLn();
  324.       Screen.ScrWriteLn();
  325.       Screen.ScrPutString(
  326.           '                         Copyright by           ');
  327.       Screen.ScrWriteLn();
  328.       Screen.ScrPutString(
  329.           '                 (c) Bühlmann Computer Software    ');
  330.       Screen.ScrWriteLn();
  331.       Screen.ScrPutString(
  332.           '                         CH-8636 Wald              ');
  333.       Screen.ScrWriteLn();
  334.     END Copyright;
  335.   BEGIN
  336.     Copyright();
  337.     DisplayInputMode := displayInputMode;
  338.     CursorSave := Screen.CursorType();
  339.     CurLine := ActualLine;
  340.     ByteString.FillBytes(ADR(Data), SIZE(Data), 0C);
  341.     editMode := TRUE;
  342.     LastLine := 1;
  343.     ActualPage := 1;
  344.     DirecOnOff := TRUE;
  345.     FKeys := Funktion;
  346.     LineOK := lineOK;
  347.     FieldOK := fieldOK;
  348.     WITH OccurDesc DO
  349.       StatusColor.Fore := black;
  350.       StatusColor.Back := white;
  351.       NumOfLines := cLinien;
  352.       WITH OccurAttr DO
  353.         Bound.Upper := 1;
  354.         Bound.Lower := 23;
  355.         Bound.Left := 0;
  356.         Bound.Right := 79;
  357.         Color.Fore := black;
  358.         Color.Back := white;
  359.         Title := ' Occurrency-Mask ';
  360.       END;
  361.     END;
  362.     WITH FieldDesc DO
  363.       Color.Fore := black;
  364.       Color.Back := white;
  365.       ActiveColor.Fore := ltWhite;
  366.       ActiveColor.Back := black;
  367.       FieldChar := 137C;
  368.     END;
  369.     ActivateOccur(OccurDesc, FieldDesc);
  370.     MakeScreen();
  371.     Screen.SetCursor(10, 0);
  372.     Screen.ScrPutString('Line  : 1');
  373.     (**)
  374.     Screen.SetScrColor(FieldDesc.ActiveColor);
  375.     Screen.SetCursor(1, 20);
  376.     Screen.ScrPutString('                                          ');
  377.     Screen.SetCursor(45, 20);
  378.     Screen.ScrPutString(' Field 2 : edit    ');
  379.     Screen.SetScrColor(FieldDesc.Color);
  380.     (**)
  381.     DefineField(1, 2, optional, 4, 4);
  382.     DefineField(6, 2, optional, 30, 20);
  383.     DefineField(27, 2, obligatory, 10, 10);
  384.     DefineField(38, 2, optional, 60, 39);
  385.     TransferProc(1, 1);
  386.     EditFields(userFunc, CharOK, line, GetComment);
  387.     EndOccur();
  388.     WriteScreen();
  389.   END OccurDemo.
  390.