Finish toolkit interface and ncurses fetch-input
This commit is contained in:
parent
d5fc89efd0
commit
e43cdb74da
|
|
@ -39,22 +39,23 @@
|
|||
(core-loop state))
|
||||
|
||||
(define (insert-mode-process-input state key)
|
||||
(case key
|
||||
((backspace)
|
||||
(backward-delete-char state))
|
||||
((delete)
|
||||
(delete-char state))
|
||||
((left)
|
||||
(move-cursor state #:x -1 #:relative? #t))
|
||||
((right)
|
||||
(move-cursor state #:x 1 #:relative? #t))
|
||||
((up)
|
||||
(move-cursor state #:y -1 #:relative? #t))
|
||||
((down)
|
||||
(move-cursor state #:y 1 #:relative? #t))
|
||||
((escape)
|
||||
(set! (mode state) 'normal-mode))
|
||||
(else (insert-char state key))))
|
||||
(if (memq key insertable-characters)
|
||||
(insert-char state key)
|
||||
(case key
|
||||
((backspace)
|
||||
(backward-delete-char state))
|
||||
((delete)
|
||||
(delete-char state))
|
||||
((left)
|
||||
(move-cursor state #:x -1 #:relative? #t))
|
||||
((right)
|
||||
(move-cursor state #:x 1 #:relative? #t))
|
||||
((up)
|
||||
(move-cursor state #:y -1 #:relative? #t))
|
||||
((down)
|
||||
(move-cursor state #:y 1 #:relative? #t))
|
||||
((escape)
|
||||
(set! (mode state) 'normal-mode)))))
|
||||
|
||||
(define (normal-mode-process-input state key)
|
||||
(case key
|
||||
|
|
|
|||
|
|
@ -4,8 +4,7 @@
|
|||
#:use-module (rnrs enums)
|
||||
#:use-module (sloth common)
|
||||
#:use-module (sloth ncurses)
|
||||
#:export (get-main-win
|
||||
insertable-char->sloth-input-code
|
||||
#:export (insertable-char->sloth-input-code
|
||||
insertable-characters
|
||||
sloth-input-code->insertable-char
|
||||
sloth-input-keys
|
||||
|
|
@ -144,8 +143,15 @@ v c-_ c-lbrace c-rbrace c-lbracket c-rbracket
|
|||
#\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
|
||||
#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
|
||||
#\` #\~ #\! #\@ #\# #\$ #\% #\^ #\& #\* #\( #\) #\- #\_
|
||||
#\= #\+ #\[ #\] #\{ #\} #\| #\| #\; #\: #\' #\" #\, #\<
|
||||
#\. #\> #\/ #\? #\newline #\space #\tab))
|
||||
#\= #\+ #\[ #\] #\{ #\} #\| #\\ #\; #\: #\' #\" #\, #\<
|
||||
#\. #\> #\/ #\? #\newline #\space #\tab
|
||||
a b c d e f g h i j k l m n o p q r s t u v w x y z
|
||||
s-a s-b s-c s-d s-e s-f s-g s-h s-i s-j s-k s-l s-m
|
||||
s-n s-o s-p s-q s-r s-s s-t s-u s-v s-w s-x s-y s-z
|
||||
zero one two three four five six seven eight nine
|
||||
backtick ~ ! @ hash $ % ^ & * lparen rparen dash _
|
||||
= + lbracket rbracket lbrace rbrace pipe backslash
|
||||
semicolon : apostrophe quote comma < > dot / ? ret space tab))
|
||||
|
||||
(define (insertable-char->sloth-input-code char)
|
||||
(case char
|
||||
|
|
|
|||
|
|
@ -21,6 +21,12 @@
|
|||
(keypad! win #t)
|
||||
state)
|
||||
|
||||
(define (input-waiting? win)
|
||||
(nodelay! win #t)
|
||||
(define result (getch win))
|
||||
(nodelay! win #f)
|
||||
result)
|
||||
|
||||
(define-method (fetch-input (nc <ncurses-frontend>))
|
||||
(let ((ch (getch (get-main-win nc))))
|
||||
(if (memq ch insertable-characters)
|
||||
|
|
@ -126,13 +132,151 @@
|
|||
((322) 'm-f10)
|
||||
((323) 'm-f11)
|
||||
((324) 'm-f12)
|
||||
;; TODO: The rest of the function characters. I'm tired.
|
||||
((330) 'delete)
|
||||
((331) 'insert)
|
||||
((336) 's-down)
|
||||
((337) 's-up)
|
||||
((360) 'end)
|
||||
((383) 's-delete)
|
||||
((386) 's-end)
|
||||
((391) 's-home)
|
||||
((393) 's-left)
|
||||
((512) 'm-delete)
|
||||
((513) 'c-delete)
|
||||
((516) 'c-m-delete)
|
||||
((518) 'm-down)
|
||||
((519) 'm-s-down)
|
||||
((520) 'c-down)
|
||||
((521) 'c-s-down)
|
||||
((522) 'c-m-down)
|
||||
((523) 'm-end)
|
||||
((525) 'c-end)
|
||||
((527) 'c-m-end)
|
||||
((528) 'm-home)
|
||||
((530) 'c-home)
|
||||
((532) 'c-m-home)
|
||||
((533) 'm-insert)
|
||||
((535) 'c-insert)
|
||||
((537) 'c-m-insert)
|
||||
((538) 'm-left)
|
||||
((539) 'm-s-left)
|
||||
((540) 'c-left)
|
||||
((541) 'c-s-left)
|
||||
((542) 'c-m-left)
|
||||
((553) 'm-right)
|
||||
((554) 'm-s-right)
|
||||
((555) 'c-right)
|
||||
((556) 'c-s-right)
|
||||
((557) 'c-m-right)
|
||||
((559) 'm-up)
|
||||
((560) 'm-s-up)
|
||||
((561) 'c-up)
|
||||
((562) 'c-s-up)
|
||||
((563) 'c-m-up)
|
||||
;; TODO: M-characters. Most of the time this is ESC
|
||||
;; immediately followed by the character, so M-6 is ESC 6.
|
||||
;; So when we see ESC we need to check if there's another
|
||||
;; character waiting, and if there is then it's M-[char],
|
||||
;; and otherwise it's just ESC.
|
||||
))))
|
||||
((#\esc)
|
||||
(let ((more? (input-waiting? (get-main-win nc))))
|
||||
(if (not more?)
|
||||
'escape
|
||||
(case more?
|
||||
((#f) 'escape)
|
||||
((#\a) 'm-a)
|
||||
((#\b) 'm-b)
|
||||
((#\c) 'm-c)
|
||||
((#\d) 'm-d)
|
||||
((#\e) 'm-e)
|
||||
((#\f) 'm-f)
|
||||
((#\g) 'm-g)
|
||||
((#\h) 'm-h)
|
||||
((#\i) 'm-i)
|
||||
((#\j) 'm-j)
|
||||
((#\k) 'm-k)
|
||||
((#\l) 'm-l)
|
||||
((#\m) 'm-m)
|
||||
((#\n) 'm-n)
|
||||
((#\o) 'm-o)
|
||||
((#\p) 'm-p)
|
||||
((#\q) 'm-q)
|
||||
((#\r) 'm-r)
|
||||
((#\s) 'm-s)
|
||||
((#\t) 'm-t)
|
||||
((#\u) 'm-u)
|
||||
((#\v) 'm-v)
|
||||
((#\w) 'm-w)
|
||||
((#\x) 'm-x)
|
||||
((#\y) 'm-y)
|
||||
((#\z) 'm-z)
|
||||
((#\A) 'm-s-a)
|
||||
((#\B) 'm-s-b)
|
||||
((#\C) 'm-s-c)
|
||||
((#\D) 'm-s-d)
|
||||
((#\E) 'm-s-e)
|
||||
((#\F) 'm-s-f)
|
||||
((#\G) 'm-s-g)
|
||||
((#\H) 'm-s-h)
|
||||
((#\I) 'm-s-i)
|
||||
((#\J) 'm-s-j)
|
||||
((#\K) 'm-s-k)
|
||||
((#\L) 'm-s-l)
|
||||
((#\M) 'm-s-m)
|
||||
((#\N) 'm-s-n)
|
||||
((#\O) 'm-s-o)
|
||||
((#\P) 'm-s-p)
|
||||
((#\Q) 'm-s-q)
|
||||
((#\R) 'm-s-r)
|
||||
((#\S) 'm-s-s)
|
||||
((#\T) 'm-s-t)
|
||||
((#\U) 'm-s-u)
|
||||
((#\V) 'm-s-v)
|
||||
((#\W) 'm-s-w)
|
||||
((#\X) 'm-s-x)
|
||||
((#\Y) 'm-s-y)
|
||||
((#\Z) 'm-s-z)
|
||||
((#\0) 'm-zero)
|
||||
((#\1) 'm-one)
|
||||
((#\2) 'm-two)
|
||||
((#\3) 'm-three)
|
||||
((#\4) 'm-four)
|
||||
((#\5) 'm-five)
|
||||
((#\6) 'm-six)
|
||||
((#\7) 'm-seven)
|
||||
((#\8) 'm-eight)
|
||||
((#\9) 'm-nine)
|
||||
((#\`) 'm-backtick)
|
||||
((#\~) 'm-~)
|
||||
((#\!) 'm-!)
|
||||
((#\@) 'm-@)
|
||||
((#\$) 'm-$)
|
||||
((#\%) 'm-%)
|
||||
((#\^) 'm-^)
|
||||
((#\&) 'm-&)
|
||||
((#\*) 'm-*)
|
||||
((#\() 'm-lparen)
|
||||
((#\)) 'm-rparen)
|
||||
((#\-) 'm-dash)
|
||||
((#\_) 'm-_)
|
||||
((#\=) 'm-=)
|
||||
((#\+) 'm-+)
|
||||
((#\[) 'm-lbracket)
|
||||
((#\]) 'm-rbracket)
|
||||
((#\{) 'm-lbrace)
|
||||
((#\}) 'm-rbrace)
|
||||
((#\\) 'm-backslash)
|
||||
((#\|) 'm-pipe)
|
||||
((#\;) 'm-semicolon)
|
||||
((#\:) 'm-:)
|
||||
((#\') 'm-apostrophe)
|
||||
((#\") 'm-quote)
|
||||
((#\,) 'm-comma)
|
||||
((#\<) 'm-<)
|
||||
((#\.) 'm-dot)
|
||||
((#\>) 'm->)
|
||||
((#\/) 'm-/)
|
||||
((#\?) 'm-?)))))))))
|
||||
|
||||
(define-method (set-cursor-pos (nc <ncurses-frontend>) x y)
|
||||
(set! (curx nc) x)
|
||||
|
|
|
|||
Loading…
Reference in New Issue