Topspeed_JPI/TS-V3/REP16/MAKEFRAM.LST

Listing:

    1  IMPLEMENTATION MODULE MakeFrame;
    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/makefram.mov   1.8   17 Mar 1991 18:02:14   coleb  $
   12   *
   13   *  Modified March 9, 1990 - mbc.  Change syntax to allow Real.x, where x
   14   *    is the number of decimal places on input for the real.
   15   *  March 24, 1990 - mbc.  move realDecPlaces declaration.
   16   *)
   17  
   18  
   19  (*EntryDiag:
   20  IMPORT Diagnostics;
   21  :EntryDiag*)
   22  
   23  IMPORT ByteFiddler;
   24  IMPORT ErrorManager;
   25  IMPORT FieldTypes;
   26  IMPORT GenLists;
   27  IMPORT LowLevel;
   28  IMPORT M2Strings;
   29  IMPORT MsColors;
   30  IMPORT NdxTypes;
   31  IMPORT Numbers;
   32  IMPORT NumTypes;
   33  IMPORT Parser;
   34  IMPORT PosUtils;
   35  IMPORT ScrnTypes;
   36  IMPORT ScrnUtl1;
   37  IMPORT StrConv;
   38  IMPORT StrCnv1;
   39  IMPORT StrEdit;
   40  IMPORT SYSTEM;
   41  IMPORT VStorage;
   42  IMPORT VWindows;
   43  
   44  VAR
   45    Initialized: BOOLEAN;
   46  
   47  
   48    TYPE
   49      CStackP = POINTER TO CStack;
*****                           ^ undeclared identifier
   50      CStack =
   51        RECORD
   52          Ccode: CHAR;
   53          forec, backc: MsColors.AColor;
*****                                 ^ not supported yet
   54          atrbc: MsColors.AMonoAttribute;
*****                          ^ not supported yet
   55          prv, nxt: CStackP;
   56        END;
*****        ^ not supported yet
   57  
   58    CONST
   59      AfterLastElmt = 65535;
   60      BorderChar = ':';
   61      MaxScrWidth = 255;
   62      EOF = 32C;
   63      EOL = 15C;
   64      FormFeed = 14C;
   65      blank = ' ';
   66      null = '';
   67      NoFrame = '';
   68      RecType = 1;
   69      SectnEnd = "}";
   70  
   71        (* Error Strings *)
   72      BadCommand = 'unrecognized command';
*****                   ^ not supported yet
   73      CoEqErr = 'Designate colors with "="';
*****                ^ not supported yet
   74      CoFormErr = 'Color statements must be of form: (number, number) attrib';
*****                  ^ not supported yet
   75      CoNumErr = 'Colors must be valid name or number < 16:';
*****                 ^ not supported yet
   76      CornerErr = 'Upper left corner is not above and left of the lower right';
*****                  ^ not supported yet
   77      DataErr = 'data list is missing or format is invalid';
*****                ^ not supported yet
   78      EdErr =  'number of lines for the editor field is missing';
*****               ^ not supported yet
   79      FewErr = 'Fewer fields in command area than on screen';
*****               ^ not supported yet
   80      FMErr = 'FieldMark (#) error: redefinition invalid or field not closed';
*****              ^ not supported yet
   81      FieldFormErr = 'invalid field type or keyword';
*****                     ^ not supported yet
   82      FrameNameErr = "Frame name incorrect or missing; must have ':' in col 0";
*****                     ^ not supported yet
   83      FrameErr = 'Frame must start with either ==== or frame name';
*****                 ^ not supported yet
   84      GroupErr = 'Choice fields must be inside groups';
*****                 ^ not supported yet
   85      HelpErr = 'help list is missing or format is invalid';
*****                ^ not supported yet
   86      HelpFErr = 'frame name for help is missing';
*****                 ^ not supported yet
   87      InsuffMem = 'Too little memory';
*****                  ^ not supported yet
   88      MoreErr = 'More fields in command section than on screen';
*****                ^ not supported yet
   89      NeedBracket = 'Max and min acceptable values in brackets are missing';
*****                    ^ not supported yet
   90      NeedColon = 'colon after position or heading key word is missing';
*****                  ^ not supported yet
   91      NeedParen = 'Field subcommands must start with "("';
*****                  ^ not supported yet
   92      NeedQuote = 'field name (may be null) in quotes must be supplied';
*****                  ^ not supported yet
   93      NestErr = 'Improper nesting of color codes';
*****                ^ not supported yet
   94      NormalErr = 'normal next frame name is missing';
*****                  ^ not supported yet
   95      NumSepErr = 'Either numbers or separators are invalid, check format';
*****                  ^ not supported yet
   96      ParentErr = 'Bad Parent Frame';
*****                  ^ not supported yet
   97      PlacementErr = 'Invalid designation of Frame Above, Below, Left, or Right';
*****                     ^ not supported yet
   98      PromptErr = 'prompt text is missing';
*****                  ^ not supported yet
   99      SectnEndErr = 'Command sections must end with "}"';
*****                    ^ not supported yet
  100      SectnErr = 'Command sections must start with ":{"';
*****                 ^ not supported yet
  101      SelectorErr = 'field selector must be a single character';
*****                    ^ not supported yet
  102      WinFormErr = 'Invalid keyword in windows subsection command';
*****                   ^ not supported yet
  103  
  104    VAR
  105      (* the following are screen characteristics that may be
  106         altered gloablly for a file by commands in any screen frame *)
  107      ColorKeys : ARRAY [0 .. 255] OF CHAR;
*****                              ^ not supported yet
*****                                      ^ not supported yet
  108        (* defined colors *)
  109      KeyFors, KeyBacks : ARRAY [0 .. 255] OF MsColors.AColor;
*****                                      ^ not supported yet
*****                                                       ^ not supported yet
  110      KeyAtrbs :  ARRAY [0 .. 255] OF MsColors.AMonoAttribute;
*****                              ^ not supported yet
*****                                               ^ not supported yet
  111  
  112      DefaultFore, DefaultBack, DefaultBordfor, DefaultBordbak,
  113          DefaultSelfor, DefaultSelbak, DefaultPbfor, DefaultPbbak,
  114          DefaultMsgfor, DefaultMsgbak, DefaultPromfor,
  115          DefaultPrombak: MsColors.AColor;
*****                                   ^ not supported yet
  116  
  117      DefaultAtrb, DefaultBordatrb, DefaultSelatrb, DefaultPbatrb,
  118          DefaultMsgatrb, DefaultPromatrb : MsColors.AMonoAttribute;
*****                                                     ^ not supported yet
  119  
  120      ColorStack: CStackP;
*****                  ^ not supported yet
  121      ColorBase: CStack;
*****                 ^ not supported yet
  122        (* We make ColorBase a record instead of a pointer so as to
  123           avoid doing dynamic memory allocation during the module
  124           initialization sequence. *)
  125      FieldMark : CHAR;
  126        (* field delimiter in the screen image *)
  127      ReplacingFieldMarks : BOOLEAN;
  128  
  129      (* the following variables are used repeatedly and are global
  130         solely for convenience *)
  131      CurrentWord: ARRAY [0..MaxScrWidth] OF CHAR;
*****                             ^ not supported yet
*****                                             ^ not supported yet
  132        (* usually the word retrieved by using GetNextWord *)
  133      Terminator: CHAR;
  134        (* usually the character terminating the word read with GetNextWord *)
  135      CurrentLine: CARDINAL;
  136        (* the line of the input genlist currently being processed *)
  137      CurrentIndex: CARDINAL;
  138        (* the index of the character on the current line currently
  139           being processed *)
  140      DataList, PromptList, HelpList, EdList, FieldList, ImageList, LinkedFrames:
  141        GenLists.GenList;
*****                 ^ not supported yet
  142      ErrStrGlobal : ARRAY [0 .. 255] OF CHAR;
*****                                 ^ not supported yet
*****                                         ^ not supported yet
  143      FrameRec: ScrnTypes.PackedFrameRec;
*****                          ^ not supported yet
  144      HelpFrame, ParentFrame, NormalNextFrame, FrameAbove, FrameBelow,
  145          FrameLeft, FrameRight: ScrnTypes.AFrameName;
*****                                           ^ not supported yet
  146      BadLineGlobal: CARDINAL;
  147      InListGlobal: GenLists.GenList;
*****                             ^ not supported yet
  148      FieldCount, LineCount: CARDINAL;
  149  
  150  PROCEDURE EnclosureCount( Opener, Closer: ARRAY OF CHAR;
*****                                                     ^ not supported yet
  151      VAR TheStr: ARRAY OF CHAR; VAR TheCount: INTEGER;
*****                           ^ not supported yet
  152      VAR StartFound, EndFound: BOOLEAN; CutWhenFound: BOOLEAN );
  153  
  154    (* A general purpose procedure for keeping track of delimiters
  155       that can cross strings and that can be nested.  It's meant
  156       to be called in a loop, and is useful in parsing series of
  157       strings when you need to find closing quotes, braces,
  158       brackets, etc.  The first time you call it, StartFound and
  159       EndFound should be false, and TheCount should be 0. If at
  160       some point in the loop you pass it a string that contains
  161       Opener, it sets StartFound to TRUE and begins to count
  162       instances of Opener and Closer in TheStr--each Opener
  163       increments TheCount, and each Closer decrements it.  Because
  164       StartFound will still be true the next time EnclosureCount
  165       is called, this continues until the Closer that matches
  166       Opener is found (i.e., until TheCount returns to 0).  At
  167       that point, EndFound gets set to TRUE.  If the CutWhenFound
  168       parameter is TRUE, the first Opener and the last Closer are
  169       deleted from TheStr. *)
  170  
  171    VAR
  172      StrIndex : INTEGER;
  173      StrLngth, OpenerLngth, CloserLngth : CARDINAL;
  174    BEGIN
  175      IF NOT StartFound THEN
  176        TheCount := 0;
  177        IF NOT PosUtils.Present( Opener, TheStr ) THEN
*****               ^ not supported yet
*****                        ^ not supported yet
*****                                 ^ not supported yet
*****                                         ^ not supported yet
  178          RETURN;
  179        END;
  180      END;
  181      EndFound := FALSE;
  182      StrLngth := M2Strings.Length( TheStr );
*****                  ^ not supported yet
*****                            ^ not supported yet
*****                                    ^ not supported yet
  183      OpenerLngth := M2Strings.Length( Opener );
*****                     ^ not supported yet
*****                               ^ not supported yet
*****                                       ^ not supported yet
  184      CloserLngth := M2Strings.Length( Closer );
*****                     ^ not supported yet
*****                               ^ not supported yet
*****                                       ^ not supported yet
  185      StrIndex := 0;
  186      WHILE (StrIndex < INTEGER(StrLngth)) AND (NOT EndFound) DO
*****                                        ^ not supported yet
  187        IF ((OpenerLngth = 1) AND (TheStr[StrIndex] = Opener[0]))
*****                                   ^ not supported yet
*****                                                  ^ not supported yet
*****                                                      ^ not supported yet
*****                                                              ^ not supported yet
  188            OR (PosUtils.PosAdr( Opener,
*****                ^ not supported yet
*****                         ^ not supported yet
*****                                 ^ not supported yet
  189            LowLevel.AddAddr(SYSTEM.ADR(TheStr),StrIndex),
*****            ^ not supported yet
*****                     ^ not supported yet
*****                             ^ not supported yet
*****                                    ^ not supported yet
*****                                        ^ not supported yet
*****                                                        ^ not supported yet
  190            OpenerLngth ) = 0) THEN
