PROGRAM DOSCREEN; {Version 2.0 by Steve Cohen 2/13/85} {Released to Public Domain } {To be compiled under Turbo-Pascal } {Revised 3/16/85 -- Fixed bug in GetScreen procedure that was truncating file Name. Also Upcased the FileNames input by the user and allowed aborting of the file creation process in WriteFile by simply pressing in response to filename prompt} {I USED THE CP/M VERSION, BUT OFFHAND, I CAN'T } {SEE WHY IT SHOULDN'T WORK WITH MS-DOS AS WELL } {$C-,V-} const { Change these if you don't have a 24x80 screen or if you } { wish to change the number of usable input lines. } { Configuration below mimics the format of BTREE.PAS included} { in the Turbo-ToolBox } Top = 4; Bottom = 21; Right = 80; Left = 1; HV = #27#40; { these are the codes that generate normal } LV = #27#41; { intensity and reduced intensity characters on } { my Advent System Kaypro video add-on board. } { Omit if you can't do reduced intensity. } type XAxis =0..81; YAxis =0..25; AnyStr = String[255]; Str80 = String[80]; FullScreen = array[Top..Bottom,Left..Right] of char; DisplayField = record XBegin : XAxis; YBegin : YAxis; Contents : String[80]; END; Var Screen:FullScreen; FieldTag,FieldBlank : Array[1..50] of DisplayField; PasFile : Text; ScrFile:File of FullScreen; NoOfBlanks,NoOfTags : Integer; FileName : String[10]; FUNCTION ConstStr(c:Char;N:Integer):AnyStr; Var S: AnyStr; BEGIN S[0] := Chr(N); FillChar(s[1],N,C); ConstStr := S; END; PROCEDURE MKSCREEN (var Screen:FullScreen); VAR Ins : Boolean; X : XAxis; Y : YAxis; C,Ch,Done : Char; Buffer : str80; PROCEDURE Display(VAR Screen: Fullscreen); VAR I: XAxis; J: YAxis; BEGIN For J := Top to Bottom do BEGIN GotoXY(Left,J); For I := Left to Right do Write(Screen[J,I]); END; GotoXY(70,2); If Ins then Write(HV,'INSERT') Else Clreol; GotoXY(1,23); Clreol; Write('Type ^F to get screen from file, ^C when finished',LV); X:=Left; Y := Top; GotoXY(X,Y); END; PROCEDURE GETSCREEN (Var Screen:FullScreen); VAR FileName : String[10]; NScreen : FullScreen; ScrFile : File of Fullscreen; C: Char; I : Integer; BEGIN GotoXY(1,23); Clreol; Write('Name of File to get: '); Readln(FileName); For I := 1 to Length(FileName) do FileName[I] := UpCase(FileName[I]); Assign(ScrFile,FileName + '.SCR'); {$I-} Reset(ScrFile); {$I+} If IOResult <> 0 then BEGIN GotoXY(1,23); Clreol; Write(^G,'FILE ',FILENAME,'.SCR NOT FOUND. TYPE ANY KEY TO CONTINUE.'); READ(KBD,C); END ELSE BEGIN Read(ScrFile,NScreen); If IOResult <> 0 then BEGIN GotoXY(1,23); Clreol; Write('BAD FILE. Can''t Read. Type any key to continue.'); Read(Kbd,C); END ELSE Screen := NScreen; END; Display(Screen); END; {AddChar adds characters to the screen in the non-insert mode } PROCEDURE AddChar(C:Char); BEGIN Write(C); Screen[Y,X] := C; X := Succ(X); If X > Right Then BEGIN X := Left; Y := Succ(Y); If Y > Bottom Then Y := Top; GotoXY(X,Y); END; {If} END;{AddChar} { InsChar inserts characters into the screen display in the } { insert mode. } PROCEDURE InsChar(C:Char); VAR Buffer : Str80; I : Integer; BEGIN If X < Right then BEGIN Move(Screen[Y,X],Buffer[1],Right - X); Buffer[0] := Chr(Right - X); Insert(C,Buffer,1); Move(Buffer[1],Screen[Y,X],Right - Pred(x)); I := Succ(Length(Buffer)); REPEAT I := Pred(I); If Buffer[I] = ' ' then Delete(Buffer,I,1) UNTIL (Buffer[I] <> ' ') or (I <= 1); Write(Buffer); X := Succ(X); If X > Right then BEGIN X := Left; Y := Succ(Y); If Y > Bottom then Y := Top; END; GotoXY(X,Y); END else AddChar(C); END; { MoveCursor handles those control codes which simply move the } { cursor around the screen display. } PROCEDURE MoveCursor(C:Char); BEGIN Case C of #24,#10 : Y := Succ(Y); #19,#8 : X := Pred(X); #4,#12 : X := Succ(X); #5,#11 : Y := Pred(Y); #13 : BEGIN Y := Succ(Y); X := Left; END;{13} END;{Case} If X < Left then BEGIN X := Right; Y := Pred(Y); END;{If} If X > Right then BEGIN X := Left; Y := Succ(Y); END;{If} If Y < Top then Y := Bottom; If Y > Bottom then Y := Top; GotoXY(X,Y); END;{MoveCursor} { Delchar deletes a character both from the screen and from } { its proper place in memory. } PROCEDURE Delchar; BEGIN Move(Screen[Y,X],Buffer[1],Right-Pred(X)); Buffer[0] := Chr(Right - Pred(X)); Delete(Buffer,1,1); Buffer := Buffer + ' '; Write(Buffer); Move(Buffer[1],Screen[Y,X],Length(Buffer)); GotoXY(X,Y); END; {TabOver implements an 8-character fixed tab } PROCEDURE TabOver(Var XPos: XAxis; Var YPos: YAxis); BEGIN If X <= 72 then XPos := Succ(8 * (Succ(Pred(XPos) div 8))) Else BEGIN XPos := 1; YPos := Succ(YPos); If YPos > Bottom then YPos := Top; END; GotoXY(XPos,YPos); END; BEGIN {MkScreen} Ins := True; Done := ' '; Clrscr; { the following four lines produce the bordering effect I } { chose for the screens I wish to generate. Modify or omit } { if you wish. If you do change these you may also wish to } { change the 'Top' and 'Bottom' constants declared at the } { start of this program. } GotoXY(1,1);Write(LV,ConstStr('-',79)); GotoXY(1,3);Write(ConstStr('-',79)); GotoXY(1,22);Write(ConstStr('-',79)); GotoXY(1,24);Write(ConstStr('-',79)); Ins := True; Display(Screen); REPEAT Read(Kbd,Ch); Case Ch of #32 .. #126 : If Ins then InsChar(Ch) else AddChar(Ch); ^D,^E,^H,^J, ^K,^L,^M,^S, ^X : MoveCursor(Ch); ^I : TabOver(X,Y); ^G : Delchar; #127 : BEGIN MoveCursor(^H); Delchar;