Topspeed_JPI/TS-V3/REP16/SCRNUTL2.MOD

IMPLEMENTATION MODULE ScrnUtl2;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/scrnutl2.mov   1.5   10 Mar 1991 15:32:40   coleb  $
 *
 *)



(*
  This module contains utilities that neither ScreenDisplay nor
  InputManager use, but that you may find useful.
*)

FROM ScrnTypes IMPORT DisplayFrameRec;
  (*We have to import this separately because of a bug in Stony
    Brook M2; TSIZE doesn't take qualified identifiers.*)

IMPORT ControlUtils;
IMPORT DspFiles;
IMPORT ErrorNames;
IMPORT FrameManager;
IMPORT FramePainter;
IMPORT GenLists;
IMPORT M2Strings;
IMPORT MsColors;
IMPORT Numbers;
IMPORT PosUtils;
IMPORT ScrnTypes;
IMPORT ScrnUtl1;
IMPORT SYSTEM;
IMPORT VStorage;
IMPORT VWindows;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      ControlUtils.Init();
      DspFiles.Init();
      ErrorNames.Init();
      FrameManager.Init();
      FramePainter.Init();
      GenLists.Init();
      M2Strings.Init();
      MsColors.Init();
      Numbers.Init();
      PosUtils.Init();
      ScrnTypes.Init();
      ScrnUtl1.Init();
      VStorage.Init();
      VWindows.Init();
    END Init;

CONST
  AfterLastElmt = 65535;

  PROCEDURE CloseDisplayFrame(VAR FrameRec : ScrnTypes.DisplayFrame);
    (* disposes of all records and pointers in use by FrameRec.  *)
  BEGIN (* procedure CloseDisplayFrame *)
    ClearFrameStack(FrameRec);
    IF (FrameRec^.FromFile # NIL) THEN
      (*Remember that there may not be a DspFile associated with
        the frame.*)
      IF NOT FrameRec^.SelfSharedWithFile THEN
        GenLists.DisposeList( FrameRec^.self );
         (*We only dispose of the self list, because all the other
           lists are actually sublists of it. *)
      END;
    ELSE
      GenLists.DisposeList( FrameRec^.self );
    END;
    FrameManager.FrameDeactivated( FrameRec );
    VStorage.DosDealloc( FrameRec, SYSTEM.TSIZE(DisplayFrameRec));
      (*Note that we don't dispose of FromFile because some other
        frame may be pointing to it.*)
  END CloseDisplayFrame;


  PROCEDURE CopyEdField( frame1: ScrnTypes.DisplayFrame;
      FieldName1: ARRAY OF CHAR; frame2: ScrnTypes.DisplayFrame;
      FieldName2: ARRAY OF CHAR );
    VAR
      list1, list2: GenLists.GenList;
    BEGIN
      IF 0 # ScrnUtl1.FieldNum( frame1, FieldName1 ) THEN
        IF ScrnUtl1.ListFromEdField( frame1,
            frame1^.CurrentField, list1 ) THEN
          IF 0 # ScrnUtl1.FieldNum( frame2, FieldName2 ) THEN
            GenLists.CopyList( list1, list2 );
            IF ScrnUtl1.ListToEdField( list2, frame2,
                frame2^.CurrentField ) THEN
              RETURN;
            END;
          END;
        END;
      END;
      HALT();
    END CopyEdField;


  PROCEDURE CreateImageElement( VAR TheElmt: ScrnTypes.ImageElement; col,
      row: CARDINAL; ForeColor, BackColor: MsColors.AColor; Attrib:
      MsColors.AMonoAttribute; FieldNum: CARDINAL; VAR TheText: ARRAY OF
      CHAR);
    BEGIN
      TheElmt.row := row;
      TheElmt.col := col;
      TheElmt.foreg := ForeColor;
      TheElmt.backg := BackColor;
      TheElmt.atrb := Attrib;
      TheElmt.field := FieldNum;
      M2Strings.Assign( TheText, TheElmt.text );
    END CreateImageElement;


  PROCEDURE AddImageElement( VAR FrameRec: ScrnTypes.DisplayFrame;
      VAR TheElmt: ScrnTypes.ImageElement; VAR NewImageNum: CARDINAL );
    VAR
      width, LastImage, cnt, LastField: CARDINAL;
      FieldPtr: ScrnTypes.InputFieldPtr;
    BEGIN
      NewImageNum := 1;
      width := M2Strings.Length( TheElmt.text );
      IF NOT GenLists.Initialized( FrameRec^.ImageList ) THEN
        GenLists.NewList( FrameRec^.ImageList );
        ScrnUtl1.PutFrameLists( FrameRec );
          (* Make sure the new ImageList gets inserted into
             FrameRec's .self list. *)
      END;
      LastImage := GenLists.ListLength( FrameRec^.ImageList );
      (* find an image element lower than row *)
      WHILE (NewImageNum <= LastImage) AND
          (ScrnUtl1.VirtualImageRow(FrameRec, NewImageNum) <= TheElmt.row) DO
        INC( NewImageNum );
      END;
      IF (TheElmt.col + width - 1) > FrameRec^.VirtualWidth THEN
        FrameRec^.VirtualWidth := TheElmt.col + width - 1;
      END;
      IF TheElmt.row > FrameRec^.VirtualHeight THEN
        FrameRec^.VirtualHeight := TheElmt.row;
      END;
      ScrnUtl1.EncodeImageRec( TheElmt );
      IF NewImageNum > LastImage THEN
        (* No lower image element found, so we put it at the end of the
           list. *)
        GenLists.ListInsert( TheElmt, GenLists.StrCode,
            FrameRec^.ImageList, AfterLastElmt );
      ELSE
        GenLists.ListInsert( TheElmt, GenLists.StrCode,
            FrameRec^.ImageList, NewImageNum );
          (* Now we have to fix up the field list; every field
             with an ImageNum >= NewImageNum needs its ImageNum
             field incremented. *)
        LastField := ScrnUtl1.FieldListTotal( FrameRec );
        FOR cnt := 1 TO LastField DO
          ScrnUtl1.GetFieldPtr( FrameRec, cnt, FieldPtr );
          IF FieldPtr^.ImageNum >= NewImageNum THEN
            (* Because we're incrementing when ImageNum =
               NewImageNum, you have to add to the ImageList
               before adding to the FieldList when you're adding
               a new field to a frame. *)
            INC( FieldPtr^.ImageNum );
          END;
        END;
      END;
    END AddImageElement;


  PROCEDURE WriteToFrame( VAR FrameRec: ScrnTypes.DisplayFrame; col,
      row: CARDINAL; text: ARRAY OF CHAR );
    VAR
      ImageNum: CARDINAL;
      TmpRec: ScrnTypes.ImageElement;
    BEGIN
      CreateImageElement( TmpRec, col, row, FrameRec^.normfor,
          FrameRec^.normbak, FrameRec^.normatrb, 0, text );
      AddImageElement( FrameRec, TmpRec, ImageNum );
    END WriteToFrame;


  PROCEDURE ChoiceListToFrame( TheList: GenLists.GenList; TheFrame:
      ScrnTypes.DisplayFrame );
    VAR
      cnt, lngth, TypeCode, col, row: CARDINAL;
      TmpStr: ARRAY [0..79] OF CHAR;
    BEGIN
      lngth := GenLists.ListLength( TheList );
      cnt := 1;
      col := 2;
      row := TheFrame^.headline + 1;
      IF row = 1 THEN
        INC( row);
      END;
      WHILE cnt <= lngth DO
        GenLists.GetElmt( TheList, cnt, TmpStr, TypeCode );
        IF TypeCode = GenLists.StrCode THEN
          ControlUtils.AddMenuItem( TheFrame, col, row, TmpStr,
              M2Strings.Length(TmpStr), 0, '' );
        END;
        INC( row );
        INC( cnt );
      END;
    END ChoiceListToFrame;


  PROCEDURE ListToFrame( TheList: GenLists.GenList; TheFrame:
      ScrnTypes.DisplayFrame );
    VAR
      cnt, lngth, TypeCode, col, row: CARDINAL;
      TmpStr: ARRAY [0..79] OF CHAR;
    BEGIN
      lngth := GenLists.ListLength( TheList );
      cnt := 1;
      col := 2;
      row := TheFrame^.headline + 1;
      IF row = 1 THEN
        INC( row);
      END;
      WHILE cnt <= lngth DO
        GenLists.GetElmt( TheList, cnt, TmpStr, TypeCode );
        IF TypeCode = GenLists.StrCode THEN
          WriteToFrame( TheFrame, col, row, TmpStr );
        END;
        INC( row );
        INC( cnt );
      END;
    END ListToFrame;


  PROCEDURE Display( TheFrame: ScrnTypes.DisplayFrame; FrameName
      : ARRAY OF CHAR );
    BEGIN
      IF TheFrame^.FromFile = NIL THEN
        ErrorNames.WarningName( 'OpnDsp' );
        RETURN;
      END;
      DspFiles.ReadFrame( TheFrame^.FromFile,
          TheFrame, FrameName );
      FramePainter.ShowDisplayFrame( TheFrame, 0, 0, 0, 0);
    END Display;


  PROCEDURE ReadAndShow( TheFile: ScrnTypes.DisplayFile;
      TheFrame: ScrnTypes.DisplayFrame; FrameName : ARRAY OF CHAR
      );
    BEGIN
      DspFiles.ReadFrame( TheFile, TheFrame, FrameName );
      FramePainter.ShowDisplayFrame( TheFrame, 0, 0, 0, 0);
    END ReadAndShow;


  PROCEDURE PushFrame( VAR FrameRec : ScrnTypes.DisplayFrame);
    (* Push the current frame, with its fields list, onto the
       frame stack for this file. The current frame will be left
       undefined, with no fields list linked to it; it must be
       filled in with a call to Display. *)
    VAR
      nodeptr : ScrnTypes.DisplayFrame;
  BEGIN
    VStorage.DosAlloc(nodeptr, SYSTEM.TSIZE(DisplayFrameRec) );
    nodeptr^ := FrameRec^;
      (* save the frame *)
    FrameRec^.PushedFrame := nodeptr;
      (* link it to the new current frame. *)
    GenLists.CopyList( FrameRec^.self, nodeptr^.self );
      (*Note that FrameRec^.self probably equals
        FrameRec^.FromFile^.ListBuf at this point, so we
        have to be careful.*)
    ScrnUtl1.GetFrameLists( nodeptr );
      (*The pushed frame's lists are now completely disconnected
        from FrameRec's lists.*)
    nodeptr^.SelfSharedWithFile := FALSE;
  END PushFrame;

  PROCEDURE CheckPushedFrame(VAR FrameRec :
      ScrnTypes.DisplayFrame) : ScrnTypes.DisplayFrame;
  (* used internally by PopFrame and PopZapFrame  *)
  (* Returns pointer to valid pushed frame. *)
    VAR
      nodeptr : ScrnTypes.DisplayFrame;
  BEGIN (* procedure CheckPushedFrame *)
    nodeptr := FrameRec^.PushedFrame;
    IF nodeptr = NIL THEN
      ErrorNames.WarningName( 'FrmStk' );
    END;
    RETURN nodeptr;
  END CheckPushedFrame;


PROCEDURE PopFrame(VAR FrameRec : ScrnTypes.DisplayFrame);
    (* Reverses the effect of PushFrame; current display file record is
       discarded, and the frame on the top of the stack replaces it.
       After PopFrame, program would usually call ControlScreen with
       "showfields" TRUE.*)
    VAR
      nodeptr : ScrnTypes.DisplayFrame;
  BEGIN
    nodeptr := CheckPushedFrame(FrameRec);
    IF NOT FrameRec^.SelfSharedWithFile THEN
      GenLists.DisposeList( FrameRec^.self );
        (* This disposes of all FrameRec's lists, because they are
           actually sublists of self.*)
    END;
    FrameRec^ := nodeptr^;
      (* restore pushed frame. *)
    IF GenLists.ListLength( FrameRec^.self ) > 0 THEN
      (*We have to do this test because we need to allow
        PushFrame's on frames that have been initialized but not
        read into; we don't have to test for uninitialized self
        lists because InitDisplayFrame does a NewList on it, and
        we can at least require FrameRec to be initialized.*)
      ScrnUtl1.GetFrameLists( FrameRec );
        (*Gets the frame's lists out of self. *)
    END;
    VStorage.DosDealloc(nodeptr, SYSTEM.TSIZE(DisplayFrameRec) );
      (* discard storage for pushed frame.  *)
  END PopFrame;

PROCEDURE PopZapFrame(VAR FrameRec : ScrnTypes.DisplayFrame);
    (*Removes last frame pushed from stack of Pushed frames, but
      does not change current frame or its contents. The current
      frame is linked to the next frame on the stack. *)
    VAR
      nodeptr : ScrnTypes.DisplayFrame;
  BEGIN (* procedure PopZapFrame *)
    nodeptr := CheckPushedFrame(FrameRec);
    IF NOT nodeptr^.SelfSharedWithFile THEN
      GenLists.DisposeList( nodeptr^.self );
        (* Disposes of all lists associated with pushed frame. *)
    END;
    FrameRec^.PushedFrame := nodeptr^.PushedFrame;
      (* link new top of stack. *)
    VStorage.DosDealloc(nodeptr, SYSTEM.TSIZE(DisplayFrameRec) );
      (* discard storage for pushed frame.  *)
  END PopZapFrame;

PROCEDURE ClearFrameStack(VAR FrameRec : ScrnTypes.DisplayFrame);
    (* Removes all frames from stack of Pushed frames.  *)
  BEGIN (* procedure ClearFrameStack *)
    WHILE FrameRec^.PushedFrame # NIL DO
      PopZapFrame(FrameRec);
    END;
  END ClearFrameStack;


  PROCEDURE ShowMessage( TheFile: ScrnTypes.DisplayFile;
      FrameName : ARRAY OF CHAR );
    VAR
      TmpFrame: ScrnTypes.DisplayFrame;
    BEGIN
      ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
      DspFiles.ReadFrame( TheFile, TmpFrame, FrameName );
      FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 );
      ControlUtils.Control( TmpFrame );
      CloseDisplayFrame( TmpFrame );
    END ShowMessage;


  PROCEDURE GetEdField( TheFrame: ScrnTypes.DisplayFrame;
      FieldName: ARRAY OF CHAR; VAR TheList: GenLists.GenList );
    BEGIN
      IF 0 # ScrnUtl1.FieldNum( TheFrame, FieldName ) THEN
        IF ScrnUtl1.ListFromEdField( TheFrame,
            TheFrame^.CurrentField, TheList ) THEN
          RETURN;
        END;
      END;
      HALT();
    END GetEdField;


BEGIN
  Initialized := FALSE;
  Init();
END ScrnUtl2.