ANSIDEMO.MOD 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. MODULE ANSIDemo;
  2. (*
  3. Demonstrate some of the capabilities of the ANSISYS module.
  4. *)
  5. FROM ANSISYS IMPORT
  6. Attribute, SetAttribute, Mode, SetMode, ResetMode,
  7. ClearScreen, GotoRowCol, GetRowCol,
  8. Up, Down, Right, Left, Save, Restore, EraseToEOL;
  9. FROM InOut IMPORT Read, Write, WriteString, WriteCard, WriteLn;
  10. FROM Terminal IMPORT GetKeyStroke;
  11. FROM Ascii IMPORT nul;
  12. VAR
  13. ch : CHAR;
  14. row, col : CARDINAL;
  15. BEGIN
  16. WriteString ("This program demonstrates some facilities of the ANSISYS module.");
  17. WriteLn;
  18. WriteLn; WriteLn;
  19. WriteString ("It first displays some atttribute settings and a menu,");
  20. WriteLn;
  21. WriteString ("and allows you to experiment with cursor positioning, etc.");
  22. WriteLn;
  23. WriteString ("If the menu is not readable, you may need to change the");
  24. WriteLn;
  25. WriteString ("colours currently used (magenta on green - revolting! - at");
  26. WriteLn;
  27. WriteString ("least one VGA card produces grey on grey on a monochrome monitor).");
  28. WriteLn; WriteLn;
  29. WriteString ('When you terminate this stage with "q", it demonstrates some other');
  30. WriteLn;
  31. WriteString ('modes; each stage will direct you to terminate with either "q" or');
  32. WriteLn;
  33. WriteString ("enter or any key.");
  34. WriteLn; WriteLn;
  35. WriteString ("Note that the display is left in 80x25 mode, yellow on blue;");
  36. WriteLn;
  37. WriteString ("you may also want to change this, or use MODE afterwards.");
  38. WriteLn; WriteLn;
  39. WriteString ("The program can then be used as a basis for your own code.");
  40. WriteLn; WriteLn;
  41. WriteString ("Any key to begin: ");
  42. GetKeyStroke (ch);
  43. (* Start with clearing, positioning, attributes *)
  44. ClearScreen;
  45. SetAttribute (allOff);
  46. WriteString ("Demonstration of some capabilities of the ANSISYS module.");
  47. GotoRowCol (2,1);
  48. WriteString ("These lines are in 'all attributes off' mode = white on black");
  49. (* These demonstrate out-of-range coordinates:
  50. GotoRowCol (0,5); Write ('A'); (* => 1,5 *)
  51. GotoRowCol (5,9); Write ('X'); (* Cursor now at 5,10 => *)
  52. GotoRowCol (40,5); Write ('B'); (* Goto ignored => 5,10 *)
  53. GotoRowCol (5,0); Write ('C'); (* => 5,1 *)
  54. GotoRowCol (5,100); Write ('D'); (* => 5,80 *)
  55. GotoRowCol (0,0); Write ('E'); (* => 1,1 *)
  56. GotoRowCol (0,100); Write ('F'); (* => 1,80 *)
  57. GotoRowCol (7,9); Write ('Y'); (* Cursor now at 7,10 => *)
  58. GotoRowCol (50,0); Write ('G'); (* Goto ignored => 7,10 => *)
  59. GotoRowCol (50,100); Write ('H'); (* Goto ignored => 7,11 *)
  60. *)
  61. GotoRowCol (8,40);
  62. SetAttribute (bold); WriteString ("Bold"); SetAttribute (allOff);
  63. GotoRowCol (8,60);
  64. SetAttribute (faint); WriteString ("Faint"); SetAttribute (allOff);
  65. GotoRowCol (10,40);
  66. SetAttribute (italic); WriteString ("Italic"); SetAttribute (allOff);
  67. GotoRowCol (10,60);
  68. SetAttribute (underscore); WriteString ("Underscore (MDA)");
  69. SetAttribute (allOff);
  70. GotoRowCol (12,40);
  71. SetAttribute (blink); WriteString ("Blink"); SetAttribute (allOff);
  72. GotoRowCol (12,60);
  73. SetAttribute (rapidBlink); WriteString ("Rapid blink"); SetAttribute (allOff);
  74. GotoRowCol (14,40);
  75. SetAttribute (reverse); WriteString ("Reverse - black on white");
  76. SetAttribute (allOff);
  77. GotoRowCol (14,60);
  78. SetAttribute (concealed); WriteString ("Concealed!"); SetAttribute (allOff);
  79. GotoRowCol (16,40);
  80. SetAttribute (bold); SetAttribute (yellowFG); SetAttribute (blueBG);
  81. SetAttribute (blink);
  82. WriteString ("Blink in yellow on blue");
  83. SetAttribute (allOff);
  84. (* Now interactive stuff *)
  85. SetAttribute (magentaFG); SetAttribute (greenBG);
  86. GotoRowCol (20,0);
  87. WriteString ("Now interactive screen update in magenta on green:");
  88. GotoRowCol (21,0);
  89. WriteString ("arrows for left/right/up/down, or home; ");
  90. WriteString ("s/r for save/restore;");
  91. GotoRowCol (22,0);
  92. WriteString ("c/e for clear screen/erase to eol; n/w for nowrap/wrap; ");
  93. GotoRowCol (23,0);
  94. WriteString ("? to read and display cursor position; q to quit;");
  95. GotoRowCol (24,0);
  96. WriteString ("all other keys just echo, preceded by ! if extended.");
  97. LOOP
  98. GetKeyStroke (ch);
  99. CASE ch OF
  100. | nul : (* Extended ASCII sequence - act on second byte *)
  101. GetKeyStroke (ch);
  102. CASE ch OF
  103. | 107C : GotoRowCol (1,1); (* Home *)
  104. | 110C : Up (1); (* Up arrow *)
  105. | 113C : Left (1); (* Left arrow *)
  106. | 115C : Right (1); (* Right arrow *)
  107. | 120C : Down (1); (* Down arrow *)
  108. ELSE Write ('!'); Write (ch);
  109. END;
  110. | '?' : GetRowCol (row, col);
  111. WriteCard (row,1);
  112. Write (",");
  113. WriteCard (col,1);
  114. | 's' : Save;
  115. | 'r' : Restore;
  116. | 'c' : ClearScreen;
  117. | 'e' : EraseToEOL;
  118. | 'n' : ResetMode (cursorWrap);
  119. | 'w' : SetMode (cursorWrap)
  120. | 'q' : EXIT;
  121. ELSE Write (ch); (* just echo *)
  122. END;
  123. END;
  124. (* Finally, other modes *)
  125. SetMode (textColour40x25); (* default clear screen *)
  126. SetAttribute (bold);
  127. SetAttribute (cyanFG);
  128. SetAttribute (greenBG);
  129. WriteString ("Should now be in");
  130. GotoRowCol (2,0);
  131. WriteString ("text colour 40 x 25 mode");
  132. GotoRowCol (20,20);
  133. WriteString ("<- row 20, column 20;");
  134. GotoRowCol (21,20);
  135. WriteString ("any key to continue");
  136. GetKeyStroke (ch);
  137. (* Show that ResetMode is equivalent to SetMode *)
  138. ResetMode (textMono80x25); (* default clear screen *)
  139. WriteString ("ResetMode to text mono 80x25");
  140. GotoRowCol (25,1);
  141. WriteString ("any key to continue");
  142. GetKeyStroke (ch);
  143. (* Show that text I/O is still possible in graphics mode *)
  144. ResetMode (graphicsMono640x200); (* default clear screen *)
  145. WriteString ("Graphics 640x200");
  146. GotoRowCol (10,10);
  147. WriteString ("<- 10,10 (i.e. equivalent to text 80x25 - 10,10 -> 80,80)");
  148. GotoRowCol (20,1);
  149. WriteString ("anything, then <enter> to continue: ");
  150. Read (ch);
  151. (* This one will be ignored on CGA & EGA, but will work on VGA *)
  152. ResetMode (graphicsColour320x200x256); (* default clear screen *)
  153. WriteString ("Graphics 320x200x256? ");
  154. GotoRowCol (10,10);
  155. WriteString ("<- 10,10 (i.e. equivalent to text 40x25 - 10,10 -> 80,80)");
  156. GotoRowCol (20,1);
  157. WriteString ("... anything, then 'q' to continue: ");
  158. REPEAT
  159. GetKeyStroke (ch);
  160. Write (ch);
  161. UNTIL ch = 'q';
  162. (* Restore 'normal' modes *)
  163. SetMode (cursorWrap);
  164. SetMode (textColour80x25);
  165. SetAttribute (bold);
  166. SetAttribute (yellowFG);
  167. SetAttribute (blueBG);
  168. END ANSIDemo.