src/plugins/old/smart-console.slate

   1 "Smart console that uses a plugin to read/write in a structured way to the
   2 console. It keeps a buffer of the data on screen so that it's possible to
   3 switch between consoles when needed. On some platforms the plugin may open new
   4 terminal windows, whereas on other platforms it may use a shared console window.
   5
   6 Possible improvements:
   7  - keep a buffer of data written to terminals and support switching between
   8    multiple instances
   9 "
  10
  11 prototypes ensureNamespace: #terminals &delegate: True.
  12
  13 terminals define: #SmartConsole &parents: {ExternalResource} &slots: {
  14   #screenData.
  15   "TODO: update data in this, or use the ncurses screen dumping feature?"
  16   #cursorRow -> 0.
  17   #cursorColumn -> 0.
  18   #currentMode -> 0.
  19   #autoScrollsAtBottom -> True. "Does the console automatically scroll when a char is put at the bottom-right?"
  20   #singleCharBuffer -> (ByteArray newSize: 1).
  21 }.
  22
  23 SmartConsole traits `>> [
  24   define: #Stream &parents: {SmartConsole Stream}.
  25   define: #Event &parents: {Cloneable}.
  26   define: #ResizeEvent &parents: {SmartConsole Event}.
  27   define: #EventStream &parents: {ReadStream} &slots: {#console}.
  28   "TODO: there should be one EventStream per Console instance,
  29    and when switching between console windows,
  30    the event readers should be managed properly."
  31
  32   define: #KeyEvent &parents: {SmartConsole Event}
  33     &slots: {#keyCode.  "A raw and potentially platform specific (basically ncurses/windoze) key code"
  34              #keyName.  "Key name (e.g. LeftArrow) interned as a symbol"
  35              #char.     "A Character or Nil if special key"
  36              #controls -> (BitArray new &capacity: 5) "Internal BitArray of control chars"}.
  37   define: #KeyDownEvent &parents: {SmartConsole KeyEvent}.
  38 ].
  39
  40 e@(SmartConsole ResizeEvent traits) new
  41 [
  42   e clone
  43 ].
  44
  45 e@(SmartConsole KeyEvent traits) new
  46 [
  47   e clone `>> [| :event | controls := event controls clone. ]
  48 ].
  49
  50 e@(SmartConsole KeyEvent traits) newForKeyCode: code
  51 [
  52   e new `>> [keyCode := code. ]
  53 ].
  54
  55 e@(SmartConsole KeyEvent traits) controlState
  56 [
  57   e leftControlState \/ [e rightControlState]
  58 ].
  59
  60 e@(SmartConsole KeyEvent traits) altState
  61 [
  62   e leftAltState \/ [e rightAltState]
  63 ].
  64
  65 {
  66   'leftControl'.
  67   'rightControl'.
  68   'leftAlt'.
  69   'rightAlt'.
  70   'shift'.
  71 } doWithIndex: [| :name :index |
  72   [| :e | e controls at: index]
  73     asMethod: ((name ; 'State') as: Symbol)
  74     on: {SmartConsole KeyEvent traits}.
  75   [| :e :value | e controls at: index put: value]
  76     asMethod: ((name ; 'State:') as: Symbol)
  77     on: {SmartConsole KeyEvent traits. Boolean traits}.
  78 ].
  79
  80 "TODO: these are basically ncurses specific, move them"
  81 SmartConsole traits ensureNamespace: #modes &slots:
  82 {#Normal    -> 0.
  83  #Standout  -> 1.
  84  #Underline -> 2.
  85  #Reverse   -> 3.
  86  #Blink     -> 4.
  87  #Dim       -> 5.
  88  #Bold      -> 6.
  89  #Invisible -> 8}.
  90
  91 SmartConsole traits ensureNamespace: #colors &slots:
  92 {#Black   -> 0.
  93  #Red     -> 1.
  94  #Green   -> 2.
  95  #Yellow  -> 3.
  96  #Blue    -> 4.
  97  #Magenta -> 5.
  98  #Cyan    -> 6.
  99  #White   -> 7}.
 100
 101 SmartConsole addLazySlot: #events initializer: [| :c | c EventStream newOn: c].
 102 SmartConsole addLazySlot: #keyEvents initializer: [| :c | c events select: [| :event | event is: c KeyEvent]].
 103
 104 s@(SmartConsole EventStream traits) on: console
 105 [
 106   s console := console.
 107   s
 108 ].
 109
 110 _@(SmartConsole EventStream traits) eventType
 111 [SmartConsole Event].
 112
 113 s@(SmartConsole EventStream traits) isAtEnd
 114 [s console reader isAtEnd].
 115
 116 s@(SmartConsole EventStream traits) next
 117 "Emulates simple SmartConsole events, SmartConsole implementations should
 118 provide specialized versions for next and isAtEnd."
 119 [| char code event |
 120   event := SmartConsole KeyDownEvent new.
 121   char := s console reader next.
 122   code := char as: Integer.
 123   (code between: 32 and: 255) ifTrue: [event char := char].
 124   event keyCode := code.
 125   s console resolveEvent: event.
 126   event
 127 ].
 128
 129 s@(SmartConsole EventStream traits) hasNext
 130 "Answer wether an event is available. TODO: factor out into AsyncStream or something"
 131 [overrideThis].
 132
 133 SmartConsole `>> [
 134   addSlot: #defaultForegroundColor valued: SmartConsole colors White.
 135   addSlot: #defaultBackgroundColor valued: SmartConsole colors Black.
 136   addSlot: #currentFgColor valued: SmartConsole colors White.
 137   addSlot: #currentBgColor valued: SmartConsole colors Black.
 138   addSlot: #singleCharBuffer valued: (ByteArray newSize: 1).
 139 ].
 140
 141 c@(SmartConsole traits) new
 142 [
 143   Platform current name = 'Windows'
 144     ifTrue: [WindowsConsole isAvailable ifTrue: [^ WindowsConsole clone]]
 145     ifFalse: [CursesConsole isAvailable ifTrue: [^ CursesConsole clone]].
 146
 147   error: 'No SmartConsole plugin was found'.
 148 ].
 149
 150 c@(SmartConsole traits) isAvailable
 151 [
 152   Platform current name = 'Windows'
 153     ifTrue: [[WindowsConsole isAvailable] on: SeriousCondition do: [| :_ | ^ False]]
 154     ifFalse: [CursesConsole isAvailable]
 155 ].
 156
 157 c@(SmartConsole traits) enable
 158 [
 159 ].
 160
 161 c@(SmartConsole traits) open
 162 [
 163   resend.
 164   c handle := 'foo'. "Something else then Nil for now"
 165 ].
 166
 167 c@(SmartConsole traits) resized
 168 [
 169 ].
 170
 171 c@(SmartConsole traits) close
 172 [
 173   resend.
 174   c handle := Nil.
 175 ].
 176
 177 c@(SmartConsole traits) width
 178 [c columns].
 179
 180 c@(SmartConsole traits) columnLast
 181 [c columns - 1].
 182
 183 _@(SmartConsole traits) columns
 184 [overrideThis].
 185
 186 c@(SmartConsole traits) height
 187 [c rows].
 188
 189 c@(SmartConsole traits) rowLast
 190 [c rows - 1].
 191
 192 _@(SmartConsole traits) rows
 193 [overrideThis].
 194
 195 _@(SmartConsole traits) clear
 196 [overrideThis].
 197
 198 _@(SmartConsole traits) clearToEOS
 199 [overrideThis].
 200
 201 _@(SmartConsole traits) clearToEOL
 202 [overrideThis].
 203
 204 _@(SmartConsole traits) elementType
 205 [overrideThis].
 206
 207 _@(SmartConsole traits) collectionType
 208 [overrideThis].
 209
 210 c@(SmartConsole traits) cursorPosition
 211 [
 212   {c cursorColumn. c cursorRow}
 213 ].
 214
 215 c@(SmartConsole traits) isCursorAtLastRow
 216 [
 217   c cursorRow = c rowLast
 218 ].
 219
 220 c@(SmartConsole traits) isCursorAtLastColumn
 221 [
 222   c cursorColumn = c columnLast
 223 ].
 224
 225 c@(SmartConsole traits) moveCursorTo: pos
 226 [| oldpos |
 227   oldpos := c cursorPosition.
 228   c cursorColumn := pos first.
 229   c cursorRow := pos second.
 230   oldpos
 231 ].
 232
 233 c@(SmartConsole traits) moveCursorWithOffset: offset
 234 [| oldpos newpos newcol newrow |
 235   oldpos := c cursorPosition.
 236   newcol := c cursorColumn + offset first min: c columnLast max: 0.
 237   newrow := c cursorRow + offset second min: c rowLast max: 0.
 238   newpos := {newcol. newrow}.
 239   oldpos = newpos ifFalse: [c moveCursorTo: newpos].
 240   newpos
 241 ].
 242
 243 c@(SmartConsole traits) writePosition: data
 244 [
 245   c writePosition: data at: c cursorPosition
 246 ].
 247
 248 c@(SmartConsole traits) writePosition: data at: pos
 249 [| oldpos |
 250   oldpos := c moveCursorTo: pos.
 251   c ; '(' ; (data first as: String) ; ',' ; (data second as: String) ; ')'.
 252   c moveCursorTo: oldpos.
 253 ].
 254
 255 c@(SmartConsole traits) writeCursorPositionAt: pos
 256 [
 257   c writePosition: c cursorPosition at: pos
 258 ].
 259
 260 c@(SmartConsole traits) moveCursorToEOL
 261 [
 262   c moveCursorTo: {c columnLast. c cursorRow}
 263 ].
 264
 265 c@(SmartConsole traits) moveCursorToBOL
 266 [
 267   c moveCursorTo: {0. c cursorRow}
 268 ].
 269
 270 c@(SmartConsole traits) moveCursorToBONL
 271 [
 272   c moveCursorTo: {0. (c cursorRow + 1 min: c rowLast)}
 273 ].
 274
 275 c@(SmartConsole traits) moveCursorLeft
 276 [
 277   c moveCursorWithOffset: {-1. 0}
 278 ].
 279
 280 c@(SmartConsole traits) moveCursorRight
 281 [
 282   c moveCursorWithOffset: {1. 0}
 283 ].
 284
 285 c@(SmartConsole traits) moveCursorUp
 286 [
 287   c moveCursorWithOffset: {0. -1}
 288 ].
 289
 290 c@(SmartConsole traits) moveCursorDown
 291 [
 292   c moveCursorWithOffset: {0. 1}
 293 ].
 294
 295 c@(SmartConsole traits) scroll &lines: lines
 296 [overrideThis].
 297
 298 c@(SmartConsole traits) updateCursorPositionFrom: col@(Collection traits)
 299 [
 300   col do: [| :char | c updateCursorPositionFrom: char].
 301 ].
 302
 303 c@(SmartConsole traits) updateCursorPositionFrom: char
 304 [
 305   char caseOf: {
 306     $\n -> [c cursorRow < c rowLast ifTrue: [
 307               c cursorRow := c cursorRow + 1].
 308             c cursorColumn := 0].
 309     $\b -> [c cursorColumn > 0 ifTrue: [c cursorColumn := c cursorColumn - 1]].
 310     $\t -> [c cursorColumn := c cursorColumn + 8 min: c columnLast].
 311   } otherwise: [
 312     c cursorColumn < c columnLast
 313       ifTrue: [c cursorColumn := c cursorColumn + 1]
 314       ifFalse: [c cursorColumn := 0.
 315                 c cursorRow := c cursorRow + 1 min: c rowLast]].
 316 ].
 317
 318 c@(SmartConsole traits) read: n from: handle into: array@(ByteArray traits) startingAt: start
 319 [| index |
 320   index := 0.
 321   [index < n]
 322     whileTrue:
 323       [| event |
 324         event := c keyEvents next.
 325         event char
 326           ifNotNil: [
 327             array at: start + index put: (event char as: Integer).
 328             index += 1].
 329       ].
 330   n
 331 ].
 332
 333 _@(SmartConsole traits) flush
 334 [overrideThis].
 335
 336 _@(SmartConsole traits) deleteChar
 337 [overrideThis].
 338
 339 c@(SmartConsole traits) deleteLine
 340 [c deleteLines: 1].
 341
 342 _@(SmartConsole traits) deleteLines: n
 343 [overrideThis].
 344
 345 c@(SmartConsole traits) insertLine
 346 [c insertLines: 1].
 347
 348 _@(SmartConsole traits) insertLines: n
 349 [overrideThis].
 350
 351 _@(SmartConsole traits) hideCursor
 352 [overrideThis].
 353
 354 _@(SmartConsole traits) showCursor
 355 [overrideThis].
 356
 357 c@(SmartConsole traits) attributeMode: mode
 358 [| old |
 359   old := c currentMode.
 360   c currentMode := mode.
 361   old
 362 ].
 363
 364 c@(SmartConsole traits) foregroundColor: color
 365 [| old |
 366   old := c currentFgColor.
 367   c currentFgColor := color.
 368   old
 369 ].
 370
 371 c@(SmartConsole traits) backgroundColor: color
 372 [| old |
 373   old := c currentBgColor.
 374   c currentBgColor := color.
 375   old
 376 ].
 377
 378 c@(SmartConsole traits) withAttributesDo: block &mode: mode &foreground: fg &background: bg
 379 [| oldmode oldfg oldbg |
 380   mode       ifNotNil: [oldmode := c attributeMode := mode].
 381   foregound  ifNotNil: [oldfg := c foregroundColor := fg].
 382   background ifNotNil: [oldbg := c backgroundColor := bg].
 383
 384   [block do]
 385     ensure: [
 386       oldmode ifNotNil: [c attributeMode := oldmode].
 387       oldfg   ifNotNil: [c foregroundColor := oldfg].
 388       oldbg   ifNotNil: [c backgroundColor := oldbg].
 389     ]
 390 ].
 391
 392 "SmartConsole Streaming"
 393
 394 SmartConsole traits `>> [
 395   define: #ReadStream &parents: {ExternalResource ReadStream. SmartConsole Stream}.
 396   define: #WriteStream &parents:
 397     {PrettyPrinterMixin. ExternalResource WriteStream. SmartConsole Stream}.
 398   define: #ReadWriteStream &parents: {SmartConsole ReadStream. SmartConsole WriteStream}.
 399 ].
 400
 401 SmartConsole ReadStream `>> [
 402   isBinary := False.
 403 ].
 404
 405 SmartConsole WriteStream `>> [
 406   isBinary := False.
 407 ].
 408
 409 c@(SmartConsole traits) ; seq
 410 "A convenience method for the Console as a Stream resource; do NOT repeat this
 411 pattern without determining that ; can have no other meaning for the resource."
 412 [c writer ; seq].
 413
 414 "TODO support encoding"
 415 s@(SmartConsole Stream traits) elementType
 416 [s resource elementType].
 417
 418 s@(SmartConsole Stream traits) collectionType
 419 [s resource collectionType].
 420
 421 _@(SmartConsole Stream traits) isAtEnd
 422 [False].
 423
 424 s@(SmartConsole Stream traits) flush
 425 [s resource flush].
 426
 427 r@(SmartConsole ReadStream traits) nextLine
 428 [
 429   (Terminal newBasedOn: r resource) commandEditor readLine &echoNewLine: True
 430 ].
 431
 432 w@(SmartConsole WriteStream traits) next: n putAll: seq startingAt: start
 433 [
 434   w resource updateCursorPositionFrom: (seq sliceFrom: start below: start + n).
 435   resend
 436 ].
 437
 438 terminals define: #StructuredConsole &parents: {SmartConsole} &slots:
 439 {#originalConsole "TODO: this is a hack"}.
 440
 441 c@(StructuredConsole traits) derive &mixins: others &rejects: rejectSlots
 442 "When derive is used, add some slots to the new traits. We need
 443 these slots on each derived traits object."
 444 [| result |
 445   result := resend.
 446   result traits `>> [
 447     define: #instances &builder: [ExtensibleArray new].
 448     define: #sequenceToKeyName &builder: [Dictionary new].
 449     define: #keyCodeToKeyName &builder: [Dictionary new].
 450     addSlot: #columns.
 451     addSlot: #rows.
 452   ].
 453   result
 454 ].
 455
 456 c@(StructuredConsole traits) isAvailable
 457 [overrideThis].
 458
 459 c@(StructuredConsole traits) isInStructuredMode
 460 [c instances isEmpty not].
 461
 462 c@(StructuredConsole traits) assumeStructuredMode
 463 [
 464   c isInStructuredMode ifFalse:
 465     [error: 'This call requires the console to be in structured mode'].
 466 ].
 467
 468 c@(StructuredConsole traits) enterStructuredMode
 469 [overrideThis].
 470
 471 c@(StructuredConsole traits) enteredStructuredMode
 472 "This method is called after entering structured mode. At the time it is called
 473 it's safe to call other methods that require the console to be in structured mode."
 474 [
 475   c initKeyMappings.
 476   c attributeMode := c modes Normal.
 477   c foregroundColor := c defaultForegroundColor.
 478   c backgroundColor := c defaultBackgroundColor.
 479 ].
 480
 481 c@(StructuredConsole traits) leaveStructuredMode
 482 [overrideThis].
 483
 484 c@(StructuredConsole traits) leftStructuredMode
 485 "This method is called after structured mode is left and console mode is
 486 restored to its original state."
 487 [].
 488
 489 c@(StructuredConsole traits) open
 490 [| result |
 491   result := resend.
 492   c isInStructuredMode
 493     ifTrue: [c instances add: c]
 494     ifFalse: [
 495       c enterStructuredMode ifFalse: [^ Nil].
 496       c instances add: c.
 497       c enteredStructuredMode.
 498       "TODO this is a hack"
 499       conditions define: #DebugConsole -> c.
 500       c originalConsole := lobby Console.
 501       lobby addSlot: #Console valued: c].
 502   c resized.
 503   result
 504 ].
 505
 506 c@(StructuredConsole traits) close
 507 [
 508   c instances remove: c ifAbsent:
 509     [error: 'Tried to close a console that is not open'. ^ Nil].
 510
 511   c isInStructuredMode ifFalse: [
 512     c leaveStructuredMode.
 513     "TODO this is a hack"
 514     lobby addSlot: #Console valued: c originalConsole.
 515     conditions define: #DebugConsole -> c originalConsole.
 516     c leftStructuredMode].
 517   resend
 518 ].
 519
 520 _@(StructuredConsole traits) actualColumns
 521 [overrideThis].
 522
 523 _@(StructuredConsole traits) actualRows
 524 [overrideThis].
 525
 526 c@(StructuredConsole traits) resized
 527 [
 528   "Actualize width/height slots and resend"
 529   c columns := c actualColumns.
 530   c rows := c actualRows.
 531   resend
 532 ].
 533
 534 StructuredConsole traits define: #DefaultKeyMappings &builder:
 535   [q{
 536     (10     (Enter $\n))
 537     (27     Escape)
 538     (9      (Tab $\t))
 539     (8      Backspace)
 540
 541     ('[1~'  Home)
 542     ('[2~'  Insert)
 543     ('[3~'  Delete)
 544     ('[4~'  End)
 545     ('[5~'  PageUp)
 546     ('[6~'  PageDown)
 547     ('[A'   UpArrow)
 548     ('[B'   DownArrow)
 549     ('[C'   RightArrow)
 550     ('[D'   LeftArrow)
 551
 552     ('[[A'  Function1)
 553     ('[[B'  Function2)
 554     ('[[C'  Function3)
 555     ('[[D'  Function4)
 556     ('[[E'  Function5)
 557     ('[17~' Function6)
 558     ('[18~' Function7)
 559     ('[19~' Function8)
 560     ('[20~' Function9)
 561     ('[21~' Function10)
 562     ('[23~' Function11)
 563     ('[24~' Function12)
 564     ('[25~' Function13)
 565     ('[26~' Function14)
 566     ('[28~' Function15)
 567     ('[29~' Function16)
 568     ('[31~' Function17)
 569     ('[32~' Function18)
 570     ('[33~' Function19)
 571     ('[34~' Function20)
 572   }].
 573
 574 c@(StructuredConsole traits) initKeyMappings
 575 "Add some defaults if they are not already defined"
 576 [
 577   c DefaultKeyMappings do:
 578     [| :key :value |
 579      (key is: String)
 580       ifTrue: [| sequence |
 581         sequence := key.
 582         (c sequenceToKeyName includesKey: sequence)
 583           ifFalse: [c sequenceToKeyName at: sequence put: value]]
 584       ifFalse: [| keyCode keyName |
 585         keyCode := key.
 586         (value is: Collection)
 587           ifTrue: [keyName := value first]
 588           ifFalse: [keyName := value. value := {keyName. Nil}].
 589         (c keyCodeToKeyName includesKey: keyCode) not
 590           /\ [(c keyCodeToKeyName detect: [| :each | each first = keyName]) isNil]
 591             ifTrue: [c keyCodeToKeyName at: keyCode put: value]].
 592   ] applier.
 593 ].
 594
 595 c@(StructuredConsole traits) printKeyMappings
 596 "This method prints the key mappings to the console for debug purposes"
 597 [
 598   c sequenceToKeyName keysAndValuesDo: [| :key :value|
 599     c ; ((key as: String) ; '->' ; (value as: String)) ; '\n'].
 600   c keyCodeToKeyName keysAndValuesDo: [| :key :value |
 601     c ; ((key as: String) ; '->' ; (value first as: String)) ; '\n'].
 602 ].
 603
 604 c@(StructuredConsole traits) resolveEvent: e
 605 [| nameFromTable |
 606   "TODO: handle encoding"
 607   c keyCodeToKeyName at: e keyCode
 608     ifPresent: [| :value |
 609       e keyName := value first.
 610       value second ifNotNil: [e char := value second]]
 611     ifAbsent: [
 612       e keyCode < 32
 613         ifTrue: [
 614           e leftControlState := True.
 615           e char := (e keyCode bitOr: 2r01100000) as: ASCIICharacter]
 616         ifFalse: [
 617           e keyCode <= 255
 618             ifTrue: [e char := e keyCode as: Character]]].
 619   e
 620 ].
 621
 622 c@(StructuredConsole traits) translateEscapedSequence: seq into: event
 623 [
 624   seq = '['
 625     ifTrue:
 626       [c keyCodeToKeyName at: (seq first as: Integer)
 627          ifPresent: [| :value | event keyName := value first. ^ True]
 628          ifAbsent:
 629            [event leftAltState := True.
 630             event char := seq first as: ASCIICharacter.
 631             ^ True]]
 632     ifFalse:
 633       [event keyName := c sequenceToKeyName at: seq
 634          ifAbsent: [^ False]].
 635   True
 636 ].
 637
 638 c@(StructuredConsole traits) encode: n into: bytes@(ByteArray traits) from: seq &startingAt: start
 639 "Filter out control chars except \n and \t and put ^ instead of them."
 640 [
 641   0 below: resend do:
 642     [| :index byte |
 643      (byte := bytes at: index) < 32 /\ [(#{9. 10. 13} includes: byte) not]
 644        ifTrue: [bytes at: index put: #[$^ as: Integer]]].
 645   n
 646 ].