Category : Files from Magazines
Archive   : DDJ0489.ZIP
Filename : VIRSCR.ASC

_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann


[LISTING ONE]

Screen = RECORD
ShowPtrs : ARRAY[1..HEIGHT] OF LinePtr;
StorePtrs : ARRAY[1..HEIGHT] OF LinePtr;
X,Y : Byte;
TopLine : 1..HEIGHT;
FollowCursor : Boolean
END;


[LISTING TWO]

{--------------------------------------------------------------}
{ SCREENS }
{ Virtual screen management unit }
{ }
{ by Jeff Duntemann KI6RA }
{ Turbo Pascal 5.0 }
{ Last modified 12/24/88 }
{--------------------------------------------------------------}

UNIT Screens;

INTERFACE

USES DOS, { Standard Borland unit }
TextInfo; { Given last issue; DDJ 3/89 }

CONST
WIDTH = 80; { These are the character sizes of the virtual screens }
HEIGHT = 66; { KEEP IN MIND THAT THIS IS A 1-ORIGIN SYSTEM!!!!!!!!! }
{ I.e., we count rows and columns from *1*, not 0. }
UP = True; { Constants for glitching and panning }
DOWN = False;


TYPE
String5 = STRING[5];
String10 = STRING[10];
String80 = STRING[80];

{ Lines are made of these; helps us mix characters and attributes: }
ScreenAtom = RECORD
CASE Boolean OF
True : (Ch : Char;
Attr : Byte);
False : (Atom : Word);
END;

LinePtr = ^Line;
Line = ARRAY[1..WIDTH] OF ScreenAtom;

ScreenPtr = ^Screen;
Screen = RECORD
ShowPtrs : ARRAY[1..HEIGHT] OF LinePtr;
StorePtrs : ARRAY[1..HEIGHT] OF LinePtr;
X,Y : Byte;
TopLine : 1..HEIGHT;
FollowCursor : Boolean
END;

CONST
ClearAtom : ScreenAtom = (Ch : ' '; { ASCII space char }
Attr : $07); { "Normal" screen attribute }

VAR
CurrentAttr : Byte; { Exported global, *not* a function! }


PROCEDURE ClearLine(LineTarget : LinePtr;
VisibleX : Byte;
ClearAtom : ScreenAtom);

INLINE
($58/ { POP AX } { Pop filler char/attribute into AX }
$59/ { POP CX } { Pop line length (repeat count) into CX }
$5F/ { POP ES } { Pop line address segment into ES }
$07/ { POP DI } { Pop line address offset into DI }
$8C/$C2/ { MOV DX,ES } { Move ES into DX for test against 0 }
$81/$FA/0/0/ { CMP DX,0000 } { Compare ES value (in DX) against 0 }
$74/$02/ { JE 2 } { If Equal, jump ahead 2 bytes }
$F3/$AB); { REP STOSW } { Otherwise, blast that line to atoms! }


FUNCTION BooStr(BooleanValue : Boolean) : String5;
PROCEDURE ClrScreen(Target : ScreenPtr; ClearAtom : ScreenAtom);
PROCEDURE DisposeOfScreen(VAR Target : ScreenPtr);
PROCEDURE GotoXY(Target : ScreenPtr; NewX,NewY : Byte);
PROCEDURE InitScreen(Target : ScreenPtr; Visible : Boolean);
FUNCTION IntStr(IntegerValue,FieldWidth : Integer) : String10;
PROCEDURE Pan(Target : ScreenPtr; PanUp : Boolean; ByLines : Integer);
FUNCTION RealStr(RealValue : Real; Exponential : Boolean;
FieldWidth,DecimalWidth : Integer) : String80;
PROCEDURE WriteTo(Target : ScreenPtr; S : String);
PROCEDURE WritelnTo(Target : ScreenPtr; S : String);


IMPLEMENTATION

{ Private to SCREENS--make it public if you need it. }

PROCEDURE GlitchDisplay(Up : Boolean; ByLines : Integer);

VAR
Service : Byte;
Regs : Registers;

BEGIN
IF Up THEN Service := $06 ELSE Service := $07;
WITH Regs DO
BEGIN
AH := Service;
AL := ByLines;
BH := CurrentAttr; { Attribute for blanked line(s) }
CH := 0; { CX & DX: Glitch the full display }
CL := 0;
DH := VisibleY-1;
DL := VisibleX-1;
END;
Intr($10,Regs);
END;


{ Returns string equivalent of RealValue: }

FUNCTION RealStr(RealValue : Real; Exponential : Boolean;
FieldWidth,DecimalWidth : Integer) : String80;

