Topspeed_JPI/TS-V3/REP16/SCRNUTL1.LST

Listing:

    1  IMPLEMENTATION MODULE ScrnUtl1;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/scrnutl1.mov   1.5   10 Mar 1991 15:32:22   coleb  $
   12   *
   13   *)
   14  
   15  IMPORT ErrorNames;
   16  IMPORT GenLists;
   17  IMPORT ListUtils;
   18  IMPORT M2Strings;
   19  IMPORT MsColors;
   20  IMPORT NumTypes;
   21  IMPORT PosUtils;
   22  IMPORT Rectangles;
   23  IMPORT ScrnTypes;
   24  IMPORT StrConv;
   25  IMPORT StrEdit;
   26  IMPORT SYSTEM;
   27  IMPORT UserOps;
   28  IMPORT VEditor;
   29  IMPORT VWindows;
   30  
   31  VAR
   32    Initialized : BOOLEAN;
   33  
   34    PROCEDURE Init();
   35      BEGIN
   36        IF Initialized THEN
   37          RETURN;
   38        ELSE
   39          Initialized := TRUE;
   40        END;
   41        ErrorNames.Init();
*****        ^ not supported yet
*****                   ^ not supported yet
*****                        ^ not supported yet
   42        GenLists.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   43        ListUtils.Init();
*****        ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   44        M2Strings.Init();
*****        ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   45        MsColors.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   46        NumTypes.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   47        PosUtils.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   48        Rectangles.Init();
*****        ^ not supported yet
*****                   ^ not supported yet
*****                        ^ not supported yet
   49        ScrnTypes.Init();
*****        ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   50        StrConv.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   51        StrEdit.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   52        UserOps.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   53        VEditor.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   54        VWindows.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   55      END Init;
*****          ^ not supported yet
   56  
   57  CONST
   58    Bit15 = 15; (*most significant bit*)
   59    Bit14 = 14; (*next most significant*)
   60    AfterLastElmt = 65535;
   61  
   62  TYPE
   63    VariantType =
   64      RECORD
   65        CASE : CARDINAL OF
