Updated release image date.
[cslatevm.git] / tests / smartconsole.slate
blob0268c95406d26bb2078816c80b1c59d46498575f
3 Image saving does not work! If you want to save an image after using SmartConsole
4 you have to execute the line below, otherwise the reference to the dll is saved
5 which will cause a crash after loading the saved image and using SmartConsole.
7 CursesConsole traits lib: Nil.
8 Image save.
11 UnitTests definePrototype: #SmartConsole.
12 "Not a real unit test, it's an object to dispatch on for a few
13 methods that test SmartConsole/Terminal functionality with human
14 interaction."
16 _@(UnitTests SmartConsole traits) streamedCommandProcessor
18   SmartConsole new sessionDo:
19   [| :console terminal editor reader |
20    terminal := Terminal newBasedOn: console.
21    editor := terminal commandEditor.
22    editor prompt := 'Prompt> '.
23    reader := editor reader.
25    terminal ; 'This test should echo all lines committed by enters, and exit if a \'q\' character is encountered'.
27    [| char |
28     char := reader next.
29     terminal nextPut: char.
30     "char printOn: terminal &radix: 16."
31     terminal flush.
32     char = $q] whileFalse
33   ].
36 _@(UnitTests SmartConsole traits) commandProcessor
38   SmartConsole new sessionDo:
39     [| :console terminal editor |
40      terminal := (Terminal newBasedOn: console).
41      editor := terminal commandEditor.
42      editor prompt := 'Prompt> '.
44      terminal ; 'This test should echo lines ending with a dot and committed with enters; quit with the \'quit.\' command'.
45      terminal newLine.
46      console writer ; 'Also demonstrates editing at any column: '.
48      [| line |
49       [line := editor readLine.
50        ["console writeCursorPositionAt: (console width // 2) , (console height // 2)."
51          line size = 0 \/ [(line at: line indexLast) ~= $. ]]
52          whileTrue: [line := editor continue].
54        terminal newLine.
55        terminal ; '\'' ; line ; '\''.
56        terminal newLine.
57        terminal flush]
58         on: Stream Exhaustion do: [| :_ |
59                                    terminal ; '\nStream closed\n'].
61       line ~= Nil /\ [line = 'quit.']
62     ] whileFalse.
63   ].
66 _@(UnitTests SmartConsole traits) dimensionInfo
68   SmartConsole new sessionDo: [| :console |
69     
70     console writer ; 'This test should write the screen dimentions in the center; quit with the Escape key'.
71     [
72       console
73         writePosition: (console width , console height)
74         at: ((console width // 2) , (console height // 2)).
76       console events next keyName = #Escape
77     ] whileFalse.
78   ].
81 _@(UnitTests SmartConsole traits) draw
83   SmartConsole new sessionDo: [| :console |
84     console ; 'Move with arrows, scroll with space, change color with 1-8, type chars, Esc quits\n'.
86     console events do: [| :event |
87       event keyName caseOf: {
88         #Escape      -> [^ Nil].
89         #Enter       -> [console moveCursorToBONL].
90         #LeftArrow   -> [console moveCursorLeft].
91         #RightArrow  -> [console moveCursorRight].
92         #UpArrow     -> [console moveCursorUp].
93         #DownArrow   -> [console moveCursorDown].
94       } otherwise: [
95         event char ifNotNil: [
96           ((event char as: Integer) between: 16r31 and: 16r40)
97             ifTrue: [console foregroundColor: (event char as: Integer) - 16r31]
98             ifFalse: [
99               event char = $\s
100                 ifTrue: [console scroll]
101                 ifFalse: [console writer nextPut: event char]]]].
102       console writeCursorPositionAt: {console width // 2. console height // 2}.
103     ].
104   ].
107 _@(UnitTests SmartConsole traits) echoEvent: event@(SmartConsole ResizeEvent traits) on: terminal
108 [| console |
109   console := terminal console.
110   terminal ; 'Console resized to: ' ; (console width as: String) ; 'x' ; (console height as: String).
111   console clearToEOL.
112   terminal newLine.
113   False
116 _@(UnitTests SmartConsole traits) echoEvent: event@(SmartConsole KeyEvent traits) on: terminal
117 [| console |
118   console := terminal console.
119   terminal ; 'Key code: ' ; (event keyCode as: String) ; ' - 16r' ;
120     (event keyCode printString &radix: 16).
121   console clearToEOL.
122   terminal newLine.
124   terminal ; 'Key name: '.
125   event keyName
126     ifNil: [terminal ; 'Nil']
127     ifNotNil: [terminal ; (event keyName as: terminal collectionType)].
128   console clearToEOL.
129   terminal newLine.
131   terminal ; 'Character: '.
132   event char
133     ifNil: [terminal ; 'Nil']
134     ifNotNil: [terminal nextPut: event char].
135   console clearToEOL.
136   terminal newLine.
138   terminal ; 'Controls: ' ; event controls printString.
139   console clearToEOL.
140   terminal newLine.
142   console writeCursorPositionAt: {console width // 2. console height // 2}.
144   event keyName = #Escape
147 t@(UnitTests SmartConsole traits) echoEvents
149   SmartConsole new sessionDo: [| :console terminal |
150    terminal := (Terminal newBasedOn: console).
151    terminal ; 'Press keys and their event will be printed, quit with Esc\n'.
153     [
154 "      console moveCursorTo: (0 , 1)."
155       t echoEvent: console events next on: terminal
156     ] whileFalse
157   ]
160 _@(UnitTests SmartConsole traits) echoRawCursesEvents
162   CursesConsole new sessionDo: [| :console terminal |
163    terminal := (Terminal newBasedOn: console).
164    terminal ; 'Press keys and raw key codes will be printed, quit with Enter\n'.
166    [| keyCode |
167     keyCode := console primitives nextEvent apply*, -1.
168     terminal ; (keyCode as: String) ; ' - 16r' ; (keyCode printString &radix: 16).
169     console clearToEOL.
170     terminal newLine.
171     keyCode = 10 \/ [keyCode = 13]
172   ] whileFalse
173   ]
176 _@(UnitTests SmartConsole traits) echoRawWindowsEvents &unicode: unicode
177 [| available |
178   available := False.
179   [WindowsConsole isAvailable ifTrue: [available := True]] breakOn: Error.
180   available ifFalse: [error: 'Windows console plugin not loaded or otherwise not available'. ^ Nil].
181   unicode `defaultsTo: False.
183   WindowsConsole clone sessionDo: [| :c record dword |
184     c ; 'Printing out raw console events coming from Windows, quit with Esc\n'.
185     c ; 'Codepage returned by GetConsoleCP: ' ; Windows Kernel GetConsoleCP do printString ; '\n'.
187     record := Windows INPUT_RECORD clone.
188     dword := ByteArray new &capacity: #[Windows DWORD byteSize].
189     [
190       [| method |
191        method := unicode
192          ifTrue: [Windows Kernel ReadConsoleInputW]
193          ifFalse: [Windows Kernel ReadConsoleInputA].
194        method apply*, c consoleIn, record, 1, dword.
195        record EventType = #[Windows KEY_EVENT]] whileFalse.
196       
197       "record printOn: c writer.
198       c newLine."
199       c ; 'Down ' ; record Event_KeyEvent_bKeyDown printString
200         ; ', Repeat ' ; record Event_KeyEvent_wRepeatCount printString
201         ; ', VKeyCode ' ; record Event_KeyEvent_wVirtualKeyCode printString
202         ; ', VScanCode ' ; record Event_KeyEvent_wVirtualScanCode printString.
203       unicode
204         ifTrue: [c ; ', Unicode ' ; (record Event_KeyEvent_uChar_UnicodeChar printString &radox: 16)]
205         ifFalse: [
206           c ; ', Ascii ' ; (record Event_KeyEvent_uChar_AsciiChar printString &radix: 16).
207           (record Event_KeyEvent_uChar_AsciiChar between: 0 and: 255)
208             ifTrue: [
209               c ; ' ('.
210               c writer nextPut: (record Event_KeyEvent_uChar_AsciiChar as: ASCIICharacter).
211               c ; ')']].
212       c  ; ', Controls ' ; (record Event_KeyEvent_dwControlKeyState printString &radix: 2) ; ' ('.
213       {
214         #RIGHT_ALT_PRESSED.
215         #LEFT_ALT_PRESSED.
216         #RIGHT_CTRL_PRESSED.
217         #LEFT_CTRL_PRESSED.
218         #SHIFT_PRESSED.
219         #NUMLOCK_ON.
220         #SCROLLLOCK_ON.
221         #CAPSLOCK_ON.
222         #ENHANCED_KEY.
223       } inject: 0 into: [| :bitCount :symbol |
224         (record Event_KeyEvent_dwControlKeyState bitAnd: (symbol sendTo: {Windows})) isZero
225           ifTrue: [bitCount]
226           ifFalse: [
227             bitCount isZero ifFalse: [c ; ','].
228             c ; symbol name.
229             bitCount + 1]].
230       c ; ')\n'.
231       record Event_KeyEvent_wVirtualKeyCode = 27
232     ] whileFalse.
233   ]