VAR
Dummy : String80;

BEGIN
IF Exponential THEN
Str(RealValue : FieldWidth,Dummy)
ELSE
Str(RealValue : FieldWidth : DecimalWidth,Dummy);
RealStr := Dummy
END;


{ Returns string equivalent of BooleanValue: }

FUNCTION BooStr(BooleanValue : Boolean) : String5;

BEGIN
IF BooleanValue THEN BooStr := 'TRUE'
ELSE BooStr := 'FALSE'
END;


{ Returns string equivalent of IntegerValue: }

FUNCTION IntStr(IntegerValue,FieldWidth : Integer) : String10;

VAR
Dummy : String10;

BEGIN
Str(IntegerValue : FieldWidth,Dummy);
IntStr := Dummy
END;


{ Clears Target to the atom passed in ClearAtom: }

PROCEDURE ClrScreen(Target : ScreenPtr; ClearAtom : ScreenAtom);

VAR
I : Integer;

BEGIN
WITH Target^ DO
BEGIN
{ Brute force: Clear all lines at the ends of pointer }
{ referents, even though non-visible lines are cleared twice }
FOR I := 1 TO HEIGHT DO
ClearLine(ShowPtrs[I],VisibleX,ClearAtom);
FOR I := 1 TO HEIGHT DO
ClearLine(StorePtrs[I],VisibleX,ClearAtom);
X := 1; Y := 1;
END
END;


{ Moves logical (*not* hardware!) cursor to NewX,NewY: }

PROCEDURE GotoXY(Target : ScreenPtr; NewX,NewY : Byte);

