216 lines
8.3 KiB
Fennel
216 lines
8.3 KiB
Fennel
(local core (require :core))
|
|
(local config (require :core.config))
|
|
(local command (require :core.command))
|
|
(local keymap (require :core.keymap))
|
|
(local style (require :core.style))
|
|
(local lume (require :lib.lume))
|
|
|
|
(fn attach-imstate [view]
|
|
(set view.imstate {})
|
|
(fn view.on_mouse_pressed [self button x y clicks]
|
|
(tset self.imstate button :pressed)
|
|
(self.__index.on_mouse_pressed self button x y clicks))
|
|
(fn view.on_mouse_released [self button x y]
|
|
(tset self.imstate button :released)
|
|
(self.__index.on_mouse_released self button x y))
|
|
(fn view.on_key_pressed [self key]
|
|
(when (= self.imstate.keys nil)
|
|
(set self.imstate.keys []))
|
|
(table.insert self.imstate.keys key))
|
|
(fn view.on_text_input [self text]
|
|
(set self.imstate.text (.. (or self.imstate.text "") text))
|
|
(self.__index.on_text_input self text))
|
|
(fn view.draw [self]
|
|
(set self.cursor nil)
|
|
(self.__index.draw self)
|
|
(when (= self.cursor nil) (set self.cursor :arrow))
|
|
(set self.imstate.keys nil)
|
|
(set self.imstate.text nil)
|
|
(when (= self.imstate.left :released)
|
|
(set self.imstate.active nil))
|
|
(each [_ button (pairs [:left :middle :right])]
|
|
(tset self.imstate button
|
|
(match (. self.imstate button)
|
|
:pressed :down
|
|
:down :down
|
|
:released nil)))))
|
|
|
|
(fn register-keys [keys]
|
|
(local commands {})
|
|
(local keymaps {})
|
|
(each [_ key (ipairs keys)]
|
|
(local command-name (.. "imstate:" key))
|
|
(tset commands command-name #(core.active_view:on_key_pressed key))
|
|
(tset keymaps key command-name))
|
|
(command.add #(not= (-?> core.active_view.imstate (. :focus)) nil) commands)
|
|
(keymap.add keymaps))
|
|
|
|
(register-keys [:backspace :delete :left :right :shift+left :shift+right :home :end :shift+home :shift+end
|
|
:ctrl+left :ctrl+right :ctrl+shift+left :ctrl+shift+right :ctrl+c :ctrl+v])
|
|
|
|
(fn cmd-predicate [p]
|
|
(var p-fn p)
|
|
(when (= (type p-fn) :string) (set p-fn (require p-fn)))
|
|
(when (= (type p-fn) :table)
|
|
(local cls p-fn)
|
|
(set p-fn (fn [] (core.active_view:is cls))))
|
|
(fn [] (when (= (-?> core.active_view.imstate (. :focus)) nil)
|
|
(p-fn))))
|
|
|
|
(fn make-tag [tag]
|
|
(match (type tag)
|
|
:string tag
|
|
:table (table.concat tag "::")
|
|
_ (tostring tag)))
|
|
|
|
(fn mouse-inside [x y w h]
|
|
(local (mx my) (values (love.mouse.getX) (love.mouse.getY)))
|
|
(and (>= mx x) (<= mx (+ x w)) (>= my y) (<= my (+ y h))))
|
|
|
|
(fn activate [view tag x y w h]
|
|
(when (and (= view.imstate.left :pressed) (mouse-inside x y w h))
|
|
(set view.imstate.active (make-tag tag))
|
|
true))
|
|
(fn active? [view tag] (= view.imstate.active (make-tag tag)))
|
|
(fn button [view tag x y w h]
|
|
(when (mouse-inside x y w h) (set view.cursor :hand))
|
|
(activate view tag x y w h)
|
|
(and (active? view tag) (= view.imstate.left :released) (mouse-inside x y w h)))
|
|
|
|
(fn textbutton [view label x y]
|
|
(local (w h) (values (+ (style.font:get_width label) 8) 24))
|
|
(renderer.draw_rect x y w h style.selection)
|
|
(renderer.draw_text style.font label (+ x 4) (+ y 4) style.text)
|
|
(values (button view label x y w h) (+ y h)))
|
|
|
|
(fn checkbox [view name isset x y ?tag]
|
|
(love.graphics.rectangle (if isset :fill :line) x y 12 12)
|
|
(local xEnd (renderer.draw_text style.font name (+ x 16) y style.text))
|
|
(love.graphics.setColor 1 1 1 1)
|
|
(button view (or ?tag name) x y (- xEnd x) 12))
|
|
|
|
(fn focused? [view tag] (= tag (-?> view.imstate.focus (. :tag))))
|
|
(fn focus [view tag x y w h opts]
|
|
(if (activate view tag x y w h)
|
|
(set view.imstate.focus
|
|
(doto (lume.clone (or opts {}))
|
|
(tset :tag tag)))
|
|
|
|
(and (= view.imstate.left :released) (focused? view tag) (not (active? view tag)))
|
|
(set view.imstate.focus nil))
|
|
(focused? view tag))
|
|
|
|
(local blink_period 0.8)
|
|
(fn x-from-i [s i xLeft font]
|
|
(if (or (<= i 1) (= s "")) xLeft
|
|
(x-from-i (s:sub 2) (- i 1) (+ xLeft (font:get_width (s:sub 1 1))) font)))
|
|
(fn i-from-x [s x xLeft font ?i]
|
|
(local i (or ?i 1))
|
|
(local w (font:get_width (s:sub 1 1)))
|
|
(local xMid (+ xLeft (/ w 2)))
|
|
(if (or (<= x xMid) (= s "")) i
|
|
(i-from-x (s:sub 2) x (+ xLeft w) font (+ i 1))))
|
|
|
|
(fn next-match [text i di pred]
|
|
(local imax (+ (length text) 1))
|
|
(local inext (+ i di))
|
|
(if (<= inext 1) 1
|
|
(> inext imax) imax
|
|
(pred (text:sub inext inext)) (if (< di 0) i inext)
|
|
(next-match text inext di pred)))
|
|
(fn is-nonword-char [char] (config.non_word_chars:find char nil true))
|
|
(fn next-word [text i di]
|
|
(let [iwordboundary (next-match text i di #(is-nonword-char $1))]
|
|
(next-match text iwordboundary di #(not (is-nonword-char $1)))))
|
|
|
|
(fn textnav [key i text]
|
|
(local imax (+ (length text) 1))
|
|
(match key
|
|
:left (math.max 1 (- i 1))
|
|
:right (math.min imax (+ i 1))
|
|
:ctrl+left (next-word text i -1)
|
|
:ctrl+right (next-word text i 1)
|
|
:home 1
|
|
:end imax))
|
|
|
|
(fn selection-span [view]
|
|
(let [f view.imstate.focus
|
|
iStart (math.min f.i f.iAnchor)
|
|
iLim (math.max f.i f.iAnchor)]
|
|
(values iStart iLim)))
|
|
(fn selection-text [view text]
|
|
(local (iStart iLim) (selection-span view))
|
|
(text:sub iStart (- iLim 1)))
|
|
|
|
(fn replace-selection [view s replacement ?iStart ?iLim]
|
|
(local (iStart iLim) (if ?iLim (values ?iStart ?iLim) (selection-span view)))
|
|
(local text
|
|
(.. (s:sub 1 (- iStart 1))
|
|
replacement
|
|
(s:sub iLim)))
|
|
(local iNew (+ iStart (length replacement)))
|
|
(set view.imstate.focus.i iNew)
|
|
(set view.imstate.focus.iAnchor iNew)
|
|
text)
|
|
|
|
(fn textbox [view tag text x y w]
|
|
(var textNew (or text ""))
|
|
(local (h hText xText yText) (values 20 16 (+ x 2) (+ y 2)))
|
|
|
|
; handle key events
|
|
(when (focus view tag x y w h {:i 1 :iAnchor 1 :blink (love.timer.getTime)})
|
|
(local f view.imstate.focus)
|
|
(when view.imstate.text
|
|
(set textNew (replace-selection view textNew view.imstate.text)))
|
|
(each [_ key (ipairs (or view.imstate.keys []))]
|
|
(set view.imstate.focus.blink (love.timer.getTime))
|
|
(if (= key :ctrl+c) (system.set_clipboard (selection-text view textNew))
|
|
(= key :ctrl+v) (set textNew (replace-selection view textNew (system.get_clipboard)))
|
|
(key:find "shift%+") (set f.i (or (textnav (key:gsub "shift%+" "") f.i textNew) f.i))
|
|
(let [iNav (textnav key f.i textNew)]
|
|
(when iNav
|
|
(set f.i iNav)
|
|
(set f.iAnchor iNav))
|
|
(when (or (= key :delete) (= key :backspace))
|
|
(local (iStartDel iLimDel)
|
|
(if (not= f.i f.iAnchor) (selection-span view)
|
|
(= key :delete) (values f.i (+ f.i 1))
|
|
(= key :backspace) (values (math.max 1 (- f.i 1)) f.i)))
|
|
(set textNew (replace-selection view textNew "" iStartDel iLimDel)))))))
|
|
|
|
; handle mouse events
|
|
(when (mouse-inside x y w h) (set view.cursor :ibeam))
|
|
(when (and (focused? view tag) (active? view tag) (mouse-inside x y w h))
|
|
(local mouse-i (i-from-x textNew (love.mouse.getX) x style.font))
|
|
(when (= view.imstate.left :pressed)
|
|
(set view.imstate.focus.iAnchor mouse-i))
|
|
(set view.imstate.focus.i mouse-i))
|
|
|
|
; draw box
|
|
(love.graphics.setLineWidth 1)
|
|
(love.graphics.rectangle :line x y w h)
|
|
(if (focused? view tag)
|
|
; draw text with selection + caret
|
|
(let [(iStart iLim) (selection-span view)
|
|
xSelect (renderer.draw_text style.font (textNew:sub 1 (- iStart 1)) xText yText style.text)
|
|
sSelect (textNew:sub iStart (- iLim 1))
|
|
wSelect (style.font:get_width sSelect)
|
|
xTail (+ xSelect wSelect)]
|
|
(when (> wSelect 0)
|
|
(renderer.draw_rect xSelect yText wSelect hText style.selection)
|
|
(renderer.draw_text style.font sSelect xSelect yText style.text))
|
|
(renderer.draw_text style.font (textNew:sub iLim) xTail yText style.text)
|
|
(when (or (active? view tag)
|
|
(< (% (- (love.timer.getTime) view.imstate.focus.blink) (* blink_period 2)) blink_period))
|
|
(renderer.draw_rect (x-from-i textNew view.imstate.focus.i xText style.font) yText style.caret_width hText style.caret)))
|
|
; just draw the text
|
|
(renderer.draw_text style.font textNew xText yText style.text))
|
|
(love.graphics.setColor 1 1 1)
|
|
(values textNew (+ y h)))
|
|
|
|
(fn textfield [view label text x y wLabel wText]
|
|
(renderer.draw_text style.font label x y style.text)
|
|
(textbox view label text (+ x wLabel) y wText))
|
|
|
|
{: attach-imstate : cmd-predicate : mouse-inside : activate : active? : button : checkbox : textbox : textfield : textbutton}
|