363 lines
9.2 KiB
Scheme
363 lines
9.2 KiB
Scheme
(define-module (sloth interface)
|
|
#:use-module (ice-9 exceptions)
|
|
#:use-module (oop goops)
|
|
#:use-module (rnrs enums)
|
|
#:use-module (sloth common)
|
|
#:use-module (sloth ncurses)
|
|
#:export (insertable-char->sloth-input-code
|
|
insertable-characters
|
|
sloth-input-code->insertable-char
|
|
sloth-input-keys
|
|
init-frontend))
|
|
|
|
(define sloth-input-keys
|
|
(make-enumeration
|
|
'(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
|
|
|
|
one two three four five six seven eight nine zero
|
|
backtick ! @ hash $ % ^ & * lparen rparen dash _
|
|
lbrace rbrace lbracket rbracket pipe backslash / ?
|
|
< > comma dot : semicolon + = apostrophe quote
|
|
|
|
c-a c-b c-c c-d c-e c-f c-g c-h
|
|
c-i c-j c-k c-l c-m c-n c-o c-p
|
|
c-q c-r c-s c-t c-u c-v c-w c-x
|
|
c-y c-z
|
|
|
|
c-one c-two c-three c-four c-five c-six
|
|
c-seven c-eight c-nine c-zero
|
|
c-~ c-backtick c-! @ c-hash c-$ c-%
|
|
c-^ c-& c-* c-lparen c-rparen c-dash
|
|
v c-_ c-lbrace c-rbrace c-lbracket c-rbracket
|
|
c-pipe c-backslash c-/ c-? c-< c->
|
|
c-comma c-dot c-: c-semicolon c-+ c-=
|
|
c-apostrophe c-quote
|
|
|
|
m-a m-b m-c m-d m-e m-f m-g m-h m-i m-j
|
|
m-k m-l m-m m-n m-o m-p m-q m-r m-s m-t
|
|
m-u m-v m-w m-x m-y m-z
|
|
m-s-a m-s-b m-s-c m-s-d m-s-e
|
|
m-s-f m-s-g m-s-h m-s-i m-s-j
|
|
m-s-k m-s-l m-s-m m-s-n m-s-o
|
|
m-s-p m-s-q m-s-r m-s-s m-s-t
|
|
m-s-u m-s-v m-s-w m-s-x m-s-y
|
|
m-s-z
|
|
|
|
m-one m-two m-three m-four m-five m-six m-seven
|
|
m-eight m-nine m-zero
|
|
m-~ m-backtick m-! @ m-hash m-$ m-% m-^ m-&
|
|
m-* m-lparen m-rparen m-dash m-_ m-lbrace
|
|
m-rbrace m-lbracket m-rbracket m-pipe m-backslash
|
|
m-/ m-? m-< m-> m-comma m-dot m-: m-semicolon m-+ m-=
|
|
m-apostrophe m-quote
|
|
|
|
c-m-a c-m-b c-m-c c-m-d c-m-e
|
|
c-m-f c-m-g c-m-h c-m-i c-m-j
|
|
c-m-k c-m-l c-m-m c-m-n c-m-o
|
|
c-m-p c-m-q c-m-r c-m-s c-m-t
|
|
c-m-u c-m-v c-m-w c-m-x c-m-y
|
|
c-m-z
|
|
c-m-s-a c-m-s-b c-m-s-c c-m-s-d
|
|
c-m-s-e c-m-s-f c-m-s-g c-m-s-h
|
|
c-m-s-i c-m-s-j c-m-s-k c-m-s-l
|
|
c-m-s-m c-m-s-n c-m-s-o c-m-s-p
|
|
c-m-s-q c-m-s-r c-m-s-s c-m-s-t
|
|
c-m-s-u c-m-s-v c-m-s-w c-m-s-x
|
|
c-m-s-y c-m-s-z
|
|
|
|
c-m-one c-m-two c-m-three c-m-four c-m-five
|
|
c-m-six c-m-seven c-m-eight c-m-nine c-m-zero
|
|
c-m-~ c-m-backtick c-m-! @ c-m-hash c-m-$
|
|
c-m-% c-m-^ c-m-& c-m-* c-m-lparen
|
|
c-m-rparen c-m-dash c-m-_ c-m-lbrace c-m-rbrace
|
|
c-m-lbracket c-m-rbracket c-m-pipe c-m-backslash
|
|
c-m-/ c-m-? c-m-< c-m-> c-m-comma c-m-dot
|
|
c-m-: c-m-semicolon c-m-+ c-m-= c-m-apostrophe c-m-quote
|
|
|
|
esc home end insert delete page-up page-down print-screen ret
|
|
backspace tab space
|
|
f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
|
|
left right up down
|
|
|
|
s-esc s-home s-end s-insert s-delete
|
|
s-page-up s-page-down s-print-screen s-ret
|
|
s-backspace s-tab s-space
|
|
s-f1 s-f2 s-f3 s-f4 s-f5 s-f6 s-f7
|
|
s-f8 s-f9 s-f10 s-f11 s-f12
|
|
s-left s-right s-up s-down
|
|
|
|
m-esc m-home m-end m-insert m-delete m-page-up m-page-down
|
|
m-print-screen m-ret m-backspace m-tab m-space
|
|
m-f1 m-f2 m-f3 m-f4 m-f5 m-f6 m-f7 m-f8 m-f9 m-f10
|
|
m-f11 m-f12
|
|
m-left m-right m-up m-down
|
|
|
|
m-s-esc m-s-home m-s-end m-s-insert
|
|
m-s-delete m-s-page-up m-s-page-down
|
|
m-s-print-screen m-s-ret m-s-backspace m-s-tab m-s-space
|
|
m-s-f1 m-s-f2 m-s-f3 m-s-f4 m-s-f5
|
|
m-s-f6 m-s-f7 m-s-f8 m-s-f9 m-s-f10
|
|
m-s-f11 m-s-f12
|
|
m-s-left m-s-right m-s-up m-s-down
|
|
|
|
c-esc c-home c-end c-insert c-delete c-page-up
|
|
c-page-down c-print-screen c-ret c-backspace c-tab c-space
|
|
c-f1 c-f2 c-f3 c-f4 c-f5 c-f6 c-f7 c-f8 c-f9
|
|
c-f10 c-f11 c-f12
|
|
c-left c-right c-up c-down
|
|
|
|
c-s-esc c-s-home c-s-end c-s-insert
|
|
c-s-delete c-s-page-up c-s-page-down
|
|
c-s-print-screen c-s-ret c-s-backspace
|
|
c-s-tab
|
|
c-s-f1 c-s-f2 c-s-f3 c-s-f4 c-s-f5
|
|
c-s-f6 c-s-f7 c-s-f8 c-s-f9 c-s-f10
|
|
c-s-f11 c-s-f12
|
|
c-s-left c-s-right c-s-up c-s-down
|
|
|
|
c-m-esc c-m-home c-m-end c-m-insert c-m-delete
|
|
c-m-page-up c-m-page-down c-m-print-screen c-m-ret
|
|
c-m-backspace c-m-tab c-m-space
|
|
c-m-f1 c-m-f2 c-m-f3 c-m-f4 c-m-f5 c-m-f6
|
|
c-m-f7 c-m-f8 c-m-f9 c-m-f10 c-m-f11 c-m-f12
|
|
c-m-left c-m-right c-m-up c-m-down
|
|
|
|
c-m-s-esc c-m-s-home c-m-s-end
|
|
c-m-s-insert c-m-s-delete c-m-s-page-up
|
|
c-m-s-page-down c-m-s-print-screen c-m-s-ret
|
|
c-m-s-backspace c-m-s-tab c-m-s-space
|
|
c-m-s-f1 c-m-s-f2 c-m-s-f3 c-m-s-f4
|
|
c-m-s-f5 c-m-s-f6 c-m-s-f7 c-m-s-f8
|
|
c-m-s-f9 c-m-s-f10 c-m-s-f11 c-m-s-f12
|
|
c-m-s-left c-m-s-right c-m-s-up c-m-s-down)))
|
|
|
|
(define insertable-characters
|
|
'(#\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
|
|
#\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
|
|
#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
|
|
#\` #\~ #\! #\@ #\# #\$ #\% #\^ #\& #\* #\( #\) #\- #\_
|
|
#\= #\+ #\[ #\] #\{ #\} #\| #\\ #\; #\: #\' #\" #\, #\<
|
|
#\. #\> #\/ #\? #\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
|
|
((#\a) 'a)
|
|
((#\b) 'b)
|
|
((#\c) 'c)
|
|
((#\d) 'd)
|
|
((#\e) 'e)
|
|
((#\f) 'f)
|
|
((#\g) 'g)
|
|
((#\h) 'h)
|
|
((#\i) 'i)
|
|
((#\j) 'j)
|
|
((#\k) 'k)
|
|
((#\l) 'l)
|
|
((#\m) 'm)
|
|
((#\n) 'n)
|
|
((#\o) 'o)
|
|
((#\p) 'p)
|
|
((#\q) 'q)
|
|
((#\r) 'r)
|
|
((#\s) 's)
|
|
((#\t) 't)
|
|
((#\u) 'u)
|
|
((#\v) 'v)
|
|
((#\w) 'w)
|
|
((#\x) 'x)
|
|
((#\y) 'y)
|
|
((#\z) 'z)
|
|
((#\A) 's-a)
|
|
((#\B) 's-b)
|
|
((#\C) 's-c)
|
|
((#\D) 's-d)
|
|
((#\E) 's-e)
|
|
((#\F) 's-f)
|
|
((#\G) 's-g)
|
|
((#\H) 's-h)
|
|
((#\I) 's-i)
|
|
((#\J) 's-j)
|
|
((#\K) 's-k)
|
|
((#\L) 's-l)
|
|
((#\M) 's-m)
|
|
((#\N) 's-n)
|
|
((#\O) 's-o)
|
|
((#\P) 's-p)
|
|
((#\Q) 's-q)
|
|
((#\R) 's-r)
|
|
((#\S) 's-s)
|
|
((#\T) 's-t)
|
|
((#\U) 's-u)
|
|
((#\V) 's-v)
|
|
((#\W) 's-w)
|
|
((#\X) 's-x)
|
|
((#\Y) 's-y)
|
|
((#\Z) 's-z)
|
|
((#\0) 'zero)
|
|
((#\1) 'one)
|
|
((#\2) 'two)
|
|
((#\3) 'three)
|
|
((#\4) 'four)
|
|
((#\5) 'five)
|
|
((#\6) 'six)
|
|
((#\7) 'seven)
|
|
((#\8) 'eight)
|
|
((#\9) 'nine)
|
|
((#\`) 'backtick)
|
|
((#\~) '~)
|
|
((#\!) '!)
|
|
((#\@) '@)
|
|
((#\#) 'hash)
|
|
((#\$) '$)
|
|
((#\%) '%)
|
|
((#\^) '^)
|
|
((#\&) '&)
|
|
((#\*) '*)
|
|
((#\() 'lparen)
|
|
((#\)) 'rparen)
|
|
((#\-) 'dash)
|
|
((#\_) '_)
|
|
((#\=) '=)
|
|
((#\+) '+)
|
|
((#\[) 'lbracket)
|
|
((#\]) 'rbracket)
|
|
((#\{) 'lbrace)
|
|
((#\}) 'rbrace)
|
|
((#\|) 'pipe)
|
|
((#\\) 'backslash)
|
|
((#\;) 'semicolon)
|
|
((#\:) ':)
|
|
((#\') 'apostrophe)
|
|
((#\") 'quote)
|
|
((#\,) 'comma)
|
|
((#\<) '<)
|
|
((#\.) 'dot)
|
|
((#\>) '>)
|
|
((#\/) '/)
|
|
((#\?) '?)
|
|
((#\newline) 'enter)
|
|
((#\space) 'space)
|
|
((#\tab) 'tab)))
|
|
|
|
(define (sloth-input-code->insertable-char code)
|
|
(case code
|
|
((a) #\a)
|
|
((b) #\b)
|
|
((c) #\c)
|
|
((d) #\d)
|
|
((e) #\e)
|
|
((f) #\f)
|
|
((g) #\g)
|
|
((h) #\h)
|
|
((i) #\i)
|
|
((j) #\j)
|
|
((k) #\k)
|
|
((l) #\l)
|
|
((m) #\m)
|
|
((n) #\n)
|
|
((o) #\o)
|
|
((p) #\p)
|
|
((q) #\q)
|
|
((r) #\r)
|
|
((s) #\s)
|
|
((t) #\t)
|
|
((u) #\u)
|
|
((v) #\v)
|
|
((w) #\w)
|
|
((x) #\x)
|
|
((y) #\y)
|
|
((z) #\z)
|
|
((s-a) #\A)
|
|
((s-b) #\B)
|
|
((s-c) #\C)
|
|
((s-d) #\D)
|
|
((s-e) #\E)
|
|
((s-f) #\F)
|
|
((s-g) #\G)
|
|
((s-h) #\H)
|
|
((s-i) #\I)
|
|
((s-j) #\J)
|
|
((s-k) #\K)
|
|
((s-l) #\L)
|
|
((s-m) #\M)
|
|
((s-n) #\N)
|
|
((s-o) #\O)
|
|
((s-p) #\P)
|
|
((s-q) #\Q)
|
|
((s-r) #\R)
|
|
((s-s) #\S)
|
|
((s-t) #\T)
|
|
((s-u) #\U)
|
|
((s-v) #\V)
|
|
((s-w) #\W)
|
|
((s-x) #\X)
|
|
((s-y) #\Y)
|
|
((s-z) #\Z)
|
|
((zero) #\0)
|
|
((one) #\1)
|
|
((two) #\2)
|
|
((three) #\3)
|
|
((four) #\4)
|
|
((five) #\5)
|
|
((six) #\6)
|
|
((seven) #\7)
|
|
((eight) #\8)
|
|
((nine) #\9)
|
|
((backtick) #\`)
|
|
((~) #\~)
|
|
((!) #\!)
|
|
((@) #\@)
|
|
((#\$) '$)
|
|
((hash) #\#)
|
|
((%) #\%)
|
|
((^) #\^)
|
|
((&) #\&)
|
|
((*) #\*)
|
|
((lparen) #\()
|
|
((rparen) #\))
|
|
((dash) #\-)
|
|
((_) #\_)
|
|
((=) #\=)
|
|
((+) #\+)
|
|
((lbracket) #\[)
|
|
((rbracket) #\])
|
|
((lbrace) #\{)
|
|
((rbrace) #\})
|
|
((pipe) #\|)
|
|
((backslash) #\\)
|
|
((semicolon) #\;)
|
|
((:) #\:)
|
|
((apostrophe) #\')
|
|
((quote) #\")
|
|
((comma) #\,)
|
|
((<) #\<)
|
|
((dot) #\.)
|
|
((>) #\>)
|
|
((/) #\/)
|
|
((?) #\?)
|
|
((enter) #\newline)
|
|
((space) #\space)
|
|
((tab) #\tab)))
|
|
|
|
(define (init-frontend frontend)
|
|
(case frontend
|
|
((ncurses) (init-ncurses))
|
|
(else (raise-exception
|
|
(make-exception
|
|
(make-exception-with-message "Unknown frontend")
|
|
(make-exception-with-irritants frontend))))))
|