{ Simply places new values in descriptor record's X & Y fields }
BEGIN
WITH Target^ DO
BEGIN
X := NewX;
Y := NewY
END
END;


{ V-Screen equivalent of Write: }

PROCEDURE WriteTo(Target : ScreenPtr; S : String);

VAR
I,K : Integer;
TX : Byte;
ShiftedAttr : Word;

BEGIN
{ Put attribute in the high byte of a word: }
ShiftedAttr := CurrentAttr SHL 8;
WITH Target^ DO
BEGIN
TX := X;
K := 0;
FOR I := 0 TO Length(S)-1 DO
BEGIN
IF X+I > VisibleX THEN { If string goes past end of line: }
BEGIN
Inc(Y); { Increment Y value }
X := 1; TX := 1; { Reset X and temp X value to 1 }
K := 0; { K is the line-offset counter }
END;
{ Here we combine the character from the string and the }
{ current attribute via OR, and assign it to its location }
{ on the screen: }
Word(ShowPtrs[Y]^[X+K]) := Word(S[I+1]) OR ShiftedAttr;
Inc(TX); Inc(K);
END;
X := TX; { Update X value in descriptor record }
END
END;


{ V-Screen equivalent of Writeln: }

PROCEDURE WritelnTo(Target : ScreenPtr; S : String);

BEGIN
WriteTo(Target,S);
Inc(Target^.Y); { These 2 lines are the equivalent of CR/LF }
Target^.X := 1
END;


{ Moves the visible display as a window onto a full-page virtual screen: }

PROCEDURE Pan(Target : ScreenPtr; PanUp : Boolean; ByLines : Integer);

VAR
I : Integer;
YOffset : byte;

BEGIN
YOffset := VisibleY-1; { Compensates for 1-based line numbering }
WITH Target^ DO
IF PanUp THEN { If we want to pan the display up the screen }
BEGIN
{ Don't do anything if we're at the top of the V-screen: }
IF TopLine > 1 THEN
BEGIN
{ If we're not at the top but ByLines would take us out of }
{ legal range, adjust ByLines to scroll the rest of the way: }
IF TopLine - ByLines < 1 THEN ByLines := TopLine - 1;
{ Move newly-hidden lines into virtual screen buffer: }
FOR I := TopLine + YOffset DOWNTO
TopLine + YOffset - (ByLines-1) DO
Move(ShowPtrs[I]^,StorePtrs[I]^,VisibleX * 2);
{ Glitch the display pointer array up: }
Move(ShowPtrs[TopLine],ShowPtrs[TopLine-ByLines],VisibleY * 4);
{ Repoint affected line pointers into virtual screen: }
FOR I := TopLine + YOffset DOWNTO
TopLine + YOffset - (ByLines-1) DO
ShowPtrs[I] := StorePtrs[I];
{ Glitch the display buffer down: }
GlitchDisplay(False,ByLines);
{ Update virtual screen's TopLine counter: }
TopLine := TopLine - ByLines;
{ Move newly-visible lines to display from virtual screen: }
FOR I := TopLine TO TopLine + (ByLines-1) DO
Move(StorePtrs[I]^,ShowPtrs[I]^,VisibleX * 2);
END
END
ELSE { If we want to pan the display down the screen }
BEGIN
{ First check if the pan would take us out of legal line range: }
IF TopLine + YOffset < Height THEN
BEGIN
{ If we're not at bottom but ByLines would take us out of }
{ legal range, adjust ByLines to scroll the rest of the way: }
IF TopLine + YOffset + ByLines > HEIGHT THEN
ByLines := HEIGHT - (TopLine + YOffset);
{ Move newly-hidden lines into virtual screen buffer: }
FOR I := TopLine TO TopLine + (ByLines-1) DO
Move(ShowPtrs[I]^,StorePtrs[I]^,VisibleX * 2);
{ Glitch the display pointer array down: }
Move(ShowPtrs[TopLine],ShowPtrs[TopLine+ByLines],VisibleY * 4);
{ Repoint affected line pointers into virtual screen: }
FOR I := TopLine TO TopLine + (ByLines-1) DO
ShowPtrs[I] := StorePtrs[I];
{ Glitch the display buffer up }
GlitchDisplay(True,ByLines);
{ Move newly-visible lines to display from virtual screen: }
FOR I := TopLine + VisibleY TO TopLine + VisibleY + (ByLines-1) DO
Move(StorePtrs[I]^,ShowPtrs[I]^,VisibleX * 2);
{ And finally, update virtual screen's TopLine counter: }
TopLine := TopLine + ByLines
END
END
END;


{ You *must* init a V-Screen through this proc before using it: }

PROCEDURE InitScreen(Target : ScreenPtr; Visible : Boolean);

VAR
I : Integer;

BEGIN
WITH Target^ DO
BEGIN
FOR I := 1 TO HEIGHT DO
BEGIN
New(ShowPtrs[I]); { Allocate a line on the heap }
StorePtrs[I] := ShowPtrs[I] { Duplicate pointer }
END;
X := 1;
Y := 1;
TopLine := 1;
FollowCursor := True;
IF Visible THEN { As opposed to a "ghost" screen on the heap }
FOR I := 0 TO VisibleY-1 DO
ShowPtrs[I+1] := { Repoint pointers into refresh buffer }
Ptr(Seg(TextBufferOrigin^),
Ofs(TextBufferOrigin^) + (I * (VisibleX * 2)))
END
END;


{ Frees up heapspace occupied by Target. DON'T use if Target is the }
{ address of a statically declared-record obtained with @ or Addr()!! }

PROCEDURE DisposeOfScreen(VAR Target : ScreenPtr);

VAR
I : Integer;

BEGIN
FOR I := 1 TO Height DO Dispose(Target^.ShowPtrs[I]);
Dispose(Target);
Target := NIL
END;


{ SCREENS Initialization Section: }

BEGIN
CurrentAttr := $07; { $07 is the "normal" video attribute }
END.


[LISTING THREE]


{--------------------------------------------------------------}
{ SCREENTEST }
{ Virtual screen demo program }
{ }
{ by Jeff Duntemann KI6RA }
{ Turbo Pascal 5.0 }
{ Last modified 12/24/88 }
{--------------------------------------------------------------}

PROGRAM ScreenTest;

USES DOS, { Standard Borland unit }
TextInfo, { Given last issue; DDJ 3/89 }
Screens; { Given this issue; DDJ 4/89 }

CONST
PanBy = 1; { Specifies # of lines to pan at once }

VAR
I : Integer;
Check : Integer;
Ch : Char;
Extended : Boolean;
Scancode : Byte;
Shifts : Byte;
TestScreen : Screen;
MyScreen : ScreenPtr;
FileName : String80;
TestFile : Text;
HalftoneAtom : ScreenAtom;
InString : String80;


{->>>>GetKey<<<<-----------------------------------------------}
{ }
{ Filename: GETKEY.SRC -- Last modified 7/23/88 }
{ }
{ This routine uses ROM BIOS services to test for the presence }
{ of a character waiting in the keyboard buffer and, if one is }
{ waiting, return it. The function itself returns a TRUE }
{ if a character has been read. The character is returned in }
{ Ch. If the key pressed was a "special" (non-ASCII) key, the }
{ Boolean variable Extended will be set to TRUE and the scan }
{ code of the special key will be returned in Scan. In }
{ addition, GETKEY returns shift status each time it is called }
{ regardless of whether or not a character was read. Shift }
{ status is returned as eight flag bits in byte Shifts, }
{ according to the bitmap below: }
{ }
{ BITS }
{ 7 6 5 4 3 2 1 0 }
{ 1 . . . . . . . INSERT (1=Active) }
{ . 1 . . . . . . CAPS LOCK (1=Active) }
{ . . 1 . . . . . NUM LOCK (1=Active) }
{ . . . 1 . . . . SCROLL LOCK (1=Active) }
{ . . . . 1 . . . ALT (1=Depressed) }
{ . . . . . 1 . . CTRL (1=Depressed) }
{ . . . . . . 1 . LEFT SHIFT (1=Depressed) }
{ . . . . . . . 1 RIGHT SHIFT (1=Depressed) }
{ }
{ Test for individual bits using masks and the AND operator: }
{ }
{ IF (Shifts AND $0A) = $0A THEN CtrlAndAltArePressed; }
{ }
{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }
{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }
{--------------------------------------------------------------}

FUNCTION GetKey(VAR Ch : Char;
VAR Extended : Boolean;
VAR Scan : Byte;
Var Shifts : Byte) : Boolean;

VAR Regs : Registers;
Ready : Boolean;

BEGIN
Extended := False; Scan := 0;
Regs.AH := $01; { AH=1: Check for keystroke }
Intr($16,Regs); { Interrupt $16: Keyboard services}
Ready := (Regs.Flags AND $40) = 0;
IF Ready THEN
BEGIN
Regs.AH := 0; { Char is ready; go read it... }
Intr($16,Regs); { ...using AH = 0: Read Char }
Ch := Chr(Regs.AL); { The char is returned in AL }
Scan := Regs.AH; { ...and scan code in AH. }
IF Ch = Chr(0) THEN Extended := True ELSE Extended := False;
END;
Regs.AH := $02; { AH=2: Get shift/alt/ctrl status }
Intr($16,Regs);
Shifts := Regs.AL;
GetKey := Ready
END;



BEGIN
IF ParamCount < 1 THEN { No file-ee, no work-ee }
BEGIN
Writeln('>>>SCRNTEST by Jeff Duntemann ');
Writeln(' Virtual screen demo program');
Writeln(' Version of 12/24/88 -- Turbo Pascal 5.0');
Writeln(' Invoke: SCRNTEST ');
Writeln(' Use up/down arrows to pan window;');
Writeln(' the DEL key to blank out a line.');
Writeln(' Press "Q" or "q" to quit...');
END
ELSE
BEGIN
FileName := ParamStr(1); { See if named file can be opened }
Assign(TestFile,FileName);
{$I-} Reset(TestFile); {$I+}
Check := IOResult;
IF Check <> 0 THEN { If not, complain: }
BEGIN
Writeln('>>Test file ',FileName,' Cannot be opened.');
Writeln(' Please invoke again with a valid file name.');
END
ELSE
BEGIN { File can be opened; let's read it into a V-screen }
HalftoneAtom.Ch := Chr(177); HalftoneAtom.Attr := $07;
MyScreen := @TestScreen;
InitScreen(MyScreen,True); { Allocate & init the screen }
ClrScreen(MyScreen,ClearAtom); { Clear the screen }

IF NOT EOF(TestFile) THEN { If the file isn't empty... }
BEGIN
I := 1; { Start from line 1 }
WHILE (NOT EOF(TestFile)) AND (I <= HEIGHT) DO
BEGIN
Readln(TestFile,InString);
{ Truncate each line at 70 columns: }
InString := Copy(InString,1,70);
{ Write line number to the V-Screen: }
WriteTo(MyScreen,IntStr(I,5));
{ Write the data line to the V-Screen: }
WritelnTo(MyScreen,': '+InString);
Inc(I) { Increment the line counter }
END;

{ Up to 66 lines of the file are on the screen. }
{ Here we pan up on the up arrow, and down on }
{ the down arrow. 'Q' quits the program. }
Extended := False;
REPEAT
IF Extended THEN
CASE Scancode OF
{ DEL } 83 : WITH MyScreen^ DO
ClearLine(ShowPtrs[TopLine + (VisibleY DIV 2)],
VisibleX,HalftoneAtom);
{ Up Arrow } 72 : Pan(MyScreen,Up,PanBy);
{ Down arrow } 80 : Pan(MyScreen,Down,PanBy);
END; { CASE }
REPEAT UNTIL GetKey(Ch,Extended,Scancode,Shifts);
UNTIL Ch IN ['Q','q'];
END
END
END
END.