src/ui/textbox.slate

   1
   2 "from key presses to function calls on the textbox"
   3 Graphics define: #InputTranslator &parents: {Cloneable}.
   4 Graphics define: #HashTableInputTranslator &parents: {InputTranslator} &slots: {#table -> Dictionary new}.
   5 Graphics define: #TextboxInputTranslator &parents: {InputTranslator}.
   6 Graphics define: #LineEditorInputTranslator &parents: {InputTranslator}.
   7
   8 Graphics define: #TextboxMorph &parents: {Morph} &slots: {
   9   #text -> '' new.
  10   #position -> 0.
  11   #fontSize -> 12.
  12   #inputTranslator -> TextboxInputTranslator new.
  13 }.
  14
  15 Graphics define: #LineEditorMorph &parents: {Morph} &slots: {
  16   #editor -> LineEditor new.
  17   #fontSize -> 12.
  18   #inputTranslator -> LineEditorInputTranslator new.
  19 }.
  20
  21 m@(LineEditorMorph traits) new
  22 [
  23   resend `>> [editor := m editor new. ]
  24 ].
  25
  26 "let the input translator class handle all keyboard input on me"
  27 m@(TextboxMorph traits) handleMyself: e@(KeyboardEvent traits)
  28 [
  29   m inputTranslator handle: e on: m
  30 ].
  31
  32 m@(LineEditorMorph traits) handleMyself: e@(KeyboardEvent traits)
  33 [
  34   m inputTranslator handle: e on: m
  35 ].
  36
  37 it@(InputTranslator traits) handle: e@(InputEvent traits) on: m@(Morph traits)
  38 [
  39   inform: 'Default handler %s does not handle event %s', it, e.
  40   Nil
  41 ].
  42
  43 it@(HashTableInputTranslator traits) handle: e@(KeyboardEvent traits) on: m@(Morph traits)
  44 [
  45   it table at: e key ifPresent: [| :func | func applyTo: {m. e}]
  46 ].
  47
  48 it@(TextboxInputTranslator traits) handle: e@(KeyboardPressEvent traits) on: m@(TextboxMorph traits) [].
  49 it@(LineEditorInputTranslator traits) handle: e@(KeyboardPressEvent traits) on: m@(LineEditorMorph traits) [].
  50
  51 "someone pressed enter"
  52 m@(TextboxMorph traits) activate [].
  53
  54 it@(TextboxInputTranslator traits) handle: e@(KeyboardReleaseEvent traits) on: m@(TextboxMorph traits)
  55 [
  56   `conditions: (
  57     [e key = 276]
  58       -> [m repaint. m position := m position - 1 max: 0].
  59     [e key = 275]
  60       -> [m repaint. m position := m position + 1 min: m printText size].
  61     [e key = 13]
  62       -> [m activate].
  63     "backspace"
  64     [e key = 8]
  65       -> [m repaint.
  66           m text := (m text first: m position - 1) ; (m text allButFirst: m position).
  67           m position := m position - 1 max: 0].
  68     "delete"
  69     [e key = 127]
  70       -> [m repaint.
  71           m text := (m text first: m position) ; (m text allButFirst: m position + 1)].
  72     [e key > 250]
  73       -> [].
  74     [e character isPrintable]
  75       -> [m repaint.
  76           m text := (m text first: m position) ; (e character as: String) ; (m text allButFirst: m position).
  77           m position := m position + 1]
  78   )
  79 ].
  80
  81 it@(LineEditorInputTranslator traits) handle: e@(KeyboardReleaseEvent traits) on: m@(LineEditorMorph traits)
  82 [
  83   `conditions: (
  84      [e key = 275]
  85        -> [m repaint. m editor cursor setTo: (m editor cursor forwardOn: m editor)].
  86      [e key = 102 /\ [e isControlOnly]]
  87        -> [m repaint. m editor cursor setTo: (m editor cursor forwardOn: m editor).
  88            m ensureVisibleCursor: m editor].
  89      [e key = 276]
  90        -> [m repaint. m editor cursor setTo: (m editor cursor backwardOn: m editor)].
  91      [e key = 98 /\ [e isControlOnly]]
  92        -> [m repaint. m editor cursor setTo: (m editor cursor backwardOn: m editor).
  93            m ensureVisibleCursor: m editor].
  94      [e key = 273]
  95        -> [m repaint. m editor cursor setTo: (m editor cursor previousLineOn: m editor)].
  96      [e key = 112 /\ [e isControlOnly]]
  97        -> [m repaint. m editor cursor setTo: (m editor cursor previousLineOn: m editor).
  98            m ensureVisibleCursor: m editor].
  99      [e key = 274]
 100        -> [m repaint. m editor cursor setTo: (m editor cursor nextLineOn: m editor)].
 101      [e key = 110 /\ [e isControlOnly]]
 102        -> [m repaint. m editor cursor setTo: (m editor cursor nextLineOn: m editor).
 103            m ensureVisibleCursor: m editor].
 104      "alt-d do it"
 105      [e key = 100 /\ [e isAltOnly]]
 106        -> [('' concatenateAll: (m editor lines collect: #contents `er) &separator: m editor lineDelimeter)
 107              evaluate].
 108      "backspace"
 109      [e key = 8]
 110        -> [m repaint. m editor deleteBackwardAt: m editor cursor].
 111      "delete"
 112      [e key = 127]
 113        -> [m repaint. m editor deleteAt: m editor cursor].
 114      "set mark C-space"
 115      [e key = 32 /\ [e isControlOnly]]
 116        -> [m repaint. m editor setMark].
 117      "del mark C-g "
 118      [e key = 103 /\ [e isControlOnly]]
 119        -> [m repaint. m editor deleteMark].
 120      "undo C-/ "
 121      [e key = 47 /\ [e isControlOnly]]
 122        -> [m repaint. m editor undo].
 123      "redo C-\ "
 124      [e key = 92 /\ [e isControlOnly]]
 125        -> [m repaint. m editor redo].
 126      "wipe C-w "
 127      [e key = 119 /\ [e isControlOnly]]
 128        -> [m repaint. m editor cutTo: e window].
 129      "copy M-w "
 130      [e key = 119 /\ [e isAltOnly]]
 131        -> [m repaint. m editor copyTo: e window].
 132      "yank C-y "
 133      [e key = 121 /\ [e isControlOnly]]
 134        -> [m repaint. m editor pasteFrom: e window].
 135      [e key > 250]
 136        -> [].
 137      [e character `cache isPrintable \/ [e key = 13]]
 138        -> [m repaint. m editor insert: e character at: m editor cursor]
 139    )
 140 ].
 141
 142 m@(TextboxMorph traits) printText
 143 ["this is the text as a string in case i change the underlying representation"
 144   m text
 145 ].
 146
 147 m@(TextboxMorph traits) handleMyself: input@(LeftMouseButtonReleaseEvent traits)
 148 [ "don't drop focus like usual"
 149   m
 150 ].
 151
 152 m@(TextboxMorph traits) paintMyselfOn: surface@(Surface traits)
 153 [| text |
 154   surface sourceRGB: m theme textboxColor alpha: m theme textboxAlpha.
 155   surface rectangleObject: m.
 156   surface fill.
 157   surface sourceRGB: m theme foregroundColor alpha: m theme foregroundAlpha.
 158   surface rectangleObject: m.
 159   surface stroke.
 160   surface fontSize: m fontSize.
 161 "fixme, we should use cairo's text_extents function to see how large the text is and draw
 162 the appropriate cursor. "
 163   text := m printText.
 164
 165   "print cursor... text is invisible here because we chose the foreground color"
 166   surface moveTo: 10 <> ((m height // 2) + 2).
 167   surface sourceRGB: m theme textboxColor alpha: m theme textboxAlpha.
 168   surface showText: (text first: m position).
 169   surface sourceRGB: m theme cursorColor alpha: m theme cursorAlpha.
 170   surface showText: '_'.
 171
 172   "print text"
 173   surface moveTo: 10 <> (m height // 2).
 174   surface sourceRGB: m theme textColor alpha: m theme textAlpha.
 175   surface showText: text.
 176 ].
 177
 178 m@(LineEditorMorph traits) handleMyself: input@(LeftMouseButtonReleaseEvent traits)
 179 [ "don't drop focus like usual"
 180   m
 181 ].
 182
 183 m@(LineEditorMorph traits) ensureVisibleCursor: le@(LineEditor traits)
 184 [
 185   (m visibleRange includes: le cursor line)
 186     ifFalse: [m editor firstVisibleLine: (le cursor line - (m editor visibleLines // 2) max: 0)].
 187 ].
 188
 189 m@(LineEditorMorph traits) visibleRange
 190 [
 191   (m editor firstVisibleLine to: (m editor firstVisibleLine + m editor visibleLines min: m editor lineCount - 1))
 192 ].
 193
 194 m@(LineEditorMorph traits) paintMyselfOn: surface@(Surface traits)
 195 [| text|
 196   surface sourceRGB: m theme textboxColor alpha: m theme textboxAlpha.
 197   surface rectangleObject: m. surface fill.
 198   surface sourceRGB: m theme foregroundColor alpha: m theme foregroundAlpha.
 199   surface rectangleObject: m. surface stroke.
 200   surface fontSize: m fontSize.
 201 "fixme, we should use cairo's text_extents function to see how large the text is and draw
 202 the appropriate cursor. "
 203
 204   "fixme scrollbar position?"
 205   m visibleRange
 206     do: [| :lineNumber line offset |
 207          line: ((m editor lineAt: lineNumber) as: String).
 208          offset: lineNumber - m editor firstVisibleLine + 1.
 209          m editor cursors do:
 210            [| :cursor |
 211             (cursor line = lineNumber)
 212               ifTrue: ["print cursor... text is invisible here because we chose the foreground color"
 213                        surface moveTo: 5 <> (offset * m fontSize + 2).
 214                        surface sourceRGB: m theme textboxColor alpha: m theme textboxAlpha.
 215                        surface showText: (line first: cursor column).
 216                        "if it is the main cursor or not"
 217                        cursor == m editor cursor
 218                          ifTrue: [surface sourceRGB: m theme cursorColor alpha: m theme cursorAlpha]
 219                          ifFalse: [surface sourceRGB: m theme alternateCursorColor alpha: m theme alternateCursorAlpha].
 220                        surface showText: '_']].
 221          "print text"
 222          surface moveTo: 5 <> (offset * m fontSize).
 223          surface sourceRGB: m theme textColor alpha: m theme textAlpha.
 224          surface showText: line].
 225 ].