home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1989 / 05 / vtools.asc < prev    next >
Text File  |  1989-05-12  |  8KB  |  249 lines
  1. _Structured Programming Column_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6. { Turbo Pascal 4.0/5.0 Registers type, from the DOS unit: }
  7.  
  8. Registers = RECORD
  9.               CASE Integer OF
  10.                 0 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Word;
  11.                 1 : (AL,AH,BL,BH,CL,CH,DL,DH          : Byte;
  12.             END;
  13.  
  14. (* TopSpeed Modula 2's Registers type, from the SYSTEM module: *)
  15.  
  16. Registers = RECORD
  17.               CASE : BOOLEAN OF
  18.               | TRUE  : AX,BX,CX,DX,BP,SI,DI,DS,ES : CARDINAL;
  19.                         Flags                      : BITSET;
  20.               | FALSE : AL,AH,BL,BH,CL,CH,DL,DH    : SHORTCARD;
  21.               END;
  22.             END;
  23.  
  24.  
  25. [LISTING TWO]
  26.  
  27. {--------------------------------------------------------------}
  28. {                          VTOOLS                              }
  29. {                                                              }
  30. {               Virtual screen I/O tools unit                  }
  31. {                                                              }
  32. {                                    by Jeff Duntemann KI6RA   }
  33. {                                    Turbo Pascal 5.0          }
  34. {                                    Last modified 1/17/89     }
  35. {--------------------------------------------------------------}
  36.  
  37. UNIT VTools;
  38.  
  39. INTERFACE
  40.  
  41. USES DOS,        { Standard Borland unit }
  42.      TextInfo,   { Given in DDJ 3/89     }
  43.      Screens;    { Given in DDJ 4/89     }
  44.  
  45. CONST
  46.   SingleLine  = False;   { To specify single vs. double line }
  47.   DoubleLine  = True;    { bars and boxes }
  48.  
  49. TYPE
  50.   LineChars   = ARRAY[SingleLine..DoubleLine] OF Char;
  51.   BarStrings  = ARRAY[SingleLine..DoubleLine] OF String;
  52.   BoxRec      = RECORD
  53.                   ULCorner,   { Each field in this record  }
  54.                   URCorner,   {  contains both the single  }
  55.                   LLCorner,   {  line and double line      }
  56.                   LRCorner,   {  form of the named line    }
  57.                   HBar,       {  character, indexed by     }
  58.                   VBar,       {  the Boolean constants     }
  59.                   LineCross,  {  SingleLine and DoubleLine }
  60.                   TDown,      {  defined above.            }
  61.                   TUp,
  62.                   TRight,
  63.                   TLeft : LineChars
  64.                 END;
  65.  
  66. CONST
  67.   BoxChars    : BoxRec =
  68.                 (ULCorner  : (#218,#201);   { ┌  ╔  }
  69.                  URCorner  : (#191,#187);   { ┐  ╗  }
  70.                  LLCorner  : (#192,#200);   { └  ╚  }
  71.                  LRcorner  : (#217,#188);   { ┘  ╝  }
  72.                  HBar      : (#196,#205);   { ─  ═  }
  73.                  VBar      : (#179,#186);   { ─  ║  }
  74.                  LineCross : (#197,#206);   { ┼  ╬  }
  75.                  TDown     : (#194,#203);   { ┬  ╦  }
  76.                  TUp       : (#193,#202);   { ┴  ╩  }
  77.                  TRight    : (#195,#185);   { ├  ╣  }
  78.                  TLeft     : (#180,#204));  { ┤  ╠  }
  79.  
  80.  
  81. VAR
  82.   HBars       : BarStrings;   { Horizontally oriented bars }
  83.   VBars       : BarStrings;   { Vertically oriented bars   }
  84.  
  85.  
  86. PROCEDURE MakeBox(Target           : ScreenPtr;
  87.                   X,Y,Width,Height : Integer;
  88.                   IsSingleLine     : Boolean);
  89.  
  90.  
  91. IMPLEMENTATION
  92.  
  93.  
  94. PROCEDURE MakeBox(Target           : ScreenPtr;
  95.                   X,Y,Width,Height : Integer;
  96.                   IsSingleLine     : Boolean);
  97.  
  98. BEGIN
  99.   GotoXY(Target,X,Y);
  100.   WITH BoxChars DO
  101.     BEGIN
  102.       { Display the top line: }
  103.       WriteTo(Target,ULCorner[IsSingleLine]+
  104.                      Copy(HBars[IsSingleLine],1,Width-2)+
  105.                      URCorner[IsSingleLine]);
  106.       { Display the left side: }
  107.       GotoXY(Target,X,Y+1);
  108.       WriteDownTo(Target,Copy(VBars[IsSingleLine],1,Height-2));
  109.       { Display the right side: }
  110.       GotoXY(Target,X+Width-1,Y+1);
  111.       WriteDownTo(Target,Copy(VBars[IsSingleLine],1,Height-2));
  112.       { Display the bottom line: }
  113.       GotoXY(Target,X,Y+Height-1);
  114.       WriteTo(Target,LLCorner[IsSingleLine]+
  115.                      Copy(HBars[IsSingleLine],1,Width-2)+
  116.                      LRCorner[IsSingleLine]);
  117.     END;
  118. END;
  119.  
  120.  
  121. { VTOOLS Initialization Section }
  122.  
  123. BEGIN
  124. { This fills the predefined HBars/VBars variables with line characters: }
  125.   FillChar(HBars[SingleLine],
  126.            SizeOf(HBars[SingleLine]),
  127.            BoxChars.HBar[SingleLine]);
  128.   FillChar(HBars[DoubleLine],
  129.            SizeOf(HBars[DoubleLine]),
  130.            BoxChars.HBar[DoubleLine]);
  131.   HBars[SingleLine,0] := Chr(255);
  132.   HBars[DoubleLine,0] := Chr(255);
  133.  
  134.   FillChar(VBars[SingleLine],
  135.            SizeOf(VBars[SingleLine]),
  136.            BoxChars.VBar[SingleLine]);
  137.   FillChar(VBars[DoubleLine],
  138.            SizeOf(VBars[DoubleLine]),
  139.            BoxChars.VBar[DoubleLine]);
  140.   VBars[SingleLine,0] := Chr(255);
  141.   VBars[DoubleLine,0] := Chr(255);
  142. END.
  143.  
  144.  
  145. [LISTING THREE]
  146.  
  147. { V-Screen procedure that writes from X,Y downward: }
  148.  
  149. PROCEDURE WriteDownTo(Target : ScreenPtr; S : String);
  150.  
  151. VAR
  152.   I,K         : Integer;
  153.   TY          : Byte;
  154.   ShiftedAttr : Word;
  155.  
  156. BEGIN
  157.   { Put attribute in the high byte of a word: }
  158.   ShiftedAttr := CurrentAttr SHL 8;
  159.   WITH Target^ DO
  160.     BEGIN
  161.       TY := Y;
  162.       K := 0;
  163.       FOR I := 0 TO Length(S)-1 DO
  164.         BEGIN
  165.           IF Y+I > VHEIGHT THEN  { If string goes past bottom of screen, }
  166.             BEGIN                { we wrap: }
  167.               Inc(X);            { Increment X value  }
  168.               Y := 1; TY := 1;   { Reset Y and temp Y value to 1 }
  169.               K := 0;            { K is the line-offset counter  }
  170.             END;
  171.           { Here we combine the character from the string and the   }
  172.           { current attribute via OR, and assign it to its location }
  173.           { on the screen: }
  174.           Word(ShowPtrs[Y+K]^[X]) := Word(S[I+1]) OR ShiftedAttr;
  175.           Inc(TY); Inc(K);
  176.         END;
  177.       Y := TY;   { Update Y value in descriptor record }
  178.     END
  179. END;
  180.  
  181.  
  182. [LISTING FOUR]
  183.  
  184. {--------------------------------------------------------------}
  185. {                          BoxTest                             }
  186. {                                                              }
  187. {              Character box draw demo program                 }
  188. {                                                              }
  189. {                                    by Jeff Duntemann KI6RA   }
  190. {                                    Turbo Pascal V5.0         }
  191. {                                    Last update 1/21/89       }
  192. {--------------------------------------------------------------}
  193.  
  194. PROGRAM BoxTest;
  195.  
  196. USES Crt,           { Standard Borland unit }
  197.      Screens,       { Given in DDJ; 4/89    }
  198.      VTools;        { Given in DDJ; 5/89    }
  199.  
  200.  
  201. VAR
  202.   WorkScreen   : Screen;
  203.   MyScreen     : ScreenPtr;
  204.   X,Y          : Integer;
  205.   Width,Height : Integer;
  206.   Count        : Integer;
  207.   Ch           : Char;
  208.   Quit         : Boolean;
  209.  
  210. BEGIN
  211.   Randomize;   { Seed the pseudorandom number generator }
  212.   MyScreen := @WorkScreen;    { Create a pointer to WorkScreen }
  213.   InitScreen(MyScreen,True);
  214.   ClrScreen(MyScreen,ClearAtom);     { Clear the entire screen }
  215.   Quit := False;
  216.  
  217.   REPEAT                    { Draw boxes until "Q" is pressed: }
  218.     IF Keypressed THEN      { If a keystroke is detected }
  219.       BEGIN
  220.         Ch := ReadKey;      { Pick up the keystroke }
  221.         IF Ord(Ch) = 0 THEN { See if it's an extended keystroke }
  222.           BEGIN
  223.             Ch := ReadKey;  { If so, pick up scan code }
  224.             CASE Ord(Ch) OF { and parse it }
  225.               72 : Pan(MyScreen,Up,1);   { Up arrow }
  226.               80 : Pan(MyScreen,Down,1); { Down arrow }
  227.             END { CASE }
  228.           END
  229.         ELSE     { If it's an ordinary keystroke, test for quit: }
  230.           IF Ch IN ['Q','q'] THEN Quit := True
  231.       END;
  232.     { Now we draw a random box. }
  233.     { First get random X/Y position on the virtual screen: }
  234.     REPEAT X := Random(VWIDTH-5) UNTIL X > 1;
  235.     REPEAT Y := Random(VHEIGHT-5) UNTIL Y > 1;
  236.     { Next get a random width and height to avoid wrapping: }
  237.     REPEAT
  238.       Width  := Random(VWIDTH)
  239.     UNTIL (Width > 1) AND ((X + Width) < VWIDTH);;
  240.     REPEAT
  241.       Height := Random(VHEIGHT)
  242.     UNTIL (Height > 1) AND ((Y + Height) < VHEIGHT);;
  243.     { Draw the box: }
  244.     MakeBox(MyScreen,X,Y,Width,Height,DoubleLine);  { and draw it! }
  245.   UNTIL Quit
  246. END.
  247.  
  248.  
  249.