Index

      Forth games for My4TH
      Tools and Applications
      Adrafruit boards I2C driver


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 i2c-stop
    if i 2* . then loop cr base ! ;

i2c-detect


Driver Screens for Adafruit STEMMA QT Boards

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 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 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]-------------------------------------------------------