| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935 |
- 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.
|