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