*****                        ^ not supported yet
  191          TheCount := TheCount + 1;
  192          IF (TheCount = 1) THEN
  193            StartFound := TRUE;
  194            IF CutWhenFound THEN
  195              M2Strings.Delete( TheStr, StrIndex, M2Strings.Length(Opener) );
*****              ^ not supported yet
*****                        ^ not supported yet
*****                                ^ not supported yet
*****                                                  ^ not supported yet
*****                                                            ^ not supported yet
*****                                                                   ^ not supported yet
  196              IF StrIndex # 0 THEN
  197                DEC( StrIndex );
*****                ^ undeclared identifier
*****                              ^ not supported yet
  198              END;
  199            END;
  200          END;
  201        END;
  202        IF ((CloserLngth = 1) AND (TheStr[StrIndex] = Closer[0]))
*****                                   ^ not supported yet
*****                                                  ^ not supported yet
*****                                                      ^ not supported yet
*****                                                              ^ not supported yet
  203            OR (PosUtils.PosAdr( Closer,
*****                ^ not supported yet
*****                         ^ not supported yet
*****                                 ^ not supported yet
  204            LowLevel.AddAddr(SYSTEM.ADR(TheStr),StrIndex),
*****            ^ not supported yet
*****                     ^ not supported yet
*****                             ^ not supported yet
*****                                    ^ not supported yet
*****                                        ^ not supported yet
*****                                                        ^ not supported yet
  205            CloserLngth ) = 0) THEN
*****                        ^ not supported yet
  206          TheCount := TheCount - 1;
  207          IF StartFound AND (TheCount = 0) THEN
  208            IF CutWhenFound THEN
  209              M2Strings.Delete( TheStr, StrIndex, M2Strings.Length(Closer) );
*****              ^ not supported yet
*****                        ^ not supported yet
*****                                ^ not supported yet
*****                                                  ^ not supported yet
*****                                                            ^ not supported yet
*****                                                                   ^ not supported yet
  210            END;
  211            EndFound := TRUE;
  212          END;
  213        END;
  214        INC( StrIndex );
*****        ^ undeclared identifier
*****                      ^ not supported yet
  215      END;
  216    END EnclosureCount;
*****        ^ not supported yet
  217  
  218  
  219  
  220    PROCEDURE EncodeColor( colr: MsColors.AColor): CHAR;
*****                                          ^ not supported yet
  221      VAR
  222        tmpbyte:
  223          RECORD
  224            CASE : BOOLEAN OF
