Term.mod 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. IMPLEMENTATION MODULE Term ;
  2. (* termios-based raw keyboard + ANSI screen output. *)
  3. FROM Posix IMPORT read, write, tcgetattr, tcsetattr, cfmakeraw, poll ;
  4. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE ;
  5. CONST
  6. TCSANOW = 0 ;
  7. STDIN = 0 ;
  8. STDOUT = 1 ;
  9. VAR
  10. saved : ARRAY [0..127] OF BYTE ;
  11. rawstate : ARRAY [0..127] OF BYTE ;
  12. haveSaved : BOOLEAN ;
  13. PROCEDURE Out (s : ARRAY OF CHAR) ;
  14. VAR i : CARDINAL ;
  15. n : LONGINT ;
  16. BEGIN
  17. i := 0 ;
  18. WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
  19. n := write (STDOUT, ADR (s [i]), 1) ;
  20. INC (i)
  21. END
  22. END Out ;
  23. PROCEDURE Open ;
  24. VAR r : INTEGER ;
  25. BEGIN
  26. r := tcgetattr (STDIN, ADR (saved)) ;
  27. rawstate := saved ;
  28. cfmakeraw (ADR (rawstate)) ;
  29. r := tcsetattr (STDIN, TCSANOW, ADR (rawstate)) ;
  30. haveSaved := TRUE ;
  31. Out ("") (* clear screen, home *)
  32. END Open ;
  33. PROCEDURE Close ;
  34. VAR r : INTEGER ;
  35. BEGIN
  36. IF haveSaved THEN
  37. r := tcsetattr (STDIN, TCSANOW, ADR (saved)) ;
  38. haveSaved := FALSE
  39. END ;
  40. Out ("") (* normal attribute *)
  41. END Close ;
  42. PROCEDURE ClrScr ;
  43. BEGIN
  44. Out ("")
  45. END ClrScr ;
  46. PROCEDURE GotoXY (row, col : CARDINAL) ;
  47. BEGIN
  48. Out ("[") ;
  49. PutCard (row) ;
  50. Out (";") ;
  51. PutCard (col) ;
  52. Out ("H")
  53. END GotoXY ;
  54. PROCEDURE PutCh (ch : CHAR) ;
  55. VAR n : LONGINT ;
  56. BEGIN
  57. n := write (STDOUT, ADR (ch), 1)
  58. END PutCh ;
  59. PROCEDURE PutStr (s : ARRAY OF CHAR) ;
  60. VAR i : CARDINAL ;
  61. n : LONGINT ;
  62. BEGIN
  63. i := 0 ;
  64. WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
  65. n := write (STDOUT, ADR (s [i]), 1) ;
  66. INC (i)
  67. END
  68. END PutStr ;
  69. PROCEDURE PutCard (n : CARDINAL) ;
  70. VAR dig : ARRAY [0..9] OF CHAR ;
  71. i : CARDINAL ;
  72. BEGIN
  73. IF n = 0 THEN
  74. PutCh ("0")
  75. ELSE
  76. i := 0 ;
  77. WHILE n > 0 DO
  78. dig [i] := CHR (ORD ("0") + (n MOD 10)) ;
  79. n := n DIV 10 ;
  80. INC (i)
  81. END ;
  82. WHILE i > 0 DO
  83. DEC (i) ;
  84. PutCh (dig [i])
  85. END
  86. END
  87. END PutCard ;
  88. PROCEDURE PutLongCard (n : LONGCARD) ;
  89. VAR dig : ARRAY [0..19] OF CHAR ;
  90. i, m : CARDINAL ;
  91. BEGIN
  92. IF n = 0 THEN
  93. PutCh ("0")
  94. ELSE
  95. i := 0 ;
  96. WHILE n > 0 DO
  97. m := n MOD 10 ;
  98. dig [i] := CHR (ORD ("0") + m) ;
  99. n := n DIV 10 ;
  100. INC (i)
  101. END ;
  102. WHILE i > 0 DO
  103. DEC (i) ;
  104. PutCh (dig [i])
  105. END
  106. END
  107. END PutLongCard ;
  108. PROCEDURE ScrnWide (n : CARDINAL) ;
  109. VAR i : CARDINAL ;
  110. BEGIN
  111. i := 0 ;
  112. WHILE i < n DO
  113. PutCh (" ") ;
  114. INC (i)
  115. END
  116. END ScrnWide ;
  117. PROCEDURE Marked ;
  118. BEGIN
  119. Out ("") (* bold + reverse video *);
  120. END Marked ;
  121. PROCEDURE Normal ;
  122. BEGIN
  123. Out ("")
  124. END Normal ;
  125. PROCEDURE GetCh (VAR ch : CHAR) ;
  126. VAR n : LONGINT ;
  127. BEGIN
  128. n := read (STDIN, ADR (ch), 1) ;
  129. IF n # 1 THEN
  130. ch := 0C
  131. END
  132. END GetCh ;
  133. PROCEDURE Avail () : BOOLEAN ;
  134. TYPE PollFd = RECORD
  135. fd : CARDINAL ;
  136. events : SHORTCARD ;
  137. revents : SHORTCARD ;
  138. END ;
  139. VAR pfd : PollFd ;
  140. n : INTEGER ;
  141. BEGIN
  142. (* struct pollfd { int fd; short events; short revents; } *)
  143. pfd.fd := STDIN ;
  144. pfd.events := 1 ; (* POLLIN *)
  145. pfd.revents := 0 ;
  146. n := poll (ADR (pfd), 1, 0) ;
  147. RETURN n > 0
  148. END Avail ;
  149. PROCEDURE GetKey (VAR ch : CHAR) ;
  150. VAR n : LONGINT ;
  151. BEGIN
  152. IF Avail () THEN
  153. n := read (STDIN, ADR (ch), 1) ;
  154. IF n # 1 THEN
  155. ch := 0C
  156. END
  157. ELSE
  158. ch := 0C
  159. END
  160. END GetKey ;
  161. PROCEDURE Beep ;
  162. VAR n : LONGINT ;
  163. b : CHAR ;
  164. BEGIN
  165. b := CHR (7) ;
  166. n := write (STDOUT, ADR (b), 1)
  167. END Beep ;
  168. BEGIN
  169. haveSaved := FALSE
  170. END Term.