summaryrefslogtreecommitdiff
path: root/world/ui.scm
diff options
context:
space:
mode:
Diffstat (limited to 'world/ui.scm')
-rw-r--r--world/ui.scm68
1 files changed, 58 insertions, 10 deletions
diff --git a/world/ui.scm b/world/ui.scm
index 757e7dd..73bfcc8 100644
--- a/world/ui.scm
+++ b/world/ui.scm
@@ -1,18 +1,66 @@
+;; TODO make this the only platform specific thing
+;; Should remember the latest screen to be able to only reprint differences
+
+(define terminal-size #f)
+(define current-port #f)
+(define scroll 0)
+
+(define (scroll-down)
+ (set! scroll (+ 3 scroll)))
+(define (scroll-up)
+ (set! scroll (- scroll 3))
+ (when (> 0 scroll) (set! scroll 0)))
+
+(define (get-terminal-size)
+ (get-terminal-dimensions current-port))
+
+(define (control c)
+ (integer->char (bitwise-and #b00011111 (char->integer c))))
+
+
+(define (redisplay! table)
+ ; TODO: This is currently utter slow!
+ "I need to remove the arguments from it... Probably call-with-window later"
+ (erase-screen!)
+ (for-each
+ (lambda (line-number)
+ (let ((line (piece-table-line table (+ line-number scroll))))
+ (move-cursor! 0 line-number)
+ (cond
+ ((eof-object? line)
+ (write-char #\~))
+ ((string? line)
+ (write-string line)))))
+ (iota (car terminal-size))))
+
(define (tui-loop)
- (define table (make-piece-table "hola"))
- (let loop ((char (read-char)))
- (move-cursor! 0 0)
- (cond
- ((char=? #\q char) #f)
- (else (piece-table-insert! table 4 "hola" 'normal)
- (erase-screen!)
- (write-string (piece-table->string table))
- (loop (read-char))))))
+ (define table (make-piece-table "hola\nhola"))
+ (redisplay! table)
+ (call/cc
+ (lambda (exit)
+ (let loop ((char (read-char)))
+ (cond
+ ; TODO: Assign characters and combinations symbolic names and
+ ; pass that to the core?
+ ((char=? (control #\q) char) (exit))
+ ((char=? (control #\d) char) (scroll-down))
+ ((char=? (control #\u) char) (scroll-up))
+ (else (piece-table-insert! table
+ (piece-table-text-length table)
+ (string char)
+ 'normal)))
+ (redisplay! table)
+ (loop (read-char))))))
(define (call-with-tui thunk)
(dynamic-wind
tui-initialize!
- (lambda () (with-raw-io (current-input-port) thunk))
+ (lambda ()
+ (call-with-input-file "/dev/tty"
+ (lambda (p)
+ (set! current-port p)
+ (set! terminal-size (get-terminal-size))
+ (with-raw-io p thunk))))
tui-deinitialize!))
(define (run arguments)