218 lines
5.8 KiB
Scheme
218 lines
5.8 KiB
Scheme
(define NULL (ascii->char 0))
|
|
|
|
(define demo
|
|
(lambda ()
|
|
(let ((win (init-screen)))
|
|
(keypad win #t)
|
|
(noecho)
|
|
|
|
(make&install-input-field win
|
|
20 10
|
|
42 23
|
|
"
|
|
+----------------------------------+
|
|
| f1 : move left input-field |
|
|
| f2 : move right input-field |
|
|
| f3 : move up input-field |
|
|
| f4 : move down input-field |
|
|
| |
|
|
| f5 : make bigger in x direction |
|
|
| f6 : make smaler in x direction |
|
|
| f7 : make bigger in y direction |
|
|
| f8 : make smaler in y direction |
|
|
| |
|
|
| f9 : toggle x-scroll |
|
|
| f10 : toggle y-scroll |
|
|
| |
|
|
| f11 : clear |
|
|
| f12 : reset |
|
|
| |
|
|
| tab : toggle insert |
|
|
| |
|
|
| ESC : quit |
|
|
+----------------------------------+
|
|
|
|
0-0 0-1 0-2 0-3 0-4 0-5
|
|
1-0 1-1 1-2 1-3 1-4 1-5 1-6
|
|
2-0 2-1 2-2 2-3 2-4 2-5 2-6 2-7
|
|
3-0 3-1 3-2 3-3 3-4 3-5 3-6 3-7 3-8
|
|
4-0 4-1 4-2 4-3 4-4 4-5 4-6 4-7 4-8 4-9
|
|
5-0 5-1 5-2 5-3 5-4 5-5 5-6 5-7 5-8 4-9
|
|
6-0 6-1 6-2 6-3 6-4 6-5 6-6 6-7 6-8
|
|
7-0 7-1 7-2 7-3 7-4 7-5 7-6 7-7
|
|
8-0 8-1 8-2 8-3 8-4 8-5 8-6
|
|
9-0 9-1 9-2 9-3 9-4 9-5\n"
|
|
(append
|
|
(list (cons 9 ;; tab
|
|
'toggle-insert)
|
|
(cons key-ppage
|
|
'move-backward)
|
|
(cons key-npage
|
|
'move-forward))
|
|
standard-behavior-pro)
|
|
#t #t #t)
|
|
|
|
(wmove win 10 20)
|
|
(screen-refresh win)
|
|
|
|
(letrec ((else-loop (lambda (asc)
|
|
(let ((infl (cursor-over-input-field? win)))
|
|
(cond ((= asc 27)
|
|
(wclear win)
|
|
(clear)
|
|
(echo)
|
|
(endwin))
|
|
((= asc key-f1)
|
|
(input-field-move infl
|
|
(- (input-field-x-location infl)
|
|
1)
|
|
(input-field-y-location infl))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f2)
|
|
(input-field-move infl
|
|
(+ (input-field-x-location infl)
|
|
1)
|
|
(input-field-y-location infl))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f3)
|
|
(input-field-move infl
|
|
(input-field-x-location infl)
|
|
(- (input-field-y-location infl)
|
|
1))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f4)
|
|
(input-field-move infl
|
|
(input-field-x-location infl)
|
|
(+ (input-field-y-location infl)
|
|
1))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f5)
|
|
(input-field-resize infl
|
|
(+ (input-field-x-size infl)
|
|
1)
|
|
(input-field-y-size infl))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f6)
|
|
(input-field-resize infl
|
|
(- (input-field-x-size infl)
|
|
1)
|
|
(input-field-y-size infl))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f7)
|
|
(input-field-resize infl
|
|
(input-field-x-size infl)
|
|
(+ (input-field-y-size infl)
|
|
1))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f8)
|
|
(input-field-resize infl
|
|
(input-field-x-size infl)
|
|
(- (input-field-y-size infl)
|
|
1))
|
|
(screen-refresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f9)
|
|
(input-field-toggle-x-scroll infl)
|
|
(wrefresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f10)
|
|
(input-field-toggle-y-scroll infl)
|
|
(wrefresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f11)
|
|
(input-field-clear infl)
|
|
(wrefresh win)
|
|
(loop (wgetch win)))
|
|
((= asc key-f12)
|
|
(input-field-reset infl)
|
|
(wrefresh win)
|
|
(loop (wgetch win)))
|
|
(else (loop (wgetch win)))))))
|
|
(loop (lambda (asc)
|
|
(cond ((cursor-over-input-field? win)
|
|
=> (lambda (infl)
|
|
(call-with-values
|
|
(lambda ()
|
|
(send-input-field infl asc))
|
|
(lambda (was-known is-changed)
|
|
(if is-changed
|
|
(begin
|
|
(wrefresh win)
|
|
(loop (wgetch win)))
|
|
(if was-known
|
|
(loop (wgetch win))
|
|
(else-loop asc)))))))))))
|
|
(loop (wgetch win))))))
|
|
|
|
|
|
(define screen-refresh
|
|
(lambda (screen)
|
|
(let ((infl (cursor-over-input-field? screen))
|
|
(x (getx screen))
|
|
(y (gety screen)))
|
|
(wclear screen)
|
|
(input-field-refresh infl)
|
|
(wdraw-box screen
|
|
(- (input-field-x-location infl) 1)
|
|
(- (input-field-y-location infl) 1)
|
|
(+ (input-field-x-size infl) 2)
|
|
(+ (input-field-y-size infl) 2))
|
|
(wmove screen y x)
|
|
(wrefresh screen))))
|
|
|
|
(define wdraw-box
|
|
(lambda (win x y dimx dimy)
|
|
(mvwaddstr win
|
|
y
|
|
x "+")
|
|
(mvwaddstr win
|
|
y
|
|
(+ dimx
|
|
(- x
|
|
1)) "+")
|
|
(mvwaddstr win
|
|
(+ dimy
|
|
(- y
|
|
1))
|
|
x "+")
|
|
(mvwaddstr win
|
|
(+ dimy
|
|
(- y
|
|
1))
|
|
(+ dimx
|
|
(- x
|
|
1)) "+")
|
|
(let loop-x ((dx (+ x 1)))
|
|
(if (= dx (+ x (- dimx 2)))
|
|
(begin
|
|
(mvwaddstr win y dx "-")
|
|
(mvwaddstr win (+ dimy
|
|
(- y
|
|
1)) dx "-"))
|
|
(begin
|
|
(mvwaddstr win y dx "-")
|
|
(mvwaddstr win (+ dimy
|
|
(- y
|
|
1)) dx "-")
|
|
(loop-x (+ dx 1)))))
|
|
(let loop-y ((dy (+ y 1)))
|
|
(if (= dy (+ y (- dimy 2)))
|
|
(begin
|
|
(mvwaddstr win dy x "|")
|
|
(mvwaddstr win dy (+ dimx
|
|
(- x
|
|
1)) "|"))
|
|
(begin
|
|
(mvwaddstr win dy x "|")
|
|
(mvwaddstr win dy (+ dimx
|
|
(- x
|
|
1)) "|")
|
|
(loop-y (+ dy 1)))))))
|