home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / dskutl / swp-ms10.ark / CONSOLE.UNT next >
Encoding:
Text File  |  1989-09-27  |  3.3 KB  |  130 lines
  1. {.L-}  { Suppress listing by LISTT }
  2. {*
  3.  * --------------------------------------------------------------------
  4.  *           C O N S O L E   I N T E R F A C E   U N I T
  5.  * --------------------------------------------------------------------
  6.  *
  7.  * In this 'unit' a number of methods are gathered for interfacing to
  8.  * the console device.
  9.  *
  10.  *               I N T E R F A C E   S E C T I O N
  11.  *}
  12.  
  13. const
  14.    Beep = ^G ;  { Bell signal }
  15.    Cr   = ^M ;  { Carriage return }
  16.  
  17. type
  18.    HexString = string[4] ;  { Hexadecimal encoded integer }
  19.  
  20. {
  21.    function  GetMaxX : Integer ;
  22.    function  GetMaxY : Integer ;
  23.    function  Hex( Value : Integer ;  DigitCount : Integer ) : HexString ;
  24.    procedure IllegalCommand ;
  25.    procedure InitConsoleUnit ;
  26.    procedure ReadCommand( var Code : Char ) ;
  27.    function  WhereX : Integer ;
  28.    function  WhereY : Integer ;
  29. }
  30.  
  31. {*
  32.  *         I M P L E M E N T A T I O N   S E C T I O N
  33.  *}
  34.  
  35. (* -------------------------
  36. function GetMaxX : Integer ;
  37. {*
  38.  * Return the number of characters on one line, that is the maximum value of
  39.  * the X coordinate.
  40.  *}
  41. begin
  42.    GetMaxX:= 80 ;
  43. end ;  { of GetMaxX }
  44.  
  45. function GetMaxY : Integer ;
  46. {*
  47.  * Return the number of user lines on the screen, that is the maximum value
  48.  * of the Y coordinate.
  49.  *}
  50. begin
  51.    GetMaxY:= 24 ;
  52. end ;  { of GetMaxY }
  53. -------------------------- *)
  54.  
  55. function Hex( Value : Integer ;  DigitCount : Integer ) : HexString ;
  56. {*
  57.  * Return the rightmost DigitCount nibbles of the variable Value in the
  58.  * hexadecimal notation in a string.
  59.  *}
  60. var
  61.    Result : HexString ;  { Area to build converted string }
  62. const
  63.    HexDigit : array[0..15] of char = '0123456789ABCDEF' ;
  64. begin
  65.    Result:= '' ;  { Preset result string }
  66.    while DigitCount>0 do
  67.     begin
  68.      Result:= HexDigit[ Value and $000F ] + Result ;
  69.      Value := Value shr 4 ;
  70.      DigitCount:= Pred( DigitCount ) ;
  71.     end ;
  72.    Hex:= Result ;
  73. end ;  { of Hex }
  74.  
  75. procedure IllegalCommand ;
  76. {*
  77.  * Remove the command character left by ReadCommand and give an audible
  78.  * alarmsignal.
  79.  *}
  80. begin
  81.    Write( ^H' '^H^G ) ;
  82. end ;  { of IllegalCommand }
  83.  
  84. procedure ReadCommand( var Code : Char ) ;
  85. {*
  86.  * The procedure ReadCommand reads a single character, the command character,
  87.  * and returns it in upper case in the variable Code.  Only letters are
  88.  * accepted as commands.
  89.  *}
  90. var
  91.    NextChar :    Char ;  { Next character entered by user }
  92.    Done     : Boolean ;  { Loop termination condition }
  93. begin
  94.    Write( Cr, 'Enter command - ' ) ;
  95.    ClrEol ;
  96.    repeat
  97.      Read ( Kbd, NextChar ) ;
  98.      NextChar:= UpCase( NextChar ) ;
  99.      Done    := NextChar in ['A'..'Z'] ;
  100.      if not Done then
  101.        Write( Beep ) ;
  102.    until Done ;
  103.    Write( NextChar ) ;
  104.    Code:= NextChar ;
  105. end ;  { of ReadCommand }
  106.  
  107. (* -----------------------
  108. function WhereX : Integer ;
  109. {*
  110.  * Return the X coordinate, the column number, of the cursor on the screen.
  111.  *}
  112. begin
  113.    WhereX:= ? ;
  114. end ;  { of WhereX }
  115.  
  116. function WhereY : Integer ;
  117. {*
  118.  * Return the Y coordinate, the row number, of the cursor on the screen.
  119.  *}
  120. begin
  121.    WhereY:= ? ;
  122. end ;  { of WhereY }
  123. ------------------------ *)
  124.  
  125. procedure InitConsoleUnit ;
  126. begin
  127.   { Nothing to do }
  128. end ;  { of InitConsoleUnit }
  129. {.L+}
  130.