From: Tim Vaughan <tgvaughan@gmail.com>
Date: Wed, 22 Jun 2016 10:22:44 +0000 (+1200)
Subject: Small changes.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=bc4c866824b12208394e0ca8d6468ed8cd5c49a8;p=scheme.forth.jl.git

Small changes.

Turns out we need terminal input to be handled
directly by read.
---

diff --git a/scheme.4th b/scheme.4th
index 5ad37c6..8d9c97a 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -7,6 +7,7 @@ include term-colours.4th
 
 0 constant number-type
 1 constant boolean-type
+2 constant character-type
 : istype? ( obj -- obj b )
     over = ;
 
@@ -15,6 +16,12 @@ include term-colours.4th
 variable parse-idx
 variable dummy-parse-idx
 
+: inc-parse-idx
+    1 parse-idx +! ;
+
+: dec-parse-idx
+    1 parse-idx -! ;
+
 : store-parse-idx
     parse-idx @ dummy-parse-idx !  ;
 
@@ -50,7 +57,7 @@ variable parse-str
     begin
         whitespace?
     while
-            1 parse-idx +!
+        inc-parse-idx
     repeat
 ;
 
@@ -69,10 +76,10 @@ variable parse-str
     then
 
     store-parse-idx
-    1 parse-idx +!
+    inc-parse-idx
 
     begin digit? while
-        1 parse-idx +!
+        inc-parse-idx
     repeat
 
     delim? charavailable? false = or if
@@ -87,26 +94,42 @@ variable parse-str
 : boolean? ( -- bool )
     nextchar [char] # <> if false exit then
 
-    1 parse-idx +!
+    store-parse-idx
+    inc-parse-idx
 
     nextchar [char] t <>
     nextchar [char] f <>
-    and if 1 parse-idx -! false exit then
+    and if restore-parse-idx false exit then
 
-    1 parse-idx -!
+    restore-parse-idx
     true
 ;
 
+: character? ( -- bool )
+    nextchar [char] # <> if false exit then
+
+    store-parse-idx
+    inc-parse-idx
+
+    nextchar [char] \ <> if restore-parse-idx false exit then
+
+    inc-parse-idx
+
+    charavailable? false = if restore-parse-idx false exit then
+
+    restore-parse-idx true
+;
+
 : readnum ( -- num-atom )
     minus? dup if
-        1 parse-idx +!
+        inc-parse-idx
     then
 
     0
 
     begin digit? while
         10 * nextchar [char] 0 - +
-        1 parse-idx +!
+        inc-parse-idx
     repeat
 
     swap if negate then
@@ -115,7 +138,7 @@ variable parse-str
 ;
 
 : readbool ( -- bool-atom )
-    1 parse-idx +!
+    inc-parse-idx
     
     nextchar [char] f = if
         false
@@ -166,6 +189,7 @@ variable parse-str
 \ ---- Print ----
 
 : printnum ( numobj -- ) drop . ;
+
 : printbool ( numobj -- )
     drop if
         ." #t"
@@ -202,7 +226,7 @@ repl-buffer parse-str !
         getline
 
         eof? if
-            bold fg blue ." Moriturus te saluto." reset-term
+            cr bold fg blue ." Moriturus te saluto." reset-term
             exit
         then
 
diff --git a/term-colours.4th b/term-colours.4th
index 5c08a00..1852a20 100644
--- a/term-colours.4th
+++ b/term-colours.4th
@@ -10,19 +10,6 @@
     escape emit [char] 0 + emit escape-end
 ;
 
-: reset-term
-    escape [char] 0 emit escape-end
-;
-
-: clear-term
-    escape [char] 2 emit [char] J emit
-    escape [char] 0 emit [char] ; emit [char] 0 emit [char] f emit
-;
-
-: bold
-    escape [char] 1 emit escape-end
-;
-
 : colour
     create ,
 does>
@@ -39,8 +26,22 @@ does>
 6 colour cyan
 7 colour white
 
+: bold
+    escape [char] 1 emit escape-end
+;
+
+: reset-term
+    escape [char] 0 emit escape-end
+;
+
+: clear-term
+    escape [char] 2 emit [char] J emit
+    escape [char] 0 emit [char] ; emit [char] 0 emit [char] f emit
+;
+
 \ Example usage:
 \ fg red        ( set fg colour to red )
 \ bg green      ( set bg colour to green )
 \ bold          ( use a bold font )
 \ reset-term    ( return everything to normal )
+\ clear-term    ( clear terminal and return cursor to origin )