home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / PCTV1N6.ZIP / DRAWLINE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-19  |  2.3 KB  |  89 lines
  1. Program Draw;
  2.  
  3. { By Rick Gessner
  4.   For PC TECHNIQUES June/July 1990 }
  5.  
  6. Uses CRT;
  7.  
  8. PROCEDURE DrawLines;
  9.  
  10. Type  Directions = (Left,Right,Up,Down);
  11.       VidRec = Record
  12.                  Ch : Char;
  13.                  Atr: Byte;
  14.                end;
  15.  
  16. Const
  17.   Check : Array[Directions] of Set of 1..11 =
  18.   ([2,3,5,7,8,9,11], {left} [2,4,6,7,8,9,10], {Right}
  19.    [1,3,4,7,8,10,11],{up}   [1,5,6,7,9,10,11]); {Down}
  20.  
  21.   AllLineChars: Array[1..11] of Char =
  22.   ('│','─','┌','┐','└','┘','┼','┬','┴','┤','├');
  23.   DeltaX      : Array[Directions] of ShortInt = (-1,1,0,0);
  24.   DeltaY      : Array[Directions] of Shortint = (0,0,-1,1);
  25.   CharTable   : Array[Directions,0..15] of Byte =
  26.   ((2,2,2,2,6,6,9,9,4,4,8,8,10,10,7,7),
  27.    (2,2,2,2,5,9,5,9,3,8,3,8,11,7,11,7),
  28.    (1,6,5,9,1,6,5,9,1,10,11,7,1,10,11,7),
  29.    (1,4,3,8,1,10,11,7,1,4,3,8,1,10,11,7));
  30.  
  31.   UpArrow = 'H';    DnArrow = 'P';    ESC = #27;
  32.   LArrow  = 'K';    RArrow  = 'M';
  33.  
  34.  
  35. FUNCTION Valid_Char(Dir: Directions;
  36.                     Row,Col: integer): Boolean;
  37.  
  38. Var VideoMem: Array[1..25,1..80]
  39.               of VidRec absolute $B800:0;
  40.     I       : Integer;
  41.  
  42. Begin
  43.   Valid_Char:=True;
  44.   For I:=1 to 11 do
  45.     If (I in Check[Dir]) and
  46.        (VideoMem[Row,Col].Ch=AllLineChars[I])
  47.     then Exit;  {Jump out because we've found our char!}
  48.   Valid_Char:=False;
  49. end; {Valid Char}
  50.  
  51.  
  52.  
  53. Var  Row,Col,Index: Integer;
  54.      Ch           : Char;
  55.      Dir          : Directions;
  56.  
  57. Begin
  58.   Repeat
  59.     Row:=WhereY; Col:=WhereX;
  60.     Ch:=Readkey; If Ch=Chr(0) then Ch:=Readkey;
  61.     If Ch in [UpArrow,DnArrow,LArrow,RArrow] then
  62.       Begin
  63.         Index :=
  64.         Ord(Valid_Char(Left, Row,  Col-1))+   {Check left}
  65.         Ord(Valid_Char(Right,Row,  Col+1))*2+ {Check right}
  66.         Ord(Valid_Char(Up,   Row-1,Col))*4+   {Check above}
  67.         Ord(Valid_Char(Down, Row+1,Col))*8;   {Check below}
  68.         Case Ch of
  69.           UpArrow : Dir:=Up;
  70.           DnArrow : Dir:=Down;
  71.           LArrow  : Dir:=Left;
  72.           RArrow  : Dir:=Right;
  73.         end;
  74.         Write(AllLineChars[CharTable[Dir,Index]]);
  75.         Gotoxy(Col+DeltaX[Dir],Row+DeltaY[Dir]);
  76.       end;
  77.   Until Ch=ESC;
  78. end; {DrawLines}
  79.  
  80.  
  81.  
  82. Begin { Main }
  83.   ClrScr;
  84.   Gotoxy(40,15);  {Arbitrary starting point}
  85.   DrawLines;
  86. end. {Draw}
  87.  
  88.  
  89.