Setup initial architecture for testing
This commit is contained in:
parent
ae990b4784
commit
878eadd075
3 changed files with 32 additions and 34 deletions
|
@ -33,7 +33,8 @@
|
|||
(arguments
|
||||
(list
|
||||
(argument (name 'file)
|
||||
(test file-exists?)
|
||||
(default "")
|
||||
(test string?)
|
||||
(synopsis "The file to open")
|
||||
(example "./file.txt"))))
|
||||
(directory (in-home ".config/"))
|
||||
|
@ -44,27 +45,7 @@
|
|||
"(Listof String) -> Int
|
||||
program entrypoint; handle commandline args and call appropriate procedures"
|
||||
(define options (getopt-config-auto args %configuration))
|
||||
(display (full-command options))
|
||||
(newline)
|
||||
(init-screen)
|
||||
(let test-loop ()
|
||||
(let ((ch (getch screen))
|
||||
(yx (getyx screen)))
|
||||
(cond
|
||||
((eq? #\backspace ch) (begin
|
||||
(delch screen)))
|
||||
((eq? KEY_LEFT ch) (move screen (car yx) (- (cadr yx) 1)))
|
||||
((eq? KEY_RIGHT ch) (move screen (car yx) (+ (cadr yx) 1)))
|
||||
((eq? KEY_UP ch) (move screen (- (car yx) 1) (cadr yx)))
|
||||
((eq? KEY_DOWN ch) (move screen (+ (car yx) 1) (cadr yx)))
|
||||
((char? ch) (insert-char ch))))
|
||||
(test-loop))
|
||||
#;
|
||||
(match (full-command options) ;
|
||||
((_ file) ;
|
||||
(open file)) ;
|
||||
((_) ;
|
||||
(new-instance))))
|
||||
(core-loop))
|
||||
|
||||
;;; Local Variables:
|
||||
;;; mode: scheme
|
||||
|
|
|
@ -1,9 +1,28 @@
|
|||
(define-module (sloth editor)
|
||||
#:use-module (sloth interface)
|
||||
#:use-module (ncurses curses)
|
||||
#:use-module (ts)
|
||||
#:use-module (sloth interface)
|
||||
#:export (insert-char))
|
||||
#:export (core-loop))
|
||||
|
||||
(define (insert-char c)
|
||||
(addch screen (normal c))
|
||||
(refresh screen))
|
||||
(define* (core-loop #:optional (win (init-win)))
|
||||
(define y (getcury win))
|
||||
(define x (getcurx win))
|
||||
(define ch (getch win))
|
||||
(cond
|
||||
((eqv? ch KEY_BACKSPACE)
|
||||
(delch win #:y y #:x (- x 1)))
|
||||
((eqv? ch KEY_DC)
|
||||
(delch win))
|
||||
((eqv? ch KEY_LEFT)
|
||||
(move win y (- x 1)))
|
||||
((eqv? ch KEY_RIGHT)
|
||||
(move win y (+ x 1)))
|
||||
((eqv? ch KEY_UP)
|
||||
(move win (- y 1) x))
|
||||
((eqv? ch KEY_DOWN)
|
||||
(move win (+ y 1) x))
|
||||
((eqv? ch #\q)
|
||||
(endwin)
|
||||
(quit))
|
||||
(else (echochar win (normal ch))))
|
||||
(core-loop win))
|
||||
|
|
|
@ -1,12 +1,10 @@
|
|||
(define-module (sloth interface)
|
||||
#:use-module (ncurses curses)
|
||||
#:export (screen
|
||||
init-screen))
|
||||
#:export (init-win))
|
||||
|
||||
(define screen '())
|
||||
|
||||
(define (init-screen)
|
||||
(set! screen (initscr))
|
||||
(define (init-win)
|
||||
(define win (initscr))
|
||||
(raw!)
|
||||
(noecho!)
|
||||
(keypad! screen #t))
|
||||
(keypad! win #t)
|
||||
win)
|
||||
|
|
Loading…
Reference in a new issue