Adding interpret time conditionals and OLED.

2021-03-04 12:56:15 -08:00
parent d13dbac8bb
commit f2ffcae3f7
11 changed files with 221 additions and 27 deletions
--- a/ueforth/Makefile
+++ b/ueforth/Makefile
@ -121,7 +121,8 @@ see_all_test: $(POSIX)/ueforth
 $(GEN):
 	mkdir -p $@

-POSIX_BOOT =  common/boot.fs common/vocabulary.fs common/hide_calls.fs common/ansi.fs \
+POSIX_BOOT =  common/boot.fs common/conditionals.fs common/vocabulary.fs \
+              common/hide_calls.fs common/ansi.fs \
              posix/posix.fs posix/posix_highlevel.fs posix/termios.fs common/locals.fs \
              common/utils.fs common/highlevel.fs common/filetools.fs posix/posix_desktop.fs \
              common/tasks.fs common/streams.fs common/blocks.fs posix/autoboot.fs \
@ -129,7 +130,8 @@ POSIX_BOOT =  common/boot.fs common/vocabulary.fs common/hide_calls.fs common/an
 $(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
 	echo "ok" | cat $(POSIX_BOOT) - | $< boot $(VERSION) $(REVISION) >$@

-WINDOWS_BOOT = common/boot.fs common/vocabulary.fs common/hide_calls.fs common/ansi.fs \
+WINDOWS_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
+               common/hide_calls.fs common/ansi.fs \
               windows/windows.fs windows/windows_highlevel.fs common/highlevel.fs \
               common/utils.fs common/filetools.fs common/tasks.fs common/streams.fs \
               common/blocks.fs common/locals.fs \
@ -137,7 +139,7 @@ WINDOWS_BOOT = common/boot.fs common/vocabulary.fs common/hide_calls.fs common/a
 $(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN)
 	echo "ok" | cat $(WINDOWS_BOOT) - | $< boot $(VERSION) $(REVISION) >$@

-ARDUINO_BOOT = common/boot.fs common/vocabulary.fs \
+ARDUINO_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
               arduino/arduino.fs arduino/arduino_highlevel.fs \
               arduino/bindings.fs common/highlevel.fs \
               common/filetools.fs common/utils.fs common/locals.fs \
--- a/ueforth/arduino/arduino.template.ino
+++ b/ueforth/arduino/arduino.template.ino
@ -16,6 +16,13 @@
 #define ENABLE_SOCKETS_SUPPORT
 #define ENABLE_FREERTOS_SUPPORT

+// Uncomment this #define for OLED Support.
+// You will need to install these libraries from the Library Manager:
+//   Adafruit SSD1306
+//   Adafruit GFX Library
+//   Adafruit BusIO
+// #define ENABLE_OLED_SUPPORT
+
 // For now assume only boards with PSRAM (ESP32-CAM)
 // will want SerialBluetooth (very large) and camera support.
 // Other boards can support these if they're set to a larger
@ -119,6 +126,7 @@
  OPTIONAL_CAMERA_SUPPORT \
  OPTIONAL_SOCKETS_SUPPORT \
  OPTIONAL_FREERTOS_SUPPORT \
+  OPTIONAL_OLED_SUPPORT \

 #ifndef ENABLE_SPIFFS_SUPPORT
 // Provide a default failing SPIFFS.begin
@ -323,6 +331,38 @@ static cell_t FromIP(IPAddress ip) {
  X("WebServer.handleClient", WEBSERVER_HANDLE_CLIENT, ws0->handleClient(); DROP)
 #endif

+#ifndef ENABLE_OLED_SUPPORT
+# define OPTIONAL_OLED_SUPPORT
+#else
+#  include <Adafruit_GFX.h>
+#  include <Adafruit_SSD1306.h>
+static Adafruit_SSD1306 *oled_display = 0;
+# define OPTIONAL_OLED_SUPPORT \
+  Y(OledAddr, PUSH oled_display) \
+  Y(OledNew, oled_display = new Adafruit_SSD1306 display(n2, n1, &Wire, n0) DROPn(3)) \
+  Y(OledDelete, delete oled_display) \
+  Y(OledBegin, n0 = oled_display->begin(n1, n0); NIP) \
+  Y(OledHOME, oled_display->setCursor(0,0); DROP) \
+  Y(OledCLS, oled_display->clearDisplay()) \
+  Y(OledTextc, oled_display->setTextColor(n0); DROP) \
+  Y(OledPrintln, oled_display->println(c0); DROP) \
+  Y(OledNumln, oled_display->println(n0); DROP) \
+  Y(OledNum, oled_display->print(n0); DROP) \
+  Y(OledDisplay, oled_display->display()) \
+  Y(OledPrint, oled_display->write(c0); DROP) \
+  Y(OledInvert, oled_display->invertDisplay(n0); DROP) \
+  Y(OledTextsize, oled_display->setTextSize(n0); DROP) \
+  Y(OledSetCursor, oled_display->setCursor(n1,n0); DROPn(2)) \
+  Y(OledPixel, oled_display->drawPixel(n2, n1, n0); DROPn(2)) \
+  Y(OledDrawL, oled_display->drawLine(n4, n3, n2, n1, n0); DROPn(4)) \
+  Y(OledCirc, oled_display->drawCircle(n3,n2, n1, n0); DROPn(3)) \
+  Y(OledCircF, oled_display->fillCircle(n3, n2, n1, n0); DROPn(3)) \
+  Y(OledRect, oled_display->drawRect(n4, n3, n2, n1, n0); DROPn(4)) \
+  Y(OledRectF, oled_display->fillRect(n4, n3, n2, n1, n0); DROPn(3)) \
+  Y(OledRectR, oled_display->drawRoundRect(n5, n4, n3, n2, n1, n0); DROPn(5)) \
+  Y(OledRectRF, oled_display->fillRoundRect(n5, n4, n3, n2, n1, n0 ); DROPn(5))
+#endif
+
 static char filename[PATH_MAX];
 static String string_value;

--- a/ueforth/arduino/bindings.fs
+++ b/ueforth/arduino/bindings.fs
@ -86,26 +86,50 @@ transfer{
 16 constant sizeof(sockaddr_in)
 forth definitions

+DEFINED? SerialBT.new [IF]
 vocabulary bluetooth   bluetooth definitions
-?transfer SerialBT.new
-?transfer SerialBT.delete
-?transfer SerialBT.begin
-?transfer SerialBT.end
-?transfer SerialBT.available
-?transfer SerialBT.readBytes
-?transfer SerialBT.write
-?transfer SerialBT.flush
-?transfer SerialBT.hasClient
-?transfer SerialBT.enableSSP
-?transfer SerialBT.setPin
-?transfer SerialBT.unpairDevice
-?transfer SerialBT.connect
-?transfer SerialBT.connectAddr
-?transfer SerialBT.disconnect
-?transfer SerialBT.connected
-?transfer SerialBT.isReady
-?transfer esp_bt_dev_get_address
+transfer{
+  SerialBT.new SerialBT.delete SerialBT.begin SerialBT.end
+  SerialBT.available SerialBT.readBytes SerialBT.write
+  SerialBT.flush SerialBT.hasClient
+  SerialBT.enableSSP SerialBT.setPin SerialBT.unpairDevice
+  SerialBT.connect SerialBT.connectAddr SerialBT.disconnect SerialBT.connected
+  SerialBT.isReady esp_bt_dev_get_address
+}transfer
 forth definitions
+[THEN]
+
+DEFINED? OledNew [IF]
+vocabulary oled   oled definitions
+transfer{
+  OledNew OledDelete
+  OledHOME OledCLS
+  OledTextc OledPrintln OledNumln OledNum
+  OledDisplay OledPrint
+  OledInvert OledTextsize OledSetCursor
+  OledPixel OledDrawL OledCirc OledCircF
+  OledRect OledRectF OledRectR OledRectrf
+}transfer
+
+128 constant width
+64 constant height
+-1 constant OledReset
+0 constant BLACK
+1 constant WHITE
+1 constant SSD1306_EXTERNALVCC
+2 constant SSD1306_SWITCHCAPVCC
+: OledInit
+  OledAddr @ 0= if
+    OledNew SSD1306_SWITCHCAPVCC $3C OledBegin drop
+  then
+  OledCLS
+  2 OledTextsize  ( Draw 2x Scale Text )
+  WHITE OledTextc  ( Draw white text )
+  0 0 OledSetCursor  ( Start at top-left corner )
+  z" *Esp32forth*" OledPrintln OledDisplay
+;
+forth definitions
+[THEN]

 internals definitions
 transfer{
--- a/ueforth/arduino/esp_camera.fs
+++ b/ueforth/arduino/esp_camera.fs
@ -1,12 +1,14 @@
 ( Handling for ESP32-CAM )

+DEFINED? esp_camera_init [IF]
+
 vocabulary camera   camera definitions

-?transfer esp_camera_init
-?transfer esp_camera_deinit
-?transfer esp_camera_fb_get
-?transfer esp_camera_fb_return
-?transfer esp_camera_sensor_get
+transfer{
+  esp_camera_init esp_camera_deinit
+  esp_camera_fb_get esp_camera_fb_return
+  esp_camera_sensor_get
+}transfer

 0 constant PIXFORMAT_RGB565
 1 constant PIXFORMAT_YUV422
@ -38,3 +40,5 @@ constant camera-fb-count
 constant camera-format

 forth definitions
+
+[THEN]
--- a/ueforth/common/all_tests.fs
+++ b/ueforth/common/all_tests.fs
@ -5,4 +5,5 @@ include common/utils_tests.fs
 include common/vocabulary_tests.fs
 include common/locals_tests.fs
 include common/doloop_tests.fs
+include common/conditionals_tests.fs
 run-tests
--- a/ueforth/common/conditionals.fs
+++ b/ueforth/common/conditionals.fs
@ -0,0 +1,12 @@
+( Interpret time conditionals )
+
+: DEFINED? ( "name" -- xt|0 )
+   bl parse find state @ if aliteral then ; immediate
+defer [SKIP]
+: [THEN] ;   : [ELSE] [SKIP] ;   : [IF] 0= if [SKIP] then ;
+: [SKIP]' 0 begin postpone defined? dup if
+    dup ['] [IF] = if swap 1+ swap then
+    dup ['] [ELSE] = if swap dup 0 <= if 2drop exit then swap then
+    dup ['] [THEN] = if swap 1- dup 0< if 2drop exit then swap then
+  then drop again ;
+' [SKIP]' is [SKIP]
--- a/ueforth/common/conditionals_tests.fs
+++ b/ueforth/common/conditionals_tests.fs
@ -0,0 +1,66 @@
+( Interpret time conditionals )
+
+e: test-1[if]
+  1 [IF]
+    : test ." hi" cr ;
+  [THEN]
+  test
+  out: hi
+;e
+
+e: test-0[if]
+  : test ." initial" cr ;
+  0 [IF]
+    : test ." hi" cr ;
+  [THEN]
+  test
+  out: initial
+;e
+
+e: test-1[if][else]
+  1 [IF]
+    : test ." hi" cr ;
+  [ELSE]
+    : test ." there" cr ;
+  [THEN]
+  test
+  out: hi
+;e
+
+e: test-0[if][else]
+  0 [IF]
+    : test ." hi" cr ;
+  [ELSE]
+    : test ." there" cr ;
+  [THEN]
+  test
+  out: there
+;e
+
+e: test-1[if]-nesting
+  1 [IF]
+    : test ." foo" cr ;
+  [ELSE]
+    1 [IF]
+      : test ." bar" cr ;
+    [ELSE]
+      : test ." baz" cr ;
+    [THEN]
+  [THEN]
+  test
+  out: foo
+;e
+
+e: test-0[if]-nesting
+  0 [IF]
+    1 [IF]
+      : test ." foo" cr ;
+    [ELSE]
+      : test ." bar" cr ;
+    [THEN]
+  [ELSE]
+    : test ." baz" cr ;
+  [THEN]
+  test
+  out: baz
+;e
--- a/ueforth/common/vocabulary.fs
+++ b/ueforth/common/vocabulary.fs
@ -11,7 +11,6 @@ current @ constant forth-wordlist
 : xt-hide ( xt -- ) xt-find& dup @ >link swap ! ;
 : xt-transfer ( xt --  ) dup xt-hide   current @ @ over >link& !   current @ ! ;
 : transfer ( "name" ) ' xt-transfer ;
-: ?transfer ( "name" ) bl parse find dup if xt-transfer else drop then ;
 : }transfer ;
 : transfer{ begin ' dup ['] }transfer = if drop exit then xt-transfer again ;

@ -40,6 +39,7 @@ transfer{
  (do) (?do) (+loop)
  parse-quote digit $@ raw.s
  tib-setup input-limit
+  [SKIP] [SKIP]'
 }transfer
 forth definitions

--- a/ueforth/site/ESP32forth.html
+++ b/ueforth/site/ESP32forth.html
@ -134,6 +134,7 @@ VLIST ( -- ) List the words in the context vocabulary (not chains)
 WORDS ( -- ) List the words in the context vocabulary (including chains)
 TRANSFER ( "name" ) Move a word from its current dictionary to the current vocabulary
                    Useful for "hiding" built-in words
+TRANSFER{ ..words.. }TRANSFER ( -- ) Transfer multiple words to the current vocabulary
 ALSO ( -- ) Duplicate the vocabulary at the top of the vocabulary stack
 ONLY ( -- ) Reset context stack to one item, the FORTH dictionary
            Non-standard, as there's no distinct ONLY vocabulary
@ -141,6 +142,20 @@ ORDER ( -- ) Print the vocabulary search order
 SEALED ( -- ) Alter the last vocabulary defined so it doesn't chain
 </pre>

+<h5>Interpret Time Conditions</h5>
+<p>
+<code>[I]F</code>, <code>[ELSE]</code>, and <code>[THEN]</code> can be used
+to selectively compile. Used in tandem with <code>DEFINED?</code> they can
+be used to handle the absence of modules gracefully.
+Nesting is supported.
+</p>
+<pre>
+DEFINED? ( "name" -- xt|0 ) Check if a word exists (works at compile time too).
+[IF] ( f -- ) Conditionally interpret the text the follows.
+[ELSE] ( -- ) Interpret time ELSE.
+[THEN] ( -- ) Interpret time THEN.
+</pre>
+
 <h5>Blocks</h5>
 <pre>
 USE ( "name" -- ) Use "name" as the blockfile, e.g. USE /spiffs/foo
--- a/ueforth/site/linux.html
+++ b/ueforth/site/linux.html
@ -83,6 +83,7 @@ VLIST ( -- ) List the words in the context vocabulary (not chains)
 WORDS ( -- ) List the words in the context vocabulary (including chains)
 TRANSFER ( "name" ) Move a word from its current dictionary to the current vocabulary
                    Useful for "hiding" built-in words
+TRANSFER{ ..words.. }TRANSFER ( -- ) Transfer multiple words to the current vocabulary
 ALSO ( -- ) Duplicate the vocabulary at the top of the vocabulary stack
 ONLY ( -- ) Reset context stack to one item, the FORTH dictionary
            Non-standard, as there's no distinct ONLY vocabulary
@ -90,6 +91,20 @@ ORDER ( -- ) Print the vocabulary search order
 SEALED ( -- ) Alter the last vocabulary defined so it doesn't chain
 </pre>

+<h5>Interpret Time Conditions</h5>
+<p>
+<code>[I]F</code>, <code>[ELSE]</code>, and <code>[THEN]</code> can be used
+to selectively compile. Used in tandem with <code>DEFINED?</code> they can
+be used to handle the absence of modules gracefully.
+Nesting is supported.
+</p>
+<pre>
+DEFINED? ( "name" -- xt|0 ) Check if a word exists (works at compile time too).
+[IF] ( f -- ) Conditionally interpret the text the follows.
+[ELSE] ( -- ) Interpret time ELSE.
+[THEN] ( -- ) Interpret time THEN.
+</pre>
+
 <h5>Blocks</h5>
 <pre>
 USE ( "name" -- ) Use "name" as the blockfile, e.g. USE /spiffs/foo
--- a/ueforth/site/windows.html
+++ b/ueforth/site/windows.html
@ -89,6 +89,7 @@ VLIST ( -- ) List the words in the context vocabulary (not chains)
 WORDS ( -- ) List the words in the context vocabulary (including chains)
 TRANSFER ( "name" ) Move a word from its current dictionary to the current vocabulary
                    Useful for "hiding" built-in words
+TRANSFER{ ..words.. }TRANSFER ( -- ) Transfer multiple words to the current vocabulary
 ALSO ( -- ) Duplicate the vocabulary at the top of the vocabulary stack
 ONLY ( -- ) Reset context stack to one item, the FORTH dictionary
            Non-standard, as there's no distinct ONLY vocabulary
@ -96,6 +97,20 @@ ORDER ( -- ) Print the vocabulary search order
 SEALED ( -- ) Alter the last vocabulary defined so it doesn't chain
 </pre>

+<h5>Interpret Time Conditions</h5>
+<p>
+<code>[I]F</code>, <code>[ELSE]</code>, and <code>[THEN]</code> can be used
+to selectively compile. Used in tandem with <code>DEFINED?</code> they can
+be used to handle the absence of modules gracefully.
+Nesting is supported.
+</p>
+<pre>
+DEFINED? ( "name" -- xt|0 ) Check if a word exists (works at compile time too).
+[IF] ( f -- ) Conditionally interpret the text the follows.
+[ELSE] ( -- ) Interpret time ELSE.
+[THEN] ( -- ) Interpret time THEN.
+</pre>
+
 <h5>Blocks</h5>
 <pre>
 USE ( "name" -- ) Use "name" as the blockfile, e.g. USE /spiffs/foo