IMPLEMENTATION MODULE MakeFrame; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1992 PMI * Green Bay, Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/mods/makefram.mov 1.8 17 Mar 1991 18:02:14 coleb $ * * Modified March 9, 1990 - mbc. Change syntax to allow Real.x, where x * is the number of decimal places on input for the real. * March 24, 1990 - mbc. move realDecPlaces declaration. *) (*EntryDiag: IMPORT Diagnostics; :EntryDiag*) IMPORT ByteFiddler; IMPORT ErrorManager; IMPORT FieldTypes; IMPORT GenLists; IMPORT LowLevel; IMPORT M2Strings; IMPORT MsColors; IMPORT NdxTypes; IMPORT Numbers; IMPORT NumTypes; IMPORT Parser; IMPORT PosUtils; IMPORT ScrnTypes; IMPORT ScrnUtl1; IMPORT StrConv; IMPORT StrCnv1; IMPORT StrEdit; IMPORT SYSTEM; IMPORT VStorage; IMPORT VWindows; VAR Initialized: BOOLEAN; TYPE CStackP = POINTER TO CStack; CStack = RECORD Ccode: CHAR; forec, backc: MsColors.AColor; atrbc: MsColors.AMonoAttribute; prv, nxt: CStackP; END; CONST AfterLastElmt = 65535; BorderChar = ':'; MaxScrWidth = 255; EOF = 32C; EOL = 15C; FormFeed = 14C; blank = ' '; null = ''; NoFrame = ''; RecType = 1; SectnEnd = "}"; (* Error Strings *) BadCommand = 'unrecognized command'; CoEqErr = 'Designate colors with "="'; CoFormErr = 'Color statements must be of form: (number, number) attrib'; CoNumErr = 'Colors must be valid name or number < 16:'; CornerErr = 'Upper left corner is not above and left of the lower right'; DataErr = 'data list is missing or format is invalid'; EdErr = 'number of lines for the editor field is missing'; FewErr = 'Fewer fields in command area than on screen'; FMErr = 'FieldMark (#) error: redefinition invalid or field not closed'; FieldFormErr = 'invalid field type or keyword'; FrameNameErr = "Frame name incorrect or missing; must have ':' in col 0"; FrameErr = 'Frame must start with either ==== or frame name'; GroupErr = 'Choice fields must be inside groups'; HelpErr = 'help list is missing or format is invalid'; HelpFErr = 'frame name for help is missing'; InsuffMem = 'Too little memory'; MoreErr = 'More fields in command section than on screen'; NeedBracket = 'Max and min acceptable values in brackets are missing'; NeedColon = 'colon after position or heading key word is missing'; NeedParen = 'Field subcommands must start with "("'; NeedQuote = 'field name (may be null) in quotes must be supplied'; NestErr = 'Improper nesting of color codes'; NormalErr = 'normal next frame name is missing'; NumSepErr = 'Either numbers or separators are invalid, check format'; ParentErr = 'Bad Parent Frame'; PlacementErr = 'Invalid designation of Frame Above, Below, Left, or Right'; PromptErr = 'prompt text is missing'; SectnEndErr = 'Command sections must end with "}"'; SectnErr = 'Command sections must start with ":{"'; SelectorErr = 'field selector must be a single character'; WinFormErr = 'Invalid keyword in windows subsection command'; VAR (* the following are screen characteristics that may be altered gloablly for a file by commands in any screen frame *) ColorKeys : ARRAY [0 .. 255] OF CHAR; (* defined colors *) KeyFors, KeyBacks : ARRAY [0 .. 255] OF MsColors.AColor; KeyAtrbs : ARRAY [0 .. 255] OF MsColors.AMonoAttribute; DefaultFore, DefaultBack, DefaultBordfor, DefaultBordbak, DefaultSelfor, DefaultSelbak, DefaultPbfor, DefaultPbbak, DefaultMsgfor, DefaultMsgbak, DefaultPromfor, DefaultPrombak: MsColors.AColor; DefaultAtrb, DefaultBordatrb, DefaultSelatrb, DefaultPbatrb, DefaultMsgatrb, DefaultPromatrb : MsColors.AMonoAttribute; ColorStack: CStackP; ColorBase: CStack; (* We make ColorBase a record instead of a pointer so as to avoid doing dynamic memory allocation during the module initialization sequence. *) FieldMark : CHAR; (* field delimiter in the screen image *) ReplacingFieldMarks : BOOLEAN; (* the following variables are used repeatedly and are global solely for convenience *) CurrentWord: ARRAY [0..MaxScrWidth] OF CHAR; (* usually the word retrieved by using GetNextWord *) Terminator: CHAR; (* usually the character terminating the word read with GetNextWord *) CurrentLine: CARDINAL; (* the line of the input genlist currently being processed *) CurrentIndex: CARDINAL; (* the index of the character on the current line currently being processed *) DataList, PromptList, HelpList, EdList, FieldList, ImageList, LinkedFrames: GenLists.GenList; ErrStrGlobal : ARRAY [0 .. 255] OF CHAR; FrameRec: ScrnTypes.PackedFrameRec; HelpFrame, ParentFrame, NormalNextFrame, FrameAbove, FrameBelow, FrameLeft, FrameRight: ScrnTypes.AFrameName; BadLineGlobal: CARDINAL; InListGlobal: GenLists.GenList; FieldCount, LineCount: CARDINAL; PROCEDURE EnclosureCount( Opener, Closer: ARRAY OF CHAR; VAR TheStr: ARRAY OF CHAR; VAR TheCount: INTEGER; VAR StartFound, EndFound: BOOLEAN; CutWhenFound: BOOLEAN ); (* A general purpose procedure for keeping track of delimiters that can cross strings and that can be nested. It's meant to be called in a loop, and is useful in parsing series of strings when you need to find closing quotes, braces, brackets, etc. The first time you call it, StartFound and EndFound should be false, and TheCount should be 0. If at some point in the loop you pass it a string that contains Opener, it sets StartFound to TRUE and begins to count instances of Opener and Closer in TheStr--each Opener increments TheCount, and each Closer decrements it. Because StartFound will still be true the next time EnclosureCount is called, this continues until the Closer that matches Opener is found (i.e., until TheCount returns to 0). At that point, EndFound gets set to TRUE. If the CutWhenFound parameter is TRUE, the first Opener and the last Closer are deleted from TheStr. *) VAR StrIndex : INTEGER; StrLngth, OpenerLngth, CloserLngth : CARDINAL; BEGIN IF NOT StartFound THEN TheCount := 0; IF NOT PosUtils.Present( Opener, TheStr ) THEN RETURN; END; END; EndFound := FALSE; StrLngth := M2Strings.Length( TheStr ); OpenerLngth := M2Strings.Length( Opener ); CloserLngth := M2Strings.Length( Closer ); StrIndex := 0; WHILE (StrIndex < INTEGER(StrLngth)) AND (NOT EndFound) DO IF ((OpenerLngth = 1) AND (TheStr[StrIndex] = Opener[0])) OR (PosUtils.PosAdr( Opener, LowLevel.AddAddr(SYSTEM.ADR(TheStr),StrIndex), OpenerLngth ) = 0) THEN TheCount := TheCount + 1; IF (TheCount = 1) THEN StartFound := TRUE; IF CutWhenFound THEN M2Strings.Delete( TheStr, StrIndex, M2Strings.Length(Opener) ); IF StrIndex # 0 THEN DEC( StrIndex ); END; END; END; END; IF ((CloserLngth = 1) AND (TheStr[StrIndex] = Closer[0])) OR (PosUtils.PosAdr( Closer, LowLevel.AddAddr(SYSTEM.ADR(TheStr),StrIndex), CloserLngth ) = 0) THEN TheCount := TheCount - 1; IF StartFound AND (TheCount = 0) THEN IF CutWhenFound THEN M2Strings.Delete( TheStr, StrIndex, M2Strings.Length(Closer) ); END; EndFound := TRUE; END; END; INC( StrIndex ); END; END EnclosureCount; PROCEDURE EncodeColor( colr: MsColors.AColor): CHAR; VAR tmpbyte: RECORD CASE : BOOLEAN OF TRUE: tcolr: MsColors.AColor; | FALSE: tlow, thi: CHAR; END; END; BEGIN tmpbyte.tcolr := colr; ScrnUtl1.EncodeByte( tmpbyte.tlow); RETURN tmpbyte.tlow; END EncodeColor; PROCEDURE EncodeAttrib( att: MsColors.AMonoAttribute): CHAR; VAR tmpbyte: RECORD CASE : BOOLEAN OF TRUE: tatt: MsColors.AMonoAttribute; | FALSE: tlow, thi: CHAR; END; END; BEGIN tmpbyte.tatt := att; ScrnUtl1.EncodeByte( tmpbyte.tlow); RETURN tmpbyte.tlow; END EncodeAttrib; PROCEDURE ReportErr( ErrDesc: ARRAY OF CHAR) : BOOLEAN; (* appends an error description to the current line of text and sets the bad line number. Always returns FALSE for calling convenience (see usage below). *) BEGIN M2Strings.Assign( Parser.TheLine, ErrStrGlobal); StrEdit.CutLeadingChars( ' ', ErrStrGlobal ); StrEdit.CutTrailingChars( ' ', ErrStrGlobal ); M2Strings.Insert( ' "', ErrStrGlobal, 0 ); StrEdit.Append( ErrStrGlobal, '" : '); StrEdit.Append( ErrStrGlobal, ErrDesc); BadLineGlobal := CurrentLine; RETURN FALSE; END ReportErr; PROCEDURE GetColorNum( str: ARRAY OF CHAR; VAR num: CARDINAL ): BOOLEAN; BEGIN IF (StrConv.StrToCardinal( str, 0, num)) THEN IF (num > 15) THEN RETURN ReportErr( CoNumErr); END; RETURN TRUE; END; IF PosUtils.Equal('BLACK', str) THEN num := 0; ELSIF PosUtils.Equal('BLUE', str) THEN num := 1; ELSIF PosUtils.Equal('GREEN', str) THEN num := 2; ELSIF PosUtils.Equal('CYAN', str) THEN num := 3; ELSIF PosUtils.Equal('RED', str) THEN num := 4; ELSIF PosUtils.Equal('MAGENTA', str) THEN num := 5; ELSIF PosUtils.Equal('BROWN', str) THEN num := 6; ELSIF PosUtils.Equal('LIGHTGREY', str) THEN num := 7; ELSIF PosUtils.Equal('DARKGREY', str) THEN num := 8; ELSIF PosUtils.Equal('LIGHTBLUE', str) THEN num := 9; ELSIF PosUtils.Equal('LIGHTGREEN', str) THEN num := 10; ELSIF PosUtils.Equal('LIGHTCYAN', str) THEN num := 11; ELSIF PosUtils.Equal('PINK', str) THEN num := 12; ELSIF PosUtils.Equal('LIGHTMAGENTA', str) THEN num := 13; ELSIF PosUtils.Equal('YELLOW', str) THEN num := 14; ELSIF PosUtils.Equal('BRIGHTWHITE', str) THEN num := 15; ELSE num := 0; RETURN ReportErr( CoNumErr); END; RETURN TRUE; END GetColorNum; PROCEDURE NameToAttrib( TheName : ARRAY OF CHAR; VAR answer : MsColors.AMonoAttribute) : BOOLEAN; (* converts a string to a text attribute *) BEGIN IF PosUtils.Equal('PLAIN',TheName) THEN answer := MsColors.plain; ELSIF PosUtils.Equal('BOLD',TheName) THEN answer := MsColors.bold; ELSIF PosUtils.Equal('UNDERSCORED',TheName) THEN answer := MsColors.underscored; ELSIF PosUtils.Equal('BLINKING',TheName) THEN answer := MsColors.blinking; ELSIF PosUtils.Equal('REVERSEVIDEO',TheName) THEN answer := MsColors.ReverseVideo; ELSIF PosUtils.Equal('UNDERLINED',TheName) THEN answer := MsColors.underscored; ELSIF M2Strings.Length(TheName) = 0 THEN answer := MsColors.invisible; (* no attribute specified *) ELSE RETURN FALSE; END; RETURN TRUE; END NameToAttrib; PROCEDURE LastChar( VAR text: ARRAY OF CHAR): CHAR; (* cut blanks and return the last non-blnk character in the string *) BEGIN StrEdit.CutTrailingChars( blank, text); IF M2Strings.Length( text) > 0 THEN RETURN text[ M2Strings.Length( text) - 1]; ELSE RETURN EOL; END; END LastChar; PROCEDURE CrunchToNextDelim( VAR StartingAndEndingAt: CARDINAL; VAR text: ARRAY OF CHAR ); VAR last: CARDINAL; done: BOOLEAN; BEGIN last := M2Strings.Length(text); IF last = 0 THEN RETURN; ELSE DEC(last); END; done := FALSE; WHILE (StartingAndEndingAt <= last) AND (NOT done) DO IF text[StartingAndEndingAt] = ' ' THEN M2Strings.Delete( text, StartingAndEndingAt, 1 ); ELSIF PosUtils.Present( text[StartingAndEndingAt], Parser.delimiters ) THEN done := TRUE; ELSE INC( StartingAndEndingAt ); END; END; END CrunchToNextDelim; PROCEDURE NextWord( VAR word: ARRAY OF CHAR; VAR term: CHAR); (* uses global defaults to shorten call to GetNextWord for code readability and skiping comments*) BEGIN Parser.GetNextWord( InListGlobal, CurrentLine, CurrentIndex, word, term); WHILE PosUtils.Equal(word,Parser.StartComment) DO Parser.SkipComments(InListGlobal,CurrentIndex,CurrentLine); Parser.GetNextWord( InListGlobal, CurrentLine, CurrentIndex, word, term); END; END NextWord; PROCEDURE NextWordCap( VAR word: ARRAY OF CHAR; VAR term: CHAR); (* uses global defaults to shorten call to GetNextWord for code readability*) BEGIN NextWord( word, term); StrEdit.CAPstr( word); END NextWordCap; PROCEDURE NextCrunchedWord( VAR word: ARRAY OF CHAR; VAR term: CHAR); (* gets the next word with blanks deleted and not counted as a separator *) VAR line, index, spot, TypeCode, StrLngth: CARDINAL; BEGIN index:=CurrentIndex; line:=CurrentLine; IF CurrentLine <= GenLists.ListLength( InListGlobal ) THEN NextWord(word,term); IF line=CurrentLine THEN CurrentIndex:=index ELSE CurrentIndex:=0 END; END; (* old version 7/17/91 John McMonagle WHILE (CurrentIndex >= M2Strings.Length( Parser.TheLine)) AND (CurrentLine < GenLists.ListLength( InListGlobal)) DO (* go to next line, skipping blank lines *) INC( CurrentLine); GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode); (*read next line*) CurrentIndex := 0; CrunchToNextDelim( CurrentIndex, Parser.TheLine ); (*Set it back to 0.*) CurrentIndex := 0; Parser.SkipComments( InListGlobal, CurrentIndex, CurrentLine ); (*We'll go back around if a comment was actually skipped.*) END; *) spot := CurrentIndex; CrunchToNextDelim( CurrentIndex, Parser.TheLine ); CurrentIndex := spot; NextWord(word, term); StrEdit.CAPstr( word); END NextCrunchedWord; PROCEDURE GetNextSep( VAR Term: CHAR); (* A muddled function. Skips over blanks and leaves CurrentIndex sitting on the first non-blank character that follows. If that happens to be a delimiter, increments CurrentIndex once more. *) BEGIN WHILE (CurrentIndex < M2Strings.Length( Parser.TheLine)) AND (Parser.TheLine[ CurrentIndex] = blank) DO (* skip blanks *) INC( CurrentIndex); END; IF (CurrentIndex < M2Strings.Length( Parser.TheLine)) THEN (* return sep, if found *) Term := Parser.TheLine[ CurrentIndex]; IF PosUtils.Present( Term, Parser.delimiters) THEN (* skip past separator found, so we start at beginning of next word next time *) INC( CurrentIndex); END; ELSE Term := EOL; (* if at end of line, return EOL *) END; END GetNextSep; PROCEDURE NextNum( VAR result: CARDINAL): BOOLEAN; (* converts next word into a CARDINAL. returns TRUE if OK *) VAR Word: ARRAY [0..MaxScrWidth] OF CHAR; BEGIN NextWord(Word, Terminator); RETURN StrConv.StrToCardinal( Word, 0, result); END NextNum; PROCEDURE FindCmdBegin( VAR line, index: CARDINAL): BOOLEAN; (* looks for the CommandBeginStr and if found, returns: TRUE, line found on & index past the end of line else RETURNS false & line started on & ending index of line. *) VAR StartLine, LstLngth, TypeCode: CARDINAL; BEGIN StartLine := line; LstLngth := GenLists.ListLength(InListGlobal); WHILE (line <= LstLngth) DO GenLists.GetElmt( InListGlobal, line, Parser.TheLine, TypeCode); IF PosUtils.Present( CommandBeginStr, Parser.TheLine) THEN (* found command begin string, so start on next line *) index := HIGH( Parser.TheLine)+1; RETURN TRUE; END; INC( line); END; (* if didn't find cmdbgnstr, go back to starting place *) line := StartLine; GenLists.GetElmt( InListGlobal, line, Parser.TheLine, TypeCode); index := HIGH( Parser.TheLine)+1; RETURN FALSE; END FindCmdBegin; PROCEDURE SetToDefaultColors( VAR FrameRec: ScrnTypes.PackedFrameRec ); BEGIN WITH FrameRec DO normatrb := DefaultAtrb; normfor := DefaultFore; normbak := DefaultBack; (* Normal text *) bordatrb := DefaultBordatrb; bordfor := DefaultBordfor; bordbak := DefaultBordbak; (* Border colors *) selatrb := DefaultSelatrb; selfor := DefaultSelfor; selbak := DefaultSelbak; (* Selected text *) pbatrb := DefaultPbatrb; pbfor := DefaultPbfor; pbbak := DefaultPbbak; (* Pointer Bar Colors *) msgatrb := DefaultMsgatrb; msgfor := DefaultMsgfor; msgbak := DefaultMsgbak; (* Message Box Colors *) promatrb := DefaultPromatrb; promfor := DefaultPromfor; prombak := DefaultPrombak; (* Prompt Line Colors *) END; END SetToDefaultColors; PROCEDURE InitOutLists(); (* initialize the output genlists *) BEGIN GenLists.NewList( DataList); GenLists.NewList( PromptList); GenLists.NewList( HelpList); GenLists.NewList( EdList); GenLists.NewList( FieldList); GenLists.NewList( ImageList); GenLists.NilList( LinkedFrames ); WITH FrameRec DO ClearFirst := TRUE; ClearAfter := FALSE; EntryBox := VWindows.DoubleBox; ExitBox := VWindows.SingleBox; Caption[0] := 0C; VirtualWidth := 0; VirtualHeight := 0; startcol := 0; endcol := 255; startrow := 0; endrow := 255; headline := 0; action := "I"; END; SetToDefaultColors( FrameRec ); StrEdit.SetLength( HelpFrame, 0); StrEdit.SetLength( ParentFrame, 0); StrEdit.SetLength( NormalNextFrame, 0); StrEdit.SetLength( FrameAbove, 0 ); StrEdit.SetLength( FrameBelow, 0 ); StrEdit.SetLength( FrameLeft, 0 ); StrEdit.SetLength( FrameRight, 0 ); END InitOutLists; PROCEDURE GetAFrameName( VAR TheFrame: ARRAY OF CHAR): BOOLEAN; (* gets the frame key as the next word, if the terminator is OK *) VAR tmpstr : ARRAY [0..79] OF CHAR; BEGIN IF (Terminator = ":") THEN NextWord( tmpstr, Terminator); IF M2Strings.Length(tmpstr) < HIGH(TheFrame) THEN M2Strings.Assign( tmpstr, TheFrame ); RETURN TRUE; END; END; RETURN FALSE; END GetAFrameName; PROCEDURE ListStartOK(): BOOLEAN; (* checks to see if we are at the valid start of a command area: we must have a ":" and a "{" next *) VAR tmpword: ARRAY [0..80] OF CHAR; BEGIN IF (Terminator = ":") THEN NextCrunchedWord( tmpword, Terminator ); RETURN (M2Strings.Length( tmpword) = 0) AND (Terminator = "{"); END; RETURN FALSE; END ListStartOK; PROCEDURE GetList( VAR OutList: GenLists.GenList): BOOLEAN; (* puts the following lines in a genlist, until a "}" is reached *) VAR type: CARDINAL; stop: BOOLEAN; BEGIN IF ListStartOK() THEN stop := FALSE; REPEAT INC( CurrentLine); IF CurrentLine > GenLists.ListLength( InListGlobal) THEN RETURN ReportErr( SectnEndErr); END; GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, type); IF (M2Strings.Length( Parser.TheLine) > 0) AND (Parser.TheLine[0] = SectnEnd) THEN stop := TRUE; ELSIF LastChar( Parser.TheLine) = SectnEnd THEN M2Strings.Delete( Parser.TheLine, M2Strings.Length(Parser.TheLine) - 1, 1); stop := TRUE; GenLists.ListInsert( Parser.TheLine, GenLists.StrCode, OutList, AfterLastElmt); ELSE GenLists.ListInsert( Parser.TheLine, GenLists.StrCode, OutList, AfterLastElmt); END; UNTIL stop; (* set CurrentIndex high so GetNextWord will go to the next line next time. *) CurrentIndex := HIGH( Parser.TheLine) + 1; RETURN TRUE; ELSE RETURN FALSE; END; END GetList; PROCEDURE GetFieldMark( Terminator: CHAR): BOOLEAN; (* reads a new field delimiter for use in the display section *) BEGIN IF (Terminator = ":") THEN NextWord( CurrentWord, Terminator); IF M2Strings.Length( CurrentWord) = 0 THEN (*They're using a terminator as a field mark.*) IF (Terminator # ' ') AND (Terminator # EOL) THEN FieldMark := Terminator; ELSE RETURN FALSE; END; GetNextSep( Terminator ); (*They may or may not have '; replace' after FieldMark command. This skips it if it's there, and leaves CurrentIndex on the EOL if not.*) ELSIF M2Strings.Length( CurrentWord) = 1 THEN FieldMark := CurrentWord[0]; ELSE RETURN FALSE; END; ELSE RETURN FALSE; END; RETURN TRUE; END GetFieldMark; PROCEDURE CheckHelpFrame(); (* if the help string is only a single word short enough to be a AFrameName, it is used as the HelpFrame, not a help list *) VAR line: ARRAY [0..255] OF CHAR; lngth, type: CARDINAL; BEGIN lngth := GenLists.ListLength( HelpList); IF (lngth <= 2) THEN GenLists.GetElmt( HelpList, 1, line, type); StrEdit.CrunchBlanks( line); StrEdit.DeleteChar( '}', line ); IF (NOT PosUtils.Present( blank, line)) AND (M2Strings.Length( line) <= NdxTypes.RecNameLength) THEN M2Strings.Assign( line, HelpFrame); GenLists.ListDelete( HelpList, 1, 1); END; END; END CheckHelpFrame; PROCEDURE SetColorBase( fore, back : MsColors.AColor; attrib: MsColors.AMonoAttribute); (* sets a new normal color & attribute, which are kept at the bottom of the color stack *) BEGIN ColorBase.forec := fore; ColorBase.backc := back; IF attrib <> MsColors.invisible THEN ColorBase.atrbc := attrib; END; END SetColorBase; PROCEDURE GetColor( VAR forecolr, backcolr: MsColors.AColor; VAR atrbut: MsColors.AMonoAttribute): BOOLEAN; (* decode the following words as colors and attributes *) VAR colorord: CARDINAL; term1 : CHAR; BEGIN NextWordCap( CurrentWord, Terminator); (* get past the "(" *) IF (M2Strings.Length( CurrentWord) # 0) OR (Terminator # '(') THEN RETURN ReportErr( CoFormErr); END; NextWordCap( CurrentWord, Terminator); (* get the 1st color number *) IF NOT GetColorNum( CurrentWord, colorord ) THEN RETURN FALSE; END; forecolr := VAL( MsColors.AColor, colorord); (* next, decode background *) term1 := Terminator; NextWordCap( CurrentWord, Terminator); (* get the 2nd color number *) IF (term1 # ',') OR (Terminator # ')') THEN RETURN ReportErr( CoFormErr); END; IF NOT GetColorNum( CurrentWord, colorord ) THEN RETURN FALSE; END; backcolr := VAL( MsColors.AColor, colorord); (* next, decode monochrome attribute *) GetNextSep( Terminator); (* see if there is a mono attrib *) IF Terminator # EOL THEN (* there is a mono attribute specified *) NextCrunchedWord( CurrentWord, Terminator); IF (Terminator # EOL) THEN (* the mono attrib should be the last word on the line *) RETURN ReportErr( CoFormErr); END; IF NOT NameToAttrib( CurrentWord, atrbut) THEN RETURN ReportErr( CoFormErr); END; END; RETURN TRUE; END GetColor; PROCEDURE DoColorChar( colorchar: CHAR) : BOOLEAN; (* add the following character to the defined global color codes *) VAR poscnt: CARDINAL; for1, back1: MsColors.AColor; atrb1: MsColors.AMonoAttribute; BEGIN poscnt := PosUtils.Pos( colorchar, ColorKeys); IF poscnt > HIGH( ColorKeys) THEN (* color character is new *) poscnt := M2Strings.Length(ColorKeys); StrEdit.Append( ColorKeys, colorchar); KeyAtrbs[poscnt] := DefaultAtrb; END; IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; (* decode foreground and background *) KeyFors[poscnt] := for1; KeyBacks[poscnt] := back1; IF atrb1 <> MsColors.invisible THEN (* if an attribute specified, replace attribute *) KeyAtrbs[poscnt] := atrb1; END; RETURN TRUE; END DoColorChar; PROCEDURE DoColors() : BOOLEAN; (* process the color command section *) VAR for1, back1 : MsColors.AColor; atrb1: MsColors.AMonoAttribute; BEGIN IF NOT ListStartOK() THEN RETURN ReportErr( SectnErr); END; REPEAT NextCrunchedWord( CurrentWord, Terminator); IF (Terminator # "=") AND (Terminator # blank) AND (Terminator # SectnEnd) THEN RETURN ReportErr( CoEqErr); END; IF PosUtils.Equal( CurrentWord, 'BORDER') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultBordatrb := atrb1; DefaultBordfor := for1; DefaultBordbak := back1; ELSIF PosUtils.Equal(CurrentWord, 'SELECTEDTEXT') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultSelatrb := atrb1; DefaultSelfor := for1; DefaultSelbak := back1; ELSIF PosUtils.Equal(CurrentWord, 'NORMALTEXT') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultAtrb := atrb1; DefaultFore := for1; DefaultBack := back1; SetColorBase( for1, back1, atrb1); (* We are changing the normal colors, so change the colorstack appropriately *) ELSIF PosUtils.Equal(CurrentWord, 'POINTERBAR') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultPbatrb := atrb1; DefaultPbfor := for1; DefaultPbbak := back1; ELSIF PosUtils.Equal(CurrentWord, 'MESSAGES') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultMsgatrb := atrb1; DefaultMsgfor := for1; DefaultMsgbak := back1; ELSIF PosUtils.Equal(CurrentWord, 'PROMPTS') THEN IF NOT GetColor( for1, back1, atrb1) THEN RETURN FALSE; END; DefaultPromatrb := atrb1; DefaultPromfor := for1; DefaultPrombak := back1; ELSIF M2Strings.Length(CurrentWord) = 1 THEN (* defining a new color code char *) IF NOT DoColorChar( CurrentWord[0]) THEN RETURN FALSE; END; ELSIF M2Strings.Length(CurrentWord) = 0 THEN (* do nothing unless hit end of list *) IF Terminator = EOF THEN RETURN ReportErr( SectnEndErr); END; ELSE RETURN ReportErr( CoFormErr); END; UNTIL Terminator = SectnEnd; RETURN TRUE; END DoColors; PROCEDURE DoWindow() : BOOLEAN; (* process the window comand section *) PROCEDURE NextNumSubOne( VAR result: CARDINAL): BOOLEAN; (* convert the next word to a number and subtract one *) BEGIN IF (NOT NextNum( result)) OR (result = 0) THEN RETURN FALSE; END; DEC( result); RETURN TRUE; END NextNumSubOne; BEGIN (* DoWindow *) IF NOT ListStartOK() THEN RETURN ReportErr( SectnErr); END; REPEAT NextCrunchedWord( CurrentWord, Terminator); IF PosUtils.Equal( CurrentWord, 'POSITION') THEN IF Terminator # ":" THEN RETURN ReportErr( NeedColon); END; NextWordCap( CurrentWord, Terminator); WITH FrameRec DO IF (Terminator # "(") OR (NOT NextNumSubOne( startcol)) OR (Terminator # ",") OR (NOT NextNumSubOne( startrow)) OR (Terminator # ",") OR (NOT NextNumSubOne( endcol)) OR (Terminator # ",") OR (NOT NextNumSubOne( endrow)) OR (Terminator # ")") THEN RETURN ReportErr( NumSepErr); END; IF (startcol > endcol) OR (startrow > endrow) THEN RETURN ReportErr( CornerErr); END; (* WindowHite := endrow - startrow; no longer used *) END; ELSIF PosUtils.Equal(CurrentWord, 'NOBOX') THEN LowLevel.Fill( SYSTEM.ADR(FrameRec.EntryBox), SYSTEM.TSIZE(VWindows.BoxStr), 0C ); LowLevel.Fill( SYSTEM.ADR(FrameRec.ExitBox), SYSTEM.TSIZE(VWindows.BoxStr), 0C ); (*Null it completely out to prevent confusion when we look at raw .DSP file dumps.*) ELSIF PosUtils.Equal(CurrentWord, 'SINGLEBOX') THEN FrameRec.ExitBox := VWindows.SingleBox; FrameRec.EntryBox := VWindows.SingleBox; ELSIF PosUtils.Equal(CurrentWord, 'DOUBLEBOX') THEN FrameRec.ExitBox := VWindows.SingleBox; FrameRec.EntryBox := VWindows.DoubleBox; ELSIF PosUtils.Equal(CurrentWord, 'ENTRYBOX') THEN IF Terminator = EOL THEN LowLevel.Fill( SYSTEM.ADR(FrameRec.EntryBox), SYSTEM.TSIZE(VWindows.BoxStr), 0C ); ELSE NextWordCap( FrameRec.EntryBox, Terminator ); END; ELSIF PosUtils.Equal(CurrentWord, 'EXITBOX') THEN IF Terminator = EOL THEN LowLevel.Fill( SYSTEM.ADR(FrameRec.ExitBox), SYSTEM.TSIZE(VWindows.BoxStr), 0C ); ELSE NextWordCap( FrameRec.ExitBox, Terminator ); END; ELSIF PosUtils.Equal(CurrentWord, 'CAPTION') THEN IF Terminator = EOL THEN FrameRec.Caption[0] := 0C; ELSE NextWord(FrameRec.Caption, Terminator ); (* We call NextWord directly to preserve case and spacing in the caption. *) END; ELSIF PosUtils.Equal(CurrentWord, 'OVERLAY') THEN FrameRec.ClearFirst := FALSE; ELSIF PosUtils.Equal(CurrentWord, 'CLEARFIRST') THEN FrameRec.ClearFirst := TRUE; ELSIF PosUtils.Equal(CurrentWord, 'CLEARAFTER') THEN FrameRec.ClearAfter := TRUE; ELSIF PosUtils.Equal(CurrentWord, 'HEADINGLINE') OR PosUtils.Equal(CurrentWord, 'HEADING') THEN IF Terminator # ":" THEN RETURN ReportErr( NeedColon); END; IF (NOT NextNum( FrameRec.headline)) THEN RETURN ReportErr( NumSepErr); END; ELSIF (M2Strings.Length(CurrentWord) = 0) THEN (* do nothing unless at end of list *) IF Terminator = EOF THEN RETURN ReportErr( SectnEndErr); END; ELSE RETURN ReportErr( WinFormErr); END; (* Since we are assuming at this point a command has completed we will move past any comments etc on the rest of the line *) IF Terminator # EOL THEN CurrentIndex:=M2Strings.Length(Parser.TheLine) END; UNTIL Terminator = SectnEnd; RETURN TRUE; END DoWindow; PROCEDURE InitFieldRec( VAR FieldRec: ScrnTypes.InputFieldRecord); (* initializes the field record *) BEGIN LowLevel.Fill( SYSTEM.ADR(FieldRec), ByteFiddler.Size(FieldRec), 0C ); END InitFieldRec; PROCEDURE InitImageRec( VAR ImageRec: ScrnTypes.ImageElement ); BEGIN LowLevel.Fill( SYSTEM.ADR(ImageRec), ByteFiddler.Size(ImageRec), 0C ); ImageRec.row := 1; ImageRec.col := 1; END InitImageRec; PROCEDURE GetSelector( VAR sel : CARDINAL) : BOOLEAN; (* parses field for menu select character *) BEGIN NextWordCap( CurrentWord, Terminator); IF (M2Strings.Length( CurrentWord) > 0) OR (Terminator # "(") THEN IF Terminator = SectnEnd THEN (* at the end of Fields section *) RETURN FALSE; ELSE RETURN ReportErr( NeedParen); END; END; NextWord( CurrentWord, Terminator ); (*We use GetNextWord instead of NextWordCap to preserve case of the select char.*) IF (M2Strings.Length( CurrentWord) > 1) OR (Terminator # ")") THEN IF NOT StrConv.StrToCardinal( CurrentWord, 0, sel ) THEN (*This lets us use extended keys as selectors.*) RETURN ReportErr( SelectorErr); ELSE RETURN TRUE; END; END; IF M2Strings.Length( CurrentWord) = 1 THEN (* the menu selector key, if specified for this field *) sel := ORD( CurrentWord[0]); ELSE sel := 0; END; RETURN TRUE; END GetSelector; PROCEDURE GetInteger( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN; BEGIN FieldRec.typ := ScrnTypes.IntCode; IF (Terminator # "[") THEN RETURN ReportErr( NeedBracket); END; NextWordCap( CurrentWord, Terminator); IF (CurrentWord[0] = 0C) AND (Terminator = "-") THEN (*The lower bound is negative.*) NextWordCap( CurrentWord, Terminator ); M2Strings.Insert( "-", CurrentWord, 0 ); END; IF (Terminator = ".") THEN (*The bounds are separated with .. instead of - .*) GetNextSep( Terminator ); IF (Terminator # ".") THEN RETURN ReportErr( NumSepErr); END; END; IF NOT (StrConv.StrToLongInteger( CurrentWord, 0, FieldRec.iMin)) THEN RETURN ReportErr( NumSepErr); END; NextWordCap( CurrentWord, Terminator); IF (CurrentWord[0] = 0C) AND (Terminator = "-") THEN (*The upper bound is negative.*) NextWordCap( CurrentWord, Terminator ); M2Strings.Insert( "-", CurrentWord, 0 ); END; IF NOT (StrConv.StrToLongInteger( CurrentWord, 0, FieldRec.iMax)) AND (Terminator = "]") THEN RETURN ReportErr( NeedBracket); END; GetNextSep( Terminator); (* move separator past the ] *) RETURN TRUE; END GetInteger; PROCEDURE GetReal( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN; BEGIN IF (Terminator # "[") THEN RETURN ReportErr( NeedBracket); END; IF NOT StrCnv1.GetEmbeddedReal( Parser.TheLine, CurrentIndex, FieldRec.rMin ) THEN RETURN ReportErr( NumSepErr ); END; (* CurrentIndex should now be sitting on whatever follows the first number -- probably a space, maybe a '.' or a '-'. *) IF Parser.TheLine[ CurrentIndex ] = ' ' THEN GetNextSep( Terminator); ELSE INC( CurrentIndex ); END; (* CurrentIndex is now sitting on the character following the first character of the separator. *) IF Parser.TheLine[ CurrentIndex ] = '.' THEN (* Don't start looking for the next number in the middle of the .. separator. *) INC( CurrentIndex ); END; IF NOT StrCnv1.GetEmbeddedReal( Parser.TheLine, CurrentIndex, FieldRec.rMax ) THEN RETURN ReportErr( NumSepErr ); END; GetNextSep( Terminator); IF (Terminator # "]") THEN RETURN ReportErr( NumSepErr); END; GetNextSep( Terminator); (* move separator past the ] *) RETURN TRUE; END GetReal; PROCEDURE GetEdField( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN; VAR TmpEdList: GenLists.GenList; BEGIN FieldRec.typ := ScrnTypes.EditorCode; NextWordCap( CurrentWord, Terminator); IF NOT (StrConv.StrToCardinal( CurrentWord, 0, FieldRec.Row2) AND (* Row2 is the number of lines now; we will correct it to the ending virtual row number when we process the image and find out what row it starts on. *) (Terminator = blank)) THEN RETURN ReportErr( EdErr); END; NextWordCap( CurrentWord, Terminator); IF NOT (PosUtils.Equal( CurrentWord, "LINES") OR PosUtils.Equal( CurrentWord, "LINE")) THEN RETURN ReportErr( EdErr); END; FieldRec.TextRow1 := 0; FieldRec.CursorCol := 1; FieldRec.CursorRow := 1; FieldRec.MaxLines := 0; FieldRec.ChangeMade := FALSE; FieldRec.ReadOnly := FALSE; GenLists.NewList( TmpEdList); GenLists.ListInsert( TmpEdList, GenLists.ListCode, EdList, AfterLastElmt); FieldRec.EdFieldNum := GenLists.ListLength( EdList); RETURN TRUE; END GetEdField; PROCEDURE GetFieldData( VAR FieldRec: ScrnTypes.InputFieldRecord ): BOOLEAN; (* This lets you put the word 'data' somewhere in the list of field attributes in the same way that you put 'prompt' there in releases preceding 1.5d. GetFieldData appends the fieldname to the frame's DataList, and then looks for the next line that contains an opening brace, and puts it plus all lines that follow it up to the matching closing brace into a TmpList, which it then appends to the end of the frame's DataList. This means you can find the data associated with a particular field by starting at the end of the frame's DataList. Any time you find an element that is a list, you look at the preceding element of the frame's DataList to see if it contains the field name in which you are interested. If it does, the elements of the sublist will be the strings retrieved by GetFieldData. We use it for things like initialization of Editor fields and storage of StrLogic expressions. *) VAR TmpList: GenLists.GenList; BraceCount : INTEGER; StartFound, EndFound : BOOLEAN; TypeCode : CARDINAL; BEGIN BraceCount := 0; StartFound := FALSE; EndFound := FALSE; GenLists.NewList( TmpList ); REPEAT INC( CurrentLine); IF CurrentLine < GenLists.ListLength( InListGlobal) THEN GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode ); EnclosureCount( '{', '}', Parser.TheLine, BraceCount, StartFound, EndFound, TRUE ); IF StartFound THEN GenLists.ListInsert( Parser.TheLine, GenLists.StrCode, TmpList, AfterLastElmt); END; ELSE RETURN ReportErr( DataErr); END; UNTIL EndFound; GenLists.ListInsert( FieldRec.fnam, GenLists.StrCode, DataList, AfterLastElmt ); (* We insert the field name as the preceding element of the DataList so that users will be able to find the data associated with a particular field by looking for its name. *) GenLists.ListInsert( TmpList, GenLists.ListCode, DataList, AfterLastElmt ); CurrentIndex := M2Strings.Length( Parser.TheLine); RETURN TRUE; END GetFieldData; PROCEDURE GetFieldOptions( VAR FieldRec: ScrnTypes.InputFieldRecord) : BOOLEAN; VAR DataFound, PromptFound : BOOLEAN; type : CARDINAL; BEGIN PromptFound := FALSE; DataFound := FALSE; IF Terminator = SectnEnd THEN RETURN TRUE; END; REPEAT GetNextSep( Terminator); IF Terminator # EOL THEN NextWordCap( CurrentWord, Terminator); IF PosUtils.Equal(CurrentWord, 'REQUIRED') THEN FieldRec.req := TRUE; ELSIF PosUtils.Equal(CurrentWord, 'PROMPT') THEN PromptFound := TRUE; Terminator:=EOL; ELSIF PosUtils.Equal(CurrentWord, 'DATA') THEN DataFound := TRUE; ELSIF PosUtils.Equal(CurrentWord, 'HELP') THEN IF Terminator = EOL THEN RETURN ReportErr( HelpFErr); END; NextWord( FieldRec.HelpFrame, Terminator ); (*Changed on 23 Apr 88: use GetNextWord to preserve case sensitivity.*) ELSIF FieldRec.typ = ScrnTypes.EditorCode THEN IF PosUtils.Equal( CurrentWord, "READONLY" ) THEN FieldRec.ReadOnly := TRUE; ELSIF PosUtils.Equal( CurrentWord, "MAXLINES" ) THEN IF NOT NextNum( FieldRec.MaxLines ) THEN FieldRec.MaxLines := 0; RETURN ReportErr( EdErr ); END; END; END; END; UNTIL (Terminator = EOL) OR (Terminator = SectnEnd) OR (Terminator = EOF); IF PromptFound THEN (* add the prompt to the prompt list *) IF Terminator = SectnEnd THEN RETURN FALSE; END; INC( CurrentLine); IF CurrentLine < GenLists.ListLength( InListGlobal) THEN GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, type); GenLists.ListInsert( Parser.TheLine, GenLists.StrCode, PromptList, AfterLastElmt); FieldRec.PromptNum := GenLists.ListLength( PromptList); ELSE RETURN ReportErr( PromptErr); END; CurrentIndex := M2Strings.Length( Parser.TheLine); END; IF DataFound THEN IF Terminator = SectnEnd THEN RETURN FALSE; END; IF NOT GetFieldData( FieldRec ) THEN RETURN FALSE; END; END; RETURN TRUE; END GetFieldOptions; PROCEDURE DoFields() : BOOLEAN; (* process the Fields section of the command area *) VAR FieldRec: ScrnTypes.InputFieldRecord; DummyDspFile: ScrnTypes.DisplayFile; selector, GroupCounter, GroupMax: CARDINAL; GroupHeader: BOOLEAN; realDecPlaces : CARDINAL; (* JDM/MBC *) BEGIN IF NOT ListStartOK() THEN RETURN ReportErr( SectnErr); END; GroupMax := 0; REPEAT GroupHeader := FALSE; InitFieldRec( FieldRec); IF NOT GetSelector( selector) THEN IF M2Strings.Length( ErrStrGlobal) = 0 THEN RETURN TRUE; ELSE RETURN FALSE; END; END; (* NextWordCap( CurrentWord, Terminator); (* space between ) and ' *) IF (M2Strings.Length( CurrentWord) > 0) OR (Terminator # "'") THEN RETURN ReportErr( NeedQuote); END; *) NextWordCap( FieldRec.fnam, Terminator); (* get field name *) IF Terminator # "'" THEN RETURN ReportErr( NeedQuote); END; NextWordCap( CurrentWord, Terminator); IF PosUtils.Equal( CurrentWord, 'STRING') THEN FieldRec.typ := ScrnTypes.StringCode; ELSIF PosUtils.Equal(CurrentWord, 'GOTO') THEN FieldRec.typ := ScrnTypes.GotoCode; FieldRec.MenuKey := selector; NextWord( FieldRec.ReturnVal, Terminator ); (*Use GetNextWord to preserve case sensitivity.*) ELSIF PosUtils.Equal(CurrentWord, 'INTEGER') THEN IF NOT GetInteger( FieldRec) THEN RETURN FALSE; END; ELSIF PosUtils.Equal(CurrentWord, 'REAL') THEN (* We have to set the tag field before any of the variant fields; Stony Brook is smart enough to check for consistency. *) FieldRec.typ := ScrnTypes.RealCode; IF Terminator = "." THEN (* find and load the number of decimal places for the REAL *) IF NOT NextNum( realDecPlaces ) THEN RETURN ReportErr( NumSepErr ); ELSE FieldRec.decimalPlace := VAL( ScrnTypes.DecimalPlaceType, realDecPlaces ); END ELSE (* Signal that the default of user-specified dec. place used *) FieldRec.decimalPlace := -1; END; IF NOT GetReal( FieldRec) THEN RETURN FALSE; END; ELSIF PosUtils.Equal(CurrentWord, 'GROUP') THEN GroupHeader := TRUE; GroupCounter := 1; IF (NOT NextNum( GroupMax)) OR (GroupMax = 0) THEN RETURN ReportErr( NumSepErr); END; ELSIF PosUtils.Equal(CurrentWord, 'CHOICE') THEN IF (GroupMax = 0) THEN (* error if didn't start a group first *) RETURN ReportErr( GroupErr); END; FieldRec.typ := ScrnTypes.GroupMember; FieldRec.ChoiceKey := selector; FieldRec.GroupSize := GroupMax; FieldRec.GroupID := GroupCounter; FieldRec.selected := (GroupCounter = 1); (* TRUE for first field *) INC( GroupCounter); IF (GroupMax < GroupCounter) THEN (* at end of group, reset size to show no group is active *) GroupMax := 0; END; ELSIF PosUtils.Equal(CurrentWord, 'EDITOR') THEN IF NOT GetEdField( FieldRec) THEN RETURN FALSE; END; ELSIF PosUtils.Equal(CurrentWord, 'DISPLAY') OR PosUtils.Equal(CurrentWord, 'DISPLAYONLY') THEN FieldRec.typ := ScrnTypes.DispCode; ELSIF M2Strings.Length(CurrentWord) = 0 THEN (* do nothing unless at end of list *) IF Terminator = EOF THEN RETURN ReportErr( SectnEndErr); END; ELSE (* This is what allows you to have user-defined type names.*) FieldRec.typ := FieldTypes.TypeCode( CurrentWord ); END; IF NOT GroupHeader THEN (* do not process options or save a field record for group headers *) IF NOT GetFieldOptions( FieldRec) THEN RETURN FALSE; END; GenLists.ListInsert( FieldRec, RecType, FieldList, AfterLastElmt); END; UNTIL Terminator = SectnEnd; RETURN TRUE; END DoFields; PROCEDURE DoCommandArea( VAR FrameName: ScrnTypes.AFrameName): BOOLEAN; (* Processes the command area of the frame. FrameName is set to the name of the frame processed. The other output is communicated in the global variables that MakeOutList uses. *) VAR dumtype: CARDINAL; BEGIN ReplacingFieldMarks := FALSE; NextWordCap( CurrentWord, Terminator); (* We start by determining whether FrameName is inside or outside the Command Area -- outside is the old syntax. *) IF (Parser.TheLine[0] # BorderChar) OR (M2Strings.Length(CurrentWord) # 0) THEN FrameName[0] := 0C; IF NOT FindCmdBegin( CurrentLine, CurrentIndex) THEN RETURN ReportErr( FrameErr); END; ELSE (* FrameName is outside the command area. *) NextWord( CurrentWord, Terminator ); (* The frame name is next and it should be the last thing on the line. We use GetNextWord to preserve case sensitivity.*) IF (Terminator # EOL) OR (M2Strings.Length(CurrentWord) = 0) THEN RETURN ReportErr( FrameNameErr); END; (* save name, which was CAPPED by NextWordCap() *) M2Strings.Assign( CurrentWord, FrameName); IF NOT FindCmdBegin( CurrentLine, CurrentIndex) THEN (* continue only if find a command begin string *) RETURN TRUE; END; END; LOOP NextCrunchedWord( CurrentWord, Terminator); IF PosUtils.Equal( CurrentWord, 'PARENTFRAME' ) THEN IF NOT GetAFrameName( ParentFrame) THEN RETURN ReportErr( ParentErr); END; ELSIF PosUtils.Equal( CurrentWord, 'NORMALNEXT' ) THEN IF NOT GetAFrameName( NormalNextFrame) THEN RETURN ReportErr( NormalErr); END; ELSIF PosUtils.Equal( CurrentWord, 'FRAMEABOVE' ) THEN IF NOT GetAFrameName( FrameAbove ) THEN RETURN ReportErr( PlacementErr ); END; ELSIF PosUtils.Equal( CurrentWord, 'FRAMEBELOW' ) THEN IF NOT GetAFrameName( FrameBelow ) THEN RETURN ReportErr( PlacementErr ); END; ELSIF PosUtils.Equal( CurrentWord, 'FRAMELEFT' ) THEN IF NOT GetAFrameName( FrameLeft ) THEN RETURN ReportErr( PlacementErr ); END; ELSIF PosUtils.Equal( CurrentWord, 'FRAMERIGHT' ) THEN IF NOT GetAFrameName( FrameRight ) THEN RETURN ReportErr( PlacementErr ); END; ELSIF PosUtils.Equal( CurrentWord, 'FIELDMARK' ) THEN IF NOT GetFieldMark( Terminator) THEN RETURN ReportErr( FMErr); END; ELSIF PosUtils.Equal( CurrentWord, 'WINDOW' ) THEN IF NOT DoWindow() THEN RETURN FALSE; END; ELSIF PosUtils.Equal( CurrentWord, 'DATA' ) THEN IF NOT GetList( DataList) THEN RETURN ReportErr( DataErr); END; ELSIF PosUtils.Equal( CurrentWord, 'HELP' ) THEN IF NOT GetList( HelpList) THEN RETURN ReportErr( HelpErr); END; CheckHelpFrame(); ELSIF PosUtils.Equal( CurrentWord, 'COLORS' ) THEN IF NOT DoColors() THEN RETURN FALSE; END; ELSIF PosUtils.Equal( CurrentWord, 'FIELDS' ) THEN IF NOT DoFields() THEN RETURN FALSE; END; ELSIF PosUtils.Present( CommandEndStr, Parser.TheLine) THEN IF FrameName[0] = 0C THEN (*We never found a FrameName.*) StrEdit.AssignStr( FrameNameErr, ErrStrGlobal ); RETURN FALSE; END; RETURN TRUE; ELSIF (Parser.TheLine[0] = BorderChar) AND (M2Strings.Length(CurrentWord) = 0) THEN NextWord( CurrentWord, Terminator ); (* The frame name is next (and it should be the last thing on the line); don't use NextWordCap because it caps, and we want to be case sensitive with frame names. *) IF (* (Terminator # EOL) OR JM 7/16/91 *) (M2Strings.Length(CurrentWord) = 0) THEN RETURN ReportErr( FrameNameErr); END; M2Strings.Assign( CurrentWord, FrameName); (* Save name*) ELSIF PosUtils.Equal( CurrentWord, 'HITANYKEY') THEN FrameRec.action := "W"; ELSIF PosUtils.Equal( CurrentWord, 'DISPLAYONLY') THEN FrameRec.action := "D"; ELSIF PosUtils.Equal( CurrentWord, 'INPUTSCREEN') THEN FrameRec.action := "I"; ELSIF PosUtils.Equal( CurrentWord, 'REPLACE') THEN ReplacingFieldMarks := TRUE; ELSE RETURN ReportErr( BadCommand); END; END; END DoCommandArea; PROCEDURE CheckFieldNumber(); (* check if same number of fields on screen as defined *) BEGIN IF FieldCount < GenLists.ListLength( FieldList) THEN StrEdit.AssignStr( MoreErr, ErrStrGlobal); BadLineGlobal := CurrentLine; ELSIF FieldCount > GenLists.ListLength( FieldList) THEN StrEdit.AssignStr( FewErr, ErrStrGlobal); BadLineGlobal := CurrentLine; (* ELSIF LineCount > (WindowHite + 1) THEN AssignStr( 'Warning: screen may exceed window; scrolling may occur', ErrStrGlobal); *) END; END CheckFieldNumber; PROCEDURE AddToOutList(VAR line : ARRAY OF CHAR): BOOLEAN; PROCEDURE HaveColor(): BOOLEAN; BEGIN (* is true if a color is turned on (we will store blanks) *) RETURN(ColorStack^.prv <> NIL) END HaveColor; PROCEDURE AddColor( incode: CHAR; forcod, backcod: MsColors.AColor; atrbcod: MsColors.AMonoAttribute); BEGIN VStorage.DosAlloc( ColorStack^.nxt, SYSTEM.TSIZE(CStack) ); ColorStack^.nxt^.prv := ColorStack; ColorStack := ColorStack^.nxt; ColorStack^.Ccode := incode; ColorStack^.forec := forcod; ColorStack^.backc := backcod; ColorStack^.atrbc := atrbcod; ColorStack^.nxt := NIL; END AddColor; PROCEDURE DeleteColor(): BOOLEAN; BEGIN IF ColorStack^.prv = NIL THEN RETURN ReportErr( NestErr); ELSE ColorStack := ColorStack^.prv; VStorage.DosDealloc( ColorStack^.nxt, SYSTEM.TSIZE(CStack) ); (* Note that this will never deallocate the ColorBase, which is good since ColorBase is now in the data segment. *) ColorStack^.nxt := NIL; RETURN TRUE; END; END DeleteColor; VAR InAField, firstcol, ColorChange : BOOLEAN; LineLngth, indentation, i, WhichColor, BlanksInARow : CARDINAL; ImageRec: ScrnTypes.ImageElement; PROCEDURE AddRecord( VAR ImageRec: ScrnTypes.ImageElement); VAR FieldRec: ScrnTypes.InputFieldRecord; TmpCol2, type: CARDINAL; BEGIN TmpCol2 := ImageRec.col + M2Strings.Length( ImageRec.text) - 1; IF (ImageRec.field > 0) THEN (* save image list position in ImageNum field in field record *) IF FieldCount > GenLists.ListLength( FieldList ) THEN IF NOT ReportErr( FewErr ) THEN END; RETURN; END; GenLists.GetElmt( FieldList, FieldCount, FieldRec, type); FieldRec.ImageNum := GenLists.ListLength( ImageList) + 1; IF FieldRec.typ = ScrnTypes.EditorCode THEN (* This editor field's width & height must be stored *) INC( FieldRec.Row2, ImageRec.row - 1); IF FieldRec.Row2 > FrameRec.VirtualHeight THEN FrameRec.VirtualHeight := FieldRec.Row2; END; IF ReplacingFieldMarks THEN FieldRec.Col2 := TmpCol2 + 1; ELSE FieldRec.Col2 := TmpCol2; END; IF FieldRec.Col2 > FrameRec.VirtualWidth THEN FrameRec.VirtualWidth := FieldRec.Col2; END; END; GenLists.ListReplace( FieldRec, type, FieldList, FieldCount); END; IF ImageRec.row > FrameRec.VirtualHeight THEN FrameRec.VirtualHeight := ImageRec.row; END; IF TmpCol2 > FrameRec.VirtualWidth THEN FrameRec.VirtualWidth := TmpCol2; END; ScrnUtl1.EncodeImageRec( ImageRec); GenLists.ListInsert( ImageRec, GenLists.StrCode, ImageList, AfterLastElmt); END AddRecord; PROCEDURE NewLineCheck(); VAR BufChar : CHAR; FieldRec: ScrnTypes.InputFieldRecord; BEGIN BufChar := line[indentation - 1]; WhichColor := PosUtils.Pos( BufChar, ColorKeys); IF (BufChar = FieldMark) OR (WhichColor <= HIGH(ColorKeys)) OR ((BufChar = blank) AND (NOT ColorChange)) THEN RETURN; END; IF firstcol THEN (* in first column of new line *) InitImageRec( ImageRec ); firstcol := FALSE; ELSIF ((BlanksInARow>=3) AND (NOT HaveColor())) OR ColorChange THEN IF BlanksInARow >= 3 THEN (* cut blanks from the end of the string *) StrEdit.CutTrailingChars( blank, ImageRec.text); END; AddRecord( ImageRec); InitImageRec( ImageRec ); ELSE RETURN; END; WITH ImageRec DO row := LineCount; col := indentation; foreg := ColorStack^.forec; backg := ColorStack^.backc; atrb := ColorStack^.atrbc; IF InAField THEN field := FieldCount; ELSE field := 0; END; END; ColorChange := FALSE; END NewLineCheck; BEGIN (*AddToOutList*) IF PosUtils.IsBlank(line) THEN RETURN TRUE; END; InAField := FALSE; firstcol := TRUE; ColorChange := FALSE; BlanksInARow := 0; indentation := 1; LineLngth := M2Strings.Length( line); InitImageRec( ImageRec ); WHILE indentation <= LineLngth DO NewLineCheck(); IF line[indentation - 1]=FieldMark THEN IF ColorStack^.Ccode = FieldMark THEN (* if this mark is at end of a field *) InAField := FALSE; IF NOT DeleteColor() THEN RETURN FALSE; END; ELSE (* we are at the beginning of a field *) AddColor( FieldMark, ColorStack^.forec, ColorStack^.backc, ColorStack^.atrbc); (* Use existing color for menu item *) InAField := TRUE; INC( FieldCount); END; IF ReplacingFieldMarks THEN line[ indentation - 1] := blank; IF InAField AND (line[indentation] # blank) THEN (*We do the following to prevent the color change associated with the field from beginning until _after_ the replaced space.*) INC( indentation ); INC(BlanksInARow); IF ((BlanksInARow<3) AND (NOT firstcol)) OR HaveColor() THEN StrEdit.Append(ImageRec.text, blank); END; END; ELSE M2Strings.Delete(line, indentation - 1, 1); DEC( LineLngth ); END; BlanksInARow := 0; ColorChange := TRUE; ELSIF WhichColor <= HIGH(ColorKeys) THEN IF ColorStack^.Ccode = ColorKeys[ WhichColor] THEN IF NOT DeleteColor() THEN RETURN FALSE; END; ELSE AddColor( ColorKeys[WhichColor], KeyFors[WhichColor], KeyBacks[WhichColor], KeyAtrbs[WhichColor]); END; M2Strings.Delete(line, indentation - 1, 1); DEC( LineLngth ); BlanksInARow := 0; ColorChange := TRUE; ELSIF line[indentation - 1]=blank THEN INC(indentation); INC(BlanksInARow); IF ((BlanksInARow<3) AND (NOT firstcol)) OR HaveColor() THEN StrEdit.Append(ImageRec.text, blank); END; ELSE StrEdit.Append(ImageRec.text, line[indentation - 1]); INC(indentation); BlanksInARow := 0; END; END; IF InAField THEN RETURN ReportErr( FMErr ); END; AddRecord( ImageRec); RETURN TRUE; END AddToOutList; PROCEDURE DoDisplayArea(); VAR TypeCode: CARDINAL; BEGIN LineCount := 0; FieldCount := 0; WHILE (CurrentLine < GenLists.ListLength( InListGlobal)) DO INC( CurrentLine); GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode); (*read next line*) StrEdit.ReplaceTabs( Parser.TheLine, 8 ); StrEdit.DeleteChar( FormFeed, Parser.TheLine ); IF PosUtils.Present(Parser.StartComment, Parser.TheLine) THEN WHILE (NOT PosUtils.Present(Parser.EndComment, Parser.TheLine)) AND (CurrentLine < GenLists.ListLength( InListGlobal)) DO INC( CurrentLine); GenLists.GetElmt( InListGlobal, CurrentLine, Parser.TheLine, TypeCode); (*read next line*) StrEdit.ReplaceTabs( Parser.TheLine, 8 ); (*lets you put comments in a frame file*) END; ELSE INC( LineCount); IF NOT AddToOutList( Parser.TheLine) THEN RETURN; END; END; END; CheckFieldNumber(); END DoDisplayArea; PROCEDURE InsertFrameLinks( VAR LinkedFrames: GenLists.GenList); BEGIN IF (FrameAbove[0] # 0C) OR (FrameBelow[0] # 0C) OR (FrameRight[0] # 0C) OR (FrameLeft[0] # 0C) THEN GenLists.NewList( LinkedFrames ); GenLists.ListInsert( FrameAbove, GenLists.StrCode, LinkedFrames, AfterLastElmt); GenLists.ListInsert( FrameBelow, GenLists.StrCode, LinkedFrames, AfterLastElmt); GenLists.ListInsert( FrameLeft, GenLists.StrCode, LinkedFrames, AfterLastElmt); GenLists.ListInsert( FrameRight, GenLists.StrCode, LinkedFrames, AfterLastElmt); END; END InsertFrameLinks; PROCEDURE MakeOutList( VAR OutList: GenLists.GenList); BEGIN SetToDefaultColors( FrameRec ); GenLists.NewList( OutList); GenLists.ListInsert( HelpFrame, GenLists.StrCode, OutList, AfterLastElmt); GenLists.ListInsert( ParentFrame, GenLists.StrCode, OutList, AfterLastElmt); GenLists.ListInsert( NormalNextFrame, GenLists.StrCode, OutList, AfterLastElmt); GenLists.ListInsert( FrameRec, RecType, OutList, AfterLastElmt); GenLists.ListInsert( DataList, GenLists.ListCode, OutList, AfterLastElmt); GenLists.ListInsert( PromptList, GenLists.ListCode, OutList, AfterLastElmt); GenLists.ListInsert( HelpList, GenLists.ListCode, OutList, AfterLastElmt); GenLists.ListInsert( EdList, GenLists.ListCode, OutList, AfterLastElmt); GenLists.ListInsert( FieldList, GenLists.ListCode, OutList, AfterLastElmt); GenLists.ListInsert( ImageList, GenLists.ListCode, OutList, AfterLastElmt); InsertFrameLinks( LinkedFrames ); GenLists.ListInsert( LinkedFrames, GenLists.ListCode, OutList, AfterLastElmt); END MakeOutList; PROCEDURE CompileFrame( VAR InList, OutList: GenLists.GenList; VAR FrameName: ScrnTypes.AFrameName; VAR ErrStr: ARRAY OF CHAR; VAR BadLine: CARDINAL); (* compiles a single frame *) VAR DataSize, TotalElems, TotalSize: LONGINT; TotalSublists: CARDINAL; BEGIN DataSize := GenLists.ListSize( InList, TotalElems, TotalSublists, TotalSize ); (*Check memory here because it's too hard to get out if we run out below. Figure we need about as much as the InList occupies.*) IF (TotalSize > NumTypes.L65535) OR (NOT VStorage.IsAvailable(Numbers.C(TotalSize))) THEN ErrorManager.WARN( InsuffMem ); RETURN; END; InitOutLists(); (* initialize the output genlists *) StrEdit.SetLength( ErrStrGlobal, 0); (* init the error string & line # *) BadLineGlobal := 0; InListGlobal := InList; StrEdit.SetLength( Parser.TheLine, 0); (* init the global line and index *) CurrentLine := 0; CurrentIndex := 1; IF GenLists.ListLength( InList) > 0 THEN IF DoCommandArea( FrameName) THEN DoDisplayArea(); END; END; MakeOutList( OutList); StrEdit.AssignStr( ErrStrGlobal, ErrStr); BadLine := BadLineGlobal; END CompileFrame; PROCEDURE InitColors(); BEGIN StrEdit.SetLength( ColorKeys, 4 ); ColorKeys[0] := 367C; (* Flash *) ColorKeys[1] := 27C; (* UnderScored *) ColorKeys[2] := 341C; (* Bold *) ColorKeys[3] := 352C; (* Reversed *) KeyFors[0] := MsColors.lightgrey; KeyFors[1] := MsColors.blue; KeyFors[2] := MsColors.brightwhite; KeyFors[3] := MsColors.black; KeyBacks[0] := MsColors.darkgrey; KeyBacks[1] := MsColors.black; KeyBacks[2] := MsColors.black; KeyBacks[3] := MsColors.lightgrey; KeyAtrbs[0] := MsColors.blinking; KeyAtrbs[1] := MsColors.underscored; KeyAtrbs[2] := MsColors.bold; KeyAtrbs[3] := MsColors.ReverseVideo; END InitColors; PROCEDURE Init(); BEGIN IF Initialized THEN RETURN; ELSE Initialized := TRUE; END; (*EntryDiag: Diagnostics.Init(); :EntryDiag*) ByteFiddler.Init(); ErrorManager.Init(); FieldTypes.Init(); GenLists.Init(); LowLevel.Init(); M2Strings.Init(); MsColors.Init(); NdxTypes.Init(); Numbers.Init(); NumTypes.Init(); Parser.Init(); PosUtils.Init(); ScrnTypes.Init(); ScrnUtl1.Init(); StrConv.Init(); StrCnv1.Init(); StrEdit.Init(); VStorage.Init(); VWindows.Init(); (*EntryDiag: Diagnostics.diagS( 'Entering MakeFrame', '' ); :EntryDiag*) (* First we initialize all the normal screen colors. Just change these assignments if your taste in colors differs from ours. *) DefaultFore := MsColors.lightgrey; DefaultBack := MsColors.blue; DefaultAtrb := MsColors.plain; DefaultBordatrb := MsColors.plain; DefaultBordfor := MsColors.lightcyan; DefaultBordbak := MsColors.blue; (* Border colors *) DefaultSelatrb := MsColors.bold; DefaultSelfor := MsColors.lightmagenta; DefaultSelbak := MsColors.blue; (* Selected text *) DefaultPbatrb := MsColors.ReverseVideo; DefaultPbfor := MsColors.black; DefaultPbbak := MsColors.red; (* Pointer Bar Colors *) DefaultMsgatrb := MsColors.plain; DefaultMsgfor := MsColors.black; DefaultMsgbak := MsColors.lightgrey; (* Message Box Colors *) DefaultPromatrb := MsColors.ReverseVideo; DefaultPromfor := MsColors.black; DefaultPrombak := MsColors.cyan; (* Prompt Line Colors *) ColorStack := SYSTEM.ADR(ColorBase); (* ColorBase is a record of the type to which ColorStack is supposed to point. *) ColorStack^.Ccode := blank; ColorStack^.forec := DefaultFore; ColorStack^.backc := DefaultBack; ColorStack^.atrbc := DefaultAtrb; ColorStack^.nxt := NIL; ColorStack^.prv := NIL; InitColors(); FieldMark := '#'; ReplacingFieldMarks := FALSE; StrEdit.AssignStr( '====================', CommandBeginStr); StrEdit.AssignStr( '--------------------', CommandEndStr); (*EntryDiag: Diagnostics.diagS( 'Exiting MakeFrame', '' ); :EntryDiag*) END Init; BEGIN Initialized := FALSE; Init(); END MakeFrame.