Index



Games

2048_game.fth This is the game " 2048 ". I copied it from Rosetta Code and ported it to My4TH. The program is too long to print its screens here. Use the my4th tool to upload the file to your My4TH board. Instructions are included in the file.


Tools

Detect I2C devices

This little tool (more like a one-liner) shows the addresses of all connected I2C devices:

: i2c-detect
    base @ hex cr 127 1 do i 2* i2c-start 2 ms i2c-stop
    if i 2* . then loop cr base ! ;

i2c-detect

Copy blocks in the EEPROM

My4TH has no built-in tool to copy (or move) blocks in the EEPROM.
You can define the word "cp" which allows you to copy blocks:

1024 buffer: bbuf

: cp  ( src dst -- )
  swap block
  bbuf 1024 move
  buffer
  bbuf swap 1024 move
  update flush
;

The following is a special version of the word "cp" that only works on My4TH.
It takes advantage of the fact that My4TH has only a single block buffer:

: cp ( src dst -- )  swap block drop buffer drop update flush ;


Driver Screens for Adafruit STEMMA QT Boards

Driver for the Adafruit AW9523 GPIO board:

----[001]-------------------------------------------------------
\ Driver for Adafruit AW9523 GPIO expander board by D. Kuschel.
\
\ You must initialize the board before you can use it. To do so,
\ call B0 IOINIT once (B0 is the hex I2C address of your board).
\ Hint:Switch to hex mode before using these words(it's easier!)
\
\ IOINIT ( addr -- )   initialize the IO port expander
\ IOCFG ( value -- )   configure pins for input(1) or output(0)
\                      with a 16-bit value (one bit per pin)
\ IOSET ( value -- )   set output port to a 16-bit value
\ IOGET ( -- value )   read actual state of all pins
\ IOHI  ( bit -- )     set an output-pin to hi-state (bit=0-15)
\ IOLO  ( bit -- )     set an output-pin to lo-state (bit=0-15)
\ IOLED ( value -- )   configure pins for LED(1) or GPIO mode(0)
\                      with a 16-bit value (one bit per pin)
\ IODIM ( led dim -- ) set LED dimming value (LED=0-15)
----[002]-------------------------------------------------------
base @ hex  0 value expa  0 value expp  \ Driver for AW9523
: _ioreg expa i2c-start drop i2c-send drop ; : _iosnd2 _ioreg
  dup i2c-send drop 8 rshift i2c-send drop i2c-stop ;
: _iord1 _ioreg expa 1+ i2c-start drop 1 i2c-recv i2c-stop ;
: IOSET ( value -- )   dup to expp 2 _iosnd2 ;
: IOGET ( -- value )   0 _iord1 1 _iord1 8 lshift or ;
: IOHI  ( bit -- )     1 swap lshift expp or IOSET ;
: IOLO  ( bit -- )     1 swap lshift invert expp and IOSET ;
: IOLED invert 12 _iosnd2 ; : IODIM swap dup 8 < if 24 else dup
  C < if 18 else 20 then then + _ioreg i2c-send drop i2c-stop ;
: IOCFG ( value -- )   4 _iosnd2 ;
: IOINIT ( I2Caddr -- )  to expa 11 _ioreg 13 i2c-send drop
  i2c-stop 0 IOLED 0 IOSET 0 IOCFG ;
\ Example 1, switch GPIO 5 high:   B0 IOINIT 0000 IOCFG 5 IOHI
\ Example 2, read all 16 inputs:   B0 IOINIT FFFF IOCFG IOGET u.
base !  \ Note: The examples work only in hex mode, so set HEX
----[EOF]-------------------------------------------------------

Driver for the Adafruit MCP23017 GPIO board:

----[001]-------------------------------------------------------
\ Driver for Adafruit MCP23017 GPIO expander board by D.Kuschel.
\
\ You must initialize the board before you can use it. To do so,
\ call 40 IOINIT once (40 is the hex I2C address of your board).
\ Hint:
\   Switch to hex mode before using these words (it's easier!)
\
\ IOINIT ( addr -- )   initialize the IO port expander
\
\ IOCFG ( value -- )   configure pins for input(1) or output(0)
\                      with a 16-bit value (one bit per pin)
\
\ IOSET ( value -- )   set output port to a 16-bit value
\ IOGET ( -- value )   read actual state of all pins
\ IOHI  ( bit -- )     set an output-pin to hi-state (bit=0-15)
\ IOLO  ( bit -- )     set an output-pin to lo-state (bit=0-15)
----[002]-------------------------------------------------------
\ Driver for Adafruit MCP23017 GPIO expander board by D.Kuschel.
base @ hex  0 value expa  0 value expp
: _ioreg expa i2c-start drop i2c-send drop ; : _iosnd2 _ioreg
  dup i2c-send drop 8 rshift i2c-send drop i2c-stop ;
: IOSET ( value -- )   dup to expp 14 _iosnd2 ;
: IOGET ( -- value )   12 _ioreg expa 1+ i2c-start drop
  0 i2c-recv 1 i2c-recv i2c-stop 8 lshift or ;
: IOHI  ( bit -- )     1 swap lshift expp or IOSET ;
: IOLO  ( bit -- )     1 swap lshift invert expp and IOSET ;
: IOCFG ( value -- )   0 _iosnd2 ;
: IOINIT ( I2Caddr -- )   \ enable pull-ups, set all to input
  to expa FFFF C _iosnd2 FFFF IOCFG 0 IOSET ;

\ Example 1, switch GPIO 5 high:   40 IOINIT 0000 IOCFG 5 IOHI
\ Example 2, read all 16 inputs:   40 IOINIT FFFF IOCFG IOGET u.
base !  \ Note: The examples work only in hex mode, so set HEX
----[EOF]-------------------------------------------------------

Driver for the Adafruit PCF8574 GPIO board:

----[001]-------------------------------------------------------
\ Driver for Adafruit PCF8574 GPIO expander board by D. Kuschel.
\
\ You must initialize the board before you can use it. To do so,
\ call 40 IOINIT once (40 is the hex I2C address of your board).
\ Hint:
\   Switch to hex mode before using these words (it's easier!)
\
\ IOINIT ( addr -- )   initialize the IO port expander
\
\ IOCFG ( value -- )   configure pins for input(1) or output(0)
\                      with a 8-bit value (one bit per pin)
\
\ IOSET ( value -- )   set output port to a 8-bit value
\ IOGET ( -- value )   read actual state of all pins
\ IOHI  ( bit -- )     set an output-pin to hi-state (bit=0-7)
\ IOLO  ( bit -- )     set an output-pin to lo-state (bit=0-7)
----[002]-------------------------------------------------------
\ Driver for Adafruit PCF8574 GPIO expander board by D. Kuschel.
base @ hex
0 value expa  0 value expp
: IOSET ( value -- )   dup to expp expa i2c-start drop 
                       i2c-send drop i2c-stop ;
: IOGET ( -- value )   expa 1+ i2c-start drop
                       1 i2c-recv i2c-stop ;
: IOHI  ( bit -- )     1 swap lshift expp or IOSET ;
: IOLO  ( bit -- )     1 swap lshift invert expp and IOSET ;
: IOCFG ( value -- )   IOSET ;
: IOINIT ( I2Caddr -- )
  to expa FF IOSET ;   \ set all pins to input with pull-up on

\ Example 1, switch GPIO 5 high:   40 IOINIT 00 IOCFG 5 IOHI
\ Example 2, read all 8 inputs:    40 IOINIT FF IOCFG IOGET u.
base !  \ Note: The examples work only in hex mode, so set HEX
----[EOF]-------------------------------------------------------

Driver for the Adafruit PCF8575 GPIO board:

----[001]-------------------------------------------------------
\ Driver for Adafruit PCF8575 GPIO expander board by D. Kuschel.
\
\ You must initialize the board before you can use it. To do so,
\ call 40 IOINIT once (40 is the hex I2C address of your board).
\ Hint:
\   Switch to hex mode before using these words (it's easier!)
\
\ IOINIT ( addr -- )   initialize the IO port expander
\
\ IOCFG ( value -- )   configure pins for input(1) or output(0)
\                      with a 16-bit value (one bit per pin)
\
\ IOSET ( value -- )   set output port to a 16-bit value
\ IOGET ( -- value )   read actual state of all pins
\ IOHI  ( bit -- )     set an output-pin to hi-state (bit=0-15)
\ IOLO  ( bit -- )     set an output-pin to lo-state (bit=0-15)
----[002]-------------------------------------------------------
\ Driver for Adafruit PCF8575 GPIO expander board by D. Kuschel.
base @ hex
0 value expa 0 value expp
: IOSET ( value -- )
  dup to expp expa i2c-start drop dup i2c-send drop 8 rshift
  i2c-send drop i2c-stop ;
: IOGET ( -- value )    expa 1+ i2c-start drop 0 i2c-recv
  1 i2c-recv i2c-stop 8 lshift or ;
: IOHI  ( bit -- )      1 swap lshift expp or IOSET ;
: IOLO  ( bit -- )      1 swap lshift invert expp and IOSET ;
: IOCFG ( value -- )    IOSET ;
: IOINIT ( I2Caddr -- ) to expa FFFF IOSET ;

\ Example 1, switch GPIO 5 high:   40 IOINIT 00 IOCFG 5 IOHI
\ Example 2, read all 8 inputs:    40 IOINIT FF IOCFG IOGET u.
base !  \ Note: The examples work only in hex mode, so set HEX
----[EOF]-------------------------------------------------------

Driver for the Adafruit PCF8591 8-bit ADC/DAC Board:

----[001]-------------------------------------------------------
\ Driver for the Adafruit PCF8591 ADC/DAC board by D. Kuschel.
\ Call "90 ADCINIT" first to set the I2C-address of your board.
\ Hint: Switch to HEX mode before calling ADCINIT, its easier!

base @ hex  0 value adca
: _adcr ( cfg -- value ) adca i2c-start drop i2c-send drop
  adca 1+ i2c-start 0 i2c-recv drop 1 i2c-recv i2c-stop ;

: DACOUT ( value -- )  \ set DAC output to a new value (0-255)
  adca i2c-start drop 40 i2c-send drop i2c-send drop i2c-stop ;

: ADCIN ( adc -- val ) 40 or _adcr ;  \ read ADC input (adc=0-3)
: ADCIN01 ( -- value ) 70 _adcr    ;  \ read diff.input ch0-ch1
: ADCIN23 ( -- value ) 71 _adcr    ;  \ read diff.input ch2-ch3
: ADCINIT ( addr -- ) to adca 0 DACOUT ;  \ initialize PCF8591
base !
----[EOF]-------------------------------------------------------

Driver for the Adafruit HTU31D Temperature & Humidity Sensor Board:

----[001]-------------------------------------------------------
\ Driver for the Adafruit HTU31 sensor board.
\
\ Use the word HTU31 to read the sensor. The word HTU31
\ pushes two integer values onto the stack:
\   - humidity with resolution 0.1 %
\   - temperature with resolution 0.1 deg.C

base @ hex
: HTU31 ( -- humidity temperature )  ( returns values * 10 )
  80 i2c-start drop 40 i2c-send drop i2c-stop 2 msec
  80 i2c-start drop 0 i2c-send drop i2c-stop
  81 i2c-start if 0 i2c-recv 8 lshift 0 i2c-recv or
   0 i2c-recv drop 0 i2c-recv 8 lshift 1 i2c-recv or i2c-stop
   1 rshift 3E8 7FFF */ swap 2/ 2/ 4 + 672 3FFF */ 190 - 
   else i2c-stop 0 0 then ;
base !
----[EOF]-------------------------------------------------------

Driver for the Adafruit LPS25 Pressure Sensor Board:

----[001]-------------------------------------------------------
\ Driver for the Adafruit LPS25 sensor board.
\ Use the word LPS25 to read the sensor.

base @ hex  0 value vLPSi  0 value vLPSt  0 value vLPSp
: LPSW ( addrDataWord -- )    BA i2c-start drop dup
  8 rshift i2c-send drop i2c-send drop i2c-stop ;
: LPSR ( addr -- value ack )  BA i2c-start drop i2c-send drop
  i2c-stop BB i2c-start 1 i2c-recv i2c-stop swap ;
: LPSI ( -- )  vLPSi 0= if 2094 dup LPSW LPSW 1 to vLPSi then ;
: LPS25 ( -- preasure temp ) ( resolution 0.1 hPa / 0.1 deg.C )
  LPSI 27 LPSR if 3 and 3 = else drop 0 to vLPSi 0 to vLPSt
  0 to vLPSp false then if
  29 LPSR drop 2A LPSR drop 8 lshift or A 10 */ dup to vLPSp
  2B LPSR drop 2C LPSR drop 8 lshift or 30 / 1A9 + dup to vLPSt
  else vLPSp vLPSt then ;
base !
----[EOF]-------------------------------------------------------

Driver for the Adafruit PCF8523 RTC board:

----[001]-------------------------------------------------------
\ Driver for the Adafruit PCF8523 RTC board:
\   Use SETTIME / GETTIME to set or get the time.
\   Use SETDATE / GETDATE to set or get the date.
\   Use .TIME / .DATE to print out the time and date.
\ This driver defines also the TIME&DATE word, which is part of
\ the optional Facility word set of the Forth 2012 standard.
base @ hex
: RTCA ( ack -- )
  0= if space ." RTC Error" cr quit then ;
: RTCW ( n-bytes count -- )
  D0 i2c-start RTCA 0 do i2c-send drop loop i2c-stop ;
: RTCR ( count addr -- n-bytes )
  D0 i2c-start RTCA i2c-send drop i2c-stop D1 i2c-start drop
  1 do 0 i2c-recv loop 1 i2c-recv i2c-stop ;
: 2BCD ( dec -- bcd )
  0 begin over 9 > while 10 + swap A - swap repeat + ;
----[002]-------------------------------------------------------
: BCD2 ( bcd -- dec )
  0 begin over 9 > while A + swap 10 - swap repeat + ;
: SETTIME ( hour min sec -- )
  rot 2BCD rot 2BCD rot 2BCD 0 0 0 0 7 RTCW ;
: GETTIME ( -- sec min hour )
  3 3 RTCR rot BCD2 rot BCD2 rot BCD2 ;
: SETDATE ( year month day -- )
  rot 64 mod 2BCD rot 2BCD rot 2BCD 0 swap 6 5 RTCW ;
: GETDATE ( -- year month day )
  4 6 RTCR rot drop BCD2 rot BCD2 rot BCD2 rot 7D0 + ;
: TIME&DATE ( -- sec min hour day month year )
  GETTIME GETDATE ROT SWAP -ROT ;
: U2. s>d <# # # #> type ;  : U4. s>d <# # # # # #> type ;
: .TIME GETTIME U2. [char] : emit U2. [char] . emit U2. space ;
: .DATE GETDATE U4. [char] - emit U2. [char] - emit U2. space ;
base !
----[EOF]-------------------------------------------------------

Driver for I2C-driven LCD displays (16x2 characters with PCF8574):

----[001]-------------------------------------------------------
\ Driver for 16x2 I2C LCD display
\ lcda: display address (4E) lcdl: display light (8 on | 0 off)
\ lcd-cmd to send LCD command
\ lcd-??d-p/p1/p2 to send a character --p1/p2 first/second line?
base @ hex 4e value lcda 8 value lcdl
: i2c-w lcda i2c-start drop lcdl or i2c-send drop i2c-stop ;
: lcd-w or dup i2c-w dup 4 or i2c-w FB and i2c-w ;
: lcd-cmd ( byte -- )
 dup F0 and 0 lcd-w 4 lshift F0 and 0 lcd-w ;
: lcd-ch   ( byte -- )
 dup F0 and 1 lcd-w 4 lshift F0 and 1 lcd-w ;
6 1 C 28 2 3 3 3 0 i2c-w : init 8 0 do lcd-cmd loop ; init
: lcd-on 8 to lcdl 0 lcd-cmd ; : lcd-off 0 to lcdl 0 lcd-cmd ;
: lcd-p 1 - begin swap dup c@ lcd-ch 1+  swap 1- dup 0< until ;
: lcd-p1 80  lcd-cmd lcd-p ; : lcd-p2 c0  lcd-cmd lcd-p ; base !
 s" Hello World" lcd-p
----[EOF]-------------------------------------------------------

Enhanced driver for I2C-driven LCD displays (by Niels Haedecke):

----[001]-------------------------------------------------------
\ Enh. Hitachi 4x20 LCD HD44780 I2C driver, LCD at  addr. (4E)
\ lcdl: display light (8 on | 0 off)    lcda: I2C address of LCD
\ lcd-cmd to send LCD command
\ lcd-p1...p4 to send a character to: p1...p4 first/last row

base @ hex
4e value lcda 8 value lcdl
: i2c-w lcda i2c-start drop lcdl or i2c-send drop i2c-stop ;
: lcd-w or dup i2c-w dup 4 or i2c-w FB and i2c-w ;
: lcd-cmd ( byte -- )
 dup F0 and 0 lcd-w 4 lshift F0 and 0 lcd-w ;
: lcd-ch   ( byte -- )
 dup F0 and 1 lcd-w 4 lshift F0 and 1 lcd-w ;
6 1 C 28 2 3 3 3 0 i2c-w : init 8 0 do lcd-cmd loop ; init
----[002]-------------------------------------------------------
\ Enh. 4x20 HD44780 LCD I2C driver, LCD at  addr. 4E (continued)

: lcd-on 8 to lcdl 0 lcd-cmd ; : lcd-off 0 to lcdl 0 lcd-cmd ;
: lcd-p 1 - begin swap dup c@ lcd-ch 1+  swap 1- dup 0< until
 2drop ;
: lcd-p1 80  lcd-cmd lcd-p ; : lcd-p2 c0  lcd-cmd lcd-p ;
: lcd-p4 d4  lcd-cmd lcd-p ; : lcd-p3 94  lcd-cmd lcd-p ;

: lcd-xf ( char -- ) 14 0 do dup lcd-ch loop ; \ x-fill row loop
: lcd-xfill ( char -- ) 80 lcd-cmd  \ fill LCD left-to-right
lcd-xf c0 lcd-cmd lcd-xf 94 lcd-cmd \ with 'char' (ASCII value)
lcd-xf d4 lcd-cmd lcd-xf drop ;
: lcd-clr 20 lcd-xfill ; \ clear LCD left-to-right (fast)

s" My4TH I2C LCD driver" lcd-p
----[003]-------------------------------------------------------
\ 4x20 LCD HD44780 I2C driver, display at  addr. 4E (continued)
variable lcd-pos 80 lcd-pos ! \ lcd-pos: current column pos.

: lcd-row dup 0= if 0 lcd-pos @ + else \ select LCD row (0-3)
dup 1 = if 40 lcd-pos @ + else
dup 2 = if 14 lcd-pos @ + else
dup 3 = if 54 lcd-pos @ + else
abort" lcd-row: *error* " then then then then lcd-cmd drop ;

: lcd-xy ( col row -- ) \ select LCD col. / row (0-17/0-3)
swap lcd-pos @ + dup lcd-cmd lcd-pos ! lcd-row 80 lcd-pos ! ;

decimal
: lcd-yfill ( char -- ) 20 0 do 4 0 do j i \ fill LCD top-down
lcd-xy dup lcd-ch loop loop drop ;         \ with char (slow)
base !
----[EOF]-------------------------------------------------------

Driver for the RGB LCD v4 from SeeedStudio.
This driver may also work with v1 to v3, but not with v5:

----[001]-------------------------------------------------------
\ Driver for the SeeedStudio "Grove - RGB LCD V4" display board
\ Note: The newer "RGB LCD V5" has an other backlight driver
base @ hex
7C value lcda  \ 7C = LCD I2C address
C4 value rgba  \ C4 = RGB backlight I2C address for RGB LCD 'V4'
: i2cs i2c-start drop 0 do i2c-send drop loop i2c-stop ;
: rsnd rgba i2cs ; : lsnd lcda i2cs ; : lcmd 80 swap 1+ lsnd ;
FF 0 FF 0 FF FF C0 20 0 80 A rsnd  \ initialise RGB backlight
28 1 lcmd 4 ms 6 1 c 28 28 5 lcmd  \ initialise the LCD
: lcd-rgb ( r g b -- )      82 4 rsnd ;   \ set display color
: lcd-clr ( -- )            1 1 lcmd ;    \ clear display
: lcd-xy  ( Xpos Ypos -- )  if C0 else 80 then or 80 2 lsnd ;
: lcd-ch  ( ch -- )         40 2 lsnd ;   \ print character
: lcd-p   ( s-addr n -- )   lcda i2c-start drop 40 i2c-send drop
  0 do dup c@ i2c-send drop 1+ loop drop i2c-stop ;   base !
s" My4TH says" lcd-p 0 1 lcd-xy s" hello world!" lcd-p
----[EOF]-------------------------------------------------------

Driver for the I2C-UART chip SC16IS750.

There are several breakout boards with SC16IS750 available on the internet. The chip adds a second "real" hardware UART to the My4TH platform. Please note that the chip only has a 3.3V interface to the line side. You will therefore need to add a level shifter to your setup (e.g. a breakout board with the MAX3232 chip). But the I2C bus is 5V-tolerant, so you can connect it directly to your My4TH board.

----[001]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023
\ You can find a demo terminal application on screens 60 & 61 !!
\
\ Word list:
\
\ 16750-rr             ( r -- n ) - read n from UART register r
\ 16750-rw             ( n r -- ) - write n to UART register r
\ 16750-rts-cts-auto   ( -- )     - configure auto RTS/CTS 
\ 16750-rts-cts-on     ( -- )     - enable auto RTS/CTS
\ 16750-rts-cts-off    ( -- )     - disable auto RTS/CTS
\ 16750-fifo-on        ( -- )     - enable FIFO buffer
\ 16750-fifo-off       ( -- )     - disable FIFO buffer
\ 16750-efr-on         ( -- )     - enable enhanced features
\ 16750-efr-off        ( -- )     - disable enhanced features

\ -> word list continues on screen 2
----[002]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023
\ Word list (continued):
\
\ 16750-sleep-mode-on  ( -- )     - enable sleep mode
\ 16750-sleep-mode-off ( -- )     - disable sleep mode
\ 16750-ckdta          ( -- n )   - check FIFO for data. Returns
\                                   1 if data available, else 0
\ 16750-get            ( -- n )   - read single character from
\                                   FIFO and put its ASCII value
\                                   on top of the stack.
\ 16750-put            ( n -- )   - send n to FIFO
\
\ 16750-setbaud        ( bps -- ) - set baud rate to bps const.
\                                   e.g.: 48 16750-setbaud
\ 16750-cd-on          ( -- )     - enable CD/RI/DSR/DTR pins
\ ?16750-cd            ( -- n )   - query CD bit (1 = Carrier)
----[003]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ Frequency (in Hz) of the UART oscillator
decimal 14745600. 2constant 16750-clk

\ clock divider calulation helper routine
: d/ begin 2dup 32768. d< invert while d2/ 2swap d2/
 2swap repeat drop 1 swap m*/ ;

\ clock divider calulation helper routine
: bdiv d/ 1 16 m*/ d>s ;

hex \ all following values and parameters are hexadecimal
\ SC16IS750 base address (default: 0x90 - change as needed!)
90 constant 16750-base

----[004]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ 16750-rr (r -- n) read register 'r', leave 'n' on stack
: 16750-rr 16750-base i2c-start drop i2c-send drop 91
 i2c-start drop 1 i2c-recv i2c-stop ;

\ 16750-rw (n r -- ) write value 'n' to register 'r'
: 16750-rw 16750-base i2c-start drop i2c-send drop
 i2c-send drop i2c-stop ;

\ EFR write-enable mode
: 16750-efr-rw bf 18 16750-rw ;

\ EFR read-only mode
: 16750-efr-ro b7 18 16750-rw ;

----[005]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ 16750-efr-on ( -- ) enable enhanced feature mode
: 16750-efr-on 16750-efr-rw 10 16750-rr 10 or 10 16750-rw ;

\ 16750-efr-off ( -- ) disable enhanced feature mode
: 16750-efr-off 10 16750-rr ef and 10 16750-rw 16750-efr-ro ;

\ 16750-sleep-on ( -- ) enable sleep mode
: 16750-sleep-on 16750-efr-on
 03 18 16750-rw 08 16750-rr 08 or 08 16750-rw ;

\ 16750-sleep-off ( -- ) disable sleep mode
: 16750-sleep-off 16750-efr-on
 03 18 16750-rw 08 16750-rr f7 and 08 16750-rw ;

----[006]------------------------: bdiv d/ 1 16 m*/ d>s ;-------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ NOTE: the FIFO of the SC16IS750 needs to be explicitly enabled
\ or disabled !!

\ 16750-fifo-on ( -- ) enable FIFO (8-N-1)
: 16750-fifo-on 03 18 16750-rw 10 16750-rr 01 or 10 16750-rw ;

\ 16750-fifo-off ( -- ) disable FIFO
: 16750-fifo-off 03 18 16750-rw 00 10 16750-rr and fe 
 10 16750-rw ;

\ 16750-init ( -- ) initialize SC16IS750 UART and FIFO (8-N-1)
: 16750-init 16750-sleep-on 16750-fifo-on ;


----[007]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ 16750-ckdta ( -- n ) check FIFO: n=1 data available, n=0 empty
: 16750-ckdta 28 16750-rr 1 and ;

\ 16750-put ( c -- ) send single character on stack to FIFO
: 16750-put 00 16750-rw ;

\ 16750-get ( -- c ) read single character from FIFO
: 16750-get 16750-ckdta if 00 16750-rr then ;

\ 16750-setbaud ( -- ) set desired baud rate, where
\ n = baud rate divisor constant (see screen 51)
: 16750-setbaud 80 18 16750-rw
 dup ff00 and 8 rshift swap 00ff and 00 16750-rw 08 16750-rw ;

----[008]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023
\ Definitions needed for auto RTS/CTS hardware flow control

\ MCR TCR/TLR enable
: 16750-tcrtlr-on 20 16750-rr 04 or 20 16750-rw ;

\ TCR Set (07:0f)
: 16750-tcr-set 30 16750-rr ef 30 16750-rw ;

\ TLR set (04:04)
: 16750-tlr-set ff 38 16750-rw ;

\ Zero FCR bits 7 and 6 for proper TCR and TLR operation
: 16750-fcr-set 10 16750-rr 3f and 10 16750-rw ;

: 16750-rstfifo 07 10 16750-rw 2 ms ; \ reset/clear FIFO
----[009]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ Auto RTS/CTS mode enable
: 16750-rts-cts-on 10 16750-rr d0 or 10 16750-rw ;

\ Auto RTS/CTS mode disable
: 16750-rts-cts-off 10 16750-rr 10 and 10 16750-rw ;

\ Set up and enable automatic RTS/CTS hardware flow control
\ 16750-rts-cts-auto ( -- ) enable auto RTS/CTS flow control
: 16750-rts-cts-auto 16750-efr-on 16750-efr-ro 16750-fcr-set
 16750-efr-rw 16750-tcrtlr-on 16750-tcr-set 16750-tlr-set 
 16750-rts-cts-on ;



----[010]-------------------------------------------------------
\ My4TH SC16IS750 UART for I2C bus driver (c) N. Haedecke 2023

\ Enable CD / RI / DSR / DTR pins
: 16750-cd-on 02 70 16750-rw ;

\ Disable CD / RI / DSR / DTR pins
: 16750-cd-off 00 70 16750-rw ;

\ check CD I/O pin
: ?16750-cd 30 16750-rr 80 and ;





decimal
----[011]-------------------------------------------------------
\ My4TH SC16IS750 UART demo app (c) N. Haedecke 2023
\ This is a very simple terminal program with auto RTS/CTS

\ This variable is used to control the main program loop
variable appstop 0 appstop !

\ Eleminate control char
: skip-ctrlch dup 0= if drop else emit then ;

\ Read serial data from FIFO and output it to terminal device
\ 16750-read ( -- ) read and output FIFO until 16750-ckdta
\ returns 0
: 16750-read begin 16750-ckdta while 16750-get skip-ctrlch
 repeat ;


----[012]-------------------------------------------------------
\ My4TH SC16IS750 UART demo app (c) N. Haedecke 2023

\ ( -- ) read chars. from console and send them until 0x0d (CR)
: readcon begin key dup dup dup 27 = if 1 appstop ! else emit
 16750-put then 13 = until ;

\ Main program "16750-term"
\ ( -- ) simple test program sending and receiving data
: 16750-term cr ."       SC16IS750 UART test program." cr
 ."    Press  then ENTER to quit" cr
 ." ---------+---------+---------+---------+" cr
 16750-clk 19200. bdiv 16750-setbaud 16750-cd-on
 16750-rts-cts-auto 16750-init begin 16750-read key? if readcon
 then appstop @ until ( cleanup stack ) depth 0 do drop loop ;


----[EOF]-------------------------------------------------------