home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1990 / 08 / dunteman.lst < prev    next >
File List  |  1990-06-20  |  16KB  |  481 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6. {-------------------------------------------------}
  7. {                     SETOBJ                      }
  8. {  Set object with an interactive editing method  }
  9. {                        by Jeff Duntemann        }
  10. {                        For DDJ 8/90             }
  11. {                        Turbo Pascal 5.5         }
  12. {                        Last modified 5/4/90     }
  13. {-------------------------------------------------}
  14.  
  15. UNIT SetObj;
  16.  
  17. INTERFACE
  18.  
  19. USES DOS,Crt;
  20.  
  21. TYPE
  22.   BitSet    = SET OF 0..255;  { Maximum size generic set }
  23.  
  24.   SetObject =
  25.     OBJECT
  26.       SetData   : BitSet;     { The set data itself }
  27.       HotBit    : Integer;    { Bit currently subject to editing }
  28.       ShowAtRow : Integer;    { Matrix may appear at row 1 to 8 }
  29.       MatrixPtr : Pointer;    { Points to matrix pattern on heap }
  30.       Origin    : Integer;    { Display text starts at 0 or 1 }
  31.       Attribute : Integer;    { Attribute for nonhighlighted elements }
  32.       Highlight : Integer;    { Attribute for highlighted elements }
  33.       EditInProcess : Boolean;    { True if inside the Edit method }
  34.       CONSTRUCTOR Init(InitialOrigin,
  35.                        InitialAttribute,
  36.                        InitialHighlight,
  37.                        InitialStartRow : Integer);
  38.       DESTRUCTOR  Done;       { Removes object from memory }
  39.       PROCEDURE   ClearSet;   { Forces all set bits to 0 }
  40.       PROCEDURE   Show;       { Displays set data; doesn't edit }
  41.       PROCEDURE   Edit;       { Displays and edits set data }
  42.     END;
  43.  
  44. IMPLEMENTATION
  45.  
  46. TYPE
  47.   Char40 = ARRAY[0..39] OF CHAR;  { For the matrix; see below }
  48.  
  49. CONST
  50.   LeftCursorChar  = #16;   { These are the bracketing characters   }
  51.   RightCursorChar = #17;   { Indicating which set element is being }
  52.                            { edited. }
  53.  
  54.   { This is the text portion of the 16-line number matrix used to display }
  55.   { and edit set elements.  They are first stored onto the heap, then the }
  56.   { object's attribute is merged with the text on the heap.  This way,    }
  57.   { you can move the whole image onto the screen, attributes and all,     }
  58.   { with a single Move statement. }
  59.  
  60.   MatrixText : ARRAY[0..32] OF Char40 = (
  61.            ' 000  001  002  003  004  005  006  007 ',
  62.            ' 008  009  010  011  012  013  014  015 ',
  63.            ' 016  017  018  019  020  021  022  023 ',
  64.            ' 024  025  026  027  028  029  030  031 ',
  65.            ' 032  033  034  035  036  037  038  039 ',
  66.            ' 040  041  042  043  044  045  046  047 ',
  67.            ' 048  049  050  051  052  053  054  055 ',
  68.            ' 056  057  058  059  060  061  062  063 ',
  69.            ' 064  065  066  067  068  069  070  071 ',
  70.            ' 072  073  074  075  076  077  078  079 ',
  71.            ' 080  081  082  083  084  085  086  087 ',
  72.            ' 088  089  090  091  092  093  094  095 ',
  73.            ' 096  097  098  099  100  101  102  103 ',
  74.            ' 104  105  106  107  108  109  110  111 ',
  75.            ' 112  113  114  115  116  117  118  119 ',
  76.            ' 120  121  122  123  124  125  126  127 ',
  77.            ' 128  129  130  131  132  133  134  135 ',
  78.            ' 136  137  138  139  140  141  142  143 ',
  79.            ' 144  145  146  147  148  149  150  151 ',
  80.            ' 152  153  154  155  156  157  158  159 ',
  81.            ' 160  161  162  163  164  165  166  167 ',
  82.            ' 168  169  170  171  172  173  174  175 ',
  83.            ' 176  177  178  179  180  181  182  183 ',
  84.            ' 184  185  186  187  188  189  190  191 ',
  85.            ' 192  193  194  195  196  197  198  199 ',
  86.            ' 200  201  202  203  204  205  206  207 ',
  87.            ' 208  209  210  211  212  213  214  215 ',
  88.            ' 216  217  218  219  220  221  222  223 ',
  89.            ' 224  225  226  227  228  229  230  231 ',
  90.            ' 232  233  224  235  236  237  238  239 ',
  91.            ' 240  241  242  243  244  245  246  247 ',
  92.            ' 248  249  250  251  252  253  254  255 ',
  93.            ' 256                                    ');
  94.  
  95. VAR
  96.   VidBufferPtr   : Pointer;  { Global, set in the init. section }
  97.   MouseAvailable : Boolean;  { Global, set in the init. section }
  98.  
  99. {-------------------------------------------------}
  100. {  Procedures and functions private to this unit: }
  101. {-------------------------------------------------}
  102.  
  103. { This is the general-purpose mouse call primitive: }
  104.  
  105. PROCEDURE MouseCall(VAR M1,M2,M3,M4 : Word);
  106.  
  107. VAR
  108.   Regs : Registers;
  109.  
  110. BEGIN
  111.   WITH Regs DO
  112.     BEGIN
  113.       AX := M1; BX := M2; CX := M3; DX := M4;
  114.     END;
  115.   INTR(51,Regs);  { 51 = $33 = Mouse driver interrupt vector }
  116.   WITH Regs DO
  117.     BEGIN
  118.       M1 := AX; M2 := BX; M3 := CX; M4 := DX;
  119.     END;
  120. END;
  121.  
  122. PROCEDURE ShowMouse;
  123.  
  124. VAR
  125.   M1,M2,M3,M4 : Word;
  126.  
  127. BEGIN
  128.   M1 := 1; MouseCall(M1,M2,M3,M4);
  129. END;
  130.  
  131. PROCEDURE HideMouse;
  132.  
  133. VAR
  134.   M1,M2,M3,M4 : Word;
  135.  
  136. BEGIN
  137.   M1 := 2; MouseCall(M1,M2,M3,M4);
  138. END;
  139.  
  140. { If called when left mouse button is down, waits for release }
  141.  
  142. PROCEDURE WaitForMouseRelease;
  143.  
  144. VAR
  145.   M1,ButtonStatus,M3,M4 : Word;
  146.  
  147. BEGIN
  148.   M1 := 3;
  149.   REPEAT
  150.     MouseCall(M1,ButtonStatus,M3,M4);
  151.   UNTIL NOT Odd(ButtonStatus);  { Wait until Bit 0 goes to 0 }
  152. END;
  153.  
  154. PROCEDURE UhUh;  { Says "uh-uh" when you press the wrong key }
  155.  
  156. VAR
  157.   I : Integer;
  158.  
  159. BEGIN
  160.   FOR I := 1 TO 2 DO
  161.     BEGIN
  162.       Sound(50); Delay(100); NoSound; Delay(50);
  163.     END;
  164. END;
  165.  
  166. FUNCTION MouseIsInstalled : Boolean;
  167.  
  168. TYPE
  169.   BytePtr = ^Byte;
  170.  
  171. VAR
  172.   TestVector : BytePtr;
  173.  
  174. BEGIN
  175.   GetIntVec(51,Pointer(TestVector));
  176.   { $CF is the binary opcode for the IRET instruction; }
  177.   { in many BIOSes, the startup code puts IRETs into   }
  178.   { most unused bectors. NIL, of course, is 4 zeroes.  }
  179.   IF (TestVector = NIL) OR (TestVector^ = $CF) THEN
  180.     MouseIsInstalled := False
  181.   ELSE
  182.     MouseIsInstalled := True
  183. END;
  184.  
  185. { Returns True if running on a mono system: }
  186.  
  187. FUNCTION IsMono : Boolean;
  188.  
  189. VAR
  190.   Regs : Registers;
  191.  
  192. BEGIN
  193.   Intr(17,Regs);
  194.   IF (Regs.AX AND $0030) = $30 THEN IsMono := True
  195.     ELSE IsMono := False;
  196. END;
  197.  
  198. {-------------------------------------------------------}
  199. { Returns True if left mouse button was clicked, and if }
  200. { the button *was* clicked, returns the X,Y position    }
  201. { of the mouse at click-time in MouseX,MouseY.  If      }
  202. { called when the mouse was *not* clicked, returns 0    }
  203. { in MouseX and MouseY.                                 }
  204. {-------------------------------------------------------}
  205.  
  206. FUNCTION MouseWasClicked(VAR MouseX,MouseY : Word) : Boolean;
  207.  
  208. VAR
  209.   M1,ButtonStatus : Word;
  210.  
  211. BEGIN
  212.   M1 := 3; MouseCall(M1,ButtonStatus,MouseX,MouseY);
  213.   IF Odd(ButtonStatus) THEN MouseWasClicked := True
  214.     ELSE
  215.       BEGIN
  216.         MouseWasClicked := False;
  217.         MouseX := 0;
  218.         MouseY := 0;
  219.       END
  220. END;
  221.  
  222. PROCEDURE MatrixBlast(TextPtr,Heapptr  : Pointer;
  223.                       SizeOfMatrix     : Word;
  224.                       Origin,Attribute : Byte);
  225.  
  226. INLINE
  227. ($58/     { POP AX }     { Pop attribute character into AX}
  228.  $5B/     { POP BX }     { Pop origin digit into BX }
  229.  $59/     { POP CX }     { Pop byte count into CX }
  230.  $5F/     { POP DI }     { Pop heap pointer offset portion into DI }
  231.  $07/     { POP ES }     { Pop heap pointer segment portion into ES }
  232.  $5E/     { POP SI }     { Pop matrix pointer offset portion into SI }
  233.  $5A/     { POP DX }     { Pop matrix pointer segment portion into DX }
  234.  $1E/     { PUSH DS }    { Store Turbo's DS value on the stack }
  235.  $8E/$DA/ { MOV DS,DX }  { Move DX into DS }
  236.  $86/$C4/ { XCHG AL,AH } { Get attribute into hi byte of AX }
  237.  $03/$F3/ { ADD SI,BX }  { Add origin adj. to matrix pointer offset }
  238.  $AC/     { LODSB }      { Load MatrixText character at DS:SI into AL }
  239.  $AB/     { STOSW }      { Store matrix char/attr pair in AX to ES:DI }
  240.  $E2/$FC/ { LOOP -4 }    { Loop back to LOADSB until CX = 0 }
  241.  $1F);    { POP DS }     { Pop Turbo's DS value from stack back to DS }
  242.  
  243.  PROCEDURE AttributeBlast(ImagePtr : Pointer;
  244.                           ImageOffset,Attribute,WordCount : Integer);
  245.  
  246.  INLINE(
  247.  $59/     { POP CX }     { Pop word count into CX }
  248.  $58/     { POP AX }     { Pop attribute value into AX }
  249.  $5B/     { POP BX }     { Pop image offset value into BX }
  250.  $D1/$E3/ { SHL BX,1 }   { Multiply image offset by 2, for words not bytes }
  251.  $5F/     { POP DI }     { Pop offset portion of image pointer into DI }
  252.  $07/     { POP ES }     { Pop segment portion of image pointer into ES }
  253.  $03/$FB/ { ADD DI,BX }  { Add image offset value to pointer offset }
  254.  $47/     { INC DI }     { Add 1 to DI to point to attribute of 1st char }
  255.  $AA/     { STOSB }      { Store AL to ES:DI; INC DI by 1 }
  256.  $47/     { INC DI }     { Increment DI past character byte }
  257.  $E2/$FC);{ LOOP -4 }    { Loop back to STOSB until CX = 0 }
  258.  
  259. {------------------------------------}
  260. {  Method definitions for SetObject: }
  261. {------------------------------------}
  262.  
  263. CONSTRUCTOR SetObject.Init(InitialOrigin,
  264.                            InitialAttribute,
  265.                            InitialHighlight,
  266.                            InitialStartRow : Integer);
  267.  
  268. BEGIN
  269.   { Set initial values for state variables: }
  270.   Origin    := InitialOrigin;
  271.   Attribute := InitialAttribute;
  272.   Highlight := InitialHighlight;
  273.   ShowAtRow := InitialStartRow;
  274.   SetData   := [];        { Set initial set value to empty }
  275.   HotBit    := 0;         { Set initial hot bit to 0 }
  276.   EditInProcess := False; { Not in Edit method right now! }
  277.  
  278.   GetMem(MatrixPtr,2560); { Allocate space on the heap for the matrix }
  279.   { Blast the matrix pattern, with attributes, onto the heap: }
  280.   MatrixBlast(@MatrixText,MatrixPtr,
  281.               SizeOf(MatrixText),(Origin*5),Attribute);
  282. END;
  283.  
  284. DESTRUCTOR SetObject.Done;
  285.  
  286. BEGIN
  287.   { Free the memory occupied by the matrix image: }
  288.   FreeMem(MatrixPtr,2560);
  289. END;
  290.  
  291. PROCEDURE SetObject.ClearSet;
  292.  
  293. BEGIN
  294.   FillChar(SetData,Sizeof(SetData),Chr(0));
  295. END;
  296.  
  297. PROCEDURE SetObject.Show;
  298.  
  299. VAR
  300.   I,Offset : Integer;
  301.   ShowPtr  : Pointer;
  302.  
  303. BEGIN
  304.   { It's important not to clobber the visible mouse cursor in the }
  305.   { video refresh buffer.  This is why we turn it off for the     }
  306.   { duration of this procedure: }
  307.   IF MouseAvailable THEN IF EditInProcess THEN HideMouse;
  308.   FOR I := 0 TO 255 DO
  309.     IF I IN SetData THEN
  310.       AttributeBlast(MatrixPtr,(I*5)+1,Highlight,3)
  311.     ELSE
  312.       AttributeBlast(MatrixPtr,(I*5)+1,Attribute,3);
  313.   Offset := (ShowAtRow-1) * 160;  { Offset in bytes into the vid. buffer }
  314.   { Create a pointer to the matrix location in the video buffer: }
  315.   ShowPtr := Pointer(LongInt(VidBufferPtr) + Offset);
  316.   { Move the matrix image from the heap into the video buffer: }
  317.   Move(MatrixPtr^,ShowPtr^,(Sizeof(MatrixText) SHL 1)-79);
  318.   { If the mouse is available we assume we're using it: }
  319.   IF MouseAvailable THEN IF EditInProcess THEN ShowMouse;
  320. END;
  321.  
  322. {--------------------------------------------------------------------}
  323. { This is the beef of the SetObject concept: A method that brings up }
  324. { a 16 X 16 matrix of bit numbers, each of which corrresponds to one }
  325. { bit in the set.  The method allows the user to zero in on a single }
  326. { bit through the keyboard or through the mouse if the driver is     }
  327. { loaded. Click on the number (or press Enter) and the bit changes   }
  328. { state, as indicated by screen highlighting.  This is useful for    }
  329. { debugging or even data entry to a set object.                      }
  330. {--------------------------------------------------------------------}
  331.  
  332. PROCEDURE SetObject.Edit;
  333.  
  334. VAR
  335.   I             : Integer;
  336.   M1,M2,M3,M4   : Word;
  337.   MouseX,MouseY : Word;
  338.   Quit          : Boolean;
  339.   InCh          : Char;
  340.  
  341. PROCEDURE PokeToCursor(Left,Right : Char);
  342.  
  343. BEGIN
  344.   Char(Pointer(LongInt(MatrixPtr)+(HotBit*10))^)   := Left;
  345.   Char(Pointer(LongInt(MatrixPtr)+(HotBit*10)+8)^) := Right;
  346. END;
  347.  
  348. PROCEDURE MoveHotBitTo(NewHotBit : Integer);
  349.  
  350. BEGIN
  351.   PokeToCursor(' ',' ');
  352.   HotBit := NewHotBit;
  353.   PokeToCursor(LeftCursorChar,RightCursorChar);
  354.   Show;
  355. END;
  356.  
  357. { Converts a mouse screen X,Y to a bit position in the matrix }
  358. { from 0-255: }
  359.  
  360. FUNCTION MouseBitPosition(MouseX,MouseY : Integer) : Integer;
  361.  
  362. VAR
  363.   ScreenX,ScreenY : Word;
  364.  
  365. BEGIN
  366.   ScreenX := (MouseX DIV 8) + 1; ScreenY := (MouseY DIV 8) + 1;
  367.   ScreenY := ScreenY - ShowAtRow;  { Adjust Y for screen position }
  368.   MouseBitPosition := (ScreenY * 16) + (ScreenX DIV 5);
  369. END;
  370.  
  371. { Simply toggles the set bit specified in FlipBitNumber: }
  372.  
  373. PROCEDURE ToggleBit(FlipBitNumber : Integer);
  374.  
  375. BEGIN
  376.   IF FlipBitNumber IN SetData THEN  { If it's a 1-bit }
  377.     BEGIN
  378.       SetData := SetData - [FlipBitNumber];
  379.       AttributeBlast(MatrixPtr,(FlipBitNumber*5)+1,Attribute,3);
  380.     END
  381.   ELSE   { If it's a 0-bit }
  382.     SetData := SetData + [FlipBitNumber];
  383. END;
  384.  
  385. BEGIN  { Body of Edit }
  386.   EditInProcess := True;
  387.   { Make keyboard cursor visible at HotBit: }
  388.   PokeToCursor(LeftCursorChar,RightCursorChar);
  389.   Show;
  390.  
  391.   { Turn on mouse cursor if mouse is available: }
  392.   IF MouseAvailable THEN
  393.     BEGIN
  394.       M1 := 0; MouseCall(M1,M2,M3,M4); { Reset mouse }
  395.       M1 := 8; M3 := ((ShowAtRow-1) SHL 3);
  396.       M4 := ((ShowAtRow-1) SHL 3) + 120;
  397.       MouseCall(M1,M2,M3,M4);  { Limit mouse movement vertically }
  398.       M1 := 1; MouseCall(M1,M2,M3,M4); { Show mouse cursor }
  399.     END;
  400.  
  401.   Quit := False;
  402.   REPEAT
  403.     IF MouseAvailable THEN     { Test global Boolean variable }
  404.       IF MouseWasClicked(MouseX,MouseY) THEN
  405.         BEGIN                            { Mouse was clicked... }
  406.           I := MouseBitPosition(MouseX,MouseY); {..on what bit? }
  407.           MoveHotBitTo(I);           { Move hot bit to that bit }
  408.           ToggleBit(I);       { Toggle the selected bit's state }
  409.           WaitForMouseRelease;        { Wait for button release }
  410.           Show;                          { Redisplay the matrix }
  411.         END;
  412.  
  413.     IF KeyPressed THEN  { If the user pressed any key... }
  414.       BEGIN
  415.         InCh := ReadKey;         { Get the key }
  416.         IF InCh = Chr(0) THEN    { If it was null... }
  417.           BEGIN
  418.             InCh := ReadKey;     { Get the second half }
  419.             CASE Ord(InCh) OF    {  and parse it: }
  420.   { Up }      72 : IF HotBit > 15 THEN I := HotBit-16 ELSE Uhuh;
  421.   { Left }    75 : IF HotBit > 0 THEN I := Hotbit-1 ELSE Uhuh;
  422.   { Right }   77 : IF HotBit < 255 THEN I := HotBit+1 ELSE Uhuh;
  423.   { Down }    80 : IF HotBit < 239 THEN I := HotBit+16 ELSE Uhuh;
  424.   { Home }    71 : I := 0;
  425.   { PgUp }    73 : I := 15;
  426.   { End }     79 : I := 240;
  427.   { PgDn }    81 : I := 255;
  428.               ELSE Uhuh;
  429.             END; { CASE }
  430.             MoveHotBitTo(I);
  431.           END;
  432.         CASE Ord(InCh) OF
  433.           13 : ToggleBit(HotBit);    { Enter }
  434.           27 : Quit := True;         { ESC }
  435.           ELSE {Uhuh;}
  436.         END; { CASE }
  437.         Show;
  438.       END;
  439.   UNTIL Quit;
  440.   IF MouseAvailable THEN HideMouse;     { Hide mouse cursor }
  441.   PokeToCursor(' ',' ');  { Erase cursor framing characters }
  442.   EditInProcess := False;
  443. END;
  444.  
  445. { Initialization section: }
  446.  
  447. BEGIN
  448.   IF IsMono THEN VidBufferPtr := Ptr($B000,0)
  449.     ELSE VidBufferPtr := Ptr($B800,0);
  450.   { Here we look for the presence of the mouse driver: }
  451.   MouseAvailable := MouseIsInstalled;
  452. END.
  453.  
  454.  
  455.  
  456.  
  457. [LISTING TWO]
  458.  
  459. PROGRAM SetTest;
  460.  
  461. USES Crt,SetObj;  { SetObj presented in DDJ 8/90 }
  462.  
  463. VAR
  464.   MySet : SetObject;
  465.  
  466. BEGIN
  467.   TextBackground(Black);
  468.   ClrScr;
  469.   MySet.Init(0,$07,$70,1);               { Create the object }
  470.   MySet.SetData := [0,17,42,121,93,250]; { Give set a value }
  471.   MySet.Edit;                            { Edit the set }
  472.   ClrScr;                                { Clear screen }
  473.   Readln;                                { Wait for keypress }
  474.   MySet.Show;                            { Show the set }
  475.   MySet.ClearSet;                        { Zero the set }
  476.   Readln;                                { Wait for keypress }
  477.   MySet.Show;                            { Show the cleared set }
  478.   Readln;                         { And wait for final keypress }
  479. END.
  480.  
  481.