home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOM2 / BOXDEMO.LBR / BOXLIB.MOD < prev    next >
Text File  |  2000-06-30  |  3KB  |  142 lines
  1. implementation module boxlib;
  2.  
  3. type
  4.     graphics = (UR, LR, UL, LL, UH, LH, RV, LV);
  5.     gchars = array [UR..LV] of char;
  6. var
  7.     wideset : gchars;
  8.     narrowset : gchars;
  9.     currentset : gchars;
  10.  
  11. (* Internal Support Routines *)
  12. procedure DrawUpperHorizontal;
  13. begin
  14.     writechar (currentset[UH]);
  15. end DrawUpperHorizontal;
  16.  
  17. procedure DrawLowerHorizontal;
  18. begin
  19.     writechar (currentset[LH]);
  20. end DrawLowerHorizontal;
  21.  
  22. procedure DrawLeftVertical;
  23. begin
  24.     writechar (currentset[LV]);
  25. end DrawLeftVertical;
  26.  
  27. procedure DrawRightVertical;
  28. begin
  29.     writechar (currentset[RV]);
  30. end DrawRightVertical;
  31.  
  32. procedure DrawUR;
  33. begin
  34.     writechar (currentset[UR]);
  35. end DrawUR;
  36.  
  37. procedure DrawLR;
  38. begin
  39.     writechar (currentset[LR]);
  40. end DrawLR;
  41.  
  42. procedure DrawUL;
  43. begin
  44.     writechar (currentset[UL]);
  45. end DrawUL;
  46.  
  47. procedure DrawLL;
  48. begin
  49.     writechar (currentset[LL]);
  50. end DrawLL;
  51.  
  52. procedure GraphicsOn;
  53. begin
  54.     writechar (33C);
  55.     writechar ('$');
  56. end GraphicsOn;
  57.  
  58. procedure GraphicsOff;
  59. begin
  60.     writechar (33C);
  61.     writechar ('%');
  62. end GraphicsOff;
  63.  
  64. (* Externally-Accessed Routines *)
  65. procedure InitBox;
  66. var
  67.     i : graphics;
  68.     wide, narr : char;
  69. begin
  70.     for i := UR to LV do
  71.         case i of
  72.         |    UR :    wide := ']';
  73.                 narr := 'G';
  74.         |    LR :    wide := '^';
  75.                 narr := 'H';
  76.         |    UL :    wide := '\';
  77.                 narr := 'F';
  78.         |    LL :    wide := '[';
  79.                 narr := 'E';
  80.         |    UH :    wide := 'Z';
  81.                 narr := 'K';
  82.         |    LH :    wide := 'X';
  83.                 narr := 'K';
  84.         |    RV :    wide := 'W';
  85.                 narr := 'J';
  86.         |    LV :    wide := 'Y';
  87.                 narr := 'J';
  88.         end;
  89.         wideset[i] := wide;
  90.         narrowset[i] := narr;
  91.         currentset[i] := narr;
  92.     end;
  93. end InitBox;
  94.  
  95. procedure SetBox (selection : boxtype);
  96. var
  97.     i : graphics;
  98. begin
  99.     for i := UR to LV do
  100.         if selection = WIDE then
  101.             currentset[i] := wideset[i];
  102.         else
  103.             currentset[i] := narrowset[i];
  104.         end;
  105.     end;
  106. end SetBox;
  107.  
  108. procedure Clear;
  109. begin
  110.     clearscreen;
  111. end Clear;
  112.  
  113. procedure At (row, column : integer);
  114. begin
  115.     gotoxy (column, row);
  116. end At;
  117.  
  118. procedure DrawBox (length, width : integer; origin : coordinate);
  119. var
  120.     i : integer;
  121. begin
  122.     GraphicsOn;
  123.     gotoxy (origin.column, origin.row);
  124.     DrawUL;
  125.     for i := 2 to width-1 do DrawUpperHorizontal; end;
  126.     DrawUR;
  127.     for i := 2 to length-1 do
  128.         gotoxy (origin.column, origin.row + i - 1);
  129.         DrawLeftVertical;
  130.         gotoxy (origin.column + width - 1, origin.row + i - 1);
  131.         DrawRightVertical;
  132.         end;
  133.     gotoxy (origin.column, origin.row + length - 1);
  134.     DrawLL;
  135.     for i := 2 to width-1 do DrawLowerHorizontal; end;
  136.     DrawLR;
  137.     GraphicsOff;
  138. end DrawBox;
  139.  
  140. end boxlib.
  141.  
  142.