299 lines
8.1 KiB
Scheme
299 lines
8.1 KiB
Scheme
(define-module (sloth ncurses)
|
|
#:use-module (ncurses curses)
|
|
#:use-module (sloth interface)
|
|
#:use-module (sloth common)
|
|
#:use-module (oop goops)
|
|
#:export (init-ncurses))
|
|
|
|
(define-class <ncurses-frontend> (<sloth-frontend>)
|
|
;; Since writing text in ncurses typically requires setting and moving the
|
|
;; cursor, our frontend class needs to know where the cursor is supposed to
|
|
;; be so it can ensure it always gets reset to that point.
|
|
(curx #:init-value 0 #:accessor curx)
|
|
(cury #:init-value 0 #:accessor cury))
|
|
|
|
(define (init-ncurses)
|
|
(define win (initscr))
|
|
(define state (make <ncurses-frontend>
|
|
#:main-win win))
|
|
(raw!)
|
|
(noecho!)
|
|
(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)
|
|
(insertable-char->sloth-input-code ch)
|
|
(case ch
|
|
;; You might note a lack of c-s-[letter], and other input
|
|
;; options. This is due to terminals being Strange. Try C-A in
|
|
;; Emacs and it moves to the front of the line while marking,
|
|
;; a distinct behavior from C-a. Try this in *terminal* Emacs,
|
|
;; and it doesn't work. In conclusion, terminals are a kludge
|
|
;; from the days of teletypewriters. If multiple inputs map to
|
|
;; the same charactes in the terminal, I've just picked
|
|
;; whichever is first (or seems like it *should* be prior)
|
|
((#\soh) 'c-a)
|
|
((#\etx) 'c-c)
|
|
((#\eot) 'c-d)
|
|
((#\enq) 'c-e)
|
|
((#\ack) 'c-f)
|
|
((#\alarm) 'c-g)
|
|
((#\vtab) 'c-k)
|
|
((#\page) 'c-l)
|
|
((#\so) 'c-n)
|
|
((#\si) 'c-o)
|
|
((#\dle) 'c-p)
|
|
((#\dc1) 'c-q)
|
|
((#\dc2) 'c-r)
|
|
((#\dc3) 'c-s)
|
|
((#\dc4) 'c-t)
|
|
((#\nak) 'c-u)
|
|
((#\syn) 'c-v)
|
|
((#\etb) 'c-w)
|
|
((#\can) 'c-x)
|
|
((#\em) 'c-y)
|
|
((#\sub) 'c-z)
|
|
((#\nul) 'c-backtick)
|
|
((#\rs) 'c-~)
|
|
((#\fs) 'c-four)
|
|
((#\gs) 'c-five)
|
|
((#\us) 'c-seven)
|
|
((258) 'down)
|
|
((259) 'up)
|
|
((260) 'left)
|
|
((261) 'right)
|
|
((262) 'home)
|
|
((263) 'backspace)
|
|
((265) 'f1)
|
|
((266) 'f2)
|
|
((267) 'f3)
|
|
((268) 'f4)
|
|
((269) 'f5)
|
|
((270) 'f6)
|
|
((271) 'f7)
|
|
((272) 'f8)
|
|
((273) 'f9)
|
|
((274) 'f10)
|
|
((275) 'f11)
|
|
((276) 'f12)
|
|
((277) 's-f1)
|
|
((278) 's-f2)
|
|
((279) 's-f3)
|
|
((280) 's-f4)
|
|
((281) 's-f5)
|
|
((282) 's-f6)
|
|
((283) 's-f7)
|
|
((284) 's-f8)
|
|
((285) 's-f9)
|
|
((286) 's-f10)
|
|
((287) 's-f11)
|
|
((288) 's-f12)
|
|
((289) 'c-f1)
|
|
((290) 'c-f2)
|
|
((291) 'c-f3)
|
|
((292) 'c-f4)
|
|
((293) 'c-f5)
|
|
((294) 'c-f6)
|
|
((295) 'c-f7)
|
|
((296) 'c-f8)
|
|
((297) 'c-f9)
|
|
((298) 'c-f10)
|
|
((299) 'c-f11)
|
|
((300) 'c-f12)
|
|
((301) 'c-s-f1)
|
|
((302) 'c-s-f2)
|
|
((303) 'c-s-f3)
|
|
((304) 'c-s-f4)
|
|
((305) 'c-s-f5)
|
|
((306) 'c-s-f6)
|
|
((307) 'c-s-f7)
|
|
((308) 'c-s-f8)
|
|
((309) 'c-s-f9)
|
|
((310) 'c-s-f10)
|
|
((311) 'c-s-f11)
|
|
((312) 'c-s-f12)
|
|
((313) 'm-f1)
|
|
((314) 'm-f2)
|
|
((315) 'm-f3)
|
|
((316) 'm-f4)
|
|
((317) 'm-f5)
|
|
((318) 'm-f6)
|
|
((319) 'm-f7)
|
|
((320) 'm-f8)
|
|
((321) 'm-f9)
|
|
((322) 'm-f10)
|
|
((323) 'm-f11)
|
|
((324) 'm-f12)
|
|
((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)
|
|
(set! (cury nc) y)
|
|
(move (get-main-win nc) y x))
|
|
|
|
(define-method (end (nc <ncurses-frontend>))
|
|
(endwin)
|
|
(quit))
|
|
|
|
(define-method (write-buffer (nc <ncurses-frontend>) buffer lines-scrolled)
|
|
(define win (get-main-win nc))
|
|
(erase win)
|
|
(do ((i 0 (1+ i)))
|
|
((> i (lines)))
|
|
(addstr win (list-ref buffer (+ i lines-scrolled))
|
|
#:y i #:x 0))
|
|
(move win (cury nc) (curx nc))
|
|
(refresh win))
|