*****        ^ not supported yet
*****                        ^ 'POINTER' expected
   66          1: c: CARDINAL;
   67        | 2: l, h: CHAR;
   68        | 3: b: BITSET;
   69        END
   70      END;
   71  
   72  
   73    PROCEDURE AbsFieldCol( TheFrame: ScrnTypes.DisplayFrame;
   74        FieldNum: CARDINAL ): INTEGER;
   75      VAR
   76        tmp: CARDINAL;
   77        ImagePtr: ScrnTypes.ImageElmtPtr;
   78      BEGIN
   79        GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
   80  (*
   81  Diagnostics.diagC( 'ImagePtr^.col', ImagePtr^.col );
   82  *)
   83        tmp := ImagePtr^.col;
   84        DecodeWord( tmp );
   85  (*
   86  Diagnostics.diagC( 'TheFrame^.startcol', TheFrame^.startcol );
   87  Diagnostics.diagC( 'TheFrame^.ColsScrolled', TheFrame^.ColsScrolled );
   88  *)
   89        RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startcol)) -
   90            INTEGER(TheFrame^.ColsScrolled);
   91      END AbsFieldCol;
   92  
   93  
   94    PROCEDURE AbsFieldRow( TheFrame: ScrnTypes.DisplayFrame;
   95        FieldNum: CARDINAL ): INTEGER;
   96      VAR
   97        tmp: CARDINAL;
   98        ImagePtr: ScrnTypes.ImageElmtPtr;
   99      BEGIN
  100        GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  101  (*
  102  Diagnostics.diagC( 'ImagePtr^.row', ImagePtr^.row );
  103  *)
  104        tmp := ImagePtr^.row;
  105        DecodeWord( tmp );
  106  (*
  107        IF (tmp + TheFrame^.startrow) < TheFrame^.RowsScrolled THEN
  108        END;
  109  Diagnostics.diagC( 'ImagePtr^.row', tmp );
  110  Diagnostics.diagC( 'TheFrame^.startrow', TheFrame^.startrow );
  111  Diagnostics.diagC( 'TheFrame^.RowsScrolled', TheFrame^.RowsScrolled );
  112  *)
  113  
  114        RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startrow)) -
  115            INTEGER(TheFrame^.RowsScrolled);
  116      END AbsFieldRow;
  117  
  118  
  119    PROCEDURE AllFieldsThisType( TheFrame: ScrnTypes.DisplayFrame;
  120        TheType: CHAR ): BOOLEAN;
  121      VAR
  122        FieldCount, LastField: CARDINAL;
  123        CountingDispFields: BOOLEAN;
  124        typ : CHAR;
  125      BEGIN
  126        FieldCount := 1;
  127        CountingDispFields := TheType = ScrnTypes.DispCode;
  128        LastField := FieldListTotal( TheFrame );
  129        WHILE (FieldCount <= LastField) DO
  130          typ := FieldType(TheFrame, FieldCount);
  131          IF (typ # TheType) THEN
  132            IF NOT CountingDispFields THEN
  133              IF typ # ScrnTypes.DispCode THEN
  134                RETURN FALSE;
  135              END;
  136            ELSE
  137              RETURN FALSE;
  138            END;
  139          END;
  140          INC( FieldCount );
  141        END;
  142        RETURN TRUE;
  143      END AllFieldsThisType;
  144  
  145  
  146    PROCEDURE BoxFrame( TheFrame: ScrnTypes.DisplayFrame; Active: BOOLEAN );
  147      VAR
  148        TheBoxStr: VWindows.BoxStr;
  149      BEGIN
  150        IF Active THEN
  151          TheBoxStr := TheFrame^.EntryBox;
  152        ELSE
  153          TheBoxStr := TheFrame^.ExitBox;
  154        END;
  155        IF TheBoxStr[0] # 0C THEN
  156          SetBorderColors( TheFrame );
  157          VWindows.DrawBox( TheFrame^.WindowHandle, TheBoxStr,
  158              TheFrame^.startcol + 1, TheFrame^.startrow + 1,
  159              TheFrame^.endcol + 1, TheFrame^.endrow + 1 );
  160          IF TheFrame^.Caption[0] # 0C THEN
  161            WriteBetween( TheFrame^.WindowHandle, TheFrame^.Caption,
  162                TheFrame^.startcol + 1, TheFrame^.startrow + 1,
  163                TheFrame^.endcol + 1, TheFrame^.endcol + 1 );
  164          END;
  165        END;
  166      END BoxFrame;
  167  
  168  
  169    PROCEDURE BoxInFrame( TheFrame: ScrnTypes.DisplayFrame ): BOOLEAN;
  170      BEGIN
  171        RETURN (TheFrame^.EntryBox[0] # 0C) OR (TheFrame^.ExitBox[0] # 0C);
  172      END BoxInFrame;
  173  
  174  
  175    PROCEDURE ChoiceNumber( TheFrame: ScrnTypes.DisplayFrame;
  176        TheField: CARDINAL ): CARDINAL;
  177      VAR
  178        FieldPtr: ScrnTypes.InputFieldPtr;
  179      BEGIN
  180        GetFieldPtr( TheFrame, TheField, FieldPtr );
  181        RETURN FieldPtr^.GroupID;
  182      END ChoiceNumber;
  183  
  184  
  185    PROCEDURE CoordsInField( TheFrame: ScrnTypes.DisplayFrame;
  186        TheField, TheCol, TheRow: CARDINAL ): BOOLEAN;
  187      VAR
  188        c1, r1, c2, r2: CARDINAL;
  189      BEGIN
  190        c1 := VirtualFieldCol( TheFrame, TheField );
  191        IF (TheCol < c1) THEN
  192          RETURN FALSE;
  193        END;
  194        r1 := VirtualFieldRow( TheFrame, TheField );
  195        IF (TheRow < r1) THEN
  196          RETURN FALSE;
  197        END;
  198        c2 := c1 + FieldWidth( TheFrame, TheField ) - 1;
  199        IF (TheCol > c2) THEN
  200          RETURN FALSE;
  201        END;
  202        r2 := r1 + FieldHeight( TheFrame, TheField ) - 1;
  203        IF (TheRow > r2) THEN
  204          RETURN FALSE;
  205        END;
  206        RETURN TRUE;
  207      END CoordsInField;
  208  
  209  
  210    PROCEDURE CurrentField( TheFrame: ScrnTypes.DisplayFrame ):
  211        CARDINAL;
  212      VAR
  213        ImagePtr: ScrnTypes.ImageElmtPtr;
  214      BEGIN
  215        GetFieldImagePtr( TheFrame, TheFrame^.CurrentField, ImagePtr );
  216          (*Make sure the list pointers are correct.*)
  217        RETURN TheFrame^.CurrentField;
  218      END CurrentField;
  219  
  220  
  221    PROCEDURE DecodeByte( VAR AnyByte: SYSTEM.BYTE );
  222      BEGIN
  223        IF CHAR(AnyByte) = 377C THEN
  224          AnyByte := SYSTEM.BYTE(0C);
  225        ELSIF CHAR(AnyByte) = 0C THEN
  226          ErrorNames.WarningName( 'EncodErr' );
  227        END;
  228      END DecodeByte;
  229  
  230  
  231    PROCEDURE DecodeImageRec( VAR TheImageRec:
  232        ScrnTypes.ImageElement );
  233      BEGIN
  234        DecodeWord( TheImageRec.row );
  235        DecodeWord( TheImageRec.col );
  236        DecodeWord( TheImageRec.field );
  237        DecodeByte( TheImageRec.foreg );
  238        DecodeByte( TheImageRec.backg );
  239        DecodeByte( TheImageRec.atrb );
  240      END DecodeImageRec;
  241  
  242  
  243    PROCEDURE DecodeWord( VAR AnyWord: SYSTEM.WORD );
  244      VAR
  245        v: VariantType;
  246      BEGIN
  247        v.c := CARDINAL(AnyWord);
  248        IF Bit14 IN v.b THEN
  249          v.l := 0C;
  250          EXCL( v.b, Bit14 );
  251        END;
  252        IF Bit15 IN v.b THEN
  253          v.h := 0C;
  254        END;
  255        AnyWord := SYSTEM.WORD(v.c);
  256      END DecodeWord;
  257  
  258  
  259    PROCEDURE EncodeByte( VAR AnyByte: SYSTEM.BYTE );
  260      BEGIN
  261        IF CHAR(AnyByte) = 0C THEN
  262          AnyByte := SYSTEM.BYTE(377C);
  263        ELSIF CHAR(AnyByte) = 377C THEN
  264          ErrorNames.WarningName( 'EncodErr' );
  265        END;
  266      END EncodeByte;
  267  
  268  
  269    PROCEDURE EncodeImageRec( VAR TheImageRec:
  270        ScrnTypes.ImageElement );
  271      BEGIN
  272        EncodeWord( TheImageRec.row );
  273        EncodeWord( TheImageRec.col );
  274        EncodeWord( TheImageRec.field );
  275        EncodeByte( TheImageRec.foreg );
  276        EncodeByte( TheImageRec.backg );
  277        EncodeByte( TheImageRec.atrb );
  278      END EncodeImageRec;
  279  
  280  
  281    PROCEDURE EncodeWord( VAR AnyWord: SYSTEM.WORD );
  282      VAR
  283        v: VariantType;
  284      BEGIN
  285        v.c := CARDINAL(AnyWord);
  286        IF v.c > 04000H THEN
  287          ErrorNames.WarningName( 'EncodErr' );
  288        END;
  289        IF (v.h = 0C) THEN
  290          INCL( v.b, Bit15 );
  291        END;
  292        IF (v.l = 0C) THEN
  293          INCL( v.b, Bit14 );
  294          v.l := 377C;
  295        END;
  296        AnyWord := SYSTEM.WORD(v.c);
  297      END EncodeWord;
  298  
  299  
  300    PROCEDURE EntirelyVisible( TheFrame: ScrnTypes.DisplayFrame;
  301        TheField: CARDINAL ): BOOLEAN;
  302      (* This procedure tells you whether TheField is entirely
  303         visible within TheFrame. *)
  304      VAR
  305        FirstVirtualColVisible, FirstVirtualRowVisible,
  306            VirtualPromptRow, LastVirtualColVisible,
  307            LastVirtualRowVisible, c1, r1, c2, r2: INTEGER;
  308      BEGIN
  309        c1 := INTEGER( VirtualFieldCol( TheFrame, TheField ) );
  310        r1 := INTEGER( VirtualFieldRow( TheFrame, TheField ) );
  311        c2 := c1 + INTEGER(FieldWidth( TheFrame, TheField )) - 1;
  312        r2 := r1 + INTEGER(FieldHeight( TheFrame, TheField )) - 1;
  313        FirstVirtualColVisible := INTEGER(TheFrame^.ColsScrolled)
  314            + 1;
  315        FirstVirtualRowVisible := (INTEGER(TheFrame^.RowsScrolled)
  316            + 1) + INTEGER(TheFrame^.headline);
  317        LastVirtualColVisible := TheFrame^.endcol -
  318            TheFrame^.startcol + 1 + TheFrame^.ColsScrolled;
  319        LastVirtualRowVisible := TheFrame^.endrow -
  320            TheFrame^.startrow + 1 + TheFrame^.RowsScrolled;
  321        IF BoxInFrame( TheFrame ) THEN
  322          (*There's a box in the window, so we have to adjust our
  323            numbers.*)
  324          IF TheFrame^.headline = 0 THEN
  325            (*But we don't have to adjust FirstVirtualRowVisible if
  326              there's a headline because we've added headline
  327              above, and the box takes up one of the lines in it.*)
  328            INC( FirstVirtualRowVisible );
  329          END;
  330          INC( FirstVirtualColVisible );
  331          DEC( LastVirtualRowVisible );
  332          DEC( LastVirtualColVisible );
  333        END;
  334  
  335        (*First determine whether it's entirely visible along
  336          its width.*)
  337        IF (c1 < FirstVirtualColVisible) OR (c2 >
  338            LastVirtualColVisible) THEN
  339          RETURN FALSE;
  340        END;
  341  
  342        (*Then determine whether it's entirely visible along
  343          its height.*)
  344  
  345        IF UserOps.DoPrompting THEN
  346          VirtualPromptRow := INTEGER(TheFrame^.RowsScrolled +
  347              UserOps.PromptRow) - INTEGER(TheFrame^.startrow);
  348          IF (r1 <= VirtualPromptRow) AND (r2 >= VirtualPromptRow) THEN
  349            RETURN FALSE;
  350          END;
  351        END;
  352  
  353        IF (r1 < FirstVirtualRowVisible) OR (r2 >
  354            LastVirtualRowVisible) THEN
  355          RETURN FALSE;
  356        END;
  357  
  358        RETURN TRUE;
  359      END EntirelyVisible;
  360  
  361  
  362    PROCEDURE FieldEntered( TheFrame: ScrnTypes.DisplayFrame;
  363        TheCol, TheRow: CARDINAL ): BOOLEAN;
  364      (*Scans the field list to determine whether these cursor
  365        coordinates are inside any field.  If so, sets
  366        TheFrame^.CurrentField to the number of the entered field
  367        and returns TRUE.*)
  368      VAR
  369        cnt, ListEnd: CARDINAL;
  370      BEGIN
  371        cnt := 1;
  372        ListEnd := FieldListTotal( TheFrame );
  373        LOOP
  374          IF cnt > ListEnd THEN
  375            RETURN FALSE;
  376          END;
  377          IF CoordsInField( TheFrame, cnt, TheCol, TheRow ) THEN
  378            TheFrame^.CurrentField := cnt;
  379            RETURN TRUE;
  380          END;
  381          INC( cnt );
  382        END;
  383      END FieldEntered;
  384  
  385  
  386    PROCEDURE FieldGroupTotal( TheFrame: ScrnTypes.DisplayFrame ):
  387        CARDINAL;
  388      VAR
  389        ListEnd, ListCnt, GroupCnt: CARDINAL;
  390        FieldPtr: ScrnTypes.InputFieldPtr;
  391      BEGIN
  392        ListEnd := FieldListTotal( TheFrame );
  393        ListCnt := 1;
  394        GroupCnt := 0;
  395        WHILE ListCnt <= ListEnd DO
  396          GetFieldPtr( TheFrame, ListCnt, FieldPtr );
  397          IF (FieldPtr^.typ = ScrnTypes.DispCode) THEN
  398            (* Do nothing *)
  399          ELSIF (FieldPtr^.typ # ScrnTypes.GroupMember) THEN
  400            INC( GroupCnt );
  401          ELSIF NOT (FieldPtr^.GroupID > 1) THEN
  402            INC( GroupCnt );
  403          END;
  404          INC( ListCnt );
  405        END;
  406        RETURN GroupCnt;
  407      END FieldGroupTotal;
  408  
  409  
  410    PROCEDURE FieldHeight( TheFrame: ScrnTypes.DisplayFrame;
  411        TheField: CARDINAL ): CARDINAL;
  412      VAR
  413        FieldPtr: ScrnTypes.InputFieldPtr;
  414      BEGIN
  415        IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN
  416          GetFieldPtr( TheFrame, TheField, FieldPtr );
  417          RETURN (FieldPtr^.Row2 - VirtualFieldRow( TheFrame, TheField) ) + 1;
  418        ELSE
  419          RETURN 1;
  420        END;
  421      END FieldHeight;
  422  
  423  
  424    PROCEDURE FieldImageNum( TheFrame: ScrnTypes.DisplayFrame;
  425        FieldNumber: CARDINAL ): CARDINAL;
  426      VAR
  427        ImagePtr: ScrnTypes.InputFieldPtr;
  428      BEGIN
  429        GetFieldPtr( TheFrame, FieldNumber, ImagePtr );
  430        RETURN ImagePtr^.ImageNum;
  431      END FieldImageNum;
  432  
  433  
  434    PROCEDURE FieldIsBlank( TheFrame: ScrnTypes.DisplayFrame;
  435        FieldName: ARRAY OF CHAR; VAR FieldNumber: CARDINAL ):
  436        BOOLEAN;
  437      (*Pass this routine a DisplayFrame (normally this will be
  438        MainFrame) and a FieldName that appears somewhere in that
  439        frame, and it tells you whether the field is blank, and
  440        what its position is in the list of fields for the frame.*)
  441      VAR
  442        TmpPtr: ScrnTypes.InputFieldPtr;
  443        ImageRec: ScrnTypes.ImageElement;
  444      BEGIN
  445        IF NOT FindField( TheFrame, FieldName, TmpPtr, ImageRec ) THEN
  446          RETURN FALSE;
  447        END;
  448        FieldNumber := FieldNum( TheFrame, FieldName );
  449        RETURN PosUtils.IsBlank( ImageRec.text );
  450      END FieldIsBlank;
  451  
  452  
  453    PROCEDURE FieldListTotal( TheFrame: ScrnTypes.DisplayFrame ):
  454        CARDINAL;
  455      BEGIN
  456        IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN
  457          RETURN 0;
  458        ELSE
  459          RETURN GenLists.ListLength( TheFrame^.FieldList );
  460        END;
  461      END FieldListTotal;
  462  
  463  
  464    PROCEDURE FieldWidth( TheFrame: ScrnTypes.DisplayFrame;
  465        TheField: CARDINAL ): CARDINAL;
  466      VAR
  467        FieldPtr: ScrnTypes.InputFieldPtr;
  468        ImagePtr: ScrnTypes.ImageElmtPtr;
  469      BEGIN
  470        IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN
  471          GetFieldPtr( TheFrame, TheField, FieldPtr );
  472          RETURN (FieldPtr^.Col2 - VirtualFieldCol( TheFrame, TheField) ) + 1;
  473        ELSE
  474          GetFieldImagePtr( TheFrame, TheField, ImagePtr );
  475          RETURN M2Strings.Length( ImagePtr^.text );
  476        END;
  477      END FieldWidth;
  478  
  479  
  480    PROCEDURE FieldType( TheFrame: ScrnTypes.DisplayFrame; FieldNum:
  481        CARDINAL ): CHAR;
  482      VAR
  483        FieldPtr: ScrnTypes.InputFieldPtr;
  484      BEGIN
  485        GetFieldPtr( TheFrame, FieldNum, FieldPtr );
  486        RETURN FieldPtr^.typ;
  487      END FieldType;
  488  
  489  
  490    PROCEDURE FindField( TheFrame: ScrnTypes.DisplayFrame;
  491        FieldName: ARRAY OF CHAR; VAR FieldPtr:
  492        ScrnTypes.InputFieldPtr; VAR ImageRec:
  493        ScrnTypes.ImageElement ): BOOLEAN;
  494      VAR
  495        spot : CARDINAL;
  496      BEGIN
  497        spot := FieldNum( TheFrame, FieldName );
  498        IF spot = 0 THEN
  499          RETURN FALSE;
  500        ELSE RETURN FindFieldNum( TheFrame, spot, FieldPtr,
  501            ImageRec );
  502        END;
  503      END FindField;
  504  
  505  
  506    PROCEDURE FindFieldNum( TheFrame: ScrnTypes.DisplayFrame;
  507        FieldNum: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr;
  508        VAR ImageRec: ScrnTypes.ImageElement ): BOOLEAN;
  509      BEGIN
  510        IF FieldNum > FieldListTotal(TheFrame) THEN
  511          RETURN FALSE;
  512        END;
  513        GetFieldPtr( TheFrame, FieldNum, FieldPtr );
  514        GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec );
  515        RETURN TRUE;
  516      END FindFieldNum;
  517  
  518  
  519    PROCEDURE FirstMember( TheFrame: ScrnTypes.DisplayFrame;
  520        TheField: CARDINAL ): CARDINAL;
  521      (* Pass this routine any field number that's a GroupMember,
  522         and it returns the number of the first field in the group.
  523         To be called only for GroupMember fields. *)
  524      VAR
  525        TmpPtr: ScrnTypes.InputFieldPtr;
  526        FieldNum: CARDINAL;
  527      BEGIN
  528        FieldNum := TheField;
  529        GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  530        WHILE TmpPtr^.GroupID > 1 DO
  531          DEC( FieldNum );
  532          GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  533        END;
  534        RETURN FieldNum;
  535      END FirstMember;
  536  
  537  
  538    PROCEDURE GetCardField( TheFrame: ScrnTypes.DisplayFrame;
  539        TheField: CARDINAL; VAR TheCard: CARDINAL );
  540      VAR
  541        tmpstr: ARRAY [0..79] OF CHAR;
  542      BEGIN
  543        GetFieldText( TheFrame, TheField, tmpstr );
  544        IF NOT StrConv.StrToCardinal( tmpstr, 0, TheCard ) THEN
  545          TheCard := 0;
  546        END;
  547      END GetCardField;
  548  
  549  
  550    PROCEDURE GetEdField( FrameRec: ScrnTypes.DisplayFrame;
  551        FieldNum: CARDINAL; VAR TheList: GenLists.GenList );
  552      VAR
  553        TmpRec: ScrnTypes.InputFieldRecord;
  554      BEGIN
  555        GetFieldRec( FrameRec, FieldNum, TmpRec );
  556        IF TmpRec.typ = ScrnTypes.EditorCode THEN
  557          GenLists.GetChildList( FrameRec^.EdFieldList, TmpRec.EdFieldNum,
  558              TheList );
  559        ELSE
  560          ErrorNames.WarningName( 'BadFld' );
  561        END;
  562      END GetEdField;
  563  
  564  
  565    PROCEDURE GetEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum:
  566        CARDINAL; VAR TheList: GenLists.GenList; VAR Rec:
  567        VEditor.AnEdControlRec );
  568      VAR
  569        FieldRec: ScrnTypes.InputFieldRecord;
  570        ImageRec: ScrnTypes.ImageElement;
  571      BEGIN
  572        GetFieldRec( FrameRec, FieldNum, FieldRec );
  573        GetFieldImageRec( FrameRec, FieldNum, ImageRec );
  574        IF FieldRec.typ # ScrnTypes.EditorCode THEN
  575          ErrorNames.WarningName( 'BadFld' );
  576          RETURN;
  577        END;
  578        GenLists.GetChildList( FrameRec^.EdFieldList, FieldRec.EdFieldNum,
  579            TheList );
  580        VEditor.InitEdRec( Rec );
  581        Rec.Col1 := ImageRec.col + FrameRec^.startcol - FrameRec^.ColsScrolled;
  582        Rec.Row1 := ImageRec.row + FrameRec^.startrow - FrameRec^.RowsScrolled;
  583        Rec.Col2 := FieldRec.Col2 + FrameRec^.startcol - FrameRec^.ColsScrolled;
  584        Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - FrameRec^.RowsScrolled;
  585          (*We adjust the col and row coordinates to absolute
  586            window coordinates.*)
  587        Rec.TextRow1 := FieldRec.TextRow1;
  588        Rec.CursorCol := FieldRec.CursorCol;
  589        Rec.CursorRow := FieldRec.CursorRow;
  590        Rec.MaxLines := FieldRec.MaxLines;
  591        Rec.ChangeMade := FieldRec.ChangeMade;
  592        Rec.ReadOnly := FieldRec.ReadOnly;
  593        Rec.FrameRec := FrameRec;
  594  
  595        WITH FrameRec^ DO
  596        (* set colors to pointer bar *)
  597          Rec.EntryForeColor := pbfor;
  598          Rec.EntryBackColor := pbbak;
  599          Rec.EntryAttrib := pbatrb;
  600        END;
  601        Rec.ExitForeColor := ImageRec.foreg;
  602        Rec.ExitBackColor := ImageRec.backg;
  603        Rec.ExitAttrib := ImageRec.atrb;
  604        Rec.EntryBox := 0;
  605        Rec.ExitBox := 0;
  606        Rec.DoCounting := FALSE;
  607        Rec.Col2 := FieldRec.Col2 +
  608            FrameRec^.startcol -FrameRec^.ColsScrolled;
  609        Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow -
  610            FrameRec^.RowsScrolled
  611      END GetEdRec;
  612  
  613  
  614    PROCEDURE GetFrameLinks( FrameRec: ScrnTypes.DisplayFrame; VAR
  615        FrameAbove, FrameBelow, FrameLeft, FrameRight:
  616        ScrnTypes.AFrameName );
  617      VAR
  618        lngth : CARDINAL;
  619      BEGIN
  620        FrameAbove[0] := 0C;
  621        FrameBelow[0] := 0C;
  622        FrameLeft[0] := 0C;
  623        FrameRight[0] := 0C;
  624        IF NOT GenLists.Initialized( FrameRec^.LinkedFrames ) THEN
  625          RETURN;
  626        END;
  627        lngth := GenLists.ListLength( FrameRec^.LinkedFrames );
  628        IF lngth >= 1 THEN
  629          ListUtils.GetStr( FrameRec^.LinkedFrames, 1, FrameAbove );
  630        END;
  631        IF lngth >= 2 THEN
  632          ListUtils.GetStr( FrameRec^.LinkedFrames, 2, FrameBelow );
  633        END;
  634        IF lngth >= 3 THEN
  635          ListUtils.GetStr( FrameRec^.LinkedFrames, 3, FrameLeft );
  636        END;
  637        IF lngth >= 4 THEN
  638          ListUtils.GetStr( FrameRec^.LinkedFrames, 4, FrameRight );
  639        END;
  640      END GetFrameLinks;
  641  
  642  
  643    PROCEDURE GetFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame );
  644      BEGIN
  645        GenLists.GetChildList( TheFrame^.self, 5, TheFrame^.DataList );
  646        GenLists.GetChildList( TheFrame^.self, 6, TheFrame^.PromptList );
  647        GenLists.GetChildList( TheFrame^.self, 7, TheFrame^.HelpList );
  648        GenLists.GetChildList( TheFrame^.self, 8, TheFrame^.EdFieldList );
  649        GenLists.GetChildList( TheFrame^.self, 9, TheFrame^.FieldList );
  650        GenLists.GetChildList( TheFrame^.self, 10, TheFrame^.ImageList );
  651        GenLists.GetChildList( TheFrame^.self, 11, TheFrame^.LinkedFrames );
  652      END GetFrameLists;
  653  
  654  
  655    PROCEDURE GetFieldDataList( TheFrame: ScrnTypes.DisplayFrame;
  656        TheField: CARDINAL; VAR FieldDataList: GenLists.GenList ): BOOLEAN;
  657      VAR
  658        FieldPtr: ScrnTypes.InputFieldPtr;
  659        TmpList: GenLists.GenList;
  660        cnt1, TypeCode : CARDINAL;
  661        FieldDataListFound : BOOLEAN;
  662        TmpName: ARRAY [0..79] OF CHAR;
  663      BEGIN
  664        GenLists.NilList( FieldDataList );
  665        IF NOT GenLists.Initialized( TheFrame^.DataList ) THEN
  666          RETURN FALSE;
  667        END;
  668        FieldDataListFound := FALSE;
  669        GetFieldPtr( TheFrame, TheField, FieldPtr );
  670        cnt1 := GenLists.ListLength( TheFrame^.DataList );
  671        WHILE (cnt1 > 1) AND (NOT FieldDataListFound) DO
  672          IF ListUtils.TypeCheck(TheFrame^.DataList,cnt1)=GenLists.ListCode THEN
  673            GenLists.GetElmt( TheFrame^.DataList, cnt1 - 1, TmpName, TypeCode );
  674            IF PosUtils.Equal( TmpName, FieldPtr^.fnam ) THEN
  675              GenLists.GetChildList( TheFrame^.DataList, cnt1, FieldDataList );
  676              FieldDataListFound := TRUE;
  677              DEC( cnt1 );
  678                (* skip over the field name *)
  679            END;
  680          END;
  681          DEC( cnt1 );
  682        END;
  683        RETURN FieldDataListFound;
  684      END GetFieldDataList;
  685  
  686  
  687    PROCEDURE GetFieldImagePtr( TheFrame: ScrnTypes.DisplayFrame;
  688        TheField: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr );
  689      VAR
  690        FieldPtr: ScrnTypes.InputFieldPtr;
  691      BEGIN
  692        GetFieldPtr( TheFrame, TheField, FieldPtr );
  693        GetImagePtr( TheFrame, FieldPtr^.ImageNum, ImagePtr );
  694      END GetFieldImagePtr;
  695  
  696  
  697    PROCEDURE GetFieldImageRec( TheFrame: ScrnTypes.DisplayFrame;
  698        TheField: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement );
  699      VAR
  700        FieldPtr: ScrnTypes.InputFieldPtr;
  701      BEGIN
  702        GetFieldPtr( TheFrame, TheField, FieldPtr );
  703        GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec );
  704      END GetFieldImageRec;
  705  
  706  
  707    PROCEDURE GetFieldPtr( TheFrame: ScrnTypes.DisplayFrame;
  708        TheField: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr );
  709      VAR
  710        TmpSize, TypeCode: CARDINAL;
  711      BEGIN
  712        GenLists.GetElmtAdr( TheFrame^.FieldList, TheField,
  713            FieldPtr, TmpSize, TypeCode );
  714      END GetFieldPtr;
  715  
  716  
  717    PROCEDURE GetFieldRec( TheFrame: ScrnTypes.DisplayFrame;
  718        TheField: CARDINAL; VAR FieldRec:
  719        ScrnTypes.InputFieldRecord );
  720      VAR
  721        TypeCode: CARDINAL;
  722      BEGIN
  723        GenLists.GetElmt( TheFrame^.FieldList, TheField,
  724            FieldRec, TypeCode );
  725      END GetFieldRec;
  726  
  727  
  728    PROCEDURE GetFieldText( TheFrame: ScrnTypes.DisplayFrame;
  729        TheField: CARDINAL; VAR TheText: ARRAY OF CHAR );
  730      VAR
  731        ImagePtr: ScrnTypes.ImageElmtPtr;
  732      BEGIN
  733        GetFieldImagePtr( TheFrame, TheField, ImagePtr );
  734        M2Strings.Assign( ImagePtr^.text, TheText );
  735      END GetFieldText;
  736  
  737  
  738    PROCEDURE GetImagePtr( TheFrame: ScrnTypes.DisplayFrame;
  739        ImageNum: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr );
  740      VAR
  741        TmpSize, TypeCode: CARDINAL;
  742      BEGIN
  743        GenLists.GetElmtAdr( TheFrame^.ImageList, ImageNum,
  744            ImagePtr, TmpSize, TypeCode );
  745      END GetImagePtr;
  746  
  747  
  748    PROCEDURE GetImageRec( TheFrame: ScrnTypes.DisplayFrame;
  749        ImageNum: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement );
  750      VAR
  751        TypeCode: CARDINAL;
  752      BEGIN
  753        GenLists.GetElmt( TheFrame^.ImageList, ImageNum,
  754            ImageRec, TypeCode );
  755        DecodeImageRec( ImageRec );
  756      END GetImageRec;
  757  
  758  
  759    PROCEDURE GetIntField( TheFrame: ScrnTypes.DisplayFrame;
  760        TheField: CARDINAL; VAR TheInt: INTEGER );
  761      VAR
  762        tmpstr: ARRAY [0..79] OF CHAR;
  763      BEGIN
  764        GetFieldText( TheFrame, TheField, tmpstr );
  765        IF NOT StrConv.StrToInteger( tmpstr, 0, TheInt ) THEN
  766          TheInt := 0;
  767        END;
  768      END GetIntField;
  769  
  770  
  771    PROCEDURE GetLongIntField( TheFrame: ScrnTypes.DisplayFrame;
  772        TheField: CARDINAL; VAR TheLongInt: LONGINT );
  773      VAR
  774        tmpstr: ARRAY [0..79] OF CHAR;
  775      BEGIN
  776        GetFieldText( TheFrame, TheField, tmpstr );
  777        IF NOT StrConv.StrToLongInteger( tmpstr, 0, TheLongInt ) THEN
  778          TheLongInt := NumTypes.L0;
  779        END;
  780      END GetLongIntField;
  781  
  782  
  783    PROCEDURE GetVisibleArea( TheFrame: ScrnTypes.DisplayFrame; VAR
  784        VisibleArea: Rectangles.ARectangle );
  785      (* Gets physical screen coordinates of visible part of frame. *)
  786      BEGIN
  787        Rectangles.DefineRectangle( VisibleArea,
  788            TheFrame^.startcol, TheFrame^.startrow,
  789            TheFrame^.endcol, TheFrame^.endrow );
  790        INC( VisibleArea.col1 );
  791        INC( VisibleArea.row1 );
  792        INC( VisibleArea.col2 );
  793        INC( VisibleArea.row2 );
  794        IF BoxInFrame( TheFrame ) THEN
  795          INC( VisibleArea.col1 );
  796          INC( VisibleArea.row1 );
  797          DEC( VisibleArea.col2 );
  798          DEC( VisibleArea.row2 );
  799        END;
  800        IF UserOps.DoPrompting AND ((INTEGER(UserOps.PromptRow) =
  801            VisibleArea.row2) OR (INTEGER(UserOps.PromptRow) =
  802            VisibleArea.row2 - 1)) THEN
  803          VisibleArea.row2 := UserOps.PromptRow - 1;
  804        END;
  805      END GetVisibleArea;
  806  
  807  
  808    PROCEDURE InputFieldsAbove( TheFrame: ScrnTypes.DisplayFrame;
  809        TheField: CARDINAL ): BOOLEAN;
  810      (*We use this to determine whether a scrolling window
  811        ought to be scrolled all the way to the top of the
  812        frame--it should if there are no input fields above
  813        it.*)
  814      VAR
  815        SavedRow: CARDINAL;
  816      BEGIN
  817        SavedRow := VirtualFieldRow( TheFrame, TheField );
  818        DEC( TheField );
  819        LOOP
  820          IF TheField = 0 THEN
  821            RETURN FALSE;
  822          ELSIF SavedRow > VirtualFieldRow( TheFrame, TheField ) THEN
  823            IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  824              RETURN TRUE;
  825            END;
  826          END;
  827          DEC( TheField );
  828        END;
  829      END InputFieldsAbove;
  830  
  831  
  832    PROCEDURE InputFieldsBelow( TheFrame: ScrnTypes.DisplayFrame;
  833        TheField: CARDINAL ): BOOLEAN;
  834      VAR
  835        ListEnd, SavedRow : CARDINAL;
  836      BEGIN
  837        SavedRow := VirtualFieldRow( TheFrame, TheField );
  838        ListEnd := FieldListTotal( TheFrame );
  839        INC( TheField );
  840        LOOP
  841          IF TheField > ListEnd THEN
  842            RETURN FALSE;
  843          ELSIF SavedRow < VirtualFieldRow( TheFrame, TheField ) THEN
  844            IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  845              RETURN TRUE;
  846            END;
  847          END;
  848          INC( TheField );
  849        END;
  850      END InputFieldsBelow;
  851  
  852  
  853    PROCEDURE InputFieldsToLeft( TheFrame: ScrnTypes.DisplayFrame;
  854        TheField: CARDINAL ): BOOLEAN;
  855      VAR
  856        SavedCol : CARDINAL;
  857      BEGIN
  858        SavedCol := VirtualFieldCol( TheFrame, TheField );
  859        DEC( TheField );
  860        LOOP
  861          IF TheField = 0 THEN
  862            RETURN FALSE;
  863          ELSIF SavedCol > VirtualFieldCol( TheFrame, TheField ) THEN
  864            IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  865              RETURN TRUE;
  866            END;
  867          END;
  868          DEC( TheField );
  869        END;
  870      END InputFieldsToLeft;
  871  
  872  
  873    PROCEDURE InputFieldsToRight( TheFrame: ScrnTypes.DisplayFrame;
  874        TheField: CARDINAL ): BOOLEAN;
  875      VAR
  876        ListEnd, SavedCol : CARDINAL;
  877      BEGIN
  878        SavedCol := VirtualFieldCol( TheFrame, TheField );
  879        ListEnd := FieldListTotal( TheFrame );
  880        INC( TheField );
  881        LOOP
  882          IF TheField > ListEnd THEN
  883            RETURN FALSE;
  884          ELSIF SavedCol < VirtualFieldCol( TheFrame, TheField ) THEN
  885            IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  886              RETURN TRUE;
  887            END;
  888          END;
  889          INC( TheField );
  890        END;
  891      END InputFieldsToRight;
  892  
  893  
  894    PROCEDURE ListFromEdField( TheFrame: ScrnTypes.DisplayFrame;
  895        TheField: CARDINAL; VAR TheList: GenLists.GenList ):
  896        BOOLEAN;
  897      VAR
  898        FieldRec: ScrnTypes.InputFieldRecord;
  899      BEGIN
  900        GetFieldRec( TheFrame, TheField, FieldRec );
  901        IF (FieldRec.typ = ScrnTypes.EditorCode) AND
  902            (FieldRec.EdFieldNum > 0) THEN
  903          GenLists.GetChildList( TheFrame^.EdFieldList, FieldRec.EdFieldNum,
  904              TheList );
  905          RETURN GenLists.Initialized( TheList);
  906        ELSE
  907          RETURN FALSE;
  908        END;
  909      END ListFromEdField;
  910  
  911  
  912    PROCEDURE ListToEdField( TheList: GenLists.GenList; TheFrame:
  913        ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN;
  914      VAR
  915        FieldRec: ScrnTypes.InputFieldRecord;
  916      BEGIN
  917        GetFieldRec( TheFrame, TheField, FieldRec );
  918        IF (FieldRec.typ = ScrnTypes.EditorCode) AND
  919            (FieldRec.EdFieldNum > 0) THEN
  920          GenLists.ListReplace( TheList, GenLists.ListCode,
  921              TheFrame^.EdFieldList, FieldRec.EdFieldNum );
  922          RETURN TRUE;
  923        ELSE
  924          RETURN FALSE;
  925        END;
  926      END ListToEdField;
  927  
  928  
  929    PROCEDURE MakeFieldDataList( TheFrame: ScrnTypes.DisplayFrame;
  930        TheField: CARDINAL; FieldDataList: GenLists.GenList );
  931      VAR
  932        TmpList: GenLists.GenList;
  933        FieldPtr: ScrnTypes.InputFieldPtr;
  934      BEGIN
  935        IF NOT GetFieldDataList( TheFrame, TheField, TmpList ) THEN
  936          GetFieldPtr( TheFrame, TheField, FieldPtr );
  937          GenLists.ListInsert( FieldPtr^.fnam, GenLists.StrCode,
  938              TheFrame^.DataList, AfterLastElmt );
  939          GenLists.ListInsert( FieldDataList, GenLists.ListCode,
  940              TheFrame^.DataList, AfterLastElmt );
  941        END;
  942      END MakeFieldDataList;
  943  
  944  
  945    PROCEDURE NumberOfChoices( TheFrame: ScrnTypes.DisplayFrame;
  946        TheField: CARDINAL ): CARDINAL;
  947      VAR
  948        FieldPtr: ScrnTypes.InputFieldPtr;
  949      BEGIN
  950        GetFieldPtr( TheFrame, TheField, FieldPtr );
  951        RETURN FieldPtr^.GroupSize;
  952      END NumberOfChoices;
  953  
  954  
  955    PROCEDURE NumberOfImages( TheFrame: ScrnTypes.DisplayFrame ):
  956        CARDINAL;
  957      BEGIN
  958        IF NOT GenLists.Initialized( TheFrame^.ImageList ) THEN
  959          RETURN 0;
  960        ELSE
  961          RETURN GenLists.ListLength( TheFrame^.ImageList );
  962        END;
  963      END NumberOfImages;
  964  
  965  
  966    PROCEDURE FieldNum( TheFrame: ScrnTypes.DisplayFrame; FieldName:
  967        ARRAY OF CHAR ): CARDINAL;
  968      (*Takes a field name and returns its number; 0 means name
  969        not found.*)
  970      VAR
  971        ListEnd, cnt : CARDINAL;
  972        msg: ARRAY [0..79] OF CHAR;
  973        TmpPtr: ScrnTypes.InputFieldPtr;
  974      BEGIN
  975        StrEdit.CAPstr(FieldName);
  976          (* make search case-insensitive *)
  977        StrEdit.DeleteChar( ' ', FieldName );
  978          (*Delete all blanks from FieldName--ScreenCompile deletes
  979            them from the actual field names.*)
  980        cnt := 1;
  981        ListEnd := FieldListTotal( TheFrame );
  982        WHILE cnt <= ListEnd DO
  983          GetFieldPtr( TheFrame, cnt, TmpPtr );
  984          IF PosUtils.Equal( FieldName, TmpPtr^.fnam ) THEN
  985            TheFrame^.CurrentField := cnt;
  986            RETURN cnt;
  987          ELSE
  988            INC( cnt );
  989          END;
  990        END;
  991  (*
  992  
  993    Commented out on 6 Dec 88.
  994  
  995        StrEdit.AssignStr( ' is not a field in frame ', msg );
  996        StrEdit.Append( msg, TheFrame^.ThisFrame );
  997        M2Strings.Insert( FieldName, msg, 0 );
  998        IF TheFrame^.FromFile # NIL THEN
  999          StrEdit.Append( msg, ' of file ' );
 1000          StrEdit.Append( msg, TheFrame^.FromFile^.name );
 1001        END;
 1002        ErrorManager.WARN( msg );
 1003  *)
 1004        RETURN 0;
 1005      END FieldNum;
 1006  
 1007  
 1008    PROCEDURE PartOutside( FrameRec: ScrnTypes.DisplayFrame; VAR
 1009        VisibleArea: Rectangles.ARectangle; direction:
 1010        VWindows.Compass ): CARDINAL;
 1011      VAR
 1012        height, width, VHeight : CARDINAL;
 1013      BEGIN
 1014        height := (VisibleArea.row2 - VisibleArea.row1) + 1;
 1015        width := (VisibleArea.col2 - VisibleArea.col1) + 1;
 1016        CASE direction OF
 1017          VWindows.South:
 1018            WITH FrameRec^ DO
 1019              IF NOT BoxInFrame(FrameRec) THEN
 1020                VHeight := VirtualHeight - headline
 1021              ELSIF headline = 0 THEN
 1022                (* compensate for bottom line of box *)
 1023                VHeight := VirtualHeight - 1;
 1024              ELSE
 1025                (* compensation for top and bottom lines of box cancel *)
 1026                VHeight := VirtualHeight - headline;
 1027              END (* if no box *);
 1028              IF (VHeight - RowsScrolled) <= height THEN
 1029                RETURN 0;
 1030              ELSE
 1031                RETURN (VHeight - height) - RowsScrolled;
 1032              END;
 1033            END (* with FrameRec^ *);
 1034        | VWindows.North:
 1035            RETURN FrameRec^.RowsScrolled;
 1036        | VWindows.East:
 1037            IF (FrameRec^.VirtualWidth - FrameRec^.ColsScrolled) <= width THEN
 1038              RETURN 0;
 1039            END;
 1040            RETURN (FrameRec^.VirtualWidth - width) - FrameRec^.ColsScrolled;
 1041        | VWindows.West:
 1042            RETURN FrameRec^.ColsScrolled;
 1043        END;
 1044        RETURN 0;
 1045      END PartOutside;
 1046  
 1047  
 1048    PROCEDURE PutEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum:
 1049        CARDINAL; VAR TheList: GenLists.GenList; VAR Rec:
 1050        VEditor.AnEdControlRec );
 1051      (*Note that this does not update the column and row
 1052        coordinates stored in the field list and image list.
 1053        That's intentional.  The EdControlRec has to have absolute
 1054        window coordinates, not frame-relative coordinates.*)
 1055      VAR
 1056        FieldRec: ScrnTypes.InputFieldRecord;
 1057      BEGIN
 1058        GetFieldRec( FrameRec, FieldNum, FieldRec );
 1059        IF FieldRec.typ # ScrnTypes.EditorCode THEN
 1060          ErrorNames.WarningName( 'BadFld' );
 1061          RETURN;
 1062        END;
 1063        GenLists.ListReplace( TheList, GenLists.ListCode,
 1064            FrameRec^.EdFieldList, FieldRec.EdFieldNum );
 1065        FieldRec.TextRow1 := Rec.TextRow1;
 1066        FieldRec.CursorCol := Rec.CursorCol;
 1067        FieldRec.CursorRow := Rec.CursorRow;
 1068        FieldRec.MaxLines := Rec.MaxLines;
 1069        FieldRec.ChangeMade := Rec.ChangeMade;
 1070        FieldRec.ReadOnly := Rec.ReadOnly;
 1071        PutFieldRec( FieldRec, FrameRec, FieldNum );
 1072      END PutEdRec;
 1073  
 1074  
 1075    PROCEDURE PutFieldImageRec( ImageRec:
 1076        ScrnTypes.ImageElement; VAR TheFrame:
 1077        ScrnTypes.DisplayFrame; TheField: CARDINAL );
 1078      BEGIN
 1079        EncodeImageRec( ImageRec );
 1080        GenLists.ListReplace( ImageRec, GenLists.StrCode, TheFrame^.ImageList,
 1081            FieldImageNum(TheFrame, TheField) );
 1082      END PutFieldImageRec;
 1083  
 1084  
 1085    PROCEDURE PutFieldRec( VAR FieldRec:
 1086        ScrnTypes.InputFieldRecord; VAR TheFrame:
 1087        ScrnTypes.DisplayFrame; TheField: CARDINAL );
 1088      VAR
 1089        cnt, ImageListEnd: CARDINAL;
 1090        ImageRec: ScrnTypes.ImageElement;
 1091      BEGIN
 1092        IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN
 1093          GenLists.NewList( TheFrame^.FieldList );
 1094          PutFrameLists( TheFrame );
 1095            (* Make sure the new FieldList gets inserted into
 1096               TheFrame's .self list. *)
 1097        END;
 1098        IF TheField <= GenLists.ListLength( TheFrame^.FieldList ) THEN
 1099          GenLists.ListReplace( FieldRec, ScrnTypes.FieldTypeCode,
 1100              TheFrame^.FieldList, TheField );
 1101        ELSE
 1102          GenLists.ListInsert( FieldRec, ScrnTypes.FieldTypeCode,
 1103              TheFrame^.FieldList, TheField );
 1104            (* Now everything in the ImageList with a FieldNum
 1105               greater than or equal to TheField has to have its
 1106               field number incremented. *)
 1107          ImageListEnd := NumberOfImages( TheFrame );
 1108          FOR cnt := 1 TO ImageListEnd DO
 1109            GetImageRec( TheFrame, cnt, ImageRec );
 1110            IF ImageRec.field > TheField THEN
 1111              INC( ImageRec.field );
 1112              EncodeImageRec( ImageRec );
 1113              GenLists.ListReplace( ImageRec, GenLists.StrCode,
 1114                  TheFrame^.ImageList, cnt );
 1115            END;
 1116          END;
 1117        END;
 1118      END PutFieldRec;
 1119  
 1120  
 1121    PROCEDURE PutFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame );
 1122      BEGIN
 1123        GenLists.ListReplace( TheFrame^.DataList,
 1124            GenLists.ListCode, TheFrame^.self, 5 );
 1125        GenLists.ListReplace( TheFrame^.PromptList,
 1126            GenLists.ListCode, TheFrame^.self, 6 );
 1127        GenLists.ListReplace( TheFrame^.HelpList,
 1128            GenLists.ListCode, TheFrame^.self, 7 );
 1129        GenLists.ListReplace( TheFrame^.EdFieldList,
 1130            GenLists.ListCode, TheFrame^.self, 8 );
 1131        GenLists.ListReplace( TheFrame^.FieldList,
 1132            GenLists.ListCode, TheFrame^.self, 9 );
 1133        GenLists.ListReplace( TheFrame^.ImageList,
 1134            GenLists.ListCode, TheFrame^.self, 10 );
 1135        GenLists.ListReplace( TheFrame^.LinkedFrames,
 1136            GenLists.ListCode, TheFrame^.self, 11 );
 1137      END PutFrameLists;
 1138  
 1139  
 1140    PROCEDURE RelativeFieldCol( TheFrame: ScrnTypes.DisplayFrame;
 1141        FieldNum: CARDINAL ): CARDINAL;
 1142      VAR
 1143        vcol : CARDINAL;
 1144      BEGIN
 1145        vcol := VirtualFieldCol( TheFrame, FieldNum );
 1146  (*
 1147        IF vcol < TheFrame^.ColsScrolled THEN
 1148          Diagnostics.diagC( 'Scrolling error. vcol', vcol );
 1149        END;
 1150  *)
 1151        RETURN vcol - TheFrame^.ColsScrolled;
 1152      END RelativeFieldCol;
 1153  
 1154  
 1155    PROCEDURE RelativeFieldRow( TheFrame: ScrnTypes.DisplayFrame;
 1156        FieldNum: CARDINAL ): CARDINAL;
 1157      VAR
 1158        vrow : CARDINAL;
 1159      BEGIN
 1160        vrow := VirtualFieldRow( TheFrame, FieldNum );
 1161  (*
 1162        IF vrow < TheFrame^.RowsScrolled THEN
 1163          Diagnostics.diagC( 'Scrolling error. RowsScrolled', TheFrame^.RowsScrolled );
 1164          Diagnostics.diagC( 'Scrolling error. vrow', vrow );
 1165        END;
 1166  *)
 1167        RETURN vrow - TheFrame^.RowsScrolled;
 1168      END RelativeFieldRow;
 1169  
 1170  
 1171    PROCEDURE ResetFieldPtr( VAR TheFrame: ScrnTypes.DisplayFrame);
 1172      VAR
 1173        dumptr: ScrnTypes.InputFieldPtr;
 1174      BEGIN
 1175        TheFrame^.CurrentField := 0;
 1176        GetFieldPtr( TheFrame, 1, dumptr );
 1177      END ResetFieldPtr;
 1178  
 1179  
 1180    PROCEDURE SelectedChar( TheFrame: ScrnTypes.DisplayFrame ):
 1181        CHAR;
 1182      VAR
 1183        FieldRec: ScrnTypes.InputFieldRecord;
 1184      BEGIN
 1185        GetFieldRec( TheFrame, TheFrame^.CurrentField, FieldRec );
 1186        IF FieldRec.typ = ScrnTypes.GotoCode THEN
 1187          IF FieldRec.MenuKey <= 255 THEN
 1188            RETURN CHR(FieldRec.MenuKey);
 1189          END;
 1190        ELSIF FieldRec.typ = ScrnTypes.GroupMember THEN
 1191          IF FieldRec.ChoiceKey <= 255 THEN
 1192            RETURN CHR(FieldRec.ChoiceKey);
 1193          END;
 1194        END;
 1195        RETURN 0C;
 1196      END SelectedChar;
 1197  
 1198  
 1199    PROCEDURE SetBorderColors( TheFrame: ScrnTypes.DisplayFrame );
 1200      BEGIN
 1201        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1202            TheFrame^.bordfor );
 1203        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1204            TheFrame^.bordbak );
 1205        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1206            TheFrame^.bordatrb );
 1207      END SetBorderColors;
 1208  
 1209  
 1210    PROCEDURE SetCurrentField( VAR TheFrame: ScrnTypes.DisplayFrame;
 1211        FieldNum: CARDINAL );
 1212      VAR
 1213        ImagePtr: ScrnTypes.ImageElmtPtr;
 1214      BEGIN
 1215        IF (FieldNum < 1) OR (FieldNum > FieldListTotal(TheFrame)) THEN
 1216          RETURN;
 1217        END;
 1218        GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
 1219          (*Make sure the list pointers are correct.*)
 1220        TheFrame^.CurrentField := FieldNum;
 1221      END SetCurrentField;
 1222  
 1223  
 1224    PROCEDURE SetFieldColors( TheFrame: ScrnTypes.DisplayFrame;
 1225        FieldNum: CARDINAL );
 1226      VAR
 1227        ImageRec: ScrnTypes.ImageElement;
 1228      BEGIN
 1229        GetFieldImageRec( TheFrame, FieldNum, ImageRec );
 1230        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1231            ImageRec.foreg );
 1232        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1233            ImageRec.backg );
 1234        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1235            ImageRec.atrb );
 1236      END SetFieldColors;
 1237  
 1238  
 1239    PROCEDURE SetMessageColors( TheFrame: ScrnTypes.DisplayFrame );
 1240      BEGIN
 1241        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1242            TheFrame^.msgfor );
 1243        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1244            TheFrame^.msgbak );
 1245        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1246            TheFrame^.msgatrb );
 1247      END SetMessageColors;
 1248  
 1249  
 1250    PROCEDURE SetNormalColors( TheFrame: ScrnTypes.DisplayFrame );
 1251      BEGIN
 1252        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1253            TheFrame^.normfor );
 1254        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1255            TheFrame^.normbak );
 1256        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1257            TheFrame^.normatrb );
 1258      END SetNormalColors;
 1259  
 1260  
 1261    PROCEDURE SetPointerBarColors( TheFrame: ScrnTypes.DisplayFrame
 1262        );
 1263      BEGIN
 1264        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1265            TheFrame^.pbfor );
 1266        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1267            TheFrame^.pbbak );
 1268        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1269            TheFrame^.pbatrb );
 1270      END SetPointerBarColors;
 1271  
 1272  
 1273    PROCEDURE SetPromptColors( TheFrame: ScrnTypes.DisplayFrame );
 1274      BEGIN
 1275        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1276            TheFrame^.promfor );
 1277        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1278            TheFrame^.prombak );
 1279        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1280            TheFrame^.promatrb );
 1281      END SetPromptColors;
 1282  
 1283  
 1284    PROCEDURE SetSelCharColors( TheFrame: ScrnTypes.DisplayFrame;
 1285        FieldNum: CARDINAL );
 1286      VAR
 1287        fore : MsColors.AColor;
 1288        attr : MsColors.AMonoAttribute;
 1289        ImageRec: ScrnTypes.ImageElement;
 1290      BEGIN
 1291        GetFieldImageRec( TheFrame, FieldNum, ImageRec );
 1292        CASE ORD(ImageRec.foreg) OF
 1293          0, 3 :
 1294            fore := MsColors.red;
 1295        | 1, 2, 4..7 :
 1296          fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) + 8) );
 1297        | 8..15:
 1298          fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) - 1) );
 1299        END;
 1300        IF ImageRec.atrb # MsColors.bold THEN
 1301          attr := MsColors.bold;
 1302        ELSE
 1303          attr := MsColors.plain;
 1304        END;
 1305        IF fore = TheFrame^.pbbak THEN
 1306          IF fore <= 2C THEN
 1307            fore := CHR( ORD(fore) + 3 );
 1308          ELSE
 1309            fore := CHR( ORD(fore) - 3 );
 1310          END;
 1311        END;
 1312        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1313            fore );
 1314        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1315            ImageRec.backg );
 1316        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1317            attr );
 1318      END SetSelCharColors;
 1319  
 1320  
 1321    PROCEDURE SetSelectionColors( TheFrame: ScrnTypes.DisplayFrame
 1322        );
 1323      BEGIN
 1324        VWindows.SetForeColor( TheFrame^.WindowHandle,
 1325            TheFrame^.selfor );
 1326        VWindows.SetBackColor( TheFrame^.WindowHandle,
 1327            TheFrame^.selbak );
 1328        VWindows.SetMonoAttr( TheFrame^.WindowHandle,
 1329            TheFrame^.selatrb );
 1330      END SetSelectionColors;
 1331  
 1332  
 1333    PROCEDURE VirtualFieldCol( TheFrame: ScrnTypes.DisplayFrame;
 1334        FieldNum: CARDINAL ): CARDINAL;
 1335      VAR
 1336        tmp: CARDINAL;
 1337        ImagePtr: ScrnTypes.ImageElmtPtr;
 1338      BEGIN
 1339        GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
 1340        tmp := ImagePtr^.col;
 1341        DecodeWord( tmp );
 1342        RETURN tmp;
 1343      END VirtualFieldCol;
 1344  
 1345  
 1346    PROCEDURE VirtualFieldRow( TheFrame: ScrnTypes.DisplayFrame;
 1347        FieldNum: CARDINAL ): CARDINAL;
 1348      VAR
 1349        tmp: CARDINAL;
 1350        ImagePtr: ScrnTypes.ImageElmtPtr;
 1351      BEGIN
 1352        GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
 1353        tmp := ImagePtr^.row;
 1354        DecodeWord( tmp );
 1355        RETURN tmp;
 1356      END VirtualFieldRow;
 1357  
 1358  
 1359    PROCEDURE VirtualImageCol( TheFrame: ScrnTypes.DisplayFrame;
 1360        ImageNum: CARDINAL ): CARDINAL;
 1361      VAR
 1362        tmp: CARDINAL;
 1363        ImagePtr: ScrnTypes.ImageElmtPtr;
 1364      BEGIN
 1365        GetImagePtr( TheFrame, ImageNum, ImagePtr );
 1366        tmp := ImagePtr^.col;
 1367        DecodeWord( tmp );
 1368        RETURN tmp;
 1369      END VirtualImageCol;
 1370  
 1371  
 1372    PROCEDURE VirtualImageRow( TheFrame: ScrnTypes.DisplayFrame;
 1373        ImageNum: CARDINAL ): CARDINAL;
 1374      VAR
 1375        tmp: CARDINAL;
 1376        ImagePtr: ScrnTypes.ImageElmtPtr;
 1377      BEGIN
 1378        GetImagePtr( TheFrame, ImageNum, ImagePtr );
 1379        tmp := ImagePtr^.row;
 1380        DecodeWord( tmp );
 1381        RETURN tmp;
 1382      END VirtualImageRow;
 1383  
 1384  
 1385    PROCEDURE WhichChoiceKey( TheFrame: ScrnTypes.DisplayFrame;
 1386        OneOfTheFields: CARDINAL ): CARDINAL;
 1387      VAR
 1388        TmpPtr: ScrnTypes.InputFieldPtr;
 1389        FieldNum: CARDINAL;
 1390      BEGIN
 1391        IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN
 1392          RETURN 0;
 1393        END;
 1394        FieldNum := FirstMember( TheFrame, OneOfTheFields );
 1395        REPEAT
 1396          GetFieldPtr( TheFrame, FieldNum, TmpPtr );
 1397          IF TmpPtr^.selected THEN
 1398            RETURN TmpPtr^.ChoiceKey;
 1399          ELSE
 1400            INC( FieldNum );
 1401          END;
 1402        UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize;
 1403        RETURN 0;
 1404      END WhichChoiceKey;
 1405  
 1406  
 1407    PROCEDURE WhichChoiceNum( TheFrame: ScrnTypes.DisplayFrame;
 1408        OneOfTheFields: CARDINAL ): CARDINAL;
 1409      VAR
 1410        TmpPtr: ScrnTypes.InputFieldPtr;
 1411        FieldNum: CARDINAL;
 1412      BEGIN
 1413        IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN
 1414          RETURN 0;
 1415        END;
 1416        FieldNum := FirstMember( TheFrame, OneOfTheFields );
 1417        REPEAT
 1418          GetFieldPtr( TheFrame, FieldNum, TmpPtr );
 1419          IF TmpPtr^.selected THEN
 1420            RETURN TmpPtr^.GroupID;
 1421          ELSE
 1422            INC( FieldNum );
 1423          END;
 1424        UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize;
 1425        RETURN FirstMember( TheFrame, OneOfTheFields );
 1426      END WhichChoiceNum;
 1427  
 1428  
 1429    PROCEDURE WriteBetween( TheWindow: VWindows.AWindowHandle;
 1430        TheStr: ARRAY OF CHAR; col1, row1, col2, row2: CARDINAL );
 1431      (*Used for writing centered captions on frame borders.*)
 1432      VAR
 1433        lngth, width: CARDINAL;
 1434      BEGIN
 1435        lngth := M2Strings.Length( TheStr );
 1436        width := (col2 - col1) - 1;
 1437        IF lngth > width  THEN
 1438          StrEdit.SetLength( TheStr, width );
 1439          lngth := width;
 1440        END;
 1441        VWindows.DrawStr( TheWindow, col1 + ((width - lngth) DIV 2) + 1,
 1442            row1, SYSTEM.ADR(TheStr), lngth );
 1443      END WriteBetween;
 1444  
 1445  
 1446    PROCEDURE WriteScrollMarks( TheFrame: ScrnTypes.DisplayFrame );
 1447      BEGIN
 1448        WITH TheFrame^ DO
 1449          IF NOT BoxInFrame( TheFrame ) THEN
 1450            (*There's no box around the window, so we don't have
 1451              any place to put our scroll marks.*)
 1452            RETURN;
 1453          END;
 1454          IF (VirtualHeight > (endrow - startrow) + 1) THEN
 1455            VWindows.SetScrollRange( TheFrame^.WindowHandle,
 1456                VWindows.SbVert, TheFrame^.startrow + 1,
 1457                TheFrame^.endrow + 1 );
 1458            VWindows.SetScrollPos( TheFrame^.WindowHandle,
 1459                VWindows.SbVert, TheFrame^.RowsScrolled );
 1460          END;
 1461          IF (VirtualWidth > (endcol - startcol) + 1) THEN
 1462            VWindows.SetScrollRange( TheFrame^.WindowHandle,
 1463                VWindows.SbHorz, TheFrame^.startcol + 1,
 1464                TheFrame^.endcol + 1 );
 1465            VWindows.SetScrollPos( TheFrame^.WindowHandle,
 1466                VWindows.SbHorz, TheFrame^.ColsScrolled );
 1467          END;
 1468            (*If neither of the two preceding IF's were
 1469              executed, the frame fits entirely within the
 1470              window; no need to write scroll marks.*)
 1471        END;
 1472      END WriteScrollMarks;
 1473  
 1474  
 1475  BEGIN
 1476    Initialized := FALSE;
 1477    Init();
 1478  END ScrnUtl1.

   45 errors