Category : Files from Magazines
Archive   : DDJ0589.ZIP
Filename : VTOOLS.ASC

 
Output of file : VTOOLS.ASC contained in archive : DDJ0589.ZIP
_Structured Programming Column_
by Jeff Duntemann

[LISTING ONE]

{ Turbo Pascal 4.0/5.0 Registers type, from the DOS unit: }

Registers = RECORD
CASE Integer OF
0 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Word;
1 : (AL,AH,BL,BH,CL,CH,DL,DH : Byte;
END;

(* TopSpeed Modula 2's Registers type, from the SYSTEM module: *)

Registers = RECORD
CASE : BOOLEAN OF
| TRUE : AX,BX,CX,DX,BP,SI,DI,DS,ES : CARDINAL;
Flags : BITSET;
| FALSE : AL,AH,BL,BH,CL,CH,DL,DH : SHORTCARD;
END;
END;


[LISTING TWO]

{--------------------------------------------------------------}
{ VTOOLS }
{ }
{ Virtual screen I/O tools unit }
{ }
{ by Jeff Duntemann KI6RA }
{ Turbo Pascal 5.0 }
{ Last modified 1/17/89 }
{--------------------------------------------------------------}

UNIT VTools;

INTERFACE

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

CONST
SingleLine = False; { To specify single vs. double line }
DoubleLine = True; { bars and boxes }

TYPE
LineChars = ARRAY[SingleLine..DoubleLine] OF Char;
BarStrings = ARRAY[SingleLine..DoubleLine] OF String;
BoxRec = RECORD
ULCorner, { Each field in this record }
URCorner, { contains both the single }
LLCorner, { line and double line }
LRCorner, { form of the named line }
HBar, { character, indexed by }
VBar, { the Boolean constants }
LineCross, { SingleLine and DoubleLine }
TDown, { defined above. }
TUp,
TRight,
TLeft : LineChars
END;

CONST
BoxChars : BoxRec =
(ULCorner : (#218,#201); { Ú É }
URCorner : (#191,#187); { ¿ » }
LLCorner : (#192,#200); { À È }
LRcorner : (#217,#188); { Ù ¼ }
HBar : (#196,#205); { Ä Í }
VBar : (#179,#186); { Ä º }
LineCross : (#197,#206); { Å Î }
TDown : (#194,#203); { Â Ë }
TUp : (#193,#202); { Á Ê }
TRight : (#195,#185); { Ã ¹ }
TLeft : (#180,#204)); { ´ Ì }


VAR
HBars : BarStrings; { Horizontally oriented bars }
VBars : BarStrings; { Vertically oriented bars }


PROCEDURE MakeBox(Target : ScreenPtr;
X,Y,Width,Height : Integer;
IsSingleLine : Boolean);


IMPLEMENTATION


PROCEDURE MakeBox(Target : ScreenPtr;
X,Y,Width,Height : Integer;
IsSingleLine : Boolean);

BEGIN
GotoXY(Target,X,Y);
WITH BoxChars DO
BEGIN
{ Display the top line: }
WriteTo(Target,ULCorner[IsSingleLine]+
Copy(HBars[IsSingleLine],1,Width-2)+
URCorner[IsSingleLine]);
{ Display the left side: }
GotoXY(Target,X,Y+1);
WriteDownTo(Target,Copy(VBars[IsSingleLine],1,Height-2));
{ Display the right side: }
GotoXY(Target,X+Width-1,Y+1);
WriteDownTo(Target,Copy(VBars[IsSingleLine],1,Height-2));
{ Display the bottom line: }
GotoXY(Target,X,Y+Height-1);
WriteTo(Target,LLCorner[IsSingleLine]+
Copy(HBars[IsSingleLine],1,Width-2)+
LRCorner[IsSingleLine]);
END;
END;


{ VTOOLS Initialization Section }

BEGIN
{ This fills the predefined HBars/VBars variables with line characters: }
FillChar(HBars[SingleLine],
SizeOf(HBars[SingleLine]),
BoxChars.HBar[SingleLine]);
FillChar(HBars[DoubleLine],
SizeOf(HBars[DoubleLine]),
BoxChars.HBar[DoubleLine]);
HBars[SingleLine,0] := Chr(255);
HBars[DoubleLine,0] := Chr(255);

FillChar(VBars[SingleLine],
SizeOf(VBars[SingleLine]),
BoxChars.VBar[SingleLine]);
FillChar(VBars[DoubleLine],
SizeOf(VBars[DoubleLine]),
BoxChars.VBar[DoubleLine]);
VBars[SingleLine,0] := Chr(255);
VBars[DoubleLine,0] := Chr(255);
END.


[LISTING THREE]

{ V-Screen procedure that writes from X,Y downward: }

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

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

BEGIN
{ Put attribute in the high byte of a word: }
ShiftedAttr := CurrentAttr SHL 8;
WITH Target^ DO
BEGIN
TY := Y;
K := 0;
FOR I := 0 TO Length(S)-1 DO
BEGIN
IF Y+I > VHEIGHT THEN { If string goes past bottom of screen, }
BEGIN { we wrap: }
Inc(X); { Increment X value }
Y := 1; TY := 1; { Reset Y and temp Y 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+K]^[X]) := Word(S[I+1]) OR ShiftedAttr;
Inc(TY); Inc(K);
END;
Y := TY; { Update Y value in descriptor record }
END
END;


[LISTING FOUR]

{--------------------------------------------------------------}
{ BoxTest }
{ }
{ Character box draw demo program }
{ }
{ by Jeff Duntemann KI6RA }
{ Turbo Pascal V5.0 }
{ Last update 1/21/89 }
{--------------------------------------------------------------}

PROGRAM BoxTest;

USES Crt, { Standard Borland unit }
Screens, { Given in DDJ; 4/89 }
VTools; { Given in DDJ; 5/89 }


VAR
WorkScreen : Screen;
MyScreen : ScreenPtr;
X,Y : Integer;
Width,Height : Integer;
Count : Integer;
Ch : Char;
Quit : Boolean;

BEGIN
Randomize; { Seed the pseudorandom number generator }
MyScreen := @WorkScreen; { Create a pointer to WorkScreen }
InitScreen(MyScreen,True);
ClrScreen(MyScreen,ClearAtom); { Clear the entire screen }
Quit := False;

REPEAT { Draw boxes until "Q" is pressed: }
IF Keypressed THEN { If a keystroke is detected }
BEGIN
Ch := ReadKey; { Pick up the keystroke }
IF Ord(Ch) = 0 THEN { See if it's an extended keystroke }
BEGIN
Ch := ReadKey; { If so, pick up scan code }
CASE Ord(Ch) OF { and parse it }
72 : Pan(MyScreen,Up,1); { Up arrow }
80 : Pan(MyScreen,Down,1); { Down arrow }
END { CASE }
END
ELSE { If it's an ordinary keystroke, test for quit: }
IF Ch IN ['Q','q'] THEN Quit := True
END;
{ Now we draw a random box. }
{ First get random X/Y position on the virtual screen: }
REPEAT X := Random(VWIDTH-5) UNTIL X > 1;
REPEAT Y := Random(VHEIGHT-5) UNTIL Y > 1;
{ Next get a random width and height to avoid wrapping: }
REPEAT
Width := Random(VWIDTH)
UNTIL (Width > 1) AND ((X + Width) < VWIDTH);;
REPEAT
Height := Random(VHEIGHT)
UNTIL (Height > 1) AND ((Y + Height) < VHEIGHT);;
{ Draw the box: }
MakeBox(MyScreen,X,Y,Width,Height,DoubleLine); { and draw it! }
UNTIL Quit
END.




  3 Responses to “Category : Files from Magazines
Archive   : DDJ0589.ZIP
Filename : VTOOLS.ASC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/