*****            ^ not supported yet
*****                           ^ 'POINTER' expected
  225              TRUE: tcolr: MsColors.AColor;
  226            | FALSE: tlow, thi: CHAR;
  227            END;
  228          END;
  229      BEGIN
  230        tmpbyte.tcolr := colr;
  231        ScrnUtl1.EncodeByte( tmpbyte.tlow);
  232        RETURN tmpbyte.tlow;
  233      END EncodeColor;
  234  
  235    PROCEDURE EncodeAttrib( att: MsColors.AMonoAttribute): CHAR;
  236      VAR
  237        tmpbyte:
  238          RECORD
  239            CASE : BOOLEAN OF
  240              TRUE: tatt: MsColors.AMonoAttribute;
  241            | FALSE: tlow, thi: CHAR;
  242            END;
  243          END;
  244      BEGIN
  245        tmpbyte.tatt := att;
  246        ScrnUtl1.EncodeByte( tmpbyte.tlow);
  247        RETURN tmpbyte.tlow;
  248      END EncodeAttrib;
  249  
  250  
  251    PROCEDURE ReportErr( ErrDesc: ARRAY OF CHAR) : BOOLEAN;
  252      (* appends an error description to the current line of text
  253         and sets the bad line number.  Always returns FALSE for
  254         calling convenience (see usage below). *)
  255      BEGIN
  256        M2Strings.Assign( Parser.TheLine, ErrStrGlobal);
  257        StrEdit.CutLeadingChars( ' ', ErrStrGlobal );
  258        StrEdit.CutTrailingChars( ' ', ErrStrGlobal );
  259        M2Strings.Insert( '  "', ErrStrGlobal, 0 );
  260        StrEdit.Append( ErrStrGlobal, '" : ');
  261        StrEdit.Append( ErrStrGlobal, ErrDesc);
  262        BadLineGlobal := CurrentLine;
  263        RETURN FALSE;
  264      END ReportErr;
  265  
  266  
  267    PROCEDURE GetColorNum( str: ARRAY OF CHAR; VAR num: CARDINAL ): BOOLEAN;
  268      BEGIN
  269        IF (StrConv.StrToCardinal( str, 0, num)) THEN
  270          IF (num > 15) THEN
  271            RETURN ReportErr( CoNumErr);
  272          END;
  273          RETURN TRUE;
  274        END;
  275        IF PosUtils.Equal('BLACK', str) THEN
  276          num := 0;
  277        ELSIF PosUtils.Equal('BLUE', str) THEN
  278          num := 1;
  279        ELSIF PosUtils.Equal('GREEN', str) THEN
  280          num := 2;
  281        ELSIF PosUtils.Equal('CYAN', str) THEN
  282          num := 3;
  283        ELSIF PosUtils.Equal('RED', str) THEN
  284          num := 4;
  285        ELSIF PosUtils.Equal('MAGENTA', str) THEN
  286          num := 5;
  287        ELSIF PosUtils.Equal('BROWN', str) THEN
  288          num := 6;
  289        ELSIF PosUtils.Equal('LIGHTGREY', str) THEN
  290          num := 7;
  291        ELSIF PosUtils.Equal('DARKGREY', str) THEN
  292          num := 8;
  293        ELSIF PosUtils.Equal('LIGHTBLUE', str) THEN
  294          num := 9;
  295        ELSIF PosUtils.Equal('LIGHTGREEN', str) THEN
  296          num := 10;
  297        ELSIF PosUtils.Equal('LIGHTCYAN', str) THEN
  298          num := 11;
  299        ELSIF PosUtils.Equal('PINK', str) THEN
  300          num := 12;
  301        ELSIF PosUtils.Equal('LIGHTMAGENTA', str) THEN
  302          num := 13;
  303        ELSIF PosUtils.Equal('YELLOW', str) THEN
  304          num := 14;
  305        ELSIF PosUtils.Equal('BRIGHTWHITE', str) THEN
  306          num := 15;
  307        ELSE
  308          num := 0;
  309          RETURN ReportErr( CoNumErr);
  310        END;
  311        RETURN TRUE;
  312      END GetColorNum;
  313  
  314  
  315    PROCEDURE NameToAttrib( TheName : ARRAY OF CHAR; VAR answer :
  316        MsColors.AMonoAttribute) : BOOLEAN;
  317        (* converts a string to a text attribute *)
  318      BEGIN
  319        IF PosUtils.Equal('PLAIN',TheName) THEN
  320          answer := MsColors.plain;
  321        ELSIF PosUtils.Equal('BOLD',TheName) THEN
  322          answer := MsColors.bold;
  323        ELSIF PosUtils.Equal('UNDERSCORED',TheName) THEN
  324          answer := MsColors.underscored;
  325        ELSIF PosUtils.Equal('BLINKING',TheName) THEN
  326          answer := MsColors.blinking;
  327        ELSIF PosUtils.Equal('REVERSEVIDEO',TheName) THEN
  328          answer := MsColors.ReverseVideo;
  329        ELSIF PosUtils.Equal('UNDERLINED',TheName) THEN
  330          answer := MsColors.underscored;
  331        ELSIF M2Strings.Length(TheName) = 0 THEN
  332          answer := MsColors.invisible;
  333            (* no attribute specified *)
  334        ELSE
  335          RETURN FALSE;
  336        END;
  337        RETURN TRUE;
  338      END NameToAttrib;
  339  
  340    PROCEDURE LastChar( VAR text: ARRAY OF CHAR): CHAR;
  341      (* cut blanks and return the last non-blnk character in the
  342         string *)
  343      BEGIN
  344        StrEdit.CutTrailingChars( blank, text);
  345        IF M2Strings.Length( text) > 0 THEN
  346          RETURN text[ M2Strings.Length( text) - 1];
  347        ELSE
  348          RETURN EOL;
  349        END;
  350      END LastChar;
  351  
  352  
  353    PROCEDURE CrunchToNextDelim( VAR StartingAndEndingAt: CARDINAL;
  354        VAR text: ARRAY OF CHAR );
  355      VAR
  356        last: CARDINAL;
  357        done: BOOLEAN;
  358      BEGIN
  359        last := M2Strings.Length(text);
  360        IF last = 0 THEN
  361          RETURN;
  362        ELSE
  363          DEC(last);
  364        END;
  365        done := FALSE;
  366        WHILE (StartingAndEndingAt <= last) AND (NOT done) DO
  367          IF text[StartingAndEndingAt] = ' ' THEN
  368            M2Strings.Delete( text, StartingAndEndingAt, 1 );
  369          ELSIF PosUtils.Present( text[StartingAndEndingAt],
  370              Parser.delimiters ) THEN
  371            done := TRUE;
  372          ELSE
  373            INC( StartingAndEndingAt );
  374          END;
  375        END;
  376      END CrunchToNextDelim;
  377  
  378  PROCEDURE NextWord( VAR word: ARRAY OF CHAR; VAR term: CHAR);
  379    (* uses global defaults to shorten call to GetNextWord for
  380       code readability and skiping comments*)
  381    BEGIN
  382      Parser.GetNextWord( InListGlobal, CurrentLine, CurrentIndex, word, term);
  383      WHILE PosUtils.Equal(word,Parser.StartComment) DO
  384        Parser.SkipComments(InListGlobal,CurrentIndex,CurrentLine);
  385        Parser.GetNextWord( InListGlobal, CurrentLine, CurrentIndex, word, term);
  386      END;
  387    END NextWord;
  388  
  389  
  390  PROCEDURE NextWordCap( VAR word: ARRAY OF CHAR; VAR term: CHAR);
  391    (* uses global defaults to shorten call to GetNextWord for
  392       code readability*)
  393    BEGIN
  394      NextWord( word, term);
  395      StrEdit.CAPstr( word);
  396    END NextWordCap;
  397  
  398  
  399  PROCEDURE NextCrunchedWord( VAR word: ARRAY OF CHAR; VAR term: CHAR);
  400    (* gets the next word with blanks deleted and not counted as a
  401       separator *)
  402    VAR
  403      line, index, spot, TypeCode, StrLngth: CARDINAL;
  404    BEGIN
  405      index:=CurrentIndex;
  406      line:=CurrentLine;
  407      IF CurrentLine <= GenLists.ListLength( InListGlobal ) THEN
  408        NextWord(word,term);
  409        IF line=CurrentLine THEN
  410          CurrentIndex:=index
  411        ELSE
  412          CurrentIndex:=0
  413        END;
  414      END;
  415      (*  old version 7/17/91 John McMonagle
  416      WHILE (CurrentIndex >= M2Strings.Length( Parser.TheLine)) AND
  417            (CurrentLine < GenLists.ListLength( InListGlobal)) DO
  418            (* go to next line, skipping blank lines *)
  419        INC( CurrentLine);
  420        GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode);
  421          (*read next line*)
  422        CurrentIndex := 0;
  423        CrunchToNextDelim( CurrentIndex, Parser.TheLine );
  424          (*Set it back to 0.*)
  425        CurrentIndex := 0;
  426        Parser.SkipComments( InListGlobal, CurrentIndex, CurrentLine );
  427          (*We'll go back around if a comment was actually skipped.*)
  428      END;
  429      *)
  430      spot := CurrentIndex;
  431      CrunchToNextDelim( CurrentIndex, Parser.TheLine );
  432      CurrentIndex := spot;
  433      NextWord(word, term);
  434      StrEdit.CAPstr( word);
  435    END NextCrunchedWord;
  436  
  437  
  438  PROCEDURE GetNextSep( VAR Term: CHAR);
  439    (* A muddled function.  Skips over blanks and leaves
  440       CurrentIndex sitting on the first non-blank character that
  441       follows.  If that happens to be a delimiter, increments
  442       CurrentIndex once more. *)
  443    BEGIN
  444      WHILE (CurrentIndex < M2Strings.Length( Parser.TheLine)) AND
  445            (Parser.TheLine[ CurrentIndex] = blank) DO
  446        (* skip blanks *)
  447        INC( CurrentIndex);
  448      END;
  449      IF (CurrentIndex < M2Strings.Length( Parser.TheLine)) THEN
  450          (* return sep, if found *)
  451        Term := Parser.TheLine[ CurrentIndex];
  452        IF PosUtils.Present( Term, Parser.delimiters) THEN
  453          (* skip past separator found, so we start at
  454             beginning of next word next time *)
  455          INC( CurrentIndex);
  456        END;
  457      ELSE
  458        Term := EOL;
  459          (* if at end of line, return EOL *)
  460      END;
  461    END GetNextSep;
  462  
  463  
  464  PROCEDURE NextNum( VAR result: CARDINAL): BOOLEAN;
  465    (* converts next word into a CARDINAL. returns TRUE if OK *)
  466    VAR
  467      Word: ARRAY [0..MaxScrWidth] OF CHAR;
  468    BEGIN
  469      NextWord(Word,
  470                 Terminator);
  471      RETURN StrConv.StrToCardinal( Word, 0, result);
  472    END NextNum;
  473  
  474  
  475  PROCEDURE FindCmdBegin( VAR line, index: CARDINAL): BOOLEAN;
  476    (* looks for the CommandBeginStr and if found, returns:
  477         TRUE, line found on & index past the end of line
  478       else
  479         RETURNS false & line started on & ending index of line. *)
  480    VAR
  481      StartLine, LstLngth, TypeCode: CARDINAL;
  482    BEGIN
  483      StartLine := line;
  484      LstLngth := GenLists.ListLength(InListGlobal);
  485      WHILE (line <= LstLngth) DO
  486        GenLists.GetElmt( InListGlobal, line, Parser.TheLine, TypeCode);
  487        IF PosUtils.Present( CommandBeginStr, Parser.TheLine) THEN
  488          (* found command begin string, so start on next line *)
  489          index := HIGH( Parser.TheLine)+1;
  490          RETURN TRUE;
  491        END;
  492        INC( line);
  493      END;
  494        (* if didn't find cmdbgnstr, go back to starting place *)
  495      line := StartLine;
  496      GenLists.GetElmt( InListGlobal, line, Parser.TheLine, TypeCode);
  497      index := HIGH( Parser.TheLine)+1;
  498      RETURN FALSE;
  499    END FindCmdBegin;
  500  
  501  
  502    PROCEDURE SetToDefaultColors( VAR FrameRec: ScrnTypes.PackedFrameRec );
  503      BEGIN
  504        WITH FrameRec DO
  505          normatrb := DefaultAtrb;
  506          normfor := DefaultFore;
  507          normbak := DefaultBack;
  508            (* Normal text *)
  509          bordatrb := DefaultBordatrb;
  510          bordfor := DefaultBordfor;
  511          bordbak := DefaultBordbak;
  512            (* Border colors *)
  513          selatrb := DefaultSelatrb;
  514          selfor := DefaultSelfor;
  515          selbak := DefaultSelbak;
  516            (* Selected text *)
  517          pbatrb := DefaultPbatrb;
  518          pbfor := DefaultPbfor;
  519          pbbak := DefaultPbbak;
  520            (* Pointer Bar Colors *)
  521          msgatrb := DefaultMsgatrb;
  522          msgfor := DefaultMsgfor;
  523          msgbak := DefaultMsgbak;
  524            (* Message Box Colors *)
  525          promatrb := DefaultPromatrb;
  526          promfor := DefaultPromfor;
  527          prombak := DefaultPrombak;
  528            (* Prompt Line Colors *)
  529        END;
  530      END SetToDefaultColors;
  531  
  532  
  533    PROCEDURE InitOutLists();
  534      (* initialize the output genlists *)
  535      BEGIN
  536        GenLists.NewList( DataList);
  537        GenLists.NewList( PromptList);
  538        GenLists.NewList( HelpList);
  539        GenLists.NewList( EdList);
  540        GenLists.NewList( FieldList);
  541        GenLists.NewList( ImageList);
  542        GenLists.NilList( LinkedFrames );
  543        WITH FrameRec DO
  544          ClearFirst := TRUE;
  545          ClearAfter := FALSE;
  546          EntryBox := VWindows.DoubleBox;
  547          ExitBox := VWindows.SingleBox;
  548          Caption[0] := 0C;
  549          VirtualWidth := 0;
  550          VirtualHeight := 0;
  551          startcol := 0;
  552          endcol := 255;
  553          startrow := 0;
  554          endrow := 255;
  555          headline := 0;
  556          action := "I";
  557        END;
  558        SetToDefaultColors( FrameRec );
  559        StrEdit.SetLength( HelpFrame, 0);
  560        StrEdit.SetLength( ParentFrame, 0);
  561        StrEdit.SetLength( NormalNextFrame, 0);
  562        StrEdit.SetLength( FrameAbove, 0 );
  563        StrEdit.SetLength( FrameBelow, 0 );
  564        StrEdit.SetLength( FrameLeft, 0 );
  565        StrEdit.SetLength( FrameRight, 0 );
  566      END InitOutLists;
  567  
  568  
  569  PROCEDURE GetAFrameName( VAR TheFrame: ARRAY OF CHAR): BOOLEAN;
  570    (* gets the frame key as the next word, if the terminator is OK *)
  571    VAR
  572      tmpstr : ARRAY [0..79] OF CHAR;
  573    BEGIN
  574      IF (Terminator = ":") THEN
  575        NextWord( tmpstr, Terminator);
  576        IF M2Strings.Length(tmpstr) < HIGH(TheFrame) THEN
  577          M2Strings.Assign( tmpstr, TheFrame );
  578          RETURN TRUE;
  579        END;
  580      END;
  581      RETURN FALSE;
  582    END GetAFrameName;
  583  
  584  
  585  PROCEDURE ListStartOK(): BOOLEAN;
  586    (* checks to see if we are at the valid start of a command
  587       area: we must have a ":" and a "{" next *)
  588    VAR
  589      tmpword: ARRAY [0..80] OF CHAR;
  590    BEGIN
  591      IF (Terminator = ":") THEN
  592        NextCrunchedWord( tmpword, Terminator );
  593        RETURN (M2Strings.Length( tmpword) = 0) AND
  594               (Terminator = "{");
  595      END;
  596      RETURN FALSE;
  597    END ListStartOK;
  598  
  599  
  600  PROCEDURE GetList( VAR OutList: GenLists.GenList): BOOLEAN;
  601    (* puts the following lines in a genlist, until a "}" is
  602       reached *)
  603    VAR
  604      type: CARDINAL;
  605      stop: BOOLEAN;
  606    BEGIN
  607      IF ListStartOK() THEN
  608        stop := FALSE;
  609        REPEAT
  610          INC( CurrentLine);
  611          IF CurrentLine > GenLists.ListLength( InListGlobal) THEN
  612            RETURN ReportErr( SectnEndErr);
  613          END;
  614          GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, type);
  615          IF (M2Strings.Length( Parser.TheLine) > 0) AND
  616              (Parser.TheLine[0] = SectnEnd) THEN
  617            stop := TRUE;
  618          ELSIF LastChar( Parser.TheLine) = SectnEnd THEN
  619            M2Strings.Delete( Parser.TheLine,
  620                M2Strings.Length(Parser.TheLine) - 1, 1);
  621            stop := TRUE;
  622            GenLists.ListInsert( Parser.TheLine, GenLists.StrCode,
  623                OutList, AfterLastElmt);
  624          ELSE
  625            GenLists.ListInsert( Parser.TheLine, GenLists.StrCode,
  626                OutList, AfterLastElmt);
  627          END;
  628        UNTIL stop;
  629        (* set CurrentIndex high so GetNextWord will go to the next
  630          line next time. *)
  631        CurrentIndex := HIGH( Parser.TheLine) + 1;
  632        RETURN TRUE;
  633      ELSE
  634        RETURN FALSE;
  635      END;
  636    END GetList;
  637  
  638  PROCEDURE GetFieldMark( Terminator: CHAR): BOOLEAN;
  639    (* reads a new field delimiter for use in the display section *)
  640    BEGIN
  641      IF (Terminator = ":") THEN
  642        NextWord( CurrentWord, Terminator);
  643        IF M2Strings.Length( CurrentWord) = 0 THEN
  644          (*They're using a terminator as a field mark.*)
  645          IF (Terminator # ' ') AND (Terminator # EOL) THEN
  646            FieldMark := Terminator;
  647          ELSE
  648            RETURN FALSE;
  649          END;
  650          GetNextSep( Terminator );
  651            (*They may or may not have '; replace' after FieldMark
  652              command.  This skips it if it's there, and leaves
  653              CurrentIndex on the EOL if not.*)
  654        ELSIF M2Strings.Length( CurrentWord) = 1 THEN
  655          FieldMark := CurrentWord[0];
  656        ELSE
  657          RETURN FALSE;
  658        END;
  659      ELSE
  660        RETURN FALSE;
  661      END;
  662      RETURN TRUE;
  663    END GetFieldMark;
  664  
  665  PROCEDURE CheckHelpFrame();
  666    (* if the help string is only a single word short enough to be
  667       a AFrameName, it is used as the HelpFrame, not a help list *)
  668    VAR
  669      line: ARRAY [0..255] OF CHAR;
  670      lngth, type: CARDINAL;
  671    BEGIN
  672      lngth := GenLists.ListLength( HelpList);
  673      IF (lngth <= 2) THEN
  674        GenLists.GetElmt( HelpList, 1, line, type);
  675        StrEdit.CrunchBlanks( line);
  676        StrEdit.DeleteChar( '}', line );
  677        IF (NOT PosUtils.Present( blank, line)) AND
  678           (M2Strings.Length( line) <= NdxTypes.RecNameLength) THEN
  679          M2Strings.Assign( line, HelpFrame);
  680          GenLists.ListDelete( HelpList, 1, 1);
  681        END;
  682      END;
  683    END CheckHelpFrame;
  684  
  685  
  686  PROCEDURE SetColorBase( fore, back : MsColors.AColor; attrib:
  687      MsColors.AMonoAttribute);
  688    (* sets a new normal color & attribute, which are kept at the
  689       bottom of the color stack *)
  690    BEGIN
  691      ColorBase.forec := fore;
  692      ColorBase.backc := back;
  693      IF attrib <> MsColors.invisible THEN
  694        ColorBase.atrbc := attrib;
  695      END;
  696    END SetColorBase;
  697  
  698  PROCEDURE GetColor( VAR forecolr, backcolr: MsColors.AColor; VAR atrbut:
  699    MsColors.AMonoAttribute): BOOLEAN;
  700    (* decode the following words as colors and attributes *)
  701    VAR
  702      colorord: CARDINAL;
  703      term1 : CHAR;
  704    BEGIN
  705      NextWordCap( CurrentWord, Terminator);
  706        (* get past the "(" *)
  707      IF (M2Strings.Length( CurrentWord) # 0) OR
  708         (Terminator # '(') THEN
  709        RETURN ReportErr( CoFormErr);
  710      END;
  711      NextWordCap( CurrentWord, Terminator);
  712        (* get the 1st color number *)
  713      IF NOT GetColorNum( CurrentWord, colorord ) THEN
  714        RETURN FALSE;
  715      END;
  716      forecolr := VAL( MsColors.AColor, colorord);
  717        (* next, decode background *)
  718      term1 := Terminator;
  719      NextWordCap( CurrentWord, Terminator);
  720        (* get the 2nd color number *)
  721      IF (term1 # ',') OR
  722         (Terminator # ')') THEN
  723        RETURN ReportErr( CoFormErr);
  724      END;
  725      IF NOT GetColorNum( CurrentWord, colorord ) THEN
  726        RETURN FALSE;
  727      END;
  728      backcolr := VAL( MsColors.AColor, colorord);
  729        (* next, decode monochrome attribute *)
  730      GetNextSep( Terminator);
  731        (* see if there is a mono attrib *)
  732      IF Terminator # EOL THEN
  733          (* there is a mono attribute specified *)
  734        NextCrunchedWord( CurrentWord, Terminator);
  735        IF (Terminator # EOL) THEN
  736            (* the mono attrib should be the last word on the line *)
  737          RETURN ReportErr( CoFormErr);
  738        END;
  739        IF NOT NameToAttrib( CurrentWord, atrbut) THEN
  740          RETURN ReportErr( CoFormErr);
  741        END;
  742      END;
  743      RETURN TRUE;
  744    END GetColor;
  745  
  746  
  747  PROCEDURE DoColorChar( colorchar: CHAR) : BOOLEAN;
  748    (* add the following character to the defined global color codes *)
  749    VAR
  750      poscnt: CARDINAL;
  751      for1, back1: MsColors.AColor;
  752      atrb1: MsColors.AMonoAttribute;
  753    BEGIN
  754      poscnt := PosUtils.Pos( colorchar, ColorKeys);
  755      IF poscnt > HIGH( ColorKeys) THEN
  756          (* color character is new *)
  757        poscnt := M2Strings.Length(ColorKeys);
  758        StrEdit.Append( ColorKeys, colorchar);
  759        KeyAtrbs[poscnt] := DefaultAtrb;
  760      END;
  761      IF NOT GetColor( for1, back1, atrb1) THEN
  762        RETURN FALSE;
  763      END;
  764        (* decode foreground and background *)
  765      KeyFors[poscnt] := for1;
  766      KeyBacks[poscnt] := back1;
  767      IF atrb1 <> MsColors.invisible THEN
  768          (* if an attribute specified, replace attribute *)
  769        KeyAtrbs[poscnt] := atrb1;
  770      END;
  771      RETURN TRUE;
  772    END DoColorChar;
  773  
  774  
  775  PROCEDURE DoColors() : BOOLEAN;
  776    (* process the color command section *)
  777    VAR
  778      for1, back1 : MsColors.AColor;
  779      atrb1: MsColors.AMonoAttribute;
  780    BEGIN
  781      IF NOT ListStartOK() THEN
  782        RETURN ReportErr( SectnErr);
  783      END;
  784      REPEAT
  785        NextCrunchedWord( CurrentWord, Terminator);
  786        IF (Terminator # "=") AND
  787           (Terminator # blank) AND
  788           (Terminator # SectnEnd) THEN
  789          RETURN ReportErr( CoEqErr);
  790        END;
  791        IF PosUtils.Equal( CurrentWord, 'BORDER') THEN
  792          IF NOT GetColor( for1, back1, atrb1) THEN
  793            RETURN FALSE;
  794          END;
  795          DefaultBordatrb := atrb1;
  796          DefaultBordfor := for1;
  797          DefaultBordbak := back1;
  798  
  799        ELSIF PosUtils.Equal(CurrentWord, 'SELECTEDTEXT') THEN
  800          IF NOT GetColor( for1, back1, atrb1) THEN
  801            RETURN FALSE;
  802          END;
  803          DefaultSelatrb := atrb1;
  804          DefaultSelfor := for1;
  805          DefaultSelbak := back1;
  806  
  807        ELSIF PosUtils.Equal(CurrentWord, 'NORMALTEXT') THEN
  808          IF NOT GetColor( for1, back1, atrb1) THEN
  809            RETURN FALSE;
  810          END;
  811          DefaultAtrb := atrb1;
  812          DefaultFore := for1;
  813          DefaultBack := back1;
  814          SetColorBase( for1, back1, atrb1);
  815            (* We are changing the normal colors, so change the
  816               colorstack appropriately *)
  817  
  818        ELSIF PosUtils.Equal(CurrentWord, 'POINTERBAR') THEN
  819          IF NOT GetColor( for1, back1, atrb1) THEN
  820            RETURN FALSE;
  821          END;
  822          DefaultPbatrb := atrb1;
  823          DefaultPbfor := for1;
  824          DefaultPbbak := back1;
  825  
  826        ELSIF PosUtils.Equal(CurrentWord, 'MESSAGES') THEN
  827          IF NOT GetColor( for1, back1, atrb1) THEN
  828            RETURN FALSE;
  829          END;
  830          DefaultMsgatrb := atrb1;
  831          DefaultMsgfor := for1;
  832          DefaultMsgbak := back1;
  833  
  834        ELSIF PosUtils.Equal(CurrentWord, 'PROMPTS') THEN
  835          IF NOT GetColor( for1, back1, atrb1) THEN
  836            RETURN FALSE;
  837          END;
  838          DefaultPromatrb := atrb1;
  839          DefaultPromfor := for1;
  840          DefaultPrombak := back1;
  841  
  842        ELSIF M2Strings.Length(CurrentWord) = 1 THEN
  843            (* defining a new color code char *)
  844          IF NOT DoColorChar( CurrentWord[0]) THEN
  845            RETURN FALSE;
  846          END;
  847        ELSIF M2Strings.Length(CurrentWord) = 0 THEN
  848            (* do nothing unless hit end of list *)
  849          IF Terminator = EOF THEN
  850            RETURN ReportErr( SectnEndErr);
  851          END;
  852        ELSE
  853          RETURN ReportErr( CoFormErr);
  854        END;
  855      UNTIL Terminator = SectnEnd;
  856      RETURN TRUE;
  857    END DoColors;
  858  
  859  
  860  PROCEDURE DoWindow() : BOOLEAN;
  861    (* process the window comand section *)
  862  
  863    PROCEDURE NextNumSubOne( VAR result: CARDINAL): BOOLEAN;
  864      (* convert the next word to a number and subtract one *)
  865      BEGIN
  866        IF (NOT NextNum( result)) OR
  867           (result = 0) THEN
  868          RETURN FALSE;
  869        END;
  870        DEC( result);
  871        RETURN TRUE;
  872      END NextNumSubOne;
  873  
  874    BEGIN
  875      (* DoWindow *)
  876      IF NOT ListStartOK() THEN
  877        RETURN ReportErr( SectnErr);
  878      END;
  879      REPEAT
  880        NextCrunchedWord( CurrentWord, Terminator);
  881        IF PosUtils.Equal( CurrentWord, 'POSITION') THEN
  882          IF Terminator # ":" THEN
  883            RETURN ReportErr( NeedColon);
  884          END;
  885          NextWordCap( CurrentWord, Terminator);
  886          WITH FrameRec DO
  887            IF (Terminator # "(") OR
  888               (NOT NextNumSubOne( startcol)) OR
  889               (Terminator # ",") OR
  890               (NOT NextNumSubOne( startrow)) OR
  891               (Terminator # ",") OR
  892               (NOT NextNumSubOne( endcol)) OR
  893               (Terminator # ",") OR
  894               (NOT NextNumSubOne( endrow)) OR
  895               (Terminator # ")") THEN
  896              RETURN ReportErr( NumSepErr);
  897            END;
  898            IF (startcol > endcol) OR
  899               (startrow > endrow)  THEN
  900              RETURN ReportErr( CornerErr);
  901            END;
  902  (*          WindowHite := endrow - startrow;  no longer used *)
  903          END;
  904        ELSIF PosUtils.Equal(CurrentWord, 'NOBOX') THEN
  905          LowLevel.Fill( SYSTEM.ADR(FrameRec.EntryBox),
  906              SYSTEM.TSIZE(VWindows.BoxStr), 0C );
  907          LowLevel.Fill( SYSTEM.ADR(FrameRec.ExitBox),
  908              SYSTEM.TSIZE(VWindows.BoxStr), 0C );
  909            (*Null it completely out to prevent confusion when
  910              we look at raw .DSP file dumps.*)
  911        ELSIF PosUtils.Equal(CurrentWord, 'SINGLEBOX') THEN
  912          FrameRec.ExitBox := VWindows.SingleBox;
  913          FrameRec.EntryBox := VWindows.SingleBox;
  914        ELSIF PosUtils.Equal(CurrentWord, 'DOUBLEBOX') THEN
  915          FrameRec.ExitBox := VWindows.SingleBox;
  916          FrameRec.EntryBox := VWindows.DoubleBox;
  917        ELSIF PosUtils.Equal(CurrentWord, 'ENTRYBOX') THEN
  918          IF Terminator = EOL THEN
  919            LowLevel.Fill( SYSTEM.ADR(FrameRec.EntryBox),
  920                SYSTEM.TSIZE(VWindows.BoxStr), 0C );
  921          ELSE
  922            NextWordCap( FrameRec.EntryBox, Terminator );
  923          END;
  924        ELSIF PosUtils.Equal(CurrentWord, 'EXITBOX') THEN
  925          IF Terminator = EOL THEN
  926            LowLevel.Fill( SYSTEM.ADR(FrameRec.ExitBox),
  927                SYSTEM.TSIZE(VWindows.BoxStr), 0C );
  928          ELSE
  929            NextWordCap( FrameRec.ExitBox, Terminator );
  930          END;
  931        ELSIF PosUtils.Equal(CurrentWord, 'CAPTION') THEN
  932          IF Terminator = EOL THEN
  933            FrameRec.Caption[0] := 0C;
  934          ELSE
  935            NextWord(FrameRec.Caption, Terminator );
  936              (* We call NextWord directly to preserve case
  937                 and spacing in the caption. *)
  938          END;
  939        ELSIF PosUtils.Equal(CurrentWord, 'OVERLAY') THEN
  940          FrameRec.ClearFirst := FALSE;
  941        ELSIF PosUtils.Equal(CurrentWord, 'CLEARFIRST') THEN
  942          FrameRec.ClearFirst := TRUE;
  943        ELSIF PosUtils.Equal(CurrentWord, 'CLEARAFTER') THEN
  944          FrameRec.ClearAfter := TRUE;
  945        ELSIF PosUtils.Equal(CurrentWord, 'HEADINGLINE') OR
  946              PosUtils.Equal(CurrentWord, 'HEADING') THEN
  947          IF Terminator # ":" THEN
  948            RETURN ReportErr( NeedColon);
  949          END;
  950          IF (NOT NextNum( FrameRec.headline)) THEN
  951            RETURN ReportErr( NumSepErr);
  952          END;
  953        ELSIF (M2Strings.Length(CurrentWord) = 0) THEN
  954            (* do nothing unless at end of list *)
  955          IF Terminator = EOF THEN
  956            RETURN ReportErr( SectnEndErr);
  957          END;
  958        ELSE
  959          RETURN ReportErr( WinFormErr);
  960        END;
  961        (* Since we are assuming at this point a command has completed we
  962          will move past any comments etc on the rest of the line *)
  963        IF Terminator # EOL THEN
  964          CurrentIndex:=M2Strings.Length(Parser.TheLine)
  965        END;
  966      UNTIL Terminator = SectnEnd;
  967      RETURN TRUE;
  968    END DoWindow;
  969  
  970  PROCEDURE InitFieldRec( VAR FieldRec: ScrnTypes.InputFieldRecord);
  971    (* initializes the field record *)
  972    BEGIN
  973      LowLevel.Fill( SYSTEM.ADR(FieldRec), ByteFiddler.Size(FieldRec), 0C );
  974    END InitFieldRec;
  975  
  976  PROCEDURE InitImageRec( VAR ImageRec: ScrnTypes.ImageElement );
  977    BEGIN
  978      LowLevel.Fill( SYSTEM.ADR(ImageRec), ByteFiddler.Size(ImageRec), 0C );
  979      ImageRec.row := 1;
  980      ImageRec.col := 1;
  981    END InitImageRec;
  982  
  983  PROCEDURE GetSelector( VAR sel : CARDINAL) : BOOLEAN;
  984    (* parses field for menu select character *)
  985    BEGIN
  986      NextWordCap( CurrentWord, Terminator);
  987      IF (M2Strings.Length( CurrentWord) > 0) OR (Terminator # "(") THEN
  988        IF Terminator = SectnEnd THEN
  989            (* at the end of Fields section *)
  990          RETURN FALSE;
  991        ELSE
  992          RETURN ReportErr( NeedParen);
  993        END;
  994      END;
  995      NextWord( CurrentWord, Terminator );
  996        (*We use GetNextWord instead of NextWordCap to preserve case
  997          of the select char.*)
  998      IF (M2Strings.Length( CurrentWord) > 1) OR (Terminator # ")") THEN
  999        IF NOT StrConv.StrToCardinal( CurrentWord, 0, sel ) THEN
 1000          (*This lets us use extended keys as selectors.*)
 1001          RETURN ReportErr( SelectorErr);
 1002        ELSE
 1003          RETURN TRUE;
 1004        END;
 1005      END;
 1006      IF M2Strings.Length( CurrentWord) = 1 THEN
 1007          (* the menu selector key, if specified for this field *)
 1008        sel := ORD( CurrentWord[0]);
 1009      ELSE
 1010        sel := 0;
 1011      END;
 1012      RETURN TRUE;
 1013    END GetSelector;
 1014  
 1015  PROCEDURE GetInteger( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN;
 1016    BEGIN
 1017      FieldRec.typ := ScrnTypes.IntCode;
 1018      IF (Terminator # "[") THEN
 1019        RETURN ReportErr( NeedBracket);
 1020      END;
 1021      NextWordCap( CurrentWord, Terminator);
 1022      IF (CurrentWord[0] = 0C) AND (Terminator = "-") THEN
 1023        (*The lower bound is negative.*)
 1024        NextWordCap( CurrentWord, Terminator );
 1025        M2Strings.Insert( "-", CurrentWord, 0 );
 1026      END;
 1027      IF (Terminator = ".") THEN
 1028        (*The bounds are separated with .. instead of - .*)
 1029        GetNextSep( Terminator );
 1030        IF (Terminator # ".") THEN
 1031          RETURN ReportErr( NumSepErr);
 1032        END;
 1033      END;
 1034      IF NOT (StrConv.StrToLongInteger( CurrentWord, 0, FieldRec.iMin)) THEN
 1035        RETURN ReportErr( NumSepErr);
 1036      END;
 1037      NextWordCap( CurrentWord, Terminator);
 1038      IF (CurrentWord[0] = 0C) AND (Terminator = "-") THEN
 1039        (*The upper bound is negative.*)
 1040        NextWordCap( CurrentWord, Terminator );
 1041        M2Strings.Insert( "-", CurrentWord, 0 );
 1042      END;
 1043      IF NOT (StrConv.StrToLongInteger( CurrentWord, 0, FieldRec.iMax)) AND
 1044         (Terminator = "]") THEN
 1045        RETURN ReportErr( NeedBracket);
 1046      END;
 1047      GetNextSep( Terminator);
 1048        (* move separator past the ] *)
 1049      RETURN TRUE;
 1050    END GetInteger;
 1051  
 1052  
 1053  PROCEDURE GetReal( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN;
 1054    BEGIN
 1055      IF (Terminator # "[") THEN
 1056        RETURN ReportErr( NeedBracket);
 1057      END;
 1058      IF NOT StrCnv1.GetEmbeddedReal( Parser.TheLine, CurrentIndex,
 1059          FieldRec.rMin ) THEN
 1060        RETURN ReportErr( NumSepErr );
 1061      END;
 1062        (* CurrentIndex should now be sitting on whatever follows the first
 1063           number -- probably a space, maybe a '.' or a '-'. *)
 1064      IF Parser.TheLine[ CurrentIndex ] = ' ' THEN
 1065        GetNextSep( Terminator);
 1066      ELSE
 1067        INC( CurrentIndex );
 1068      END;
 1069        (* CurrentIndex is now sitting on the character following
 1070           the first character of the separator. *)
 1071      IF Parser.TheLine[ CurrentIndex ] = '.' THEN
 1072        (* Don't start looking for the next number in the middle of
 1073           the .. separator. *)
 1074        INC( CurrentIndex );
 1075      END;
 1076      IF NOT StrCnv1.GetEmbeddedReal( Parser.TheLine, CurrentIndex,
 1077          FieldRec.rMax ) THEN
 1078        RETURN ReportErr( NumSepErr );
 1079      END;
 1080  
 1081      GetNextSep( Terminator);
 1082      IF (Terminator # "]") THEN
 1083        RETURN ReportErr( NumSepErr);
 1084      END;
 1085      GetNextSep( Terminator);
 1086        (* move separator past the ] *)
 1087      RETURN TRUE;
 1088    END GetReal;
 1089  
 1090  
 1091  PROCEDURE GetEdField( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN;
 1092    VAR
 1093      TmpEdList: GenLists.GenList;
 1094    BEGIN
 1095      FieldRec.typ := ScrnTypes.EditorCode;
 1096      NextWordCap( CurrentWord, Terminator);
 1097      IF NOT (StrConv.StrToCardinal( CurrentWord, 0, FieldRec.Row2) AND
 1098         (* Row2 is the number of lines now; we will correct it to
 1099            the ending virtual row number when we process the image
 1100            and find out what row it starts on. *)
 1101         (Terminator = blank)) THEN
 1102        RETURN ReportErr( EdErr);
 1103      END;
 1104      NextWordCap( CurrentWord, Terminator);
 1105      IF NOT (PosUtils.Equal( CurrentWord, "LINES") OR
 1106              PosUtils.Equal( CurrentWord, "LINE")) THEN
 1107        RETURN ReportErr( EdErr);
 1108      END;
 1109      FieldRec.TextRow1 := 0;
 1110      FieldRec.CursorCol := 1;
 1111      FieldRec.CursorRow := 1;
 1112      FieldRec.MaxLines := 0;
 1113      FieldRec.ChangeMade := FALSE;
 1114      FieldRec.ReadOnly := FALSE;
 1115      GenLists.NewList( TmpEdList);
 1116      GenLists.ListInsert( TmpEdList, GenLists.ListCode, EdList, AfterLastElmt);
 1117      FieldRec.EdFieldNum := GenLists.ListLength( EdList);
 1118      RETURN TRUE;
 1119    END GetEdField;
 1120  
 1121  
 1122  PROCEDURE GetFieldData( VAR FieldRec: ScrnTypes.InputFieldRecord ): BOOLEAN;
 1123    (* This lets you put the word 'data' somewhere in the list of
 1124       field attributes in the same way that you put 'prompt' there
 1125       in releases preceding 1.5d.  GetFieldData appends the fieldname to
 1126       the frame's DataList, and then looks for the next
 1127       line that contains an opening brace, and puts it plus all
 1128       lines that follow it up to the matching closing brace into a
 1129       TmpList, which it then appends to the end of the frame's
 1130       DataList.  This means you can find the data associated with a
 1131       particular field by starting at the end of the frame's
 1132       DataList.  Any time you find an element that is a list, you
 1133       look at the preceding element of the frame's DataList to see if it
 1134       contains the field name in which you are interested.  If it
 1135       does, the elements of the sublist will be the
 1136       strings retrieved by GetFieldData.  We use it for things
 1137       like initialization of Editor fields and storage of
 1138       StrLogic expressions. *)
 1139    VAR
 1140      TmpList: GenLists.GenList;
 1141      BraceCount : INTEGER;
 1142      StartFound, EndFound : BOOLEAN;
 1143      TypeCode : CARDINAL;
 1144  
 1145    BEGIN
 1146      BraceCount := 0;
 1147      StartFound := FALSE;
 1148      EndFound := FALSE;
 1149      GenLists.NewList( TmpList );
 1150      REPEAT
 1151        INC( CurrentLine);
 1152        IF CurrentLine < GenLists.ListLength( InListGlobal) THEN
 1153          GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode );
 1154  
 1155          EnclosureCount( '{', '}', Parser.TheLine, BraceCount, StartFound,
 1156              EndFound, TRUE );
 1157  
 1158          IF StartFound THEN
 1159            GenLists.ListInsert( Parser.TheLine, GenLists.StrCode,
 1160                TmpList, AfterLastElmt);
 1161          END;
 1162        ELSE
 1163          RETURN ReportErr( DataErr);
 1164        END;
 1165      UNTIL EndFound;
 1166      GenLists.ListInsert( FieldRec.fnam, GenLists.StrCode, DataList,
 1167          AfterLastElmt );
 1168        (* We insert the field name as the preceding element of the DataList
 1169           so that users will be able to find the data associated with
 1170           a particular field by looking for its name. *)
 1171      GenLists.ListInsert( TmpList, GenLists.ListCode, DataList, AfterLastElmt );
 1172      CurrentIndex := M2Strings.Length( Parser.TheLine);
 1173      RETURN TRUE;
 1174    END GetFieldData;
 1175  
 1176  
 1177  PROCEDURE GetFieldOptions( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN;
 1178    VAR
 1179      DataFound, PromptFound : BOOLEAN;
 1180      type : CARDINAL;
 1181    BEGIN
 1182      PromptFound := FALSE;
 1183      DataFound := FALSE;
 1184      IF Terminator = SectnEnd THEN
 1185        RETURN TRUE;
 1186      END;
 1187      REPEAT
 1188        GetNextSep( Terminator);
 1189        IF Terminator # EOL THEN
 1190          NextWordCap( CurrentWord, Terminator);
 1191          IF PosUtils.Equal(CurrentWord, 'REQUIRED') THEN
 1192            FieldRec.req := TRUE;
 1193          ELSIF PosUtils.Equal(CurrentWord, 'PROMPT') THEN
 1194            PromptFound := TRUE;
 1195            Terminator:=EOL;
 1196          ELSIF PosUtils.Equal(CurrentWord, 'DATA') THEN
 1197            DataFound := TRUE;
 1198          ELSIF PosUtils.Equal(CurrentWord, 'HELP') THEN
 1199            IF Terminator = EOL THEN
 1200              RETURN ReportErr( HelpFErr);
 1201            END;
 1202            NextWord( FieldRec.HelpFrame, Terminator );
 1203              (*Changed on 23 Apr 88:  use GetNextWord to preserve case
 1204                sensitivity.*)
 1205          ELSIF FieldRec.typ = ScrnTypes.EditorCode THEN
 1206            IF PosUtils.Equal( CurrentWord, "READONLY" ) THEN
 1207              FieldRec.ReadOnly := TRUE;
 1208            ELSIF PosUtils.Equal( CurrentWord, "MAXLINES" ) THEN
 1209              IF NOT NextNum( FieldRec.MaxLines ) THEN
 1210                FieldRec.MaxLines := 0;
 1211                RETURN ReportErr( EdErr );
 1212              END;
 1213            END;
 1214          END;
 1215        END;
 1216      UNTIL (Terminator = EOL) OR (Terminator = SectnEnd) OR
 1217            (Terminator = EOF);
 1218      IF PromptFound THEN
 1219        (* add the prompt to the prompt list *)
 1220        IF Terminator = SectnEnd THEN
 1221          RETURN FALSE;
 1222        END;
 1223        INC( CurrentLine);
 1224        IF CurrentLine < GenLists.ListLength( InListGlobal) THEN
 1225          GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, type);
 1226          GenLists.ListInsert( Parser.TheLine, GenLists.StrCode,
 1227              PromptList, AfterLastElmt);
 1228          FieldRec.PromptNum := GenLists.ListLength( PromptList);
 1229        ELSE
 1230          RETURN ReportErr( PromptErr);
 1231        END;
 1232        CurrentIndex := M2Strings.Length( Parser.TheLine);
 1233      END;
 1234      IF DataFound THEN
 1235        IF Terminator = SectnEnd THEN
 1236          RETURN FALSE;
 1237        END;
 1238        IF NOT GetFieldData( FieldRec ) THEN
 1239          RETURN FALSE;
 1240        END;
 1241      END;
 1242      RETURN TRUE;
 1243    END GetFieldOptions;
 1244  
 1245  
 1246  PROCEDURE DoFields() : BOOLEAN;
 1247    (* process the Fields section of the command area *)
 1248    VAR
 1249      FieldRec: ScrnTypes.InputFieldRecord;
 1250      DummyDspFile: ScrnTypes.DisplayFile;
 1251      selector, GroupCounter, GroupMax: CARDINAL;
 1252      GroupHeader: BOOLEAN;
 1253      realDecPlaces : CARDINAL;                                (* JDM/MBC *)
 1254    BEGIN
 1255      IF NOT ListStartOK() THEN
 1256        RETURN ReportErr( SectnErr);
 1257      END;
 1258      GroupMax := 0;
 1259      REPEAT
 1260        GroupHeader := FALSE;
 1261        InitFieldRec( FieldRec);
 1262        IF NOT GetSelector( selector) THEN
 1263          IF M2Strings.Length( ErrStrGlobal) = 0 THEN
 1264            RETURN TRUE;
 1265          ELSE
 1266            RETURN FALSE;
 1267          END;
 1268        END;
 1269  (*
 1270        NextWordCap( CurrentWord, Terminator);
 1271          (* space between ) and ' *)
 1272        IF (M2Strings.Length( CurrentWord) > 0) OR (Terminator # "'") THEN
 1273          RETURN ReportErr( NeedQuote);
 1274        END;
 1275  *)
 1276        NextWordCap( FieldRec.fnam, Terminator);
 1277          (* get field name *)
 1278        IF Terminator # "'" THEN
 1279          RETURN ReportErr( NeedQuote);
 1280        END;
 1281        NextWordCap( CurrentWord, Terminator);
 1282        IF PosUtils.Equal( CurrentWord, 'STRING') THEN
 1283          FieldRec.typ := ScrnTypes.StringCode;
 1284        ELSIF PosUtils.Equal(CurrentWord, 'GOTO') THEN
 1285          FieldRec.typ := ScrnTypes.GotoCode;
 1286          FieldRec.MenuKey := selector;
 1287          NextWord(  FieldRec.ReturnVal, Terminator );
 1288            (*Use GetNextWord to preserve case sensitivity.*)
 1289        ELSIF PosUtils.Equal(CurrentWord, 'INTEGER') THEN
 1290          IF NOT GetInteger( FieldRec) THEN
 1291            RETURN FALSE;
 1292          END;
 1293        ELSIF PosUtils.Equal(CurrentWord, 'REAL') THEN
 1294          (*  We have to set the tag field before any of the variant
 1295              fields; Stony Brook is smart enough to check for consistency. *)
 1296          FieldRec.typ := ScrnTypes.RealCode;
 1297          IF Terminator = "."  THEN
 1298            (* find and load the number of decimal places for the REAL *)
 1299            IF NOT NextNum( realDecPlaces ) THEN
 1300              RETURN ReportErr( NumSepErr );
 1301            ELSE
 1302              FieldRec.decimalPlace := VAL( ScrnTypes.DecimalPlaceType,
 1303                                            realDecPlaces );
 1304            END
 1305          ELSE
 1306            (* Signal that the default of user-specified dec. place used *)
 1307            FieldRec.decimalPlace := -1;
 1308          END;
 1309          IF NOT GetReal( FieldRec) THEN
 1310            RETURN FALSE;
 1311          END;
 1312        ELSIF PosUtils.Equal(CurrentWord, 'GROUP') THEN
 1313          GroupHeader := TRUE;
 1314          GroupCounter := 1;
 1315          IF (NOT NextNum( GroupMax)) OR
 1316             (GroupMax = 0) THEN
 1317            RETURN ReportErr( NumSepErr);
 1318          END;
 1319        ELSIF PosUtils.Equal(CurrentWord, 'CHOICE') THEN
 1320          IF (GroupMax = 0) THEN
 1321            (* error if didn't start a group first *)
 1322            RETURN ReportErr( GroupErr);
 1323          END;
 1324          FieldRec.typ := ScrnTypes.GroupMember;
 1325          FieldRec.ChoiceKey := selector;
 1326          FieldRec.GroupSize := GroupMax;
 1327          FieldRec.GroupID := GroupCounter;
 1328          FieldRec.selected := (GroupCounter = 1);
 1329            (* TRUE for first field *)
 1330          INC( GroupCounter);
 1331          IF (GroupMax < GroupCounter) THEN
 1332             (* at end of group, reset size to show no group is active *)
 1333            GroupMax := 0;
 1334          END;
 1335        ELSIF PosUtils.Equal(CurrentWord, 'EDITOR') THEN
 1336          IF NOT GetEdField( FieldRec) THEN
 1337            RETURN FALSE;
 1338          END;
 1339        ELSIF PosUtils.Equal(CurrentWord, 'DISPLAY') OR
 1340              PosUtils.Equal(CurrentWord, 'DISPLAYONLY') THEN
 1341          FieldRec.typ := ScrnTypes.DispCode;
 1342  
 1343        ELSIF M2Strings.Length(CurrentWord) = 0 THEN
 1344          (* do nothing unless at end of list *)
 1345          IF Terminator = EOF THEN
 1346            RETURN ReportErr( SectnEndErr);
 1347          END;
 1348        ELSE
 1349          (* This is what allows you to have user-defined type names.*)
 1350          FieldRec.typ := FieldTypes.TypeCode(  CurrentWord );
 1351        END;
 1352        IF NOT GroupHeader THEN
 1353          (* do not process options or save a field record for
 1354             group headers *)
 1355          IF NOT GetFieldOptions( FieldRec) THEN
 1356            RETURN FALSE;
 1357          END;
 1358          GenLists.ListInsert( FieldRec, RecType, FieldList, AfterLastElmt);
 1359        END;
 1360      UNTIL Terminator = SectnEnd;
 1361      RETURN TRUE;
 1362    END DoFields;
 1363  
 1364  PROCEDURE DoCommandArea( VAR FrameName: ScrnTypes.AFrameName): BOOLEAN;
 1365    (* Processes the command area of the frame.  FrameName is set to
 1366       the name of the frame processed.  The other output is communicated
 1367       in the global variables that MakeOutList uses. *)
 1368    VAR
 1369      dumtype: CARDINAL;
 1370    BEGIN
 1371      ReplacingFieldMarks := FALSE;
 1372      NextWordCap( CurrentWord, Terminator);
 1373        (* We start by determining whether FrameName is inside or
 1374           outside the Command Area -- outside is the old syntax. *)
 1375      IF (Parser.TheLine[0] # BorderChar) OR
 1376         (M2Strings.Length(CurrentWord) # 0) THEN
 1377        FrameName[0] := 0C;
 1378        IF NOT FindCmdBegin( CurrentLine, CurrentIndex) THEN
 1379          RETURN ReportErr( FrameErr);
 1380        END;
 1381      ELSE
 1382        (* FrameName is outside the command area. *)
 1383        NextWord( CurrentWord, Terminator );
 1384          (* The frame name is next and it should be the last thing
 1385             on the line.  We use GetNextWord to preserve case
 1386             sensitivity.*)
 1387        IF (Terminator # EOL) OR
 1388           (M2Strings.Length(CurrentWord) = 0) THEN
 1389          RETURN ReportErr( FrameNameErr);
 1390        END;
 1391          (* save name, which was CAPPED by NextWordCap() *)
 1392        M2Strings.Assign( CurrentWord, FrameName);
 1393        IF NOT FindCmdBegin( CurrentLine, CurrentIndex) THEN
 1394            (* continue only if find a command begin string *)
 1395          RETURN TRUE;
 1396        END;
 1397      END;
 1398  
 1399      LOOP
 1400        NextCrunchedWord( CurrentWord, Terminator);
 1401        IF PosUtils.Equal( CurrentWord, 'PARENTFRAME' ) THEN
 1402          IF NOT GetAFrameName( ParentFrame) THEN
 1403            RETURN ReportErr( ParentErr);
 1404          END;
 1405        ELSIF PosUtils.Equal( CurrentWord, 'NORMALNEXT' ) THEN
 1406          IF NOT GetAFrameName( NormalNextFrame) THEN
 1407            RETURN ReportErr( NormalErr);
 1408          END;
 1409        ELSIF PosUtils.Equal( CurrentWord, 'FRAMEABOVE' ) THEN
 1410          IF NOT GetAFrameName( FrameAbove ) THEN
 1411            RETURN ReportErr( PlacementErr );
 1412          END;
 1413        ELSIF PosUtils.Equal( CurrentWord, 'FRAMEBELOW' ) THEN
 1414          IF NOT GetAFrameName( FrameBelow ) THEN
 1415            RETURN ReportErr( PlacementErr );
 1416          END;
 1417        ELSIF PosUtils.Equal( CurrentWord, 'FRAMELEFT' ) THEN
 1418          IF NOT GetAFrameName( FrameLeft ) THEN
 1419            RETURN ReportErr( PlacementErr );
 1420          END;
 1421        ELSIF PosUtils.Equal( CurrentWord, 'FRAMERIGHT' ) THEN
 1422          IF NOT GetAFrameName( FrameRight ) THEN
 1423            RETURN ReportErr( PlacementErr );
 1424          END;
 1425        ELSIF PosUtils.Equal( CurrentWord, 'FIELDMARK' ) THEN
 1426          IF NOT GetFieldMark( Terminator) THEN
 1427            RETURN ReportErr( FMErr);
 1428          END;
 1429        ELSIF PosUtils.Equal( CurrentWord, 'WINDOW' ) THEN
 1430          IF NOT DoWindow() THEN
 1431            RETURN FALSE;
 1432          END;
 1433        ELSIF PosUtils.Equal( CurrentWord, 'DATA' ) THEN
 1434          IF NOT GetList( DataList) THEN
 1435            RETURN ReportErr( DataErr);
 1436          END;
 1437        ELSIF PosUtils.Equal( CurrentWord, 'HELP' ) THEN
 1438          IF NOT GetList( HelpList) THEN
 1439            RETURN ReportErr( HelpErr);
 1440          END;
 1441          CheckHelpFrame();
 1442        ELSIF PosUtils.Equal( CurrentWord, 'COLORS' ) THEN
 1443          IF NOT DoColors() THEN
 1444            RETURN FALSE;
 1445          END;
 1446        ELSIF PosUtils.Equal( CurrentWord, 'FIELDS' ) THEN
 1447          IF NOT DoFields() THEN
 1448            RETURN FALSE;
 1449          END;
 1450        ELSIF PosUtils.Present( CommandEndStr, Parser.TheLine) THEN
 1451          IF FrameName[0] = 0C THEN
 1452            (*We never found a FrameName.*)
 1453            StrEdit.AssignStr( FrameNameErr, ErrStrGlobal );
 1454            RETURN FALSE;
 1455          END;
 1456          RETURN TRUE;
 1457        ELSIF (Parser.TheLine[0] = BorderChar) AND
 1458           (M2Strings.Length(CurrentWord) = 0) THEN
 1459          NextWord( CurrentWord, Terminator );
 1460            (* The frame name is next (and it should be the last thing
 1461               on the line); don't use NextWordCap because it caps, and
 1462               we want to be case sensitive with frame names.  *)
 1463          IF (* (Terminator # EOL) OR   JM 7/16/91 *)
 1464             (M2Strings.Length(CurrentWord) = 0) THEN
 1465            RETURN ReportErr( FrameNameErr);
 1466          END;
 1467          M2Strings.Assign( CurrentWord, FrameName);
 1468            (* Save name*)
 1469        ELSIF PosUtils.Equal( CurrentWord, 'HITANYKEY') THEN
 1470          FrameRec.action := "W";
 1471        ELSIF PosUtils.Equal( CurrentWord, 'DISPLAYONLY') THEN
 1472          FrameRec.action := "D";
 1473        ELSIF PosUtils.Equal( CurrentWord, 'INPUTSCREEN') THEN
 1474          FrameRec.action := "I";
 1475        ELSIF PosUtils.Equal( CurrentWord, 'REPLACE') THEN
 1476          ReplacingFieldMarks := TRUE;
 1477        ELSE
 1478          RETURN ReportErr( BadCommand);
 1479        END;
 1480      END;
 1481    END DoCommandArea;
 1482  
 1483    PROCEDURE CheckFieldNumber();
 1484      (* check if same number of fields on screen as defined *)
 1485      BEGIN
 1486        IF FieldCount < GenLists.ListLength( FieldList) THEN
 1487          StrEdit.AssignStr( MoreErr, ErrStrGlobal);
 1488          BadLineGlobal := CurrentLine;
 1489        ELSIF FieldCount > GenLists.ListLength( FieldList) THEN
 1490          StrEdit.AssignStr( FewErr, ErrStrGlobal);
 1491          BadLineGlobal := CurrentLine;
 1492  (*      ELSIF LineCount > (WindowHite + 1) THEN
 1493          AssignStr( 'Warning: screen may exceed window; scrolling may occur',
 1494                      ErrStrGlobal); *)
 1495        END;
 1496      END CheckFieldNumber;
 1497  
 1498    PROCEDURE AddToOutList(VAR line : ARRAY OF CHAR): BOOLEAN;
 1499  
 1500      PROCEDURE HaveColor(): BOOLEAN;
 1501        BEGIN
 1502          (* is true if a color is turned on (we will store blanks) *)
 1503          RETURN(ColorStack^.prv <> NIL)
 1504        END HaveColor;
 1505  
 1506      PROCEDURE AddColor( incode: CHAR; forcod, backcod: MsColors.AColor;
 1507                          atrbcod: MsColors.AMonoAttribute);
 1508        BEGIN
 1509          VStorage.DosAlloc( ColorStack^.nxt, SYSTEM.TSIZE(CStack) );
 1510          ColorStack^.nxt^.prv := ColorStack;
 1511          ColorStack := ColorStack^.nxt;
 1512          ColorStack^.Ccode := incode;
 1513          ColorStack^.forec := forcod;
 1514          ColorStack^.backc := backcod;
 1515          ColorStack^.atrbc := atrbcod;
 1516          ColorStack^.nxt := NIL;
 1517        END AddColor;
 1518  
 1519      PROCEDURE DeleteColor(): BOOLEAN;
 1520        BEGIN
 1521          IF ColorStack^.prv = NIL THEN
 1522            RETURN ReportErr( NestErr);
 1523          ELSE
 1524            ColorStack := ColorStack^.prv;
 1525            VStorage.DosDealloc( ColorStack^.nxt, SYSTEM.TSIZE(CStack) );
 1526              (* Note that this will never deallocate the
 1527                 ColorBase, which is good since ColorBase is now
 1528                 in the data segment. *)
 1529            ColorStack^.nxt := NIL;
 1530            RETURN TRUE;
 1531          END;
 1532        END DeleteColor;
 1533  
 1534      VAR
 1535        InAField, firstcol, ColorChange : BOOLEAN;
 1536        LineLngth, indentation, i, WhichColor, BlanksInARow : CARDINAL;
 1537        ImageRec: ScrnTypes.ImageElement;
 1538  
 1539      PROCEDURE AddRecord( VAR ImageRec: ScrnTypes.ImageElement);
 1540        VAR
 1541          FieldRec: ScrnTypes.InputFieldRecord;
 1542          TmpCol2, type: CARDINAL;
 1543        BEGIN
 1544          TmpCol2 := ImageRec.col + M2Strings.Length(
 1545              ImageRec.text) - 1;
 1546          IF (ImageRec.field > 0) THEN
 1547              (* save image list position in ImageNum field in field record *)
 1548            IF FieldCount > GenLists.ListLength( FieldList ) THEN
 1549              IF NOT ReportErr( FewErr ) THEN
 1550              END;
 1551              RETURN;
 1552            END;
 1553            GenLists.GetElmt( FieldList, FieldCount, FieldRec, type);
 1554            FieldRec.ImageNum := GenLists.ListLength( ImageList) + 1;
 1555            IF FieldRec.typ = ScrnTypes.EditorCode THEN
 1556                (* This editor field's width & height must be stored *)
 1557              INC( FieldRec.Row2, ImageRec.row - 1);
 1558              IF FieldRec.Row2 > FrameRec.VirtualHeight THEN
 1559                FrameRec.VirtualHeight := FieldRec.Row2;
 1560              END;
 1561              IF ReplacingFieldMarks THEN
 1562                FieldRec.Col2 := TmpCol2 + 1;
 1563              ELSE
 1564                FieldRec.Col2 := TmpCol2;
 1565              END;
 1566              IF FieldRec.Col2 > FrameRec.VirtualWidth THEN
 1567                FrameRec.VirtualWidth := FieldRec.Col2;
 1568              END;
 1569            END;
 1570            GenLists.ListReplace( FieldRec, type, FieldList, FieldCount);
 1571          END;
 1572          IF ImageRec.row > FrameRec.VirtualHeight THEN
 1573            FrameRec.VirtualHeight := ImageRec.row;
 1574          END;
 1575          IF TmpCol2 > FrameRec.VirtualWidth THEN
 1576            FrameRec.VirtualWidth := TmpCol2;
 1577          END;
 1578          ScrnUtl1.EncodeImageRec( ImageRec);
 1579          GenLists.ListInsert( ImageRec, GenLists.StrCode,
 1580              ImageList, AfterLastElmt);
 1581        END AddRecord;
 1582  
 1583      PROCEDURE NewLineCheck();
 1584        VAR
 1585          BufChar : CHAR;
 1586          FieldRec: ScrnTypes.InputFieldRecord;
 1587        BEGIN
 1588          BufChar := line[indentation - 1];
 1589          WhichColor := PosUtils.Pos( BufChar, ColorKeys);
 1590          IF (BufChar = FieldMark) OR
 1591              (WhichColor <= HIGH(ColorKeys)) OR
 1592              ((BufChar = blank) AND (NOT ColorChange)) THEN
 1593            RETURN;
 1594          END;
 1595          IF firstcol THEN
 1596              (* in first column of new line *)
 1597            InitImageRec( ImageRec );
 1598            firstcol := FALSE;
 1599          ELSIF ((BlanksInARow>=3) AND (NOT HaveColor())) OR
 1600              ColorChange THEN
 1601            IF BlanksInARow >= 3 THEN
 1602                (* cut blanks from the end of the string *)
 1603              StrEdit.CutTrailingChars( blank, ImageRec.text);
 1604            END;
 1605            AddRecord( ImageRec);
 1606            InitImageRec( ImageRec );
 1607          ELSE
 1608            RETURN;
 1609          END;
 1610          WITH ImageRec DO
 1611            row := LineCount;
 1612            col := indentation;
 1613            foreg := ColorStack^.forec;
 1614            backg := ColorStack^.backc;
 1615            atrb := ColorStack^.atrbc;
 1616            IF InAField THEN
 1617              field := FieldCount;
 1618            ELSE
 1619              field := 0;
 1620            END;
 1621          END;
 1622          ColorChange := FALSE;
 1623        END NewLineCheck;
 1624  
 1625      BEGIN
 1626        (*AddToOutList*)
 1627        IF PosUtils.IsBlank(line) THEN
 1628          RETURN TRUE;
 1629        END;
 1630        InAField := FALSE;
 1631        firstcol := TRUE;
 1632        ColorChange := FALSE;
 1633        BlanksInARow := 0;
 1634        indentation := 1;
 1635        LineLngth := M2Strings.Length( line);
 1636        InitImageRec( ImageRec );
 1637        WHILE indentation <= LineLngth DO
 1638          NewLineCheck();
 1639          IF line[indentation - 1]=FieldMark THEN
 1640            IF ColorStack^.Ccode = FieldMark THEN
 1641                (* if this mark is at end of a field *)
 1642              InAField := FALSE;
 1643              IF NOT DeleteColor() THEN
 1644                RETURN FALSE;
 1645              END;
 1646            ELSE
 1647                (* we are at the beginning of a field *)
 1648              AddColor( FieldMark, ColorStack^.forec,
 1649                        ColorStack^.backc, ColorStack^.atrbc);
 1650                (* Use existing color for menu item *)
 1651              InAField := TRUE;
 1652              INC( FieldCount);
 1653            END;
 1654            IF ReplacingFieldMarks THEN
 1655              line[ indentation - 1] := blank;
 1656              IF InAField AND (line[indentation] # blank) THEN
 1657                (*We do the following to prevent the color change associated
 1658                  with the field from beginning until _after_ the replaced
 1659                  space.*)
 1660                INC( indentation );
 1661                INC(BlanksInARow);
 1662                IF ((BlanksInARow<3) AND (NOT firstcol)) OR HaveColor() THEN
 1663                  StrEdit.Append(ImageRec.text, blank);
 1664                END;
 1665              END;
 1666            ELSE
 1667              M2Strings.Delete(line, indentation - 1, 1);
 1668              DEC( LineLngth );
 1669            END;
 1670            BlanksInARow := 0;
 1671            ColorChange := TRUE;
 1672          ELSIF WhichColor <= HIGH(ColorKeys) THEN
 1673            IF ColorStack^.Ccode = ColorKeys[ WhichColor] THEN
 1674              IF NOT DeleteColor() THEN
 1675                RETURN FALSE;
 1676              END;
 1677            ELSE
 1678              AddColor( ColorKeys[WhichColor], KeyFors[WhichColor],
 1679                        KeyBacks[WhichColor], KeyAtrbs[WhichColor]);
 1680            END;
 1681            M2Strings.Delete(line, indentation - 1, 1);
 1682            DEC( LineLngth );
 1683            BlanksInARow := 0;
 1684            ColorChange := TRUE;
 1685          ELSIF line[indentation - 1]=blank THEN
 1686            INC(indentation);
 1687            INC(BlanksInARow);
 1688            IF ((BlanksInARow<3) AND (NOT firstcol)) OR HaveColor() THEN
 1689              StrEdit.Append(ImageRec.text, blank);
 1690            END;
 1691          ELSE
 1692            StrEdit.Append(ImageRec.text, line[indentation - 1]);
 1693            INC(indentation);
 1694            BlanksInARow := 0;
 1695          END;
 1696        END;
 1697        IF InAField THEN
 1698          RETURN ReportErr( FMErr );
 1699        END;
 1700        AddRecord( ImageRec);
 1701        RETURN TRUE;
 1702      END AddToOutList;
 1703  
 1704    PROCEDURE DoDisplayArea();
 1705      VAR
 1706        TypeCode: CARDINAL;
 1707      BEGIN
 1708        LineCount := 0;
 1709        FieldCount := 0;
 1710        WHILE (CurrentLine < GenLists.ListLength( InListGlobal)) DO
 1711          INC( CurrentLine);
 1712          GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode);
 1713            (*read next line*)
 1714          StrEdit.ReplaceTabs( Parser.TheLine, 8 );
 1715          StrEdit.DeleteChar( FormFeed, Parser.TheLine );
 1716          IF PosUtils.Present(Parser.StartComment, Parser.TheLine) THEN
 1717            WHILE (NOT PosUtils.Present(Parser.EndComment, Parser.TheLine)) AND
 1718                  (CurrentLine < GenLists.ListLength( InListGlobal)) DO
 1719              INC( CurrentLine);
 1720              GenLists.GetElmt( InListGlobal, CurrentLine,
 1721                  Parser.TheLine, TypeCode);
 1722                (*read next line*)
 1723              StrEdit.ReplaceTabs( Parser.TheLine, 8 );
 1724                (*lets you put comments in a frame file*)
 1725            END;
 1726          ELSE
 1727            INC( LineCount);
 1728            IF NOT AddToOutList( Parser.TheLine) THEN
 1729              RETURN;
 1730            END;
 1731          END;
 1732        END;
 1733        CheckFieldNumber();
 1734      END DoDisplayArea;
 1735  
 1736  
 1737    PROCEDURE InsertFrameLinks( VAR LinkedFrames: GenLists.GenList);
 1738      BEGIN
 1739        IF (FrameAbove[0] # 0C)
 1740            OR (FrameBelow[0] # 0C)
 1741            OR (FrameRight[0] # 0C)
 1742            OR (FrameLeft[0] # 0C) THEN
 1743          GenLists.NewList( LinkedFrames );
 1744          GenLists.ListInsert( FrameAbove, GenLists.StrCode, LinkedFrames,
 1745              AfterLastElmt);
 1746          GenLists.ListInsert( FrameBelow, GenLists.StrCode, LinkedFrames,
 1747              AfterLastElmt);
 1748          GenLists.ListInsert( FrameLeft, GenLists.StrCode, LinkedFrames,
 1749              AfterLastElmt);
 1750          GenLists.ListInsert( FrameRight, GenLists.StrCode, LinkedFrames,
 1751              AfterLastElmt);
 1752        END;
 1753      END InsertFrameLinks;
 1754  
 1755  
 1756    PROCEDURE MakeOutList( VAR OutList: GenLists.GenList);
 1757      BEGIN
 1758        SetToDefaultColors( FrameRec );
 1759        GenLists.NewList( OutList);
 1760        GenLists.ListInsert( HelpFrame, GenLists.StrCode, OutList,
 1761            AfterLastElmt);
 1762        GenLists.ListInsert( ParentFrame, GenLists.StrCode,
 1763            OutList, AfterLastElmt);
 1764        GenLists.ListInsert( NormalNextFrame, GenLists.StrCode,
 1765            OutList, AfterLastElmt);
 1766        GenLists.ListInsert( FrameRec, RecType, OutList,
 1767            AfterLastElmt);
 1768        GenLists.ListInsert( DataList, GenLists.ListCode, OutList,
 1769            AfterLastElmt);
 1770        GenLists.ListInsert( PromptList, GenLists.ListCode,
 1771            OutList, AfterLastElmt);
 1772        GenLists.ListInsert( HelpList, GenLists.ListCode, OutList,
 1773            AfterLastElmt);
 1774        GenLists.ListInsert( EdList, GenLists.ListCode, OutList,
 1775            AfterLastElmt);
 1776        GenLists.ListInsert( FieldList, GenLists.ListCode, OutList,
 1777            AfterLastElmt);
 1778        GenLists.ListInsert( ImageList, GenLists.ListCode, OutList,
 1779            AfterLastElmt);
 1780  
 1781        InsertFrameLinks( LinkedFrames );
 1782        GenLists.ListInsert( LinkedFrames, GenLists.ListCode, OutList,
 1783            AfterLastElmt);
 1784      END MakeOutList;
 1785  
 1786  
 1787  PROCEDURE CompileFrame( VAR InList, OutList: GenLists.GenList; VAR
 1788      FrameName: ScrnTypes.AFrameName; VAR ErrStr: ARRAY OF CHAR; VAR
 1789      BadLine: CARDINAL);
 1790    (* compiles a single frame *)
 1791    VAR
 1792      DataSize, TotalElems, TotalSize: LONGINT;
 1793      TotalSublists: CARDINAL;
 1794    BEGIN
 1795      DataSize := GenLists.ListSize( InList, TotalElems,
 1796          TotalSublists, TotalSize );
 1797        (*Check memory here because it's too hard to get out if we
 1798          run out below.  Figure we need about as much as the
 1799          InList occupies.*)
 1800      IF (TotalSize > NumTypes.L65535) OR
 1801          (NOT VStorage.IsAvailable(Numbers.C(TotalSize))) THEN
 1802        ErrorManager.WARN( InsuffMem );
 1803        RETURN;
 1804      END;
 1805      InitOutLists();
 1806        (* initialize the output genlists *)
 1807      StrEdit.SetLength( ErrStrGlobal, 0);
 1808        (* init the error string & line # *)
 1809      BadLineGlobal := 0;
 1810      InListGlobal := InList;
 1811      StrEdit.SetLength( Parser.TheLine, 0);
 1812        (* init the global line and index *)
 1813      CurrentLine := 0;
 1814      CurrentIndex := 1;
 1815      IF GenLists.ListLength( InList) > 0 THEN
 1816        IF DoCommandArea( FrameName) THEN
 1817          DoDisplayArea();
 1818        END;
 1819      END;
 1820      MakeOutList( OutList);
 1821      StrEdit.AssignStr( ErrStrGlobal, ErrStr);
 1822      BadLine := BadLineGlobal;
 1823    END CompileFrame;
 1824  
 1825  
 1826  PROCEDURE InitColors();
 1827    BEGIN
 1828      StrEdit.SetLength( ColorKeys, 4 );
 1829      ColorKeys[0] := 367C;  (* Flash *)
 1830      ColorKeys[1] := 27C;   (* UnderScored *)
 1831      ColorKeys[2] := 341C;  (* Bold *)
 1832      ColorKeys[3] := 352C;  (* Reversed *)
 1833      KeyFors[0] := MsColors.lightgrey;
 1834      KeyFors[1] := MsColors.blue;
 1835      KeyFors[2] := MsColors.brightwhite;
 1836      KeyFors[3] := MsColors.black;
 1837      KeyBacks[0] := MsColors.darkgrey;
 1838      KeyBacks[1] := MsColors.black;
 1839      KeyBacks[2] := MsColors.black;
 1840      KeyBacks[3] := MsColors.lightgrey;
 1841      KeyAtrbs[0] := MsColors.blinking;
 1842      KeyAtrbs[1] := MsColors.underscored;
 1843      KeyAtrbs[2] := MsColors.bold;
 1844      KeyAtrbs[3] := MsColors.ReverseVideo;
 1845    END InitColors;
 1846  
 1847  
 1848  
 1849  PROCEDURE Init();
 1850  BEGIN
 1851    IF Initialized THEN
 1852      RETURN;
 1853    ELSE
 1854      Initialized := TRUE;
 1855    END;
 1856  
 1857  (*EntryDiag:
 1858        Diagnostics.Init();
 1859  :EntryDiag*)
 1860  
 1861        ByteFiddler.Init();
 1862        ErrorManager.Init();
 1863        FieldTypes.Init();
 1864        GenLists.Init();
 1865        LowLevel.Init();
 1866        M2Strings.Init();
 1867        MsColors.Init();
 1868        NdxTypes.Init();
 1869        Numbers.Init();
 1870        NumTypes.Init();
 1871        Parser.Init();
 1872        PosUtils.Init();
 1873        ScrnTypes.Init();
 1874        ScrnUtl1.Init();
 1875        StrConv.Init();
 1876        StrCnv1.Init();
 1877        StrEdit.Init();
 1878        VStorage.Init();
 1879        VWindows.Init();
 1880  (*EntryDiag:
 1881    Diagnostics.diagS( 'Entering MakeFrame', '' );
 1882  :EntryDiag*)
 1883  
 1884    (* First we initialize all the normal screen colors. Just
 1885       change these assignments if your taste in colors differs
 1886       from ours. *)
 1887    DefaultFore := MsColors.lightgrey;
 1888    DefaultBack := MsColors.blue;
 1889    DefaultAtrb := MsColors.plain;
 1890    DefaultBordatrb := MsColors.plain;
 1891    DefaultBordfor := MsColors.lightcyan;
 1892    DefaultBordbak := MsColors.blue;
 1893      (* Border colors *)
 1894    DefaultSelatrb := MsColors.bold;
 1895    DefaultSelfor := MsColors.lightmagenta;
 1896    DefaultSelbak := MsColors.blue;
 1897      (* Selected text *)
 1898    DefaultPbatrb := MsColors.ReverseVideo;
 1899    DefaultPbfor := MsColors.black;
 1900    DefaultPbbak := MsColors.red;
 1901      (* Pointer Bar Colors *)
 1902    DefaultMsgatrb := MsColors.plain;
 1903    DefaultMsgfor := MsColors.black;
 1904    DefaultMsgbak := MsColors.lightgrey;
 1905      (* Message Box Colors *)
 1906    DefaultPromatrb := MsColors.ReverseVideo;
 1907    DefaultPromfor := MsColors.black;
 1908    DefaultPrombak := MsColors.cyan;
 1909      (* Prompt Line Colors *)
 1910  
 1911   ColorStack := SYSTEM.ADR(ColorBase);
 1912      (* ColorBase is a record of the type to which ColorStack is
 1913         supposed to point. *)
 1914    ColorStack^.Ccode := blank;
 1915    ColorStack^.forec := DefaultFore;
 1916    ColorStack^.backc := DefaultBack;
 1917    ColorStack^.atrbc := DefaultAtrb;
 1918    ColorStack^.nxt := NIL;
 1919    ColorStack^.prv := NIL;
 1920    InitColors();
 1921    FieldMark := '#';
 1922    ReplacingFieldMarks := FALSE;
 1923    StrEdit.AssignStr( '====================', CommandBeginStr);
 1924    StrEdit.AssignStr( '--------------------', CommandEndStr);
 1925  
 1926  (*EntryDiag:
 1927    Diagnostics.diagS( 'Exiting MakeFrame', '' );
 1928  :EntryDiag*)
 1929  END Init;
 1930  
 1931  
 1932  BEGIN
 1933    Initialized := FALSE;
 1934    Init();
 1935  END MakeFrame.

  117 errors