Term.mod 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. IMPLEMENTATION MODULE Term ;
  2. (* termios-based raw keyboard + ANSI screen output. *)
  3. FROM Posix IMPORT read, write, tcgetattr, tcsetattr, cfmakeraw ;
  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 Beep ;
  134. VAR n : LONGINT ;
  135. b : CHAR ;
  136. BEGIN
  137. b := CHR (7) ;
  138. n := write (STDOUT, ADR (b), 1)
  139. END Beep ;
  140. BEGIN
  141. haveSaved := FALSE
  142. END Term.