diff options
| -rw-r--r-- | color-repl.mu | 146 | ||||
| -rw-r--r-- | mu.arc | 52 | ||||
| -rw-r--r-- | x.rkt | 14 |
3 files changed, 208 insertions, 4 deletions
diff --git a/color-repl.mu b/color-repl.mu new file mode 100644 index 00000000..51ba263a --- /dev/null +++ b/color-repl.mu @@ -0,0 +1,146 @@ +; a simple line editor for reading lisp s-expressions + +(function read-sexp [ + (default-space:space-address <- new space:literal 30:literal) + (result:buffer-address <- init-buffer 30:literal) + (open-parens:integer <- copy 0:literal) + { begin + (c:character <- $wait-for-key-from-host) + ; handle backspace + ; todo: backspace into comment or string + { begin + (backspace?:boolean <- equal c:character ((#\backspace literal))) + (break-unless backspace?:boolean) + ($print-key-to-host c:character) + (len:integer-address <- get-address result:buffer-address/deref length:offset) + ; but only if we need to + { begin + (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal) + (break-if zero?:boolean) + (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) + } + (loop 2:blocks) + } + (result:buffer-address <- append result:buffer-address c:character) + ; parse comment + { begin + (comment?:boolean <- equal c:character ((#\; literal))) + (break-unless comment?:boolean) + ($print-key-to-host c:character 4:literal/fg/blue) + (skip-comment) + ; comment slurps newline, so check if we should return + (end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal) + (break-if end-sexp?:boolean 2:blocks) + (loop 2:blocks) + } + ; parse string + { begin + (string-started?:boolean <- equal c:character ((#\" literal))) ; for vim: " + (break-unless string-started?:boolean) + ($print-key-to-host c:character 6:literal/fg/cyan) + (slurp-string result:buffer-address) + (loop 2:blocks) + } + ; balance parens + { begin + (open-paren?:boolean <- equal c:character ((#\( literal))) + (break-unless open-paren?:boolean) + (_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal) + (color-code:integer <- add color-code:integer 1:literal) + ($print-key-to-host c:character color-code:integer) + (open-parens:integer <- add open-parens:integer 1:literal) + (loop 2:blocks) + } + { begin + (close-paren?:boolean <- equal c:character ((#\) literal))) + (break-unless close-paren?:boolean) + (open-parens:integer <- subtract open-parens:integer 1:literal) + (_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal) + (color-code:integer <- add color-code:integer 1:literal) + ($print-key-to-host c:character color-code:integer) + (loop 2:blocks) + } + { begin + (newline?:boolean <- equal c:character ((#\newline literal))) + (break-unless newline?:boolean) + ($print-key-to-host c:character) + (end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal) + (break-if end-sexp?:boolean 2:blocks) + (loop 2:blocks) + } + ($print-key-to-host c:character) + ; todo: error on space outside parens, like python + ; [] + ; don't return if there's no non-whitespace in result + (loop) + } + (s:string-address <- get result:buffer-address/deref data:offset) + (reply s:string-address) +]) + +(function skip-comment [ + (default-space:space-address <- new space:literal 30:literal) + { begin + (c:character <- $wait-for-key-from-host) + ($print-key-to-host c:character 4:literal/fg/blue) + ; handle backspace + ; todo: how to exit comment? + { begin + (backspace?:boolean <- equal c:character ((#\backspace literal))) + (break-unless backspace?:boolean) + (len:integer-address <- get-address result:buffer-address/deref length:offset) + ; but only if we need to + { begin + (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal) + (break-if zero?:boolean) + (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) + } + (loop 2:blocks) + } + (newline?:boolean <- equal c:character ((#\newline literal))) + (break-if newline?:boolean) + (loop) + } +]) + +(function slurp-string [ + (default-space:space-address <- new space:literal 30:literal) + (result:buffer-address <- next-input) + { begin + (c:character <- $wait-for-key-from-host) + ($print-key-to-host c:character 6:literal/fg/cyan) + ; handle backspace + ; todo: how to exit string? + { begin + (backspace?:boolean <- equal c:character ((#\backspace literal))) + (break-unless backspace?:boolean) + (len:integer-address <- get-address result:buffer-address/deref length:offset) + ; but only if we need to + { begin + (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal) + (break-if zero?:boolean) + (len:integer-address/deref <- subtract len:integer-address/deref 1:literal) + } + (loop 2:blocks) + } + (result:buffer-address <- append result:buffer-address c:character) + (end-quote?:boolean <- equal c:character ((#\" literal))) ; for vim: " + (break-if end-quote?:boolean) + (loop) + } +]) + +(function main [ + (default-space:space-address <- new space:literal 30:literal) + (cursor-mode) + { begin + (print-primitive-to-host (("anarki> " literal))) + (s:string-address <- read-sexp) + (retro-mode) ; print errors cleanly + (t:string-address <- $eval s:string-address) + (cursor-mode) + (print-string nil:literal/terminal t:string-address) + (print-character nil:literal/terminal ((#\newline literal))) + (loop) + } +]) diff --git a/mu.arc b/mu.arc index 14d23f95..5de3f75d 100644 --- a/mu.arc +++ b/mu.arc @@ -462,7 +462,13 @@ ($:require "charterm/main.rkt") ($:require graphics/graphics) +;? ($:require "terminal-color/terminal-color/main.rkt") ;? 1 (= Viewport nil) +; http://rosettacode.org/wiki/Terminal_control/Coloured_text#Racket +($:define (tput . xs) (system (apply ~a 'tput " " (add-between xs " "))) (void)) +($:define (foreground color) (tput 'setaf color)) +($:define (background color) (tput 'setab color)) +($:define (reset) (tput 'sgr0)) ; run instructions from 'routine*' for 'time-slice' (def run-for-time-slice (time-slice) @@ -769,10 +775,48 @@ $quit (quit) $wait-for-key-from-host - (if ($.current-charterm) - ($.charterm-read-key) - ($.graphics-open?) - ($.get-key-press Viewport)) + (when ($.current-charterm) + (ret result ($.charterm-read-key) + (case result + ; charterm exceptions + return + (= result #\newline) + backspace + (= result #\backspace) + ))) + $print-key-to-host + (do1 nil +;? (write (m arg.0)) (pr " => ") (prn (type (m arg.0))) + (if (no ($.current-charterm)) + (pr (m arg.0)) + (caselet x (m arg.0) + ; todo: test these exceptions + #\newline + ($.charterm-newline) + #\backspace + ; backspace doesn't clear after moving the cursor + (do ($.charterm-display #\backspace) + ($.charterm-display #\space) + ($.charterm-display #\backspace)) + ctrl-c + (do ($.close-charterm) + (die "interrupted")) + ;else + (if (len> arg 2) + (do + ($.foreground (m arg.1)) + ($.background (m arg.2)) + (pr x) + ($.reset)) + (len> arg 1) + (do + ($.foreground (m arg.1)) + (pr x) + ($.reset)) +;? (print-with-fg x (m arg.1)) ;? 1 + :else + ($.charterm-display x)))) + ) $eval (new-string:repr:eval:read:to-arc-string (m arg.0)) diff --git a/x.rkt b/x.rkt new file mode 100644 index 00000000..ef5ad28b --- /dev/null +++ b/x.rkt @@ -0,0 +1,14 @@ +(require "charterm/main.rkt") +(require "terminal-color/terminal-color/main.rkt") +(open-charterm) +(charterm-clear-screen) +(charterm-cursor 5 5) +(displayln-color "Hello" #:fg 'green) ; works +(charterm-cursor 25 5) +(displayln-color " Hello" #:fg 'green) ; works +;? ;? (charterm-cursor 1 6) ;? 2 +;? ;? (display-color "Hello" #:fg 'green) ; err: cursor moves to start of line ;? 1 +;? (charterm-newline) ; doesn't work after display; somehow runs before it ;? 1 +;? ;? (charterm-clear-line) ;? 3 +;? (displayln-color "World" #:fg 'green) ;? 1 +(close-charterm) |