home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / screened.mod < prev    next >
Text File  |  1997-12-09  |  17KB  |  459 lines
  1. IMPLEMENTATION MODULE ScreenEditor;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Screen data capture                     *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        9 December 1997                 *)
  9.         (*  Status:                                             *)
  10.         (*      Basic features working, but see faults in       *)
  11.         (*      module RowEditor.                               *)
  12.         (*                                                      *)
  13.         (********************************************************)
  14.  
  15. FROM RowEditor IMPORT
  16.     (* type *)  StructureRow,
  17.     (* proc *)  WriteRow, EditRow, NewRow, CombineRows,
  18.                 CopyOfRow, AdjustRow, DeleteRow, NewList, NewMenu,
  19.                 DumpRow, StartColumn;
  20.  
  21. FROM ListEditor IMPORT
  22.     (* type *)  List, ListFormat;
  23.  
  24. FROM SYSTEM IMPORT
  25.     (* type *)  BYTE, ADDRESS,
  26.     (* proc *)  ADR;
  27.  
  28. FROM Windows IMPORT
  29.     (* type *)  Window,
  30.     (* proc *)  OpenSimpleWindow, CloseWindow, SetCursor, SaveCursor,
  31.     (* proc *)  WriteLn, WriteString, PressAnyKey;      (* for debugging *)
  32.  
  33. FROM NumericIO IMPORT                           (* for debugging *)
  34.     (* proc *)  WriteAddress, WriteCard;
  35.  
  36. FROM Menus IMPORT
  37.     (* type *)  Menu, MenuOption, MO, OffEdgeOption,
  38.     (* proc *)  SetOptions, OffEdge;
  39.  
  40. FROM Keyboard IMPORT
  41.     (* proc *)  InKey, PutBack;
  42.  
  43. FROM FieldEditor IMPORT
  44.     (* var  *)  Byte, Cardinal, Real, String,
  45.     (* type *)  FieldType,
  46.     (* proc *)  DefineFieldType;
  47.  
  48. FROM Storage IMPORT
  49.     (* proc *)  ALLOCATE, DEALLOCATE;
  50.  
  51. (************************************************************************)
  52.  
  53. CONST testing = FALSE;
  54.  
  55. CONST Esc = CHR(27);
  56.  
  57. TYPE
  58.  
  59.     Structure = POINTER TO RowHeader;
  60.  
  61.     (* The fields in a RowHeader record are:                            *)
  62.     (*          pointer:        the row structure for this row          *)
  63.     (*          row:            screen position                         *)
  64.     (*          up, down:       pointers to adjacent rows               *)
  65.  
  66.     RowHeader = RECORD
  67.                     pointer: StructureRow;
  68.                     row: CARDINAL;
  69.                     up, down: Structure;
  70.                 END (*RECORD*);
  71.  
  72. (************************************************************************)
  73. (*                          SCREEN OUTPUT                               *)
  74. (************************************************************************)
  75.  
  76. PROCEDURE WriteStructure (w: Window;  S: Structure);
  77.  
  78.     BEGIN
  79.         WHILE S <> NIL DO
  80.             WITH S^ DO
  81.                 WriteRow (w, pointer, row);
  82.             END (*WITH*);
  83.             S := S^.down;
  84.         END (*WHILE*);
  85.     END WriteStructure;
  86.  
  87. (************************************************************************)
  88. (*                 INTRODUCING A NEW FIELD TO THE SYSTEM                *)
  89. (************************************************************************)
  90.  
  91. PROCEDURE CreateField (VariableAddress: ADDRESS;  ftype: FieldType;
  92.                         screenrow, screencolumn, width: CARDINAL): Structure;
  93.  
  94.     (* Creates a new structure consisting of a single field.  Before    *)
  95.     (* calling this procedure, the caller should make sure, by calling  *)
  96.     (* FieldEditor.DefineFieldType if necessary, that ftype is a type   *)
  97.     (* already known to module FieldEditor.                             *)
  98.  
  99.     VAR result: Structure;
  100.  
  101.     BEGIN
  102.         NEW (result);
  103.         WITH result^ DO
  104.             pointer := NewRow (VariableAddress, ftype, screencolumn, width);
  105.             row := screenrow;
  106.             up := NIL;  down := NIL;
  107.         END (*WITH*);
  108.         RETURN result;
  109.     END CreateField;
  110.  
  111. (************************************************************************)
  112.  
  113. PROCEDURE CardinalField (VAR (*IN*) variable: CARDINAL;
  114.                         screenrow, screencolumn, width: CARDINAL): Structure;
  115.  
  116.     (* Creates a one-field structure for editing the given CARDINAL     *)
  117.     (* variable.                                                        *)
  118.  
  119.     BEGIN
  120.         RETURN CreateField (ADR(variable), Cardinal,
  121.                                         screenrow, screencolumn, width);
  122.     END CardinalField;
  123.  
  124. (************************************************************************)
  125.  
  126. PROCEDURE ByteField (VAR (*IN*) variable: BYTE;
  127.                         screenrow, screencolumn, width: CARDINAL): Structure;
  128.  
  129.     (* Creates a one-field structure for editing a BYTE variable.       *)
  130.  
  131.     BEGIN
  132.         RETURN CreateField (ADR(variable), Byte,
  133.                                         screenrow, screencolumn, width);
  134.     END ByteField;
  135.  
  136. (************************************************************************)
  137.  
  138. PROCEDURE RealField (VAR (*IN*) variable: REAL;
  139.                         screenrow, screencolumn, width: CARDINAL): Structure;
  140.  
  141.     (* Creates a one-field structure for editing a REAL variable.       *)
  142.  
  143.     BEGIN
  144.         RETURN CreateField (ADR(variable), Real,
  145.                                         screenrow, screencolumn, width);
  146.     END RealField;
  147.  
  148. (************************************************************************)
  149.  
  150. PROCEDURE StringField (VAR (*IN*) variable: ARRAY OF CHAR;
  151.                         screenrow, screencolumn, width: CARDINAL): Structure;
  152.  
  153.     (* Creates a one-field structure for editing a character string.    *)
  154.  
  155.     BEGIN
  156.         RETURN CreateField (ADR(variable), String,
  157.                                         screenrow, screencolumn, width);
  158.     END StringField;
  159.  
  160. (************************************************************************)
  161.  
  162. PROCEDURE MenuField (VAR (*IN*) variable: CARDINAL;
  163.                 screenrow, screencolumn, lines, width: CARDINAL;
  164.                                                 M: Menu): Structure;
  165.  
  166.     (* Creates a one-field structure for editing a cardinal variable    *)
  167.     (* via menu selection.  The caller must ensure that M has already   *)
  168.     (* been defined by a call to Menus.                                 *)
  169.  
  170.     VAR result: Structure;
  171.  
  172.     BEGIN
  173.         SetOptions (M, MO{MNoClose,MKeyBack,MNoMouse,MNoTitle,MNoBorder});
  174.         OffEdge (M, return, return, return, return);
  175.         NEW (result);
  176.         WITH result^ DO
  177.             pointer := NewMenu (variable, M, screencolumn, lines, width);
  178.             row := screenrow;
  179.             up := NIL;  down := NIL;
  180.         END (*WITH*);
  181.         RETURN result;
  182.     END MenuField;
  183.  
  184. (************************************************************************)
  185.  
  186. PROCEDURE ListField (VAR (*IN*) variable: List;
  187.                                 screenrow, screencolumn: CARDINAL;
  188.                                         f: ListFormat): Structure;
  189.  
  190.     (* Creates a structure for editing a linear list.  The caller must  *)
  191.     (* ensure that f has been defined by a call to module ListEditor.   *)
  192.  
  193.     VAR result: Structure;
  194.  
  195.     BEGIN
  196.         NEW (result);
  197.         WITH result^ DO
  198.             pointer := NewList (variable, f, screencolumn);
  199.             row := screenrow;
  200.             up := NIL;  down := NIL;
  201.         END (*WITH*);
  202.         RETURN result;
  203.     END ListField;
  204.  
  205. (************************************************************************)
  206. (*                          TEST PROCEDURE                              *)
  207. (************************************************************************)
  208.  
  209. PROCEDURE DumpStructure (S: Structure);
  210.  
  211.     (* For debugging: writes a representation of S to the screen.       *)
  212.  
  213.     VAR w: Window;
  214.  
  215.     BEGIN
  216.         OpenSimpleWindow (w, 0, 10, 0, 79);
  217.         WHILE S <> NIL DO
  218.             WriteLn (w);
  219.             WriteString (w, "Dumping row ");  WriteCard (w, S^.row);
  220.             WriteString (w, " @");  WriteAddress (w, S);
  221.             WriteString (w, ", up = ");  WriteAddress (w, S^.up);
  222.             WriteString (w, ", down = ");  WriteAddress (w, S^.down);
  223.             DumpRow (w, S^.pointer);  S := S^.down;
  224.         END (*WHILE*);
  225.         PressAnyKey(w);
  226.         CloseWindow (w);
  227.     END DumpStructure;
  228.  
  229. (************************************************************************)
  230. (*                        DELETING A STRUCTURE                          *)
  231. (************************************************************************)
  232.  
  233. PROCEDURE DeleteStructure (VAR (*INOUT*) S: Structure);
  234.  
  235.     (* Deallocates the storage which was used in setting up structure   *)
  236.     (* S.  Note that this has nothing to do with the space used by      *)
  237.     (* variables to which S gives access; we delete only the overhead   *)
  238.     (* space which was originally allocated by this module.             *)
  239.  
  240.     VAR temp: Structure;
  241.  
  242.     BEGIN
  243.         WHILE S <> NIL DO
  244.             DeleteRow (S^.pointer);  temp := S^.down;
  245.             DISPOSE(S);  S := temp;
  246.         END (*WHILE*);
  247.     END DeleteStructure;
  248.  
  249. (************************************************************************)
  250. (*                CONSTRUCTING COMPLEX STRUCTURE TYPES                  *)
  251. (************************************************************************)
  252.  
  253. PROCEDURE Combine (VAR (*INOUT*) A: Structure;  B: Structure);
  254.  
  255.     (* Strips all of the fields from B and adds them to the existing    *)
  256.     (* fields of A.  Note that B is destroyed in the process.           *)
  257.  
  258.     VAR previous, current, next, temp: Structure;
  259.  
  260.     BEGIN
  261.         previous := NIL;  current := A;
  262.         WHILE B <> NIL DO
  263.  
  264.             (* Find a place to insert the first element on the B list. *)
  265.  
  266.             LOOP
  267.                 IF current = NIL THEN EXIT (*LOOP*) END (*IF*);
  268.                 next := current^.down;
  269.                 IF B^.row <= current^.row THEN EXIT (*LOOP*) END (*IF*);
  270.                 previous := current;  current := next;
  271.             END (*LOOP*);
  272.  
  273.             IF (current<>NIL) AND (B^.row = current^.row) THEN
  274.  
  275.                 (* Special case: two rows must be merged. *)
  276.  
  277.                 CombineRows (current^.pointer, B^.pointer);
  278.                 temp := B;  B := B^.down;  DISPOSE (temp);
  279.  
  280.             ELSE
  281.  
  282.                 (* Take the whole of the B list, insert it below        *)
  283.                 (* previous^, then take what remains of the original    *)
  284.                 (* destination list and call it the B list.  Swapping   *)
  285.                 (* lists like this is a little unconventional, but it   *)
  286.                 (* works, and in many cases it speeds up the merge.     *)
  287.  
  288.                 IF previous = NIL THEN
  289.                     A := B;
  290.                 ELSE
  291.                     previous^.down := B;
  292.                 END (*IF*);
  293.                 B^.up := previous;  previous := B;  B := current;
  294.                 current := previous^.down;
  295.             END (*IF*);
  296.  
  297.         END (*WHILE*);
  298.         (* DumpStructure (A); *)
  299.  
  300.     END Combine;
  301.  
  302. (************************************************************************)
  303.  
  304. PROCEDURE CopyOf (S: Structure): Structure;
  305.  
  306.     (* Makes a duplicate copy of S.  The variables to be edited are not *)
  307.     (* duplicated; we simply set up a duplicate set of pointers.        *)
  308.  
  309.     VAR result, newrow: Structure;
  310.  
  311.     BEGIN
  312.         result := NIL;
  313.         WHILE S <> NIL DO
  314.             NEW (newrow);
  315.             WITH newrow^ DO
  316.                 pointer := CopyOfRow (S^.pointer);
  317.                 row := S^.row;  up := NIL;  down := NIL;
  318.             END (*WITH*);
  319.             Combine (result, newrow);
  320.             S := S^.down;
  321.         END (*WHILE*);
  322.         RETURN result;
  323.     END CopyOf;
  324.  
  325. (************************************************************************)
  326.  
  327. PROCEDURE AdjustAddresses (S: Structure;  addroffset, rowoffset,
  328.                                                 coloffset: CARDINAL);
  329.  
  330.     (* Adjusts the pointer, row, and column fields of all elements of S *)
  331.     (* by adding the specified offsets to those fields.                 *)
  332.  
  333.     BEGIN
  334.         WHILE S <> NIL DO
  335.             AdjustRow (S^.pointer, addroffset, coloffset);
  336.             INC (S^.row, rowoffset);  S := S^.down;
  337.         END (*WHILE*);
  338.     END AdjustAddresses;
  339.  
  340. (************************************************************************)
  341.  
  342. PROCEDURE MakeArray (VAR (*INOUT*) S: Structure;  count: CARDINAL;
  343.                 addroffset, rowoffset, coloffset: CARDINAL);
  344.  
  345.     (* Creates a structure for an array of count elements, where on     *)
  346.     (* entry S is a structure already created for the first array       *)
  347.     (* element.  Parameter addroffset is the difference between         *)
  348.     (* adjacent array elements.  The remaining two parameters give the  *)
  349.     (* offset on the screen between the starting positions of adjacent  *)
  350.     (* array elements.                                                  *)
  351.     (* In this version, I simply replicate item the required number of  *)
  352.     (* times, making appropriate adjustments to the replicated items.   *)
  353.     (* There is probably a more elegant solution which involves the     *)
  354.     (* invention of a new "replicating" type, but that will take more   *)
  355.     (* thought than I have as yet given to the problem.                 *)
  356.  
  357.     VAR current, copy: Structure;  j: CARDINAL;
  358.  
  359.     BEGIN
  360.         copy := CopyOf(S);
  361.         FOR j := 2 TO count DO
  362.  
  363.             current := copy;
  364.             AdjustAddresses (current, addroffset, rowoffset, coloffset);
  365.  
  366.             (* Save a copy for the next time around the loop, then      *)
  367.             (* incorporate current into the result.                     *)
  368.  
  369.             copy := CopyOf (current);
  370.             Combine (S, current);
  371.  
  372.         END (*FOR*);
  373.         IF testing THEN
  374.             DumpStructure (S);
  375.         END (*IF*);
  376.         DeleteStructure (copy);
  377.     END MakeArray;
  378.  
  379. (************************************************************************)
  380. (*                         EDITING A STRUCTURE                          *)
  381. (************************************************************************)
  382.  
  383. PROCEDURE SetStartingPoint (VAR (*INOUT*) S: Structure;
  384.                                                 screenrow: CARDINAL);
  385.  
  386.     (* On entry, S points to the first row in a structure.  On exit, S  *)
  387.     (* points to the field in that row whose "row" field most           *)
  388.     (* closely matches the second argument to this procedure.           *)
  389.  
  390.     VAR next: Structure;
  391.  
  392.     BEGIN
  393.         IF S = NIL THEN RETURN END (*IF*);
  394.         LOOP
  395.             next := S^.down;
  396.             IF next = NIL THEN EXIT(*LOOP*) END (*IF*);
  397.             IF screenrow <= S^.row THEN
  398.                 EXIT (*LOOP*);
  399.             END (*IF*);
  400.             S := next;
  401.         END (*LOOP*);
  402.     END SetStartingPoint;
  403.  
  404. (************************************************************************)
  405.  
  406. PROCEDURE ScreenEdit (w: Window;  S: Structure;  VAR (*OUT*) abort: BOOLEAN);
  407.  
  408.     (* Displays structure S in window w, and allows the keyboard user   *)
  409.     (* to edit the components of S.  It is assumed that w is already    *)
  410.     (* open and that S has already been fully defined.  Returns         *)
  411.     (* abort=TRUE if user aborted the editing with the Esc key.         *)
  412.  
  413.     VAR nextchar: CHAR;  startrow, startcol: CARDINAL;
  414.  
  415.     BEGIN
  416.         abort := FALSE;
  417.         IF S = NIL THEN
  418.             RETURN;
  419.         END (*IF*);
  420.         SaveCursor (w, startrow, startcol);
  421.         WriteStructure (w, S);
  422.         SetStartingPoint (S, startrow);
  423.         SetCursor (w, S^.row, StartColumn(S^.pointer));
  424.         LOOP
  425.             EditRow (w, S^.pointer, S^.row);
  426.             nextchar := InKey();
  427.             IF nextchar = CHR(0) THEN
  428.                 nextchar := InKey();
  429.                 IF (nextchar = "H") AND (S^.up <> NIL) THEN
  430.                     S := S^.up;
  431.                 ELSIF (nextchar = "P") AND (S^.down <> NIL) THEN
  432.                     S := S^.down;
  433.                 ELSE
  434.                     PutBack (nextchar);  PutBack (CHR(0));
  435.                     EXIT (*LOOP*);
  436.                 END (*IF*);
  437.             ELSIF nextchar = CHR(13) THEN       (* <return> *)
  438.                 IF S^.down <> NIL THEN
  439.                     S := S^.down;
  440.                     SetCursor (w, S^.row, StartColumn(S^.pointer));
  441.                 ELSE
  442.                     EXIT (*LOOP*);
  443.                 END (*IF*);
  444.             ELSIF nextchar = Esc THEN
  445.                 abort := TRUE;
  446.                 EXIT (*LOOP*);
  447.             ELSE
  448.                 PutBack (nextchar);
  449.             END (*IF*);
  450.  
  451.         END (*LOOP*);
  452.  
  453.     END ScreenEdit;
  454.  
  455. (************************************************************************)
  456.  
  457. END ScreenEditor.
  458.  
  459.