Category : Files from Magazines
Archive   : DDJ-9008.ZIP
Filename : DUNTEMAN.LST

 
Output of file : DUNTEMAN.LST contained in archive : DDJ-9008.ZIP
_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann

[LISTING ONE]

{-------------------------------------------------}
{ SETOBJ }
{ Set object with an interactive editing method }
{ by Jeff Duntemann }
{ For DDJ 8/90 }
{ Turbo Pascal 5.5 }
{ Last modified 5/4/90 }
{-------------------------------------------------}

UNIT SetObj;

INTERFACE

USES DOS,Crt;

TYPE
BitSet = SET OF 0..255; { Maximum size generic set }

SetObject =
OBJECT
SetData : BitSet; { The set data itself }
HotBit : Integer; { Bit currently subject to editing }
ShowAtRow : Integer; { Matrix may appear at row 1 to 8 }
MatrixPtr : Pointer; { Points to matrix pattern on heap }
Origin : Integer; { Display text starts at 0 or 1 }
Attribute : Integer; { Attribute for nonhighlighted elements }
Highlight : Integer; { Attribute for highlighted elements }
EditInProcess : Boolean; { True if inside the Edit method }
CONSTRUCTOR Init(InitialOrigin,
InitialAttribute,
InitialHighlight,
InitialStartRow : Integer);
DESTRUCTOR Done; { Removes object from memory }
PROCEDURE ClearSet; { Forces all set bits to 0 }
PROCEDURE Show; { Displays set data; doesn't edit }
PROCEDURE Edit; { Displays and edits set data }
END;

IMPLEMENTATION

TYPE
Char40 = ARRAY[0..39] OF CHAR; { For the matrix; see below }

CONST
LeftCursorChar = #16; { These are the bracketing characters }
RightCursorChar = #17; { Indicating which set element is being }
{ edited. }

{ This is the text portion of the 16-line number matrix used to display }
{ and edit set elements. They are first stored onto the heap, then the }
{ object's attribute is merged with the text on the heap. This way, }
{ you can move the whole image onto the screen, attributes and all, }
{ with a single Move statement. }

MatrixText : ARRAY[0..32] OF Char40 = (
' 000 001 002 003 004 005 006 007 ',
' 008 009 010 011 012 013 014 015 ',
' 016 017 018 019 020 021 022 023 ',
' 024 025 026 027 028 029 030 031 ',
' 032 033 034 035 036 037 038 039 ',
' 040 041 042 043 044 045 046 047 ',
' 048 049 050 051 052 053 054 055 ',
' 056 057 058 059 060 061 062 063 ',
' 064 065 066 067 068 069 070 071 ',
' 072 073 074 075 076 077 078 079 ',
' 080 081 082 083 084 085 086 087 ',
' 088 089 090 091 092 093 094 095 ',
' 096 097 098 099 100 101 102 103 ',
' 104 105 106 107 108 109 110 111 ',
' 112 113 114 115 116 117 118 119 ',
' 120 121 122 123 124 125 126 127 ',
' 128 129 130 131 132 133 134 135 ',
' 136 137 138 139 140 141 142 143 ',
' 144 145 146 147 148 149 150 151 ',
' 152 153 154 155 156 157 158 159 ',
' 160 161 162 163 164 165 166 167 ',
' 168 169 170 171 172 173 174 175 ',
' 176 177 178 179 180 181 182 183 ',
' 184 185 186 187 188 189 190 191 ',
' 192 193 194 195 196 197 198 199 ',
' 200 201 202 203 204 205 206 207 ',
' 208 209 210 211 212 213 214 215 ',
' 216 217 218 219 220 221 222 223 ',
' 224 225 226 227 228 229 230 231 ',
' 232 233 224 235 236 237 238 239 ',
' 240 241 242 243 244 245 246 247 ',
' 248 249 250 251 252 253 254 255 ',
' 256 ');

VAR
VidBufferPtr : Pointer; { Global, set in the init. section }
MouseAvailable : Boolean; { Global, set in the init. section }

{-------------------------------------------------}
{ Procedures and functions private to this unit: }
{-------------------------------------------------}

{ This is the general-purpose mouse call primitive: }

PROCEDURE MouseCall(VAR M1,M2,M3,M4 : Word);

VAR
Regs : Registers;

BEGIN
WITH Regs DO
BEGIN
AX := M1; BX := M2; CX := M3; DX := M4;
END;
INTR(51,Regs); { 51 = $33 = Mouse driver interrupt vector }
WITH Regs DO
BEGIN
M1 := AX; M2 := BX; M3 := CX; M4 := DX;
END;
END;

PROCEDURE ShowMouse;

VAR
M1,M2,M3,M4 : Word;

BEGIN
M1 := 1; MouseCall(M1,M2,M3,M4);
END;

PROCEDURE HideMouse;

VAR
M1,M2,M3,M4 : Word;

BEGIN
M1 := 2; MouseCall(M1,M2,M3,M4);
END;

{ If called when left mouse button is down, waits for release }

PROCEDURE WaitForMouseRelease;

VAR
M1,ButtonStatus,M3,M4 : Word;

BEGIN
M1 := 3;
REPEAT
MouseCall(M1,ButtonStatus,M3,M4);
UNTIL NOT Odd(ButtonStatus); { Wait until Bit 0 goes to 0 }
END;

PROCEDURE UhUh; { Says "uh-uh" when you press the wrong key }

VAR
I : Integer;

BEGIN
FOR I := 1 TO 2 DO
BEGIN
Sound(50); Delay(100); NoSound; Delay(50);
END;
END;

FUNCTION MouseIsInstalled : Boolean;

TYPE
BytePtr = ^Byte;

VAR
TestVector : BytePtr;

BEGIN
GetIntVec(51,Pointer(TestVector));
{ $CF is the binary opcode for the IRET instruction; }
{ in many BIOSes, the startup code puts IRETs into }
{ most unused bectors. NIL, of course, is 4 zeroes. }
IF (TestVector = NIL) OR (TestVector^ = $CF) THEN
MouseIsInstalled := False
ELSE
MouseIsInstalled := True
END;

{ Returns True if running on a mono system: }

FUNCTION IsMono : Boolean;

VAR
Regs : Registers;

BEGIN
Intr(17,Regs);
IF (Regs.AX AND $0030) = $30 THEN IsMono := True
ELSE IsMono := False;
END;

{-------------------------------------------------------}
{ Returns True if left mouse button was clicked, and if }
{ the button *was* clicked, returns the X,Y position }
{ of the mouse at click-time in MouseX,MouseY. If }
{ called when the mouse was *not* clicked, returns 0 }
{ in MouseX and MouseY. }
{-------------------------------------------------------}

FUNCTION MouseWasClicked(VAR MouseX,MouseY : Word) : Boolean;

VAR
M1,ButtonStatus : Word;

BEGIN
M1 := 3; MouseCall(M1,ButtonStatus,MouseX,MouseY);
IF Odd(ButtonStatus) THEN MouseWasClicked := True
ELSE
BEGIN
MouseWasClicked := False;
MouseX := 0;
MouseY := 0;
END
END;

PROCEDURE MatrixBlast(TextPtr,Heapptr : Pointer;
SizeOfMatrix : Word;
Origin,Attribute : Byte);

INLINE
($58/ { POP AX } { Pop attribute character into AX}
$5B/ { POP BX } { Pop origin digit into BX }
$59/ { POP CX } { Pop byte count into CX }
$5F/ { POP DI } { Pop heap pointer offset portion into DI }
$07/ { POP ES } { Pop heap pointer segment portion into ES }
$5E/ { POP SI } { Pop matrix pointer offset portion into SI }
$5A/ { POP DX } { Pop matrix pointer segment portion into DX }
$1E/ { PUSH DS } { Store Turbo's DS value on the stack }
$8E/$DA/ { MOV DS,DX } { Move DX into DS }
$86/$C4/ { XCHG AL,AH } { Get attribute into hi byte of AX }
$03/$F3/ { ADD SI,BX } { Add origin adj. to matrix pointer offset }
$AC/ { LODSB } { Load MatrixText character at DS:SI into AL }
$AB/ { STOSW } { Store matrix char/attr pair in AX to ES:DI }
$E2/$FC/ { LOOP -4 } { Loop back to LOADSB until CX = 0 }
$1F); { POP DS } { Pop Turbo's DS value from stack back to DS }

PROCEDURE AttributeBlast(ImagePtr : Pointer;
ImageOffset,Attribute,WordCount : Integer);

INLINE(
$59/ { POP CX } { Pop word count into CX }
$58/ { POP AX } { Pop attribute value into AX }
$5B/ { POP BX } { Pop image offset value into BX }
$D1/$E3/ { SHL BX,1 } { Multiply image offset by 2, for words not bytes }
$5F/ { POP DI } { Pop offset portion of image pointer into DI }
$07/ { POP ES } { Pop segment portion of image pointer into ES }
$03/$FB/ { ADD DI,BX } { Add image offset value to pointer offset }
$47/ { INC DI } { Add 1 to DI to point to attribute of 1st char }
$AA/ { STOSB } { Store AL to ES:DI; INC DI by 1 }
$47/ { INC DI } { Increment DI past character byte }
$E2/$FC);{ LOOP -4 } { Loop back to STOSB until CX = 0 }

{------------------------------------}
{ Method definitions for SetObject: }
{------------------------------------}

CONSTRUCTOR SetObject.Init(InitialOrigin,
InitialAttribute,
InitialHighlight,
InitialStartRow : Integer);

BEGIN
{ Set initial values for state variables: }
Origin := InitialOrigin;
Attribute := InitialAttribute;
Highlight := InitialHighlight;
ShowAtRow := InitialStartRow;
SetData := []; { Set initial set value to empty }
HotBit := 0; { Set initial hot bit to 0 }
EditInProcess := False; { Not in Edit method right now! }

GetMem(MatrixPtr,2560); { Allocate space on the heap for the matrix }
{ Blast the matrix pattern, with attributes, onto the heap: }
MatrixBlast(@MatrixText,MatrixPtr,
SizeOf(MatrixText),(Origin*5),Attribute);
END;

DESTRUCTOR SetObject.Done;

BEGIN
{ Free the memory occupied by the matrix image: }
FreeMem(MatrixPtr,2560);
END;

PROCEDURE SetObject.ClearSet;

BEGIN
FillChar(SetData,Sizeof(SetData),Chr(0));
END;

PROCEDURE SetObject.Show;

VAR
I,Offset : Integer;
ShowPtr : Pointer;

BEGIN
{ It's important not to clobber the visible mouse cursor in the }
{ video refresh buffer. This is why we turn it off for the }
{ duration of this procedure: }
IF MouseAvailable THEN IF EditInProcess THEN HideMouse;
FOR I := 0 TO 255 DO
IF I IN SetData THEN
AttributeBlast(MatrixPtr,(I*5)+1,Highlight,3)
ELSE
AttributeBlast(MatrixPtr,(I*5)+1,Attribute,3);
Offset := (ShowAtRow-1) * 160; { Offset in bytes into the vid. buffer }
{ Create a pointer to the matrix location in the video buffer: }
ShowPtr := Pointer(LongInt(VidBufferPtr) + Offset);
{ Move the matrix image from the heap into the video buffer: }
Move(MatrixPtr^,ShowPtr^,(Sizeof(MatrixText) SHL 1)-79);
{ If the mouse is available we assume we're using it: }
IF MouseAvailable THEN IF EditInProcess THEN ShowMouse;
END;

{--------------------------------------------------------------------}
{ This is the beef of the SetObject concept: A method that brings up }
{ a 16 X 16 matrix of bit numbers, each of which corrresponds to one }
{ bit in the set. The method allows the user to zero in on a single }
{ bit through the keyboard or through the mouse if the driver is }
{ loaded. Click on the number (or press Enter) and the bit changes }
{ state, as indicated by screen highlighting. This is useful for }
{ debugging or even data entry to a set object. }
{--------------------------------------------------------------------}

PROCEDURE SetObject.Edit;

VAR
I : Integer;
M1,M2,M3,M4 : Word;
MouseX,MouseY : Word;
Quit : Boolean;
InCh : Char;

PROCEDURE PokeToCursor(Left,Right : Char);

BEGIN
Char(Pointer(LongInt(MatrixPtr)+(HotBit*10))^) := Left;
Char(Pointer(LongInt(MatrixPtr)+(HotBit*10)+8)^) := Right;
END;

PROCEDURE MoveHotBitTo(NewHotBit : Integer);

BEGIN
PokeToCursor(' ',' ');
HotBit := NewHotBit;
PokeToCursor(LeftCursorChar,RightCursorChar);
Show;
END;

{ Converts a mouse screen X,Y to a bit position in the matrix }
{ from 0-255: }

FUNCTION MouseBitPosition(MouseX,MouseY : Integer) : Integer;

VAR
ScreenX,ScreenY : Word;

BEGIN
ScreenX := (MouseX DIV 8) + 1; ScreenY := (MouseY DIV 8) + 1;
ScreenY := ScreenY - ShowAtRow; { Adjust Y for screen position }
MouseBitPosition := (ScreenY * 16) + (ScreenX DIV 5);
END;

{ Simply toggles the set bit specified in FlipBitNumber: }

PROCEDURE ToggleBit(FlipBitNumber : Integer);

BEGIN
IF FlipBitNumber IN SetData THEN { If it's a 1-bit }
BEGIN
SetData := SetData - [FlipBitNumber];
AttributeBlast(MatrixPtr,(FlipBitNumber*5)+1,Attribute,3);
END
ELSE { If it's a 0-bit }
SetData := SetData + [FlipBitNumber];
END;

BEGIN { Body of Edit }
EditInProcess := True;
{ Make keyboard cursor visible at HotBit: }
PokeToCursor(LeftCursorChar,RightCursorChar);
Show;

{ Turn on mouse cursor if mouse is available: }
IF MouseAvailable THEN
BEGIN
M1 := 0; MouseCall(M1,M2,M3,M4); { Reset mouse }
M1 := 8; M3 := ((ShowAtRow-1) SHL 3);
M4 := ((ShowAtRow-1) SHL 3) + 120;
MouseCall(M1,M2,M3,M4); { Limit mouse movement vertically }
M1 := 1; MouseCall(M1,M2,M3,M4); { Show mouse cursor }
END;

Quit := False;
REPEAT
IF MouseAvailable THEN { Test global Boolean variable }
IF MouseWasClicked(MouseX,MouseY) THEN
BEGIN { Mouse was clicked... }
I := MouseBitPosition(MouseX,MouseY); {..on what bit? }
MoveHotBitTo(I); { Move hot bit to that bit }
ToggleBit(I); { Toggle the selected bit's state }
WaitForMouseRelease; { Wait for button release }
Show; { Redisplay the matrix }
END;

IF KeyPressed THEN { If the user pressed any key... }
BEGIN
InCh := ReadKey; { Get the key }
IF InCh = Chr(0) THEN { If it was null... }
BEGIN
InCh := ReadKey; { Get the second half }
CASE Ord(InCh) OF { and parse it: }
{ Up } 72 : IF HotBit > 15 THEN I := HotBit-16 ELSE Uhuh;
{ Left } 75 : IF HotBit > 0 THEN I := Hotbit-1 ELSE Uhuh;
{ Right } 77 : IF HotBit < 255 THEN I := HotBit+1 ELSE Uhuh;
{ Down } 80 : IF HotBit < 239 THEN I := HotBit+16 ELSE Uhuh;
{ Home } 71 : I := 0;
{ PgUp } 73 : I := 15;
{ End } 79 : I := 240;
{ PgDn } 81 : I := 255;
ELSE Uhuh;
END; { CASE }
MoveHotBitTo(I);
END;
CASE Ord(InCh) OF
13 : ToggleBit(HotBit); { Enter }
27 : Quit := True; { ESC }
ELSE {Uhuh;}
END; { CASE }
Show;
END;
UNTIL Quit;
IF MouseAvailable THEN HideMouse; { Hide mouse cursor }
PokeToCursor(' ',' '); { Erase cursor framing characters }
EditInProcess := False;
END;

{ Initialization section: }

BEGIN
IF IsMono THEN VidBufferPtr := Ptr($B000,0)
ELSE VidBufferPtr := Ptr($B800,0);
{ Here we look for the presence of the mouse driver: }
MouseAvailable := MouseIsInstalled;
END.




[LISTING TWO]

PROGRAM SetTest;

USES Crt,SetObj; { SetObj presented in DDJ 8/90 }

VAR
MySet : SetObject;

BEGIN
TextBackground(Black);
ClrScr;
MySet.Init(0,$07,$70,1); { Create the object }
MySet.SetData := [0,17,42,121,93,250]; { Give set a value }
MySet.Edit; { Edit the set }
ClrScr; { Clear screen }
Readln; { Wait for keypress }
MySet.Show; { Show the set }
MySet.ClearSet; { Zero the set }
Readln; { Wait for keypress }
MySet.Show; { Show the cleared set }
Readln; { And wait for final keypress }
END.



  3 Responses to “Category : Files from Magazines
Archive   : DDJ-9008.ZIP
Filename : DUNTEMAN.LST

  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/