64 lines
1.7 KiB
Scheme
64 lines
1.7 KiB
Scheme
(define-module (sloth editor)
|
|
#:use-module (sloth interface)
|
|
#:use-module (ncurses curses)
|
|
#:use-module (ts)
|
|
#:use-module (ice-9 textual-ports)
|
|
#:export (start-loop))
|
|
|
|
(define modes '(#:normal-mode #:insert-mode))
|
|
|
|
(define* (start-loop #:key (win (init-win))
|
|
(file #f))
|
|
(if file (find-file win file))
|
|
(core-loop win))
|
|
|
|
(define* (core-loop win #:optional (mode #:normal-mode))
|
|
(define process-result
|
|
(case mode
|
|
((#:normal-mode) (normal-mode-process-input win (getch win)))
|
|
((#:insert-mode) (insert-mode-process-input win (getch win)))))
|
|
(if (memq process-result modes)
|
|
(core-loop win process-result)
|
|
(core-loop win mode)))
|
|
|
|
(define (insert-mode-process-input win key)
|
|
(define y (getcury win))
|
|
(define x (getcurx win))
|
|
(cond
|
|
((eqv? key KEY_BACKSPACE)
|
|
(delch win #:y y #:x (- x 1)))
|
|
((eqv? key KEY_DC)
|
|
(delch win))
|
|
((eqv? key KEY_LEFT)
|
|
(move win y (- x 1)))
|
|
((eqv? key KEY_RIGHT)
|
|
(move win y (+ x 1)))
|
|
((eqv? key KEY_UP)
|
|
(move win (- y 1) x))
|
|
((eqv? key KEY_DOWN)
|
|
(move win (+ y 1) x))
|
|
((eqv? key #\esc) #:normal-mode)
|
|
(else (insch win (normal key) #:y y #:x (+ x 1)))))
|
|
|
|
(define (normal-mode-process-input win key)
|
|
(define y (getcury win))
|
|
(define x (getcurx win))
|
|
(cond
|
|
((eqv? key KEY_LEFT)
|
|
(move win y (- x 1)))
|
|
((eqv? key KEY_RIGHT)
|
|
(move win y (+ x 1)))
|
|
((eqv? key KEY_UP)
|
|
(move win (- y 1) x))
|
|
((eqv? key KEY_DOWN)
|
|
(move win (+ y 1) x))
|
|
((eqv? key #\i) #:insert-mode)
|
|
((eqv? key #\q)
|
|
(endwin)
|
|
(quit))))
|
|
|
|
(define (find-file win file)
|
|
(when (file-exists? file)
|
|
(addstr win (call-with-input-file file get-string-all))
|
|
(refresh win)))
|