├── DS-1307RTC-eeprom.TXT ├── DS-1307RTC.TXT ├── ENCODER-KY-040.txt ├── ESP32FORTH_62-TING.pdf ├── ESP32forth-Adding-words.doc ├── ESP32forth-Short-DAC_Sine_Wave_Signal_Generator-1 (1).pdf ├── ESP32forth-Timer1-Experiment-1.pdf ├── ESP32forth-knight-rider-short-version.txt ├── ESP32forth-knight-rider.txt ├── ESP32forth705-serial2.ino ├── I2C-lib.txt ├── ILI9488-ESP32-WIRING-5-2022.pdf ├── ILI9488userwords.h ├── Jet-game ├── JET-3.odp ├── Jet-manual.pdf └── jet.fth ├── LEDPWM.txt ├── LEDPWMstrip3.txt ├── LICENSE ├── MCP23017.txt ├── README.md ├── Ralph-lundvall-music.txt ├── RotaryEncoder-KY-040-WithInterrupts-ChristianH.txt ├── SERVO-PWM-EXAMPLE.txt ├── Timers-Mini-OOF-multitask.fth ├── ULTRASOUND-lib.txt ├── USOUNDlib-READMEfirst.txt ├── esp32forth-oled.txt ├── esp32forth63-touch.ino ├── extra-stacks.txt ├── frank.lin ├── DHT11-12-FRANK-LIN.txt ├── FRANK-LIN-DHT11 DHT22 Temperature and Humidity Sensor[ESP32FORTH].pdf └── readme.txt ├── lcd-driver.txt ├── lm393-speedsensor.txt ├── mini-oof-BPaysan-by-bob-edwards.txt ├── pwm-forthmobile.txt └── robertedwards ├── .R for ESP32forth.fth ├── Batch file for ESP32forth.fth ├── Case for ESP32forth.fth ├── Pick for ESP32forth.fth ├── Programmer’s Guide to Mini_OOF.odt ├── Programmer’s Guide to Mini_OOF.pdf ├── Simple queue for ESP32forth.fth ├── String Library Glossary for ESP32forth v7073.odt ├── String Library Glossary for ESP32forth v7073.pdf ├── String library for esp32forth.fth ├── TCPptpcomm-ESP32forthDemo.txt ├── mini-oof demo.fth ├── mini-oof for esp32forth ver3.forth ├── readme.txt ├── rstack display.fth ├── timeout for ESP32forth.fth └── trace for esp32forth.fth /DS-1307RTC-eeprom.TXT: -------------------------------------------------------------------------------- 1 | \ 24c32 I2C 32Kb EEPROM chip single byte write and read. 2 | \ This chip is often found on same small board with DS1307 RTC! 🙂 3 | \ $50 is the I2C number/address used by my 24c32 32Kb chip 4 | \ OBS: Some chips, e.g. Atmel, use adr + 1 (51) for Read, and 50 for Write! 5 | \ My chip use same addr. for both read and write! 6 | \ Max addr. for a single byte write/read: 7FFF ! 7 | \ Jan Langevaad 28-February-2022 8 | 9 | base @ 10 | hex 11 | WIRE 12 | 13 | : 24c32writebyte \ DATAbyte ADDR16bits(0...7FFF) --- 14 | 15 | 50 Wire.beginTransmission \ start $50 write drop 16 | dup 17 | 100 / \ get MSB 18 | TimeBuff 9 + c! 19 | TimeBuff 9 + 1 Wire.write drop \ adr MSB in EEPROM 20 | 21 | ff and \ get LSB 22 | TimeBuff 9 + c! 23 | TimeBuff 9 + 1 Wire.write drop \ adr MSB in EEPROM 24 | 25 | TimeBuff 9 + c! 26 | TimeBuff 9 + 1 Wire.write drop \ DataByte to EEPROM 27 | 28 | 1 Wire.endTransmission drop \ 1=StopOption --- Return Drop(0= ok 1..4 see doc!) 29 | ; 30 | 31 | : 24c32readbyte \ ADDR16bits(0...7FFF) --- databyte 32 | 33 | 50 Wire.beginTransmission 34 | dup 35 | 100 / \ get MSB 36 | TimeBuff 9 + c! 37 | TimeBuff 9 + 38 | 1 Wire.write drop \ adr MSB in EEPROM 39 | 40 | ff and \ get LSB 41 | TimeBuff 9 + c! 42 | TimeBuff 9 + 43 | 1 Wire.write drop \ adr MSB in EEPROM 44 | 0 Wire.endTransmission drop \ --- 0 = cont. option, drop return 0= ok 1..4 see d 45 | 46 | 50 1 -1 Wire.requestFrom drop 47 | Wire.Available drop \ --- # bytes to read 48 | Wire.Read \ --- RamDataByte 49 | ; 50 | 51 | FORTH 52 | BASE ! 53 | 54 | \ EOF 55 | 56 | -------------------------------------------------------------------------------- /DS-1307RTC.TXT: -------------------------------------------------------------------------------- 1 | \ Language: ESP32Forth 2 | \ Simplified use of the DS1307 Real Time Clock I2C chip. 3 | \ Read the documentation for DS1307 for more details: 4 | \ https://datasheets.maximintegrated.com/en/ds/DS1307.pdf 5 | \ Author: Jan Langevad - february 2022 - free software. 6 | \ Not claiming that this is optimal, but an introduction to RTC an I2C 7 | \ Good ideas are welcome 🙂 8 | 9 | 10 | base @ 11 | decimal 12 | 13 | 0 value TimeBuff 14 | 15 | INTERNALS \ <********** 16 | : GetBuffMemory 17 | 10 malloc ( --- 0/Addr allocate byte buffer for Time RTC data RAM ) 18 | is TimeBuff 19 | ; 20 | GetBuffMemory 21 | 22 | FORTH 23 | 24 | hex \ <---------- OBS - Practical with BCD numbers too 25 | 26 | \ 15 constant GPIO21 ( SDA ) \ = 21 27 | \ 16 CONSTANT GPIO22 ( SCL ) 28 | \ : INIT-PINS GPIO21 OUTPUT PINMODE LOW GPIO21 PIN 29 | \ GPIO22 OUTPUT PINMODE LOW GPIO22 PIN ; 30 | \ INIT-PINS 31 | 32 | variable second 33 | variable minute 34 | variable hour 35 | variable dayofweek 36 | variable dayofmonth 37 | variable month 38 | variable year 39 | 40 | variable nullbyte 41 | 42 | variable WireOK? \ save wire prep stack result here 43 | 0 WireOK? ! 44 | 45 | ( OBS: BCD - Binary Coded Decimal! TESTDATA: ) 46 | 22 year ! 47 | 02 month ! 48 | 28 dayofmonth ! 49 | 02 dayofweek ! \ d# 1..7 Sunday=1 50 | 12 hour ! \ Default i RTC is 24 Hour format 51 | 34 minute ! 52 | 00 second ! 53 | 54 | 0 nullbyte ! 55 | 56 | : setuptimeBCD \ yy mm dd d# hh mm ss --- \ to entered with HEX BASE 57 | second C! 58 | minute C! 59 | hour C! 60 | dayofweek C! \ 1...7 1 = sunday 61 | dayofmonth C! 62 | month C! 63 | year C! 64 | 65 | 0 TimeBuff c! 66 | 0 TimeBuff 1+ c! 67 | second c@ TimeBuff 2 + c! 68 | minute c@ TimeBuff 3 + c! 69 | hour c@ TimeBuff 4 + c! 70 | dayofweek c@ TimeBuff 5 + c! \ 1...7 1 = sunday 71 | dayofmonth c@ TimeBuff 6 + c! 72 | month c@ TimeBuff 7 + c! 73 | year c@ TimeBuff 8 + c! 74 | ; 75 | 76 | 22 02 28 2 12 34 00 setuptimeBCD \ test yy mm dd d# hh mm ss --- 77 | 78 | WIRE \ change vocabulary 79 | 80 | : Wire.Prep 15 16 Wire.begin WireOK? ! ; \ initialize IC2 pins SDA SCL --- 81 | Wire.Prep \ 15 16 hex = 21 22 decimal GPIO pin # 82 | 83 | cr ." WireOK?=1 is OK: " WireOK? @ . cr 84 | 85 | : settime \ $68 is the I2C address used by DS1307 RTC chip 86 | 87 | 68 Wire.beginTransmission 88 | \ unfortunately Wire.write in our Forth requires adresses and not values on stack 89 | \ Therefore use of TimeBuff 90 | 91 | TimeBuff 1 Wire.write drop \ send register address 92 | TimeBuff 1 Wire.write drop \ reset seconds!! and start RTC 93 | TimeBuff 3 + 1 Wire.write drop \ minute 94 | TimeBuff 4 + 1 Wire.write drop \ hour 95 | TimeBuff 5 + 1 Wire.write drop \ dayofweek 96 | TimeBuff 6 + 1 Wire.write drop \ dayofmonth 97 | TimeBuff 7 + 1 Wire.write drop \ month 98 | TimeBuff 8 + 1 Wire.write drop \ year 99 | 100 | 1 Wire.endTransmission drop \ --- 1 = stop option, drop return 0= ok 1..4 see doc! 101 | ; 102 | 103 | : mmssAdjustTime \ mm ss --- Just setting Minute and Second in RTC: 104 | TimeBuff 2 + c! 105 | TimeBuff 3 + c! 106 | 107 | 68 Wire.beginTransmission 108 | TimeBuff 1 Wire.write drop \ send register address 109 | TimeBuff 2 + 1 Wire.write drop \ reset seconds!! and start RTC 110 | TimeBuff 3 + 1 Wire.write drop \ minute 111 | 1 Wire.endTransmission drop \ --- 1 = stop option, drop return 0= ok 1..4 see doc! 112 | ; 113 | 114 | : gettime ( --- SS MM HH D# DD MM YY ) 115 | 116 | 68 Wire.beginTransmission 117 | nullbyte 1 Wire.write drop \ send register address 118 | 0 Wire.endTransmission drop \ --- 0 = cont. option, drop return 0= ok 1..4 see d 119 | 120 | 68 7 -1 Wire.requestFrom drop 121 | Wire.Available drop \ --- # bytes to read 122 | Wire.Read \ second ! 123 | Wire.Read \ minute ! 124 | Wire.Read \ hour ! 125 | Wire.Read \ dayofweek ! 126 | Wire.Read \ dayofmonth ! 127 | Wire.Read \ month ! 128 | Wire.Read \ year ! 129 | \ Apparently ot needed(!/?): 130 | \ 1 Wire.endTransmission drop \ --- 1 = stop option, drop return 0= ok 1..4 see d 131 | ; 132 | 133 | : gettime. gettime . . . . . . . ; \ Print time on terminal 134 | 135 | : gettime! gettime \ Store current time in memory 136 | year C! month C! dayofmonth C! dayofweek C! hour C! minute C! second C! 137 | ; 138 | 139 | FORTH 140 | BASE ! 141 | 142 | \ EOF -------------------------------------------------------------------------------- /ENCODER-KY-040.txt: -------------------------------------------------------------------------------- 1 | \ tested with Encoder KY-040 it works ok 2 | \ needs cap 0.1 filter on each input +R 220Ohms 3 | \ by PeterForth July2021 with Christian Hinse 4 | 5 | interrupts 6 | 7 | 15 input pinmode \ set GPIO15 as an input 8 | 4 input pinmode \ set GPIO4 as an input 9 | 10 | 4 gpio_pulldown_en 11 | 15 gpio_pulldown_en 12 | 2drop 13 | 14 | timers 15 | 16 | 0 value var 0 value oldA 0 value pinA 0 value pinB 17 | 18 | : readvar ( --) 19 | 4 digitalread to pinB 15 digitalRead DUP to pinA 20 | if \ pin A high 21 | oldA if \ no change 22 | else \ **** rising edge 23 | pinB if 1 +to var else -1 +to var then 24 | then 25 | then \ pin A low 26 | pinA to oldA \ save state 27 | RERUN ; 28 | 29 | ' readvar 10000 0 interval \ and run that every 1/100 seconds 30 | \ experiment with other values... 31 | 32 | : v. cr var . ; \ helping word to watch counter and debug 33 | -------------------------------------------------------------------------------- /ESP32FORTH_62-TING.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/ESP32FORTH_62-TING.pdf -------------------------------------------------------------------------------- /ESP32forth-Adding-words.doc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/ESP32forth-Adding-words.doc -------------------------------------------------------------------------------- /ESP32forth-Short-DAC_Sine_Wave_Signal_Generator-1 (1).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/ESP32forth-Short-DAC_Sine_Wave_Signal_Generator-1 (1).pdf -------------------------------------------------------------------------------- /ESP32forth-Timer1-Experiment-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/ESP32forth-Timer1-Experiment-1.pdf -------------------------------------------------------------------------------- /ESP32forth-knight-rider-short-version.txt: -------------------------------------------------------------------------------- 1 | 2 | ( KNIGHT RIDER -- SHORTER VERSION ) 3 | 4 | DECIMAL 5 | 6 | : init 15 OUTPUT PINMODE 4 OUTPUT PINMODE 7 | 5 OUTPUT PINMODE 18 OUTPUT PINMODE 8 | 19 OUTPUT PINMODE 23 OUTPUT PINMODE 9 | 12 OUTPUT PINMODE 13 OUTPUT PINMODE 10 | 14 OUTPUT PINMODE 15 OUTPUT PINMODE 11 | 4 OUTPUT PINMODE 5 OUTPUT PINMODE ; 12 | 13 | low VALUE WOW 14 | 15 | 16 | : all ( n --) to wow WOW 15 pin WOW 4 pin 17 | WOW 5 pin WOW 18 pin 18 | WOW 19 pin WOW 23 pin 19 | WOW 12 pin WOW 13 pin 20 | WOW 14 pin WOW 2 pin ; 21 | 22 | 23 | CREATE ARRAY 24 | 15 , 2 , 4 , 5 , 25 | 18 , 19 , 23 , 12 , 26 | 14 , 13 , 14 , 27 | 12 , 23 , 19 , 18 , 28 | 5 , 4 , 2 , 15 , 29 | 30 | 31 | 0 VALUE P# ( Pin number ) 32 | 33 | : PINN P# PIN : 34 | 35 | 50 VALUE DEL4 ( delay to blink 1 led ) 36 | 37 | : LED# ( n--) CELLS ARRAY + @ TO P# ; 38 | 39 | : BLINK ( n--) LED# LOW PINN DEL4 MS HIGH PINN ; 40 | 41 | 42 | : KNIGHT-RIDER HIGH ALL 20 0 DO I BLINK LOOP ; 43 | 44 | 45 | : RUN ( --) init 10 0 DO KNIGHT-RIDER LOOP ; 46 | 47 | -------------------------------------------------------------------------------- /ESP32forth-knight-rider.txt: -------------------------------------------------------------------------------- 1 | ( KNIGHT RIDER "long version" for ESP32Forth ) 2 | DECIMAL 3 | 4 | : ... 300 ms ; 5 | ... 6 | 7 | 15 constant GPIO15 8 | ... 9 | 4 constant GPIO4 10 | ... 11 | 2 CONSTANT GPIO2 12 | ... 13 | 5 constant GPIO5 14 | ... 15 | 18 constant GPIO18 16 | ... 17 | 19 constant GPIO19 18 | ... 19 | 23 constant GPIO23 20 | ... 21 | 12 constant GPIO12 22 | ... 23 | 13 constant GPIO13 24 | ... 25 | 14 constant GPIO14 26 | ... 27 | 4 constant GPIO4 28 | ... 29 | 5 constant GPIO5 30 | ... 31 | : i-1 GPIO15 OUTPUT PINMODE low GPIO15 pin ; 32 | ... 33 | : i1 i-1 GPIO4 OUTPUT PINMODE low GPIO4 pin low GPIO2 pin ; 34 | ... 35 | : i2 GPIO5 OUTPUT PINMODE low GPIO5 pin GPIO18 OUTPUT PINMODE low GPIO18 pin ; 36 | ... 37 | : i3 GPIO19 OUTPUT PINMODE low GPIO19 pin GPIO23 OUTPUT PINMODE low GPIO23 pin ; 38 | ... 39 | : i4 GPIO12 OUTPUT PINMODE low GPIO12 pin GPIO13 OUTPUT PINMODE low GPIO13 pin 40 | ... 41 | : i5 GPIO14 OUTPUT PINMODE low GPIO14 pin GPIO15 OUTPUT PINMODE low GPIO15 pin ; 42 | ... 43 | : i6 GPIO4 OUTPUT PINMODE low GPIO4 pin GPIO5 OUTPUT PINMODE low GPIO5 pin ; 44 | ... 45 | : init i1 i2 i3 i4 i5 i6 ; 46 | ... 47 | 48 | low VALUE WOW 49 | ... 50 | 51 | : all2 WOW GPIO15 pin WOW GPIO4 pin ; 52 | ... 53 | : all3 WOW GPIO5 pin WOW GPIO18 pin ; 54 | ... 55 | : all1 WOW GPIO19 pin WOW GPIO23 pin WOW GPIO12 pin WOW GPIO13 pin ; 56 | ... 57 | : all ( n--) to wow WOW GPIO14 pin WOW GPIO2 pin all2 all3 all1 ; 58 | ... 59 | 60 | CREATE ARRAY 61 | ... 62 | GPIO15 , GPIO2 , GPIO4 , GPIO5 , 63 | ... 64 | GPIO18 , GPIO19 , GPIO23 , GPIO12 , 65 | ... 66 | GPIO14 , GPIO13 , GPIO14 , 67 | ... 68 | GPIO12 , GPIO23 , GPIO19 , GPIO18 , 69 | ... 70 | GPIO5 , GPIO4 , GPIO2 , GPIO15 , 71 | ... 72 | 73 | 0 VALUE P# ( Pin number ) 74 | ... 75 | : PINN P# PIN : 76 | ... 77 | 50 VALUE DEL4 ( delay to blink 1 led ) 78 | ... 79 | : LED# ( n--) CELLS ARRAY + @ TO P# ; 80 | ... 81 | : BLINK ( n--) LED# LOW PINN DEL4 MS HIGH PINN ; 82 | ... 83 | 84 | 85 | : KNIGHT-RIDER HIGH ALL 20 0 DO I BLINK LOOP ; 86 | ... 87 | 88 | : RUN ( --) init 10 0 DO KNIGHT-RIDER LOOP ; 89 | ... 90 | 91 | -------------------------------------------------------------------------------- /I2C-lib.txt: -------------------------------------------------------------------------------- 1 | ( i2c high level forth library PeterForth 2021 ) 2 | ( see address is set for $4E by default ) 3 | FORTH DECIMAL 4 | 5 | 6 | 15 constant GPIO15 ( SDA ) 7 | 8 | 2 CONSTANT GPIO2 ( SCL ) 9 | 10 | : INIT-PINS GPIO15 OUTPUT PINMODE low GPIO15 PIN GPIO2 OUTPUT PINMODE LOW GPIO2 PIN ; 11 | 12 | ( send a value to both pins ) 13 | 14 | : ALL ( n--) DUP GPIO15 PIN GPIO2 PIN ; 15 | 16 | 1 VALUE CLKDELAY 17 | 18 | : CLK ( --) HIGH GPIO2 PIN CLKDELAY MS LOW GPIO2 PIN CLKDELAY MS ; 19 | 20 | : >I2 GPIO15 PIN CLK ; 21 | 22 | : START-I2C 1 GPIO15 PIN 1 MS 0 >I2 ; 23 | 24 | : STOP-I2C LOW GPIO15 PIN 1 MS HIGH GPIO2 PIN ; 25 | 26 | ( default set to 0x4E $4E == 78 decimal == 0100 1110 address word ) 27 | 28 | : SENDADDR START-I2C 0 >I2 1 >I2 0 >I2 0 >I2 1 >I2 1 >I2 1 >I2 0 >I2 CLK ; 29 | 30 | : R1 SENDADDR START-I2C 1 >I2 0 >I2 1 >I2 0 >I2 1 >I2 1 >I2 1 >I2 1 >I2 ; 31 | 32 | : INIT-I2C INIT-PINS 0 ALL r1 10 MS 1 ALL ; INIT-I2C 33 | 34 | 0 value byte 35 | 36 | : i2c1 ( n--) to byte sendaddr 7 for byte 1 and >i2 byte 2/ to byte next ; 37 | 38 | : vv byte and >i2 ; 39 | 40 | : i2c-invert ( n--) to byte sendaddr 1 vv 2 vv 4 vv 8 vv 16 vv 32 vv 64 vv 128 vv 0 >I2 STOP-I2C ; 41 | 42 | : i2c ( n-- ) to byte sendaddr 128 vv 64 vv 32 vv 16 vv 8 vv 4 vv 2 vv 1 vv 0 >I2 STOP-I2C ; 43 | 44 | : i2test 255 0 do i i2c loop ; 45 | -------------------------------------------------------------------------------- /ILI9488-ESP32-WIRING-5-2022.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/ILI9488-ESP32-WIRING-5-2022.pdf -------------------------------------------------------------------------------- /ILI9488userwords.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright PeterForth 2022 3 | * use freely according MIT license 4 | * redistribution only possible with 5 | * acknowledgment to the author 6 | * more information of the project https://esp32.forth2020.org 7 | * tft libraries of Bodmer https://github.com/Bodmer/TFT_eSPI 8 | * download ESP32forth from Brad Nelson 9 | * https://esp32forth.appspot.com/ESP32forth.html 10 | */ 11 | 12 | #define nn0 ((uint16_t *) tos) 13 | #define nn1 (*(uint16_t **) &n1) 14 | 15 | #include 16 | #include 17 | TFT_eSPI tft = TFT_eSPI(); 18 | 19 | void setuptouch(void) { 20 | uint16_t calData[5] = { 235, 3234, 504, 3066, 0 }; 21 | tft.setTouch(calData); 22 | } 23 | void setuptftdemo(void) { 24 | uint16_t calData[5] = { 235, 3234, 504, 3066, 0 }; 25 | tft.setTouch(calData); 26 | 27 | tft.init(); 28 | tft.fillScreen(TFT_BLACK); 29 | 30 | tft.setCursor(20, 10, 4); 31 | 32 | tft.setTextColor(TFT_WHITE, TFT_BLACK); 33 | 34 | tft.println("White Text\n"); 35 | tft.println("Next White Text"); 36 | 37 | tft.setCursor(10, 100); 38 | tft.setTextFont(2); 39 | tft.setTextColor(TFT_RED, TFT_WHITE); 40 | tft.println("Red Text, White Background"); 41 | 42 | tft.setCursor(10, 140, 4); 43 | tft.setTextColor(TFT_GREEN); 44 | tft.println("Green text"); 45 | 46 | tft.setCursor(70, 180); 47 | tft.setTextColor(TFT_BLUE, TFT_YELLOW); 48 | tft.println("Blue text"); 49 | 50 | tft.setCursor(50, 220); 51 | tft.setTextFont(4); 52 | tft.setTextColor(TFT_YELLOW); 53 | tft.println("2020-06-16"); 54 | 55 | tft.setCursor(50, 260); 56 | tft.setTextFont(7); 57 | tft.setTextColor(TFT_PINK); 58 | tft.println("20:35"); 59 | } 60 | 61 | #define USER_WORDS \ 62 | Y(tftdemo, setuptftdemo(); DROP) \ 63 | Y(tftinit, tft.init(); DROP) \ 64 | Y(tftcls, tft.fillScreen(TFT_BLACK);) \ 65 | Y(tftcursor, tft.setCursor(n1, n0); DROPn(2)) \ 66 | Y(tftcursorink, tft.setCursor(n2,n1, n0); DROPn(2)) \ 67 | Y(tftTextFont, tft.setTextFont(n0); DROP) \ 68 | Y(tftTextColor, tft.setTextColor(n1,n0); DROPn(2)) \ 69 | Y(tftprintln, tft.println(c0); DROP) \ 70 | Y(tftprint, tft.print(c0); DROP) \ 71 | Y(tftNum, tft.print(n0); DROP) \ 72 | Y(tftNumln, tft.println(n0); DROP) \ 73 | Y(tftCircle, tft.drawCircle(n3,n2,n1,n0); DROPn(3)) \ 74 | Y(tftPixel, tft.drawPixel(n2,n1,n0); DROPn(3)) \ 75 | Y(tftLine, tft.drawLine(n4,n3,n2,n1,n0); DROPn(5)) \ 76 | Y(tftfillRect, tft.fillRect(n4,n3,n2,n1,n0); DROPn(5)) \ 77 | Y(tftfillRRect, tft.fillRoundRect(n5,n4,n3,n2,n1,n0); DROPn(6)) \ 78 | Y(tftRect, tft.drawRect(n4,n3,n2,n1,n0); DROPn(5)) \ 79 | Y(tftHLine, tft.drawFastHLine(n3,n2,n1,n0); DROPn(4)) \ 80 | Y(tftVLine, tft.drawFastVLine(n3,n2,n1,n0); DROPn(4)) \ 81 | Y(tftfillCircle, tft.fillCircle(n3,n2,n1,n0); DROPn(4)) \ 82 | Y(tftRotation, tft.setRotation(n0); DROP) \ 83 | Y(tftfillscreen, tft.fillScreen(n0); DROP) \ 84 | Y(tftEllipse, tft.drawEllipse(n4,n3,n2,n1,n0); DROPn(5)) \ 85 | Y(tftfillEllipse, tft.fillEllipse(n4,n3,n2,n1,n0); DROPn(5)) \ 86 | Y(tftTriangle, tft.drawTriangle(n6,n5,n4,n3,n2,n1,n0); DROPn(7)) \ 87 | Y(tftfillTriangle, tft.fillTriangle(n6,n5,n4,n3,n2,n1,n0); DROPn(7)) \ 88 | Y(tfttouch, tft.getTouch(nn1, nn0); DROPn(2)) \ 89 | Y(tftinittouch, setuptouch; DROP) 90 | 91 | 92 | -------------------------------------------------------------------------------- /Jet-game/JET-3.odp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/Jet-game/JET-3.odp -------------------------------------------------------------------------------- /Jet-game/Jet-manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/Jet-game/Jet-manual.pdf -------------------------------------------------------------------------------- /Jet-game/jet.fth: -------------------------------------------------------------------------------- 1 | ( INFO: ) 2 | ( recriação em FORTH de um jogo em BASIC publicado na revista ) 3 | ( MICROSISTEMAS n. 53, de fev. 1986, pág. 32,) 4 | ( de nome "Estratégia", ) 5 | ( de autoria de Jorge A. C. Bettencourt Soares ) 6 | ( https://datassette.org/revistas/micro-sistemas/micro-sistemas-no-53 ) 7 | ( . ) 8 | ( Versão em esp32FORTH por Ricardo Cunha Michel, Brasil, 2022 ) 9 | 10 | 11 | ( ponto de apagamento ) 12 | : ALL ; 13 | 14 | ( variaveis ) 15 | decimal 16 | variable dr_altura ( o quão perto o drone está da regiao segura ) 17 | variable dr_pos ( posição do drone em um dos 4 caminhos aéreos ) 18 | variable dr_char ( caracter que representa o drone, "A") 19 | variable dr_ok? ( registra se o drone está OK, i.e., se não foi atingido ) 20 | variable vitorias ( quantas missoes cumpriu sem ser atingido? ) 21 | variable derrotas ( quantas missoes foram impedidas pelo míssil? ) 22 | variable mi_altura ( onde está o missil ) 23 | variable mi_pos ( posição do míssil em um dos 4 caminhos aéreos ) 24 | variable mi_char ( caracter que representa o míssil, "^" ) 25 | 26 | ( procedimentos ) 27 | : cls 50 0 do cr loop ; ( limpa tela ) 28 | : var- dup @ rot - swap ! ; ( n var_name -- ) ( subtrai "n" unidades do valor armazenado na variável ) 29 | 30 | variable RND 31 | MS-TICKS RND ! 32 | : RANDOM RND @ 31421 * 6927 + ABS 65536 /MOD drop DUP RND ! ; 33 | : CHOOSE RANDOM * 65536 /MOD SWAP DROP ; 34 | 35 | : init_vars ( caminho e distancia iniciais do drone e do missil ) 36 | 22 dr_altura ! 37 | 1 dr_pos ! 38 | 65 dr_char ! 39 | 28 mi_altura ! 40 | 0 mi_pos ! 41 | 94 mi_char ! 42 | 1 dr_ok? ! ; 43 | 44 | ( o JOGO em si ) 45 | : zona1 ." #########################" cr ; 46 | : zona2 ." #### FORA DE ALCANCE ####" cr ; 47 | : zona3 ." ########|0|1|2|3|########" cr ; 48 | : zona4 ." ////////| | | | |////////" cr ; 49 | : zona_dr s" ////////| | | | |////////" 2dup drop 9 dr_pos @ 2 * + + dup dr_char @ swap c! rot rot TYPE 32 swap c! cr ; 50 | : zona_mi s" ////////| | | | |////////" 2dup drop 9 mi_pos @ 2 * + + dup mi_char @ swap c! rot rot TYPE 32 swap c! cr ; 51 | 52 | : desenha 53 | cls 54 | zona1 zona1 zona2 zona1 zona3 55 | 29 0 do 56 | i dr_altura @ = if zona_dr else 57 | i mi_altura @ = if zona_mi else 58 | zona4 then then 59 | loop ; 60 | 61 | : MOVE_dr begin key? until key 48 - dr_pos ! ; ( o código das teclas numéricas menos 48 é o valor do dígito ) 62 | : MOVE_mi_alea 4 CHOOSE mi_pos ! ; ( ‘n CHOOSE’ gera um número aleatório inteiro entre 0 e n-1 ) 63 | : ATUALIZA_posicoes mi_pos @ dr_pos @ = if 3 mi_altura var- else 1 dr_altura var- then ; 64 | : TESTA_FIM 65 | mi_altura @ dr_altura @ <= 66 | if ." >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>MORREU" 1 derrotas +! cr 0 dr_ok? ! then 67 | dr_altura @ 0 <= 68 | if ." <><><><><><><><> V I T O R I A <><><><><><><><> " 1 vitorias +! cr 0 dr_ok? ! then 69 | ; 70 | 71 | ( IA ************************************************************** ) 72 | variable ia_dr_atual ( a posição atual que o míssil vê o drone, X ) 73 | variable ia_dr_anterior ( onde o drone estava antes de estar na posição atual, Y ) 74 | variable situacao ( situação do drone ) 75 | 76 | : init_IA ( como não há informação sobre como o drone chegou nesse posição, assume ambos os valores como sendo iguais ) 77 | dr_pos @ dup ia_dr_atual ! ia_dr_anterior ! ; 78 | 79 | : tabela CREATE 64 cells allot DOES> swap cells + ; ( ‘posição nome_da_tabela’ deixará no stack o endereço da posição ) 80 | tabela ia_tab_freq ( a tabela com 64 posições, com as 4 frequências de ocorrẽncia para cada uma das 16 situações ) 81 | 82 | : zera_tab_freq 64 0 do 0 i ia_tab_freq ! loop ; 83 | zera_tab_freq 84 | 85 | : mostra_tab_freq 86 | 16 0 do 87 | i . ." : " 88 | i 4 * 0 + ia_tab_freq ? ." : " 89 | i 4 * 1 + ia_tab_freq ? ." : " 90 | i 4 * 2 + ia_tab_freq ? ." : " 91 | i 4 * 3 + ia_tab_freq ? 92 | cr loop ; 93 | 94 | : max rot > if swap then drop ; 95 | 96 | : MOVE_mi_IA 97 | ( calcula e armazena o valor de ‘situação’ ) 98 | ia_dr_anterior @ 4 * ia_dr_atual @ + situacao ! 99 | ( agora, recordar as 4 frequências de movimento... ) 100 | situacao @ 4 * 0 + ia_tab_freq @ 101 | situacao @ 4 * 1 + ia_tab_freq @ 102 | situacao @ 4 * 2 + ia_tab_freq @ 103 | situacao @ 4 * 3 + ia_tab_freq @ 104 | ( . . . e compará-las ) 105 | 3 mi_pos ! 106 | 3 0 do 107 | 2dup > if 2 i - mi_pos ! swap then nip 108 | loop 109 | drop 110 | cr mi_pos ? cr ; 111 | 112 | : ATUALIZA_IA 113 | ia_dr_atual @ ia_dr_anterior ! ( atualiza posicoes ) 114 | dr_pos @ ia_dr_atual ! ( coloca a posição detectada como sendo a nova 'posição atual' ) 115 | situacao @ 4 * ia_dr_atual @ + ia_tab_freq dup @ 1 + swap ! ; ( atualiza a tabela de frequencias da situação ocorrida ) 116 | 117 | ( ************************************************************** FIM da IA ) 118 | 119 | ( descrição de abertura, tela inicial etc. ) 120 | 121 | : ABERTURA 122 | CR CR CR 123 | CR 124 | ." O objetivo é fazer o máximo de missões, escapando do míssil." 125 | CR 126 | ." Você pode usar os quatro corredores aéreos: 0, 1, 2, 3" 127 | CR 128 | ." Mas o míssil aprende..." 129 | CR 130 | CR 131 | ." Pressione qualquer tecla..." 132 | CR CR CR 133 | ; 134 | 135 | ( cada execução do jogo ) 136 | : UM_JOGO 137 | init_vars ( nao zera memoria ) 138 | init_IA 139 | desenha 140 | begin 141 | dr_ok? @ 142 | while 143 | MOVE_dr 144 | MOVE_mi_IA 145 | ATUALIZA_posicoes 146 | ATUALIZA_IA 147 | desenha 148 | TESTA_FIM 149 | repeat 150 | ; 151 | 152 | ( a chamada inicial >> AQUI começa o jogo ) 153 | : JOGO 154 | cls 155 | ABERTURA 156 | 0 vitorias ! 157 | 0 derrotas ! 158 | begin 159 | key? key 27 - 160 | while 161 | UM_JOGO 162 | CR ." VITORIAS: " vitorias @ . 163 | CR ." DERROTAS: " derrotas @ . 164 | CR CR CR 165 | 3000 ms 166 | ." interrompe, outra tecla recomeça" 167 | repeat 168 | ; 169 | ( ************************************************************** FIM ) 170 | -------------------------------------------------------------------------------- /LEDPWM.txt: -------------------------------------------------------------------------------- 1 | FORTH DECIMAL 2 | 12 CONSTANT PWMR 2 CONSTANT CHRIGHT 3 | 4 | FORTH DEFINITIONS ALSO LEDC 5 | 6 | : INIT-PWM PWMR CHRIGHT LEDCATTACHPIN 7 | CHRIGHT 4000 50 LEDCSETUP drop ; 8 | 9 | : LEDPWM 100 * CHRIGHT SWAP LEDCWRITE ; 10 | 11 | INIT-PWM 12 | 13 | : STEST 95 5 DO I LEDPWM 200 MS 10 +LOOP ; 14 | : STEST2 95 5 DO 95 I - LEDPWM 200 MS 10 +LOOP ; 15 | 16 | : LEDTEST STEST2 STEST ; 17 | 18 | : LEDTEST2 0 ?DO LEDTEST LOOP ; 19 | 20 | LEDTEST 21 | -------------------------------------------------------------------------------- /LEDPWMstrip3.txt: -------------------------------------------------------------------------------- 1 | FORTH DECIMAL 2 | 12 CONSTANT PWMR1 2 CONSTANT CHAN1 3 | 13 CONSTANT PWMR2 3 CONSTANT CHAN2 4 | 14 CONSTANT PWMR3 4 CONSTANT CHAN3 5 | 6 | FORTH DEFINITIONS ALSO LEDC 7 | 8 | : INIT-PWM ( --) 9 | PWMR1 CHAN1 LEDCATTACHPIN 10 | CHAN1 4000 50 LEDCSETUP drop 11 | PWMR2 CHAN2 LEDCATTACHPIN 12 | CHAN2 4000 50 LEDCSETUP drop 13 | PWMR3 CHAN3 LEDCATTACHPIN 14 | CHAN3 4000 50 LEDCSETUP drop 15 | ; 16 | 17 | DEFER LEDPWM 18 | 19 | : LEDPWM1 100 * CHAN1 SWAP LEDCWRITE ; 20 | : LEDPWM2 100 * CHAN2 SWAP LEDCWRITE ; 21 | : LEDPWM3 100 * CHAN3 SWAP LEDCWRITE ; 22 | 23 | : RED ['] LEDPWM1 IS LEDPWM ; 24 | : BLUE ['] LEDPWM2 IS LEDPWM ; 25 | : GREEN ['] LEDPWM3 IS LEDPWM ; 26 | 27 | INIT-PWM 28 | 29 | RED 30 | 31 | 50 VALUE DELAY 32 | 33 | : WAIT DELAY MS ; 34 | 35 | : STEST 2000 0 DO I LEDPWM WAIT 100 +LOOP ; 36 | : STEST2 2000 0 DO 2000 I - LEDPWM WAIT 100 +LOOP ; 37 | 38 | : LEDTEST STEST2 STEST STEST2 0 LEDPWM ; 39 | 40 | : LEDTEST2 0 ?DO RED LEDTEST BLUE LEDTEST GREEN LEDTEST LOOP 0 LEDPWM ; 41 | 42 | 43 | 44 | LEDTEST 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /MCP23017.txt: -------------------------------------------------------------------------------- 1 | 2 | \ Language: ESP32Forth 3 | \ Simplified use of the 16 bit I/O Expander w. I2C interface: MCP23017 4 | \ Read the documentation for MCP23017 for more details, here: 5 | \ https://ww1.microchip.com/downloads/en/devicedoc/20001952c.pdf 6 | \ This chip can also deal with interrupts when input bit(s) change. 7 | \ This feature is not included in this simplified program. 8 | \ PortA is here used as Output, and PortB as Input. 9 | \ Arduino inspiration source: https://tronixstuff.com/2011/08/26/arduino-mcp23017-tutorial/ 10 | \ Author: Jan Langevad - March 2022 - free software. 11 | \ Not claiming that this icode s optimal, but only an introduction to this expander and I2C in ESP32Forth. 12 | \ Good ideas are welcome 🙂 13 | 14 | base @ 15 | 16 | FORTH 17 | 18 | hex \ <---------- OBS 19 | 20 | \ Unfortunately ESP32Forth Wire.write words requires adresses, and not values on stack so: 21 | variable Var00 00 Var00 ! 22 | variable Var01 01 Var01 ! 23 | variable Var20 20 Var20 ! 24 | variable Var12 12 Var12 ! 25 | variable Var13 13 Var13 ! 26 | variable VarFF FF VarFF ! 27 | variable Varxx 00 Varxx ! 28 | variable VarPortB 00 VarPortB ! \ read port B result saved here 29 | 30 | variable WireOK? \ save wire prep result here 31 | 0 WireOK? ! 32 | 33 | variable WireResultA 34 | 0 WireResultA ! \ "Return code" saved here 35 | variable WireResultB 36 | 0 WireResultB ! \ "Return code" saved here 37 | 38 | WIRE \ change vocabulary 39 | 40 | : Wire.Prep 15 16 Wire.begin WireOK? ! ; \ initialize IC2 pins SDA SCL --- 41 | Wire.Prep \ 15 16 hex = 21 22 decimal GPIO pin # <********************* 42 | cr ." WireOK?=1 is OK: " WireOK? @ . cr 43 | 44 | : ExpanderSetup ( --- ) \ Set PortA t output and PortB to Input: 45 | 46 | \ $20 is the I2C WRITE address used in this chip/setup (Microchip doc. says 40!/???) 47 | 48 | 20 Wire.beginTransmission \ Start 49 | \ unfortunately Wire.write in our Forth requires adresses, and not values on stack 50 | Var00 1 Wire.write drop \ 00=IODIRA register. Var01=IODIRB register 51 | Var00 1 Wire.write drop \ 00 = all 8 pins are output! (Default @ Reset is INPUT!) 52 | 1 Wire.endTransmission \ --- 1 = stop option, drop return 0= ok 1..4 see doc! 53 | WireResultA ! \ "Return code" saved here 54 | 55 | 20 Wire.beginTransmission \ Start 56 | \ unfortunately Wire.write in our Forth requires adresses, and not values on stack 57 | Var01 1 Wire.write drop \ 00=IODIRA register. Var01=IODIRB register 58 | VarFF 1 Wire.write drop \ FF = all 8 pins are Input! (Default @ Reset is INPUT!) 59 | 1 Wire.endTransmission \ --- 1 = stop option, drop return 0= ok 1..4 see doc! 60 | WireResultB ! \ "Return code" saved here 61 | ; 62 | 63 | : ExpanderSetPortA ( byte --- ) \ write to port A 64 | 65 | VarXX ! \ store byte in a value 😊 at an address ) 66 | 67 | \ $20 is the I2C WRITE address used in this chip/setup (Microchip doc. says 40!/???) 68 | 69 | 20 Wire.beginTransmission \ Start 70 | Var12 1 Wire.write drop \ address port A. (Address port B=Var13) 71 | Varxx 1 Wire.write drop \ Write input byte/Varxx variable to PortA 72 | 73 | 1 Wire.endTransmission \ --- 1 = stop option, drop return 0= ok 1..4 see doc! 74 | WireResultA ! \ "Return code" saved here 75 | ; 76 | 77 | : ExpanderGetPortB ( --- byte ) \ read from port B 78 | 79 | \ $20 is the I2C WRITE address used in this chip/setup (Microchip doc. says 40!/???) 80 | 81 | 20 Wire.beginTransmission \ Start 82 | Var13 1 Wire.write drop \ address port port B 83 | 0 Wire.endTransmission drop \ --- 0 = cont. option, drop return 0= ok 1..4 see d 84 | 85 | 20 1 -1 Wire.requestFrom drop \ request one byte of data from MCP20317 86 | Wire.Available drop \ --- # bytes to read DROPPED 87 | Wire.read \ --- byte gets PortB data byte 88 | dup VarPortB ! \ --- byte save a copy in RAM 89 | ; 90 | 91 | FORTH 92 | BASE ! -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # esp32forth-addons 2 | 3 | Adding new features to Espforth version 7.54 & 7.06 of Bradley Nelson and Dr. Ting 4 | 5 | https://esp32forth.appspot.com/ESP32forth.html 6 | 7 | This Github repository reflects the effort of members from the Forth2020 group 8 | https://www.facebook.com/groups/forth2020 9 | 10 | ** New ESP32forth FB GROUP ** 11 | https://www.facebook.com/groups/esp32a 12 | ESP32FORTH forth programming for the ESP32 CPU 13 | 14 | And is complementary to our web page with information and examples https://esp32.forth2020.org 15 | 16 | 17 | A large collection of free Forth Books manuals, and PDF visit our https://books.forth2020.org 18 | 19 | Other links : 20 | 21 | Join our monthly Zoom meetings to talk to developers and users www.forth2020.org 22 | 23 | Zoom Channel https://www.youtube.com/forth2020 24 | 25 | Contact https://www.forth2020.org/home/contact 26 | -------------------------------------------------------------------------------- /Ralph-lundvall-music.txt: -------------------------------------------------------------------------------- 1 | editor 0 list 2 | 3 | 0 r ( : mystart 0 2 thru 10 15 thru ; ) 4 | 1 r ( startup: mystart ) 5 | 2 r ( pin D4 to speaker ) 6 | 3 r 4 constant SPKR 1 constant CHAN 7 | 4 r ledc 1000 ms SPKR CHAN ledcattachpin 8 | 5 r : NOTE ( hz ms -- ) chan rot tone ms chan 0 tone ; 9 | 6 r 3000 150 NOTE 10 | 7 r ( blank lines for your utilities etc ) 11 | 8 r 12 | 9 r 13 | 10 r : LOADBPM 1 2 THRU ; 14 | 11 r : LOADNOTES 10 14 THRU ; 15 | 12 r variable ~mpm 200 ms 2000000 ~mpm ! 16 | 13 r variable ~mscale 200 ms 240000000 ~mscale ! 17 | 14 r : BPM ~mscale @ SWAP / ~mpm ! ; 18 | 15 r : BPM? ~mscale @ ~mpm @ / . ; 19 | 20 | flush 21 | update 22 | 23 | editor 1 list 24 | 25 | 0 r ( sound library ) 26 | 1 r : BIP 3000 50 NOTE ; 27 | 2 r : BEEP 3000 150 NOTE ; 28 | 3 r : BEEPS 0 DO BEEP 50 ms LOOP ; 29 | 4 r : 3RD ( 1n 2n 3n -- 1n 2n 3n 1n ) >R OVER R> SWAP ; 30 | 5 r : WARBLE 3 0 DO 3RD OVER NOTE 2DUP NOTE LOOP DROP 2DROP ; 31 | 6 r BEEP 32 | 7 r : SIREN 400 550 400 WARBLE ; 33 | 8 r : ~R 500 600 40 WARBLE ; 34 | 9 r : RING ~R 200 ms ~R ; 35 | 10 r : RINGS ( rings -- ) 0 DO RING 1000 ms LOOP ; 36 | 11 r : ZAP 3000 100 DO I 15 I 300 / - NOTE 200 +LOOP ; 37 | 12 r : ZAPS ( cnt -- ) 0 DO ZAP 50 ms LOOP ; 38 | 13 r : SAUCER 10 0 DO 600 50 NOTE 580 50 NOTE LOOP ; 39 | 14 r 40 | 15 r 41 | 42 | flush 43 | 44 | editor 2 list 45 | 46 | 0 r : .1 ~mpm @ 1000 / NOTE ; 47 | 1 r : .2 ~mpm @ 2000 / NOTE ; 48 | 2 r : .4 ~mpm @ 4000 / NOTE ; 49 | 3 r : .8 ~mpm @ 8000 / NOTE ; 50 | 4 r : .16 ~mpm @ 16000 / NOTE ; 51 | 5 r : .32 ~mpm @ 32000 / NOTE ; 52 | 6 r : .64 ~mpm @ 64000 / NOTE ; 53 | 7 r : .4. ~mpm @ 2667 / NOTE ; 54 | 8 r : .2. ~mpm @ 1333 / NOTE ; 55 | 9 r : sl 12 NOTE ; 56 | 10 r : .8. ~mpm @ 5333 / NOTE ; 57 | 11 r : .28 ~mpm @ 1600 / NOTE ; 58 | 12 r : .3 ~mpm @ 3000 / NOTE ; 59 | 13 r : .6 ~mpm @ 6000 / NOTE ; 60 | 61 | flush 62 | 63 | 64 | editor 10 list 65 | 0 R 16 CONSTANT C0 17 CONSTANT C0# 18 CONSTANT D0 66 | 1 R 19 CONSTANT D0# 21 CONSTANT E0 22 CONSTANT F0 67 | 2 R 23 CONSTANT F0# 24 CONSTANT G0 26 CONSTANT G0# 68 | 3 R 28 CONSTANT A0 29 CONSTANT A0# 31 CONSTANT B0 69 | 4 R 33 CONSTANT C1 35 CONSTANT C1# 37 CONSTANT D1 70 | 5 R 39 CONSTANT D1# 41 CONSTANT E1 44 CONSTANT F1 71 | 6 R 46 CONSTANT F1# 49 CONSTANT G1 52 CONSTANT G1# 72 | 7 R 55 CONSTANT A1 58 CONSTANT A1# 62 CONSTANT B1 73 | 8 R 65 CONSTANT C2 69 CONSTANT C2# 73 CONSTANT D2 74 | 9 R 78 CONSTANT D2# 82 CONSTANT E2 87 CONSTANT F2 75 | 10 R 92 CONSTANT F2# 98 CONSTANT G2 104 CONSTANT G2# 76 | 11 R 110 CONSTANT A2 117 CONSTANT A2# 123 CONSTANT B2 77 | 12 R 131 CONSTANT C3 139 CONSTANT C3# 147 CONSTANT D3 78 | 13 R 156 CONSTANT D3# 165 CONSTANT E3 175 CONSTANT F3 79 | 14 R 185 CONSTANT F3# 196 CONSTANT G3 208 CONSTANT G3# 80 | 15 R 220 CONSTANT A3 233 CONSTANT A3# 247 CONSTANT B3 81 | 82 | flush 83 | 84 | editor 11 list 85 | 0 R 262 CONSTANT C4 277 CONSTANT C4# 294 CONSTANT D4 86 | 1 R 311 CONSTANT D4# 330 CONSTANT E4 349 CONSTANT F4 87 | 2 R 370 CONSTANT F4# 392 CONSTANT G4 415 CONSTANT G4# 88 | 3 R 440 CONSTANT A4 466 CONSTANT A4# 494 CONSTANT B4 89 | 4 R 523 CONSTANT C5 554 CONSTANT C5# 587 CONSTANT D5 90 | 5 R 622 CONSTANT D5# 659 CONSTANT E5 698 CONSTANT F5 91 | 6 R 740 CONSTANT F5# 784 CONSTANT G5 831 CONSTANT G5# 92 | 7 R 880 CONSTANT A5 932 CONSTANT A5# 988 CONSTANT B5 93 | 8 R 1047 CONSTANT C6 1109 CONSTANT C6# 1175 CONSTANT D6 94 | 9 R 1245 CONSTANT D6# 1319 CONSTANT E6 1397 CONSTANT F6 95 | 10 R 1480 CONSTANT F6# 1568 CONSTANT G6 1661 CONSTANT G6# 96 | 11 R 1760 CONSTANT A6 1865 CONSTANT A6# 1976 CONSTANT B6 97 | 12 R 2093 CONSTANT C7 2217 CONSTANT C7# 2349 CONSTANT D7 98 | 13 R 2489 CONSTANT D7# 2637 CONSTANT E7 2794 CONSTANT F7 99 | 14 R 2960 CONSTANT F7# 3136 CONSTANT G7 3322 CONSTANT G7# 100 | 15 R 3520 CONSTANT A7 3729 CONSTANT A7# 3951 CONSTANT B7 101 | 102 | flush 103 | 104 | editor 12 list 105 | 0 R 4186 CONSTANT C8 4435 CONSTANT C8# 0 CONSTANT rst 106 | 1 R 107 | 2 R 108 | 3 R 109 | 4 R 110 | 5 R 111 | 112 | 113 | flush 114 | 115 | editor 13 list 116 | 117 | 0 r : JINGLE ( BLOCK 13 ) 118 | 1 r E5 .8 E5 .8 E5 .4 119 | 2 r E5 .8 E5 .8 E5 .4 120 | 3 r E5 .8 G5 .8 C5 .8 D5 .8 E5 .2 121 | 4 r F5 .8 F5 .8 F5 .8 F5 .8 122 | 5 r F5 .8 E5 .8 E5 .8 E5 .16 E5 .16 123 | 6 r E5 .8 D5 .8 D5 .8 E5 .8 D5 .4 G5 .4 124 | 7 r E5 .8 E5 .8 E5 .4 E5 .8 E5 .8 E5 .4 125 | 8 r E5 .8 G5 .8 C5 .8 D5 .8 E5 .2 126 | 9 r F5 .8 F5 .8 F5 .8 F5 .8 127 | 10 r F5 .8 E5 .8 E5 .8 E5 .16 E5 .16 128 | 11 r G5 .8 G5 .8 F5 .8 D5 .8 C5 .2 ; 129 | 130 | flush 131 | 132 | editor 14 list 133 | 134 | 0 r : RUDOLPH 220 BPM G4 .8 A4 .8 G4 .4 E4 .4 C5 .4 A4 .4 G4 .2. 135 | 1 r G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 C5 .4 B4 .1 136 | 2 r F4 .8 G4 .8 F4 .4 D4 .4 B4 .4 A4 .4 G4 .2. 137 | 3 r G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 A4 .4 E4 .1 138 | 4 r G4 .8 A4 .8 G4 .4 E4 .4 C5 .4 A4 .4 G4 .2. 139 | 5 r G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 C5 .4 B4 .1 140 | 6 r F4 .8 G4 .8 F4 .4 D4 .4 B4 .4 A4 .4 G4 .2. 141 | 7 r G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 D5 .4 C5 .2. 142 | 8 r A4 .4 A4 .4 C5 .4 A4 .4 G4 .4 E4 .4 G4 .2 F4 .4 143 | 9 r A4 .4 G4 .4 F4 .4 E4 .1 D4 .4 E4 .4 G4 .4 144 | 10 r A4 .4 B4 .4 B4 .4 B4 .2 C5 .4 C5 .4 B4 .4 A4 .4 145 | 11 r G4 .4 F4 .8 D4 .28 G4 .8 A4 .8 G4 .4 E4 .4 146 | 12 r C5 .4 A4 .4 G4 .2. G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 147 | 13 r C5 .4 B4 .1 F4 .8 G4 .8 F4 .4 D4 .4 B4 .4 148 | 14 r A4 .4 G4 .2. G4 .8 A4 .8 G4 .8 A4 .8 G4 .4 D5 .4 C5 .2. ; 149 | 150 | flush 151 | 152 | editor 15 list 153 | 154 | 0 r : CARTOON 155 | 1 r C7 .8 G6 .16 G6 .16 A6 .8 G6 .8 rst .8 156 | 2 157 | 3 r C7 .8 G6 .16 G6 .16 A6 .8 G6 .8 rst .8 158 | 4 r C7 .8 G6 .16 G6 .16 A6 .8 G6 .8 rst .8 159 | 5 r B6 .8 C7 .4 ; 160 | 161 | 8 r : CARTOON2 162 | 9 r C6 .8 G5 .16 G5 .16 A5 .8 G5 .8 rst .8 163 | 10 r C6 .8 G5 .16 G5 .16 A5 .8 G5 .8 rst .8 164 | 11 r C6 .8 G5 .16 G5 .16 A5 .8 G5 .8 rst .8 165 | 12 r B5 .8 C6 .4 ; 166 | 167 | flush 168 | 169 | 170 | -------------------------------------------------------------------------------- /RotaryEncoder-KY-040-WithInterrupts-ChristianH.txt: -------------------------------------------------------------------------------- 1 | \ ESP32forth - Rotary Encoder KY-040 driver. 2 | \ by Peter Forth and Christian Hinse 3 | \ ESP32forth version: ESP32forth-7.0.5.4.zip 4 | 5 | \ *** Description *** 6 | \ This a modified and commented version of the original code posted by Peter Forth. 7 | \ I added comments to better understand the code, included code to use 8 | \ pin interrupts and use all rotary encoder detents. 9 | \ - This rotary encoder code will increment the value of varA 10 | \ when rotating clockwise and decrement it when going counterclockwise. 11 | \ - It will also increment varSW when the push-button switch is depressed. 12 | \ Tested without RC filter resistors and capacitors and works properly. 13 | 14 | \ ==> 2021-08-01 15 | \ Modified to add push button switch interrupts with timer debounce. 16 | \ 1. Configure GPIO 05 as input with pullup for the push-button switch. 17 | \ 2. Generate interrupts on pin state change. 18 | \ 3. Disable interrupts on pin on any interrupt 19 | \ and starts a timer to read after a delay. 20 | \ 4. Read and re-enable interrupts after a hardware timer 21 | \ delay of 10 ms to provide switch debounce. 22 | 23 | \ ==> 2021-07-30 24 | \ Modified to use pin interrupts and timer. 25 | \ 1. Generate interrupts on pin state change. 26 | \ 2. Disable interrupts on pin on any interrupt 27 | \ and starts a timer to read encoder after a delay. 28 | \ 3. Read and re-enable interrupts after a hardware timer 29 | \ delay of 2 ms to provide switch debounce. 30 | 31 | \ ==> 2021-07-20 32 | \ 1. Counts on all 30 detents instead of of 15 in the original Peter Forth code. 33 | \ 2. The timer 0 delay was also changed from 10000 to 2000 usec or 10 ms to 2 ms. 34 | \ to prevent droping counts when turning fast. 35 | \ 3. The pin pulldown code was removed. It works fine 36 | \ without it because the KY-040 has its own pullup resistors. 37 | \ 4. Code was factored into smaller words 38 | \ for easy testing and readability. 39 | \ 5. The original Peter Forth code was modified to increment 40 | \ on clockwise rotation and decrement on counterclockwise rotation. 41 | \ 6. Comments were added to explain the code. 42 | 43 | \ *** Define all VALUEs used in this program. 44 | 0 value varA \ This the ariable being incremented or decremented 45 | \ by the rotation of the rotary encoder. 46 | 0 value varSW \ This the ariable being incremented or decremented 47 | \ by the depression of the push-button switch SW. 48 | 0 value oldA \ Contains the state of the last pinA read. 49 | 0 value pinA \ Contains the state of the present pinA read. 50 | 0 value pinB \ Contains the state of the present pinB read. 51 | 0 value pinSW \ Contains the state of the present pinSW read. 52 | 0 value oldSW \ Contains the state of the last pinSW read. 53 | 15 value pinA# \ The # of the GPIO pin used for encoder pinA. 54 | 4 value pinB# \ The # of the GPIO pin used for encoder pinB. 55 | 5 value pinSW# \ The # of the GPIO pin used for the push-button switch pinSW. 56 | 57 | \ *** Define all CONSTANTs used in this program. 58 | -1 constant TRUE \ Definitions of a logic TRUE and FALSE. 59 | 0 constant FALSE 60 | 61 | \ *** Set encoder pinA# and pinB# in iput mode. 62 | pinA# input pinmode 63 | pinB# input pinmode 64 | 65 | \ *** Set the push-button pinSW# in iput mode with internal pullup. 66 | interrupts \ Required for recognition of gpio_pullup_en. 67 | pinSW# dup input pinmode gpio_pullup_en drop ; 68 | 69 | \ *** Define words to read the pin state into values pinA, pinB and pinSW. 70 | : rd-pinA pinA# digitalRead to pinA ; 71 | : rd-pinB pinB# digitalread to pinB ; 72 | : rd-pinSW pinSW# digitalread to pinSW ; 73 | 74 | \ *** Set oldA to the state of the actual encoder detent. 75 | \ This prevent an initial unintended change of var on startup. 76 | : init-oldA pinA# digitalread to oldA ; 77 | init-oldA 78 | 79 | \ *** Define a word to determine if pinA was not changed. 80 | : oldA=pinA? oldA pinA = if TRUE else FALSE then ; 81 | 82 | \ *** Define a word to determine if pinSW was not changed. 83 | : oldSW=pinSW? oldSW pinSW = if TRUE else FALSE then ; 84 | 85 | \ *** Define a word to determine if pinA is falling. 86 | : pinA-fall? pinA oldA - -1 = ; \ Only equals -1 if pinA is 0 and oldA is 1. 87 | 88 | \ *** Define a word to determine if pinSW is falling. 89 | : pinSW-fall? pinSW oldSW - -1 = ; \ Only equals -1 if pinSW is 0 and oldSW is 1. 90 | 91 | \ Define words to enable or disable interrupts on pinA. 92 | 93 | interrupts \ Required for gpio_intr_dis and ena reconition. 94 | : dis-intA pinA# gpio_intr_disable drop ; 95 | : ena-intA pinA# gpio_intr_enable drop ; 96 | 97 | \ Define words to enable or disable interrupts on pinSW. 98 | 99 | interrupts \ Required for gpio_intr_dis and ena reconition. 100 | : dis-intSW pinSW# gpio_intr_disable drop ; 101 | : ena-intSW pinSW# gpio_intr_enable drop ; 102 | 103 | \ *** Define the action word when pinA changes state. 104 | \ This word is used by timer 0 interrupt ISR. 105 | : pinA-do? 106 | rd-pinA rd-pinB 107 | oldA=pinA? if \ Do nothing if no change. 108 | else pinA-fall? if pinB if 1 +to varA \ Falling clockwise. 109 | else -1 +to varA \ Falling counterclockwise. 110 | then 111 | else pinB if -1 +to varA \ Rising counterclockwise. 112 | else 1 +to varA \ Rising clockwise. 113 | then 114 | then 115 | pinA to oldA \ Update oldA. 116 | then 117 | ena-intA \ Reactivate interrupts disabled by pin interrupts ISR. 118 | ; 119 | 120 | \ *** Define the action word when pinSW changes state. 121 | \ Depression and release of pinSW push-button should increment varSw by 1. 122 | \ This word is used by timer 1 interrupt ISR. 123 | : pinSW-do? 124 | rd-pinSW 125 | oldSW=pinSW? if \ Do nothing if no change. 126 | else pinSW-fall? if 1 +to varSW \ Increment if falling. 127 | else \ No action if rising. 128 | then 129 | pinSW to oldSW \ Update oldSW. 130 | then 131 | ena-intSW \ Reactivate interrupts disabled 132 | \ by pin interrupt ISR. 133 | ; 134 | \ *** Define the timer 0 ISR word to be executed 135 | \ by the t0 interrupt after a 2 ms delay 136 | \ to filter out switch bounce. 137 | : t0-readvarA \ Used as t0 ISR. 138 | pinA-do? \ Executes action required on pinA state change. 139 | ; 140 | 141 | \ *** Define the timer 1 ISR word to be executed 142 | \ by the t1 interrupt after a 10 ms delay 143 | \ to filter out switch bounce. 144 | : t1-readvarSW \ Used as t0 ISR. 145 | pinSW-do? \ Executes action required on pinSW state change. 146 | ; 147 | 148 | \ *** Configure timer 0 to read pinA and reactivate 149 | \ interrupts after 2 ms. 150 | timers \ Required for interval and rerun recognition. 151 | ' t0-readvarA 2000 0 interval 152 | \ This delay value may have to be adjusted depending on the type 153 | \ of switch based encoder used. 154 | 155 | \ *** Configure timer 1 to read pinSW and reactivate 156 | \ interrupts after 10 ms. 157 | timers \ Required for interval and rerun recognition. 158 | ' t1-readvarSW 10000 1 interval 159 | \ This delay value may have to be adjusted depending on the type 160 | \ of push-button switch used. 161 | 162 | \ *** Define the pinA interrupts ISR word. 163 | : intA-do 164 | dis-intA \ Disable interrupts on pinA to prevent multiple spurrious interrupts 165 | \ due to switch bounce. 166 | 0 rerun \ Start t0 delayed rotary encoder action word execution 167 | \ and reactivation of pinA interrupts. 168 | ; 169 | \ *** Activate pin change interrupts on pinA. 170 | interrupts \ Required for pinchange recognition. 171 | ' intA-do pinA# pinchange 172 | 173 | \ *** Define the pinSW interrupt ISR word. 174 | timers \ Required for interval and rerun recognition. 175 | : intSW-do 176 | dis-intSW \ Disable interrupts on pinA to prevent multiple spurrious interrupts 177 | \ due to switch bounce. 178 | 1 rerun \ Start t1 delayed push-button SW action word execution 179 | \ and reactivation of pinSW interrupts. 180 | ; 181 | \ *** Activate pin change interrupts on pinSW. 182 | interrupts \ Required for pinchange recognition. 183 | ' intSW-do pinSW# pinchange 184 | 185 | \ *** Define a test word to show the value of varA. 186 | : .varA cr varA . ; 187 | 188 | \ *** Define a test word to show the value of varSW. 189 | : .varSW cr varSW . ; 190 | 191 | \ *** Testing procedure for rotary encoder. *** 192 | \ 1. Type .varA to show the initial value of valA. 193 | \ 2. Rotate the encoder knob clockwise for a full turn. 194 | \ 3. Type .valA. The value shown should be the number of detents 195 | \ on your encoder. Mine had 30 detents. 196 | \ 4. Rotate the encoder knob to counterclockwise for a full turn. 197 | \ 5. Type .valA. The value shown should decrent from your number of detents 198 | \ back to 0. 199 | \ ** My test results on the screen ** 200 | \ --> .varA 201 | \ 0 ok 202 | \ --> .varA 203 | \ 30 ok 204 | \ --> .varA 205 | \ 0 ok 206 | \ --> 207 | 208 | \ *** Testing procedure for push-button SW. *** 209 | \ 1. Type .varSW to show the initial value of valSW. 210 | \ 2. Depress and release the push-button SW. 211 | \ 3. Type .valSW. The value of valSW should have been incremented by 1. 212 | \ 4. Repeat 1-3 a few times to confirm repeated increments by 1 only. 213 | \ ** My test results on the screen ** 214 | \ --> .varsw 215 | \ 0 ok 216 | \ --> .varsw 217 | \ 1 ok 218 | \ --> .varsw 219 | \ 2 ok 220 | \ --> .varsw 221 | \ 3 ok 222 | \ --> 223 | 224 | \ *** Comments *** 225 | \ 1. With the help of Peter Forth I finally succeeded in getting 226 | \ a cheap switch based rotary encoder working properly with pin interrupts 227 | \ even with the switch bounce occuring on these KY-040 encoders. 228 | \ 2. This approach requires no RC filter and generates a single interrupt 229 | \ for each detent change. 230 | \ 3. With the 2000us timer setting, rotating the knob very fast 231 | \ could still drop some inc/dec . A lower settings could 232 | \ reduce this probability further but may not be sufficient 233 | \ to debounce long bounce periods at slow rotation. 234 | \ 4. Knob selection affects switch bounce: 235 | \ - a heavy knob bounces more, 236 | \ - a larger knob bounces more because it goes over the detent 237 | \ transition more slowly and generates longer bounce periods, 238 | \ - a larger knob reduces the speed of rotation and may prevent dropping 239 | \ counts due to fast rotation. 240 | \ 5. My best results were obtained from a knob of 1.5cm of diameter. 241 | \ 6. The timer delay is a compromise between dropping counts or insufficient debounce. 242 | \ 7. The debouce approach with a timer is also usable for the push-button switch. 243 | \ 8. The word factoring could be improved for performance. 244 | \ My goal was understanding more than performance. 245 | \ 9. This experiment allowed me to better understand switch bounce, timers 246 | \ and debounce procedures. Now that I have a switch working with interrupts, 247 | \ I can move on to something else. 248 | -------------------------------------------------------------------------------- /SERVO-PWM-EXAMPLE.txt: -------------------------------------------------------------------------------- 1 | \ example how to use RC servos without libraries, by PeterForth 2 | 3 | FORTH DEFINITIONS also LEDC ( vocabulary ) 4 | 5 | DECIMAL 6 | 7 | 15 constant PWMR 2 constant chRIGHT 8 | 9 | : init-pwm PWMR chRIGHT ledcAttachPin 10 | chRIGHT 40000 10 ledcSetup ; 11 | 12 | : servo ( speed -- ) chRIGHT swap ledcWrite ; 13 | 14 | init-pwm 15 | 16 | ( here some test examples ) 17 | 18 | : test 180 10 do i servo 200 ms 10 +loop ; 19 | 20 | : test2 180 10 do 180 i - servo 200 ms 10 +loop ; 21 | 22 | : test3 test2 test ; 23 | 24 | : test4 4 0 do test3 loop ; 25 | 26 | 27 | -------------------------------------------------------------------------------- /Timers-Mini-OOF-multitask.fth: -------------------------------------------------------------------------------- 1 | \ Periodic Timers using Mini-OOF ver 2 by Bob Edwards April 2022 2 | \ this code allows multiple words to execute periodically, all with different time periods, 3 | \ on one cog. 4 | \ Run MAIN for a demo, which terminates on any key being pressed 5 | 6 | \ NB On entering each method, the address of the current object is top of the data stack 7 | \ This must be removed by the method before exiting 8 | \ You can see that it is often convenient to transfer that to the R stack to get 9 | \ to any input parameters. You must clean up the R stack before exiting the method, though 10 | 11 | DEFINED? *TIMERS* [IF] forget *TIMERS* [THEN] 12 | : *TIMERS* ; 13 | 14 | \ TIMER class definition 15 | OBJECT CLASS 16 | 4 VAR STARTTIME 17 | 4 VAR PERIOD 18 | 4 VAR TCODE 19 | METHOD TSET 20 | METHOD TRUN 21 | METHOD TPRINT 22 | END-CLASS TIMER 23 | 24 | :noname >R 25 | R@ PERIOD ! \ save the reqd period in ms 26 | R@ TCODE ! \ save the cfa of the word that will run periodically 27 | MS-TICKS R> STARTTIME ! \ save the current time since reset 28 | ; TIMER DEFINES TSET ( codetorun period -- ) \ initialises the TIMER 29 | 30 | :noname >R 31 | MS-TICKS DUP \ read the present time 32 | R@ STARTTIME @ \ read when this TIMER last ran 33 | - \ calculate how long ago that is 34 | R@ PERIOD @ >= \ is it time to run the TCODE? 35 | IF 36 | R@ STARTTIME ! \ save the present time 37 | R> TCODE @ EXECUTE \ run cfa stored in TCODE 38 | ELSE 39 | DROP R> DROP \ else forget the present time 40 | THEN 41 | ; TIMER DEFINES TRUN ( -- ) \ run TCODE every PERIOD ms 42 | 43 | :noname >R 44 | CR 45 | ." STARTTIME = " R@ STARTTIME @ . CR 46 | ." PERIOD = " R@ PERIOD @ . CR 47 | ." TCODE = " R> TCODE @ . CR 48 | ; TIMER DEFINES TPRINT ( -- ) \ print timer variables for debug 49 | \ end of TIMER class definition 50 | 51 | \ Example application 52 | TIMER NEW CONSTANT TIMER1 53 | TIMER NEW CONSTANT TIMER2 54 | TIMER NEW CONSTANT TIMER3 55 | TIMER NEW CONSTANT TIMER4 56 | TIMER NEW CONSTANT TIMER5 57 | 58 | : HELLO1 ." Hi from HELLO1" CR ; 59 | : HELLO2 ." HELLO2 here !" CR ; 60 | : HELLO3 ." Watcha there from HELLO3" CR ; 61 | : HELLO4 ." Good day, Mate from HELLO4" CR ; 62 | : HELLO5 ." How's it going? from HELLO5" CR ; 63 | 64 | \ Print all timer variables 65 | : .VARS ( -- ) 66 | CR CR ." Timer1" CR 67 | TIMER1 TPRINT 68 | CR ." Timer2" CR 69 | TIMER2 TPRINT 70 | CR ." Timer3" CR 71 | TIMER3 TPRINT 72 | CR ." Timer4" CR 73 | TIMER4 TPRINT 74 | CR ." Timer5" CR 75 | TIMER5 TPRINT 76 | ; 77 | 78 | : MAIN ( -- ) \ demo runs until a key is pressed 79 | CR 80 | ['] HELLO1 2000 TIMER1 TSET 81 | ['] HELLO2 450 TIMER2 TSET 82 | ['] HELLO3 3500 TIMER3 TSET 83 | ['] HELLO4 35000 TIMER4 TSET 84 | ['] HELLO5 2500 TIMER5 TSET \ all timer periods and actions defined 85 | 0 86 | BEGIN 87 | 1+ 88 | TIMER1 TRUN 89 | TIMER2 TRUN 90 | TIMER3 TRUN 91 | TIMER4 TRUN 92 | TIMER5 TRUN \ all timers repeatedly run 93 | KEY? UNTIL 94 | CR ." The five timers TRUNs were each run " . ." times" CR 95 | .VARS \ show each timer's data 96 | ; 97 | 98 | 99 | -------------------------------------------------------------------------------- /ULTRASOUND-lib.txt: -------------------------------------------------------------------------------- 1 | ( Ultrasound SR04 high level forth library Atle Bergstrøm 2021 ) 2 | ( ... delay between lines is useful when uploading over WIFI ) 3 | DECIMAL 4 | : ... 200 ms ; 5 | ... 6 | 19 constant trigpin 7 | ... 8 | 18 constant echopin 9 | ... 10 | : init trigpin output pinmode echopin input pinmode ; 11 | ... 12 | init 13 | ... 14 | ( if you don´t use OLED, comment the line out ) 15 | : o. oledcls oledhome olednum oleddisplay ; 16 | ... 17 | : trig low trigpin pin 2 ms high trigpin pin 10 ms low trigpin pin ; 18 | ... 19 | : echo echopin pulsein ; 20 | ... 21 | : scan trig echo . cr ; 22 | ... 23 | : testus 100 for scan next ; -------------------------------------------------------------------------------- /USOUNDlib-READMEfirst.txt: -------------------------------------------------------------------------------- 1 | 2 | Before using the ultrasound library 3 | you need to add to esp32forth.ino 4 | 5 | the PULSEIN word 6 | 7 | which is defined as follows : 8 | 9 | Y(pulsein, n0 = pulseIn(n0, HIGH)) \ 10 | 11 | 12 | ( I defined it after analogin 13 | Y(analogRead, n0 = analogRead(n0)) \ ) 14 | 15 | we are still on development so, give us feedback 16 | of your success. 17 | 18 | Pinout and connection : 19 | I had no problem using the HC-SRC04 module 20 | with vcc of the module to VIN (5V) of the ESP32 21 | gnd to gnd of the esp32 22 | trig connected to pin GPIO19 of esp32 23 | echo connected to pin GPIO18 of esp32 24 | 25 | 26 | -------------------------------------------------------------------------------- /esp32forth-oled.txt: -------------------------------------------------------------------------------- 1 | the esp32forth oled 2 | is version 7.0 of ESP32forth complete 3 | with OLED support included 4 | all 1 file download from here 5 | https://github.com/PeterForth/espforth/tree/ESP32forth7/ESP32forth-7-oled-5-5 6 | 7 | It works well , but still need to fix the vocabulary of the oled 8 | it has graphics primitives of points lines rectangles triangles, invert 9 | screen , etc.. 10 | 11 | (work in progress will adapt to version 7.03 and add some more features) 12 | 13 | -------------------------------------------------------------------------------- /esp32forth63-touch.ino: -------------------------------------------------------------------------------- 1 | / +++++++++++++++ esp32forth.ino with TOUCH Forth word added ++++++++++++++++++++++ 2 | / ESP32forth - Adding functionality with existing C Arduino-ESP32 libraries 3 | / Date: 2020-01-03 4 | / Name: Christian Hinse 5 | /*******************************************************************************/ 6 | /* esp32Forth, Version 6.3 : for NodeMCU ESP32S */ 7 | /*******************************************************************************/ 8 | /* 16jun25cht _63 Added TOUCH word for touch PAD. */ 9 | /* Also corrected peeek to peek. C.Hinse 2020-01-02 */ 10 | /* 16jun25cht _63 */ 11 | /* web server */ 12 | /* 16jun19cht _62 */ 13 | /* structures */ 14 | /* 14jun19cht _61 */ 15 | /* macro assembler with labels */ 16 | /* 10may19cht _54 */ 17 | /* robot tests */ 18 | /* 21jan19cht _51 */ 19 | /* 8 channel electronic organ */ 20 | /* 15jan19cht _50 */ 21 | /* Clean up for AIR robot */ 22 | /* 03jan19cht _47-49 */ 23 | /* Move to ESP32 */ 24 | /* 07jan19cht _46 */ 25 | /* delete UDP */ 26 | /* 03jan19cht _45 */ 27 | /* Move to NodeMCU ESP32S Kit */ 28 | /* 18jul17cht _44 */ 29 | /* Byte code sequencer */ 30 | /* 14jul17cht _43 */ 31 | /* Stacks in circular buffers */ 32 | /* 01jul17cht _42 */ 33 | /* Compiled as an Arduino sketch */ 34 | /* 20mar17cht _41 */ 35 | /* Compiled as an Arduino sketch */ 36 | /* Follow the ceForth model with 64 primitives */ 37 | /* Serial Monitor at 115200 baud */ 38 | /* Send and receive UDP packets in parallel with Serial Monitor */ 39 | /* Case insensitive interpreter */ 40 | /* data[] must be filled with rom42.h eForth dictionary */ 41 | /* 22jun17cht */ 42 | /* Stacks are 256 cell circular buffers, with byte pointers R and S */ 43 | /* All references to R and S are forced to (unsigned char) */ 44 | /* All multiply-divide words cleaned up */ 45 | /******************************************************************************/ 46 | 47 | #include "SPIFFS.h" 48 | #include 49 | #include 50 | // #include 51 | 52 | const char* ssid = "VIDEOTRON3347";//type your ssid 53 | const char* pass = "tarifa-475";//type your password 54 | // static ip address 55 | IPAddress ip(10,0,0,99); 56 | IPAddress gateway(10,0,0,1); 57 | IPAddress subnet(255,255,255,0); 58 | 59 | WebServer server(80); 60 | 61 | /******************************************************************************/ 62 | /* esp32Forth_51 */ 63 | /******************************************************************************/ 64 | 65 | # define FALSE 0 66 | # define TRUE -1 67 | # define LOGICAL ? TRUE : FALSE 68 | # define LOWER(x,y) ((unsigned long)(x)<(unsigned long)(y)) 69 | # define pop top = stack[(unsigned char)S--] 70 | # define push stack[(unsigned char)++S] = top; top = 71 | # define popR rack[(unsigned char)R--] 72 | # define pushR rack[(unsigned char)++R] 73 | 74 | long rack_main[256] = {0}; 75 | long stack_main[256] = {0}; 76 | long rack_background[256] = {0}; 77 | long stack_background[256] = {0}; 78 | __thread long *rack; 79 | __thread long *stack; 80 | __thread unsigned char R, S, bytecode ; 81 | __thread long* Pointer ; 82 | __thread long P, IP, WP, top, links, len ; 83 | uint8_t* cData ; 84 | __thread long long int d, n, m ; 85 | String HTTPin; 86 | String HTTPout; 87 | TaskHandle_t background_thread; 88 | 89 | int BRAN=0,QBRAN=0,DONXT=0,DOTQP=0,STRQP=0,TOR=0,ABORQP=0; 90 | 91 | //#include "rom_54.h" /* load dictionary */ 92 | long data[16000] = {}; 93 | int IMEDD=0x80; 94 | int COMPO=0x40; 95 | 96 | void HEADER(int lex, char seq[]) { 97 | P=IP>>2; 98 | int i; 99 | int len=lex&31; 100 | data[P++]=links; 101 | IP=P<<2; 102 | Serial.println(); 103 | Serial.print(links,HEX); 104 | for (i=links>>2;i>2; 133 | data[P++]=6; // dolist 134 | va_list argList; 135 | va_start(argList, len); 136 | Serial.println(); 137 | Serial.print(addr,HEX); 138 | Serial.print(" "); 139 | Serial.print(6,HEX); 140 | for(; len;len--) { 141 | int j=va_arg(argList, int); 142 | data[P++]=j; 143 | Serial.print(" "); 144 | Serial.print(j,HEX); 145 | } 146 | IP=P<<2; 147 | va_end(argList); 148 | return addr; 149 | } 150 | int LABEL(int len, ... ) { 151 | int addr=IP; 152 | P=IP>>2; 153 | va_list argList; 154 | va_start(argList, len); 155 | Serial.println(); 156 | Serial.print(addr,HEX); 157 | for(; len;len--) { 158 | int j=va_arg(argList, int); 159 | data[P++]=j; 160 | Serial.print(" "); 161 | Serial.print(j,HEX); 162 | } 163 | IP=P<<2; 164 | va_end(argList); 165 | return addr; 166 | } 167 | void BEGIN(int len, ... ) { 168 | P=IP>>2; 169 | Serial.println(); 170 | Serial.print(IP,HEX); 171 | Serial.print(" BEGIN "); 172 | pushR=P; 173 | va_list argList; 174 | va_start(argList, len); 175 | for(; len;len--) { 176 | int j=va_arg(argList, int); 177 | data[P++]=j; 178 | Serial.print(" "); 179 | Serial.print(j,HEX); 180 | } 181 | IP=P<<2; 182 | va_end(argList); 183 | } 184 | void AGAIN(int len, ... ) { 185 | P=IP>>2; 186 | Serial.println(); 187 | Serial.print(IP,HEX); 188 | Serial.print(" AGAIN "); 189 | data[P++]=BRAN; 190 | data[P++]=popR<<2; 191 | va_list argList; 192 | va_start(argList, len); 193 | for(; len;len--) { 194 | int j=va_arg(argList, int); 195 | data[P++]=j; 196 | Serial.print(" "); 197 | Serial.print(j,HEX); 198 | } 199 | IP=P<<2; 200 | va_end(argList); 201 | } 202 | void UNTIL(int len, ... ) { 203 | P=IP>>2; 204 | Serial.println(); 205 | Serial.print(IP,HEX); 206 | Serial.print(" UNTIL "); 207 | data[P++]=QBRAN; 208 | data[P++]=popR<<2; 209 | va_list argList; 210 | va_start(argList, len); 211 | for(; len;len--) { 212 | int j=va_arg(argList, int); 213 | data[P++]=j; 214 | Serial.print(" "); 215 | Serial.print(j,HEX); 216 | } 217 | IP=P<<2; 218 | va_end(argList); 219 | } 220 | void WHILE(int len, ... ) { 221 | P=IP>>2; 222 | int k; 223 | Serial.println(); 224 | Serial.print(IP,HEX); 225 | Serial.print(" WHILE "); 226 | data[P++]=QBRAN; 227 | data[P++]=0; 228 | k=popR; 229 | pushR=(P-1); 230 | pushR=k; 231 | va_list argList; 232 | va_start(argList, len); 233 | for(; len;len--) { 234 | int j=va_arg(argList, int); 235 | data[P++]=j; 236 | Serial.print(" "); 237 | Serial.print(j,HEX); 238 | } 239 | IP=P<<2; 240 | va_end(argList); 241 | } 242 | void REPEAT(int len, ... ) { 243 | P=IP>>2; 244 | Serial.println(); 245 | Serial.print(IP,HEX); 246 | Serial.print(" REPEAT "); 247 | data[P++]=BRAN; 248 | data[P++]=popR<<2; 249 | data[popR]=P<<2; 250 | va_list argList; 251 | va_start(argList, len); 252 | for(; len;len--) { 253 | int j=va_arg(argList, int); 254 | data[P++]=j; 255 | Serial.print(" "); 256 | Serial.print(j,HEX); 257 | } 258 | IP=P<<2; 259 | va_end(argList); 260 | } 261 | void IF(int len, ... ) { 262 | P=IP>>2; 263 | Serial.println(); 264 | Serial.print(IP,HEX); 265 | Serial.print(" IF "); 266 | data[P++]=QBRAN; 267 | pushR=P; 268 | data[P++]=0; 269 | va_list argList; 270 | va_start(argList, len); 271 | for(; len;len--) { 272 | int j=va_arg(argList, int); 273 | data[P++]=j; 274 | Serial.print(" "); 275 | Serial.print(j,HEX); 276 | } 277 | IP=P<<2; 278 | va_end(argList); 279 | } 280 | void ELSE(int len, ... ) { 281 | P=IP>>2; 282 | Serial.println(); 283 | Serial.print(IP,HEX); 284 | Serial.print(" ELSE "); 285 | data[P++]=BRAN; 286 | data[P++]=0; 287 | data[popR]=P<<2; 288 | pushR=P-1; 289 | va_list argList; 290 | va_start(argList, len); 291 | for(; len;len--) { 292 | int j=va_arg(argList, int); 293 | data[P++]=j; 294 | Serial.print(" "); 295 | Serial.print(j,HEX); 296 | } 297 | IP=P<<2; 298 | va_end(argList); 299 | } 300 | void THEN(int len, ... ) { 301 | P=IP>>2; 302 | Serial.println(); 303 | Serial.print(IP,HEX); 304 | Serial.print(" THEN "); 305 | data[popR]=P<<2; 306 | va_list argList; 307 | va_start(argList, len); 308 | for(; len;len--) { 309 | int j=va_arg(argList, int); 310 | data[P++]=j; 311 | Serial.print(" "); 312 | Serial.print(j,HEX); 313 | } 314 | IP=P<<2; 315 | va_end(argList); 316 | } 317 | void FOR(int len, ... ) { 318 | P=IP>>2; 319 | Serial.println(); 320 | Serial.print(IP,HEX); 321 | Serial.print(" FOR "); 322 | data[P++]=TOR; 323 | pushR=P; 324 | va_list argList; 325 | va_start(argList, len); 326 | for(; len;len--) { 327 | int j=va_arg(argList, int); 328 | data[P++]=j; 329 | Serial.print(" "); 330 | Serial.print(j,HEX); 331 | } 332 | IP=P<<2; 333 | va_end(argList); 334 | } 335 | void NEXT(int len, ... ) { 336 | P=IP>>2; 337 | Serial.println(); 338 | Serial.print(IP,HEX); 339 | Serial.print(" NEXT "); 340 | data[P++]=DONXT; 341 | data[P++]=popR<<2; 342 | va_list argList; 343 | va_start(argList, len); 344 | for(; len;len--) { 345 | int j=va_arg(argList, int); 346 | data[P++]=j; 347 | Serial.print(" "); 348 | Serial.print(j,HEX); 349 | } 350 | IP=P<<2; 351 | va_end(argList); 352 | } 353 | void AFT(int len, ... ) { 354 | P=IP>>2; 355 | int k; 356 | Serial.println(); 357 | Serial.print(IP,HEX); 358 | Serial.print(" AFT "); 359 | data[P++]=BRAN; 360 | data[P++]=0; 361 | k=popR; 362 | pushR=P; 363 | pushR=P-1; 364 | va_list argList; 365 | va_start(argList, len); 366 | for(; len;len--) { 367 | int j=va_arg(argList, int); 368 | data[P++]=j; 369 | Serial.print(" "); 370 | Serial.print(j,HEX); 371 | } 372 | IP=P<<2; 373 | va_end(argList); 374 | } 375 | void DOTQ(char seq[]) { 376 | P=IP>>2; 377 | int i; 378 | int len=strlen(seq); 379 | data[P++]=DOTQP; 380 | IP=P<<2; 381 | cData[IP++]=len; 382 | for (i=0;i>2; 392 | int i; 393 | int len=strlen(seq); 394 | data[P++]=STRQP; 395 | IP=P<<2; 396 | cData[IP++]=len; 397 | for (i=0;i>2; 407 | int i; 408 | int len=strlen(seq); 409 | data[P++]=ABORQP; 410 | IP=P<<2; 411 | cData[IP++]=len; 412 | for (i=0;i>2]; 461 | IP += 4; 462 | WP = P+4; } 463 | 464 | void accep() 465 | /* WiFiClient */ 466 | { while (Serial.available()) { 467 | len = Serial.readBytes(cData, top); } 468 | Serial.write(cData, len); 469 | top = len; 470 | } 471 | void qrx(void) 472 | { while (Serial.available() == 0) {}; 473 | push Serial.read(); 474 | push -1; } 475 | 476 | void txsto(void) 477 | { Serial.write( (unsigned char) top); 478 | char c=top; 479 | HTTPout += c ; 480 | pop; 481 | } 482 | 483 | void docon(void) 484 | { push data[WP>>2]; } 485 | 486 | void dolit(void) 487 | { push data[IP>>2]; 488 | IP += 4; 489 | next(); } 490 | 491 | void dolist(void) 492 | { rack[(unsigned char)++R] = IP; 493 | IP = WP; 494 | next(); } 495 | 496 | void exitt(void) 497 | { IP = (long) rack[(unsigned char)R--]; 498 | next(); } 499 | 500 | void execu(void) 501 | { P = top; 502 | WP = P + 4; 503 | pop; } 504 | 505 | void donext(void) 506 | { if(rack[(unsigned char)R]) { 507 | rack[(unsigned char)R] -= 1 ; 508 | IP = data[IP>>2]; 509 | } else { IP += 4; (unsigned char)R-- ; } 510 | next(); } 511 | 512 | void qbran(void) 513 | { if(top == 0) IP = data[IP>>2]; 514 | else IP += 4; pop; 515 | next(); } 516 | 517 | void bran(void) 518 | { IP = data[IP>>2]; 519 | next(); } 520 | 521 | void store(void) 522 | { data[top>>2] = stack[(unsigned char)S--]; 523 | pop; } 524 | 525 | void at(void) 526 | { top = data[top>>2]; } 527 | 528 | void cstor(void) 529 | { cData[top] = (unsigned char) stack[(unsigned char)S--]; 530 | pop; } 531 | 532 | void cat(void) 533 | { top = (long) cData[top]; } 534 | 535 | void rpat(void) {} 536 | void rpsto(void) {} 537 | 538 | void rfrom(void) 539 | { push rack[(unsigned char)R--]; } 540 | 541 | void rat(void) 542 | { push rack[(unsigned char)R]; } 543 | 544 | void tor(void) 545 | { rack[(unsigned char)++R] = top; pop; } 546 | 547 | void spat(void) {} 548 | void spsto(void) {} 549 | 550 | void drop(void) 551 | { pop; } 552 | 553 | void dup(void) 554 | { stack[(unsigned char)++S] = top; } 555 | 556 | void swap(void) 557 | { WP = top; 558 | top = stack[(unsigned char)S]; 559 | stack[(unsigned char)S] = WP; } 560 | 561 | void over(void) 562 | { push stack[(unsigned char)(S-1)]; } 563 | 564 | void zless(void) 565 | { top = (top < 0) LOGICAL; } 566 | 567 | void andd(void) 568 | { top &= stack[(unsigned char)S--]; } 569 | 570 | void orr(void) 571 | { top |= stack[(unsigned char)S--]; } 572 | 573 | void xorr(void) 574 | { top ^= stack[(unsigned char)S--]; } 575 | 576 | void uplus(void) 577 | { stack[(unsigned char)S] += top; 578 | top = LOWER(stack[(unsigned char)S], top); } 579 | 580 | void nop(void) 581 | { next(); } 582 | 583 | void qdup(void) 584 | { if(top) stack[(unsigned char)++S] = top ; } 585 | 586 | void rot(void) 587 | { WP = stack[(unsigned char)(S-1)]; 588 | stack[(unsigned char)(S-1)] = stack[(unsigned char)S]; 589 | stack[(unsigned char)S] = top; 590 | top = WP; } 591 | 592 | void ddrop(void) 593 | { drop(); drop(); } 594 | 595 | void ddup(void) 596 | { over(); over(); } 597 | 598 | void plus(void) 599 | { top += stack[(unsigned char)S--]; } 600 | 601 | void inver(void) 602 | { top = -top-1; } 603 | 604 | void negat(void) 605 | { top = 0 - top; } 606 | 607 | void dnega(void) 608 | { inver(); 609 | tor(); 610 | inver(); 611 | push 1; 612 | uplus(); 613 | rfrom(); 614 | plus(); } 615 | 616 | void subb(void) 617 | { top = stack[(unsigned char)S--] - top; } 618 | 619 | void abss(void) 620 | { if(top < 0) 621 | top = -top; } 622 | 623 | void great(void) 624 | { top = (stack[(unsigned char)S--] > top) LOGICAL; } 625 | 626 | void less(void) 627 | { top = (stack[(unsigned char)S--] < top) LOGICAL; } 628 | 629 | void equal(void) 630 | { top = (stack[(unsigned char)S--] == top) LOGICAL; } 631 | 632 | void uless(void) 633 | { top = LOWER(stack[(unsigned char)S], top) LOGICAL; S--; } 634 | 635 | void ummod(void) 636 | { d = (long long int)((unsigned long)top); 637 | m = (long long int)((unsigned long)stack[(unsigned char) S]); 638 | n = (long long int)((unsigned long)stack[(unsigned char) (S - 1)]); 639 | n += m << 32; 640 | pop; 641 | top = (unsigned long)(n / d); 642 | stack[(unsigned char) S] = (unsigned long)(n%d); } 643 | void msmod(void) 644 | { d = (signed long long int)((signed long)top); 645 | m = (signed long long int)((signed long)stack[(unsigned char) S]); 646 | n = (signed long long int)((signed long)stack[(unsigned char) S - 1]); 647 | n += m << 32; 648 | pop; 649 | top = (signed long)(n / d); 650 | stack[(unsigned char) S] = (signed long)(n%d); } 651 | void slmod(void) 652 | { if (top != 0) { 653 | WP = stack[(unsigned char) S] / top; 654 | stack[(unsigned char) S] %= top; 655 | top = WP; 656 | } } 657 | void mod(void) 658 | { top = (top) ? stack[(unsigned char) S--] % top : stack[(unsigned char) S--]; } 659 | void slash(void) 660 | { top = (top) ? stack[(unsigned char) S--] / top : (stack[(unsigned char) S--], 0); } 661 | void umsta(void) 662 | { d = (unsigned long long int)top; 663 | m = (unsigned long long int)stack[(unsigned char) S]; 664 | m *= d; 665 | top = (unsigned long)(m >> 32); 666 | stack[(unsigned char) S] = (unsigned long)m; } 667 | void star(void) 668 | { top *= stack[(unsigned char) S--]; } 669 | void mstar(void) 670 | { d = (signed long long int)top; 671 | m = (signed long long int)stack[(unsigned char) S]; 672 | m *= d; 673 | top = (signed long)(m >> 32); 674 | stack[(unsigned char) S] = (signed long)m; } 675 | void ssmod(void) 676 | { d = (signed long long int)top; 677 | m = (signed long long int)stack[(unsigned char) S]; 678 | n = (signed long long int)stack[(unsigned char) (S - 1)]; 679 | n *= m; 680 | pop; 681 | top = (signed long)(n / d); 682 | stack[(unsigned char) S] = (signed long)(n%d); } 683 | void stasl(void) 684 | { d = (signed long long int)top; 685 | m = (signed long long int)stack[(unsigned char) S]; 686 | n = (signed long long int)stack[(unsigned char) (S - 1)]; 687 | n *= m; 688 | pop; pop; 689 | top = (signed long)(n / d); } 690 | 691 | void pick(void) 692 | { top = stack[(unsigned char)(S-top)]; } 693 | 694 | void pstor(void) 695 | { data[top>>2] += stack[(unsigned char)S--], pop; } 696 | 697 | void dstor(void) 698 | { data[(top>>2)+1] = stack[(unsigned char)S--]; 699 | data[top>>2] = stack[(unsigned char)S--]; 700 | pop; } 701 | 702 | void dat(void) 703 | { push data[top>>2]; 704 | top = data[(top>>2)+1]; } 705 | 706 | void count(void) 707 | { stack[(unsigned char)++S] = top + 1; 708 | top = cData[top]; } 709 | 710 | void dovar(void) 711 | { push WP; } 712 | 713 | void maxx(void) 714 | { if (top < stack[(unsigned char)S]) pop; 715 | else (unsigned char)S--; } 716 | 717 | void minn(void) 718 | { if (top < stack[(unsigned char)S]) (unsigned char)S--; 719 | else pop; } 720 | 721 | void audio(void) 722 | { WP=top; pop; 723 | ledcWriteTone(WP,top); 724 | pop; 725 | } 726 | 727 | void sendPacket(void) 728 | {} 729 | 730 | void poke(void) 731 | { Pointer = (long*)top; *Pointer = stack[(unsigned char)S--]; 732 | pop; } 733 | 734 | void peek(void) 735 | { Pointer = (long*)top; top = *Pointer; } 736 | 737 | void adc(void) 738 | { top= (long) analogRead(top); } 739 | 740 | void pin(void) 741 | { WP=top; pop; 742 | ledcAttachPin(top,WP); 743 | pop; 744 | } 745 | 746 | void duty(void) 747 | { WP=top; pop; 748 | ledcAnalogWrite(WP,top,255); 749 | pop; 750 | } 751 | 752 | void freq(void) 753 | { WP=top; pop; 754 | ledcSetup(WP,top,13); 755 | pop; 756 | } 757 | 758 | void touch(void) 759 | { top= (long) touchRead(top); } 760 | 761 | void (*primitives[82])(void) = { 762 | /* case 0 */ nop, 763 | /* case 1 */ accep, 764 | /* case 2 */ qrx, 765 | /* case 3 */ txsto, 766 | /* case 4 */ docon, 767 | /* case 5 */ dolit, 768 | /* case 6 */ dolist, 769 | /* case 7 */ exitt, 770 | /* case 8 */ execu, 771 | /* case 9 */ donext, 772 | /* case 10 */ qbran, 773 | /* case 11 */ bran, 774 | /* case 12 */ store, 775 | /* case 13 */ at, 776 | /* case 14 */ cstor, 777 | /* case 15 */ cat, 778 | /* case 16 */ nop, 779 | /* case 17 */ nop, 780 | /* case 18 */ rfrom, 781 | /* case 19 */ rat, 782 | /* case 20 */ tor, 783 | /* case 21 */ nop, 784 | /* case 22 */ nop, 785 | /* case 23 */ drop, 786 | /* case 24 */ dup, 787 | /* case 25 */ swap, 788 | /* case 26 */ over, 789 | /* case 27 */ zless, 790 | /* case 28 */ andd, 791 | /* case 29 */ orr, 792 | /* case 30 */ xorr, 793 | /* case 31 */ uplus, 794 | /* case 32 */ next, 795 | /* case 33 */ qdup, 796 | /* case 34 */ rot, 797 | /* case 35 */ ddrop, 798 | /* case 36 */ ddup, 799 | /* case 37 */ plus, 800 | /* case 38 */ inver, 801 | /* case 39 */ negat, 802 | /* case 40 */ dnega, 803 | /* case 41 */ subb, 804 | /* case 42 */ abss, 805 | /* case 43 */ equal, 806 | /* case 44 */ uless, 807 | /* case 45 */ less, 808 | /* case 46 */ ummod, 809 | /* case 47 */ msmod, 810 | /* case 48 */ slmod, 811 | /* case 49 */ mod, 812 | /* case 50 */ slash, 813 | /* case 51 */ umsta, 814 | /* case 52 */ star, 815 | /* case 53 */ mstar, 816 | /* case 54 */ ssmod, 817 | /* case 55 */ stasl, 818 | /* case 56 */ pick, 819 | /* case 57 */ pstor, 820 | /* case 58 */ dstor, 821 | /* case 59 */ dat, 822 | /* case 60 */ count, 823 | /* case 61 */ dovar, 824 | /* case 62 */ maxx, 825 | /* case 63 */ minn, 826 | /* case 64 */ audio, 827 | /* case 65 */ sendPacket, 828 | /* case 66 */ poke, 829 | /* case 67 */ peek, 830 | /* case 68 */ adc, 831 | /* case 69 */ pin, 832 | /* case 70 */ duty, 833 | /* case 71 */ freq, 834 | /* case 72 */ touch }; 835 | 836 | int as_nop=0; 837 | int as_accept=1; 838 | int as_qrx=2; 839 | int as_txsto=3; 840 | int as_docon=4; 841 | int as_dolit=5; 842 | int as_dolist=6; 843 | int as_exit=7; 844 | int as_execu=8; 845 | int as_donext=9; 846 | int as_qbran=10; 847 | int as_bran=11; 848 | int as_store=12; 849 | int as_at=13; 850 | int as_cstor=14; 851 | int as_cat=15; 852 | int as_rpat=16; 853 | int as_rpsto=17; 854 | int as_rfrom=18; 855 | int as_rat=19; 856 | int as_tor=20; 857 | int as_spat=21; 858 | int as_spsto=22; 859 | int as_drop=23; 860 | int as_dup=24; 861 | int as_swap=25; 862 | int as_over=26; 863 | int as_zless=27; 864 | int as_andd=28; 865 | int as_orr=29; 866 | int as_xorr=30; 867 | int as_uplus=31; 868 | int as_next=32; 869 | int as_qdup=33; 870 | int as_rot=34; 871 | int as_ddrop=35; 872 | int as_ddup=36; 873 | int as_plus=37; 874 | int as_inver=38; 875 | int as_negat=39; 876 | int as_dnega=40; 877 | int as_subb=41; 878 | int as_abss=42; 879 | int as_equal=43; 880 | int as_uless=44; 881 | int as_less=45; 882 | int as_ummod=46; 883 | int as_msmod=47; 884 | int as_slmod=48; 885 | int as_mod=49; 886 | int as_slash=50; 887 | int as_umsta=51; 888 | int as_star=52; 889 | int as_mstar=53; 890 | int as_ssmod=54; 891 | int as_stasl=55; 892 | int as_pick=56; 893 | int as_pstor=57; 894 | int as_dstor=58; 895 | int as_dat=59; 896 | int as_count=60; 897 | int as_dovar=61; 898 | int as_max=62; 899 | int as_min=63; 900 | int as_tone=64; 901 | int as_sendPacket=65; 902 | int as_poke=66; 903 | int as_peek=67; 904 | int as_adc=68; 905 | int as_pin=69; 906 | int as_duty=70; 907 | int as_freq=71; 908 | int as_touch=72; 909 | 910 | //void evaluate() 911 | //{ while (true){ 912 | // bytecode=(unsigned char)cData[P++]; 913 | // if (bytecode) {primitives[bytecode]();} 914 | // else {break;} 915 | // } // break on NOP 916 | //} 917 | 918 | __thread int counter = 0; 919 | void evaluate() 920 | { while (true){ 921 | if (counter++ > 10000) { 922 | delay(1); 923 | counter = 0; 924 | } 925 | bytecode=(unsigned char)cData[P++]; 926 | if (bytecode) {primitives[bytecode]();} 927 | else {break;} 928 | } // break on NOP 929 | } 930 | 931 | static const char *index_html = 932 | "\n" 933 | "\n" 934 | "esp32forth\n" 935 | "\n" 953 | "\n" 954 | "

esp32forth

\n" 955 | "\n" 956 | "\n" 957 | "Upload File:
\n" 958 | "\n" 959 | "\n" 960 | "\n" 961 | "\n" 962 | "\n" 963 | "\n" 964 | "\n" 965 | "\n" 966 | "\n" 967 | "\n" 968 | "\n" 969 | "\n" 970 | "\n" 971 | "\n" 972 | "
\n" 973 | "\n" 974 | "
\n" 975 | "\n" 1032 | ; 1033 | 1034 | static void returnFail(String msg) { 1035 | server.send(500, "text/plain", msg + "\r\n"); 1036 | } 1037 | 1038 | static void handleInput() { 1039 | if (!server.hasArg("cmd")) { 1040 | return returnFail("Missing Input"); 1041 | } 1042 | HTTPin = server.arg("cmd"); 1043 | HTTPout = ""; 1044 | Serial.println(HTTPin); // line cleaned up 1045 | len = HTTPin.length(); 1046 | HTTPin.getBytes(cData, len); 1047 | //Serial.println("Enter Forth."); 1048 | data[0x66] = 0; // >IN 1049 | data[0x67] = len; // #TIB 1050 | data[0x68] = 0; // 'TIB 1051 | if (len > 3 && memcmp(cData, "bg ", 3) == 0) { 1052 | if (background_thread) { 1053 | vTaskDelete(background_thread); 1054 | background_thread = 0; 1055 | } 1056 | data[0x66] = 3; // Skip "bg " 1057 | // Start background thread 1024 byte stack. 1058 | xTaskCreate(background, "background", 1024, &IP, tskIDLE_PRIORITY, &background_thread); 1059 | } else { 1060 | P = 0x180; // EVAL 1061 | WP = 0x184; 1062 | evaluate(); 1063 | } 1064 | // Serial.println(); 1065 | // Serial.println("Return from Forth."); // line cleaned up 1066 | // Serial.print("Returning "); 1067 | Serial.print(HTTPout.length()); 1068 | // Serial.println(" characters"); 1069 | server.setContentLength(HTTPout.length()); 1070 | server.send(200, "text/plain", HTTPout); 1071 | } 1072 | 1073 | void background(void *ipp) { 1074 | long *ipv = (long*) ipp; 1075 | rack = rack_background; 1076 | stack = stack_background; 1077 | Serial.println("background!!"); 1078 | IP = *ipv; 1079 | S = 0; 1080 | R = 0; 1081 | top = 0; 1082 | P = 0x180; // EVAL 1083 | WP = 0x184; 1084 | evaluate(); 1085 | for(;;) { 1086 | } 1087 | } 1088 | void setup() { 1089 | 1090 | rack = rack_main; 1091 | stack = stack_main; 1092 | P = 0x180; 1093 | WP = 0x184; 1094 | IP = 0; 1095 | S = 0; 1096 | R = 0; 1097 | top = 0; 1098 | cData = (uint8_t *) data; 1099 | Serial.begin(115200); 1100 | delay(100); 1101 | WiFi.config(ip, gateway, subnet); 1102 | // WiFi.mode(WIFI_STA); 1103 | // attempt to connect to Wifi network: 1104 | WiFi.begin(ssid, pass); 1105 | while (WiFi.status() != WL_CONNECTED) { 1106 | delay(500); 1107 | Serial.print("."); 1108 | } 1109 | Serial.println(""); 1110 | Serial.println("WiFi connected"); 1111 | Serial.print("IP Address: "); 1112 | Serial.println(WiFi.localIP()); 1113 | // if you get a connection, report back via serial: 1114 | server.begin(); 1115 | Serial.println("Booting esp32Forth v6.3 ..."); 1116 | 1117 | // Setup timer and attach timer to a led pin 1118 | ledcSetup(0, 100, LEDC_TIMER_13_BIT); 1119 | ledcAttachPin(5, 0); 1120 | ledcAnalogWrite(0, 250, brightness); 1121 | pinMode(2,OUTPUT); 1122 | digitalWrite(2, HIGH); // turn the LED2 on 1123 | pinMode(16,OUTPUT); 1124 | digitalWrite(16, LOW); // motor1 forward 1125 | pinMode(17,OUTPUT); 1126 | digitalWrite(17, LOW); // motor1 backward 1127 | pinMode(18,OUTPUT); 1128 | digitalWrite(18, LOW); // motor2 forward 1129 | pinMode(19,OUTPUT); 1130 | digitalWrite(19, LOW); // motor2 bacward 1131 | pinMode(4,INPUT); // TOUCH0 defined as input pin. 1132 | // Setting pin in INPUT or OUTPUT mode could also be done with the Forth word 1133 | // P0ENS ( mask -- )or P0ENC ( mask -- ) Ex: Pin 4 in INPUT is HEX 10 P0ENS 1134 | 1135 | IP=512; 1136 | R=0; 1137 | HEADER(3,"HLD"); 1138 | int HLD=CODE(8,as_docon,as_next,0,0,0X90,1,0,0); 1139 | HEADER(4,"SPAN"); 1140 | int SPAN=CODE(8,as_docon,as_next,0,0,0X94,1,0,0); 1141 | HEADER(3,">IN"); 1142 | int INN=CODE(8,as_docon,as_next,0,0,0X98,1,0,0); 1143 | HEADER(4,"#TIB"); 1144 | int NTIB=CODE(8,as_docon,as_next,0,0,0X9C,1,0,0); 1145 | HEADER(4,"'TIB"); 1146 | int TTIB=CODE(8,as_docon,as_next,0,0,0XA0,1,0,0); 1147 | HEADER(4,"BASE"); 1148 | int BASE=CODE(8,as_docon,as_next,0,0,0XA4,1,0,0); 1149 | HEADER(7,"CONTEXT"); 1150 | int CNTXT=CODE(8,as_docon,as_next,0,0,0XA8,1,0,0); 1151 | HEADER(2,"CP"); 1152 | int CP=CODE(8,as_docon,as_next,0,0,0XAC,1,0,0); 1153 | HEADER(4,"LAST"); 1154 | int LAST=CODE(8,as_docon,as_next,0,0,0XB0,1,0,0); 1155 | HEADER(5,"'EVAL"); 1156 | int TEVAL=CODE(8,as_docon,as_next,0,0,0XB4,1,0,0); 1157 | HEADER(6,"'ABORT"); 1158 | int TABRT=CODE(8,as_docon,as_next,0,0,0XB8,1,0,0); 1159 | HEADER(3,"tmp"); 1160 | int TEMP=CODE(8,as_docon,as_next,0,0,0XBC,1,0,0); 1161 | HEADER(1,"Z"); 1162 | int Z=CODE(8,as_docon,as_next,0,0,0,0,0,0); 1163 | HEADER(4,"ppqn"); 1164 | int PPQN=CODE(8,as_docon,as_next,0,0,0XC0,1,0,0); 1165 | HEADER(7,"channel"); 1166 | int CHANN=CODE(8,as_docon,as_next,0,0,0XC4,1,0,0); 1167 | 1168 | HEADER(3,"NOP"); 1169 | int NOP=CODE(4,as_nop,as_next,0,0); 1170 | HEADER(6,"ACCEPT"); 1171 | int ACCEP=CODE(4,as_accept,as_next,0,0); 1172 | HEADER(4,"?KEY"); 1173 | int QKEY=CODE(4,as_qrx,as_next,0,0); 1174 | HEADER(4,"EMIT"); 1175 | int EMIT=CODE(4,as_txsto,as_next,0,0); 1176 | HEADER(5,"DOLIT"); 1177 | int DOLIT=CODE(4,as_dolit,as_next,0,0); 1178 | HEADER(6,"DOLIST"); 1179 | int DOLST=CODE(4,as_dolist,as_next,0,0); 1180 | HEADER(4,"EXIT"); 1181 | int EXITT=CODE(4,as_exit,as_next,0,0); 1182 | HEADER(7,"EXECUTE"); 1183 | int EXECU=CODE(4,as_execu,as_next,0,0); 1184 | HEADER(6,"DONEXT"); 1185 | DONXT=CODE(4,as_donext,as_next,0,0); 1186 | HEADER(7,"QBRANCH"); 1187 | QBRAN=CODE(4,as_qbran,as_next,0,0); 1188 | HEADER(6,"BRANCH"); 1189 | BRAN=CODE(4,as_bran,as_next,0,0); 1190 | HEADER(1,"!"); 1191 | int STORE=CODE(4,as_store,as_next,0,0); 1192 | HEADER(1,"@"); 1193 | int AT=CODE(4,as_at,as_next,0,0); 1194 | HEADER(2,"C!"); 1195 | int CSTOR=CODE(4,as_cstor,as_next,0,0); 1196 | HEADER(2,"C@"); 1197 | int CAT=CODE(4,as_cat,as_next,0,0); 1198 | HEADER(2,"R>"); 1199 | int RFROM=CODE(4,as_rfrom,as_next,0,0); 1200 | HEADER(2,"R@"); 1201 | int RAT=CODE(4,as_rat,as_next,0,0); 1202 | HEADER(2,">R"); 1203 | TOR=CODE(4,as_tor,as_next,0,0); 1204 | HEADER(4,"DROP"); 1205 | int DROP=CODE(4,as_drop,as_next,0,0); 1206 | HEADER(3,"DUP"); 1207 | int DUPP=CODE(4,as_dup,as_next,0,0); 1208 | HEADER(4,"SWAP"); 1209 | int SWAP=CODE(4,as_swap,as_next,0,0); 1210 | HEADER(4,"OVER"); 1211 | int OVER=CODE(4,as_over,as_next,0,0); 1212 | HEADER(2,"0<"); 1213 | int ZLESS=CODE(4,as_zless,as_next,0,0); 1214 | HEADER(3,"AND"); 1215 | int ANDD=CODE(4,as_andd,as_next,0,0); 1216 | HEADER(2,"OR"); 1217 | int ORR=CODE(4,as_orr,as_next,0,0); 1218 | HEADER(3,"XOR"); 1219 | int XORR=CODE(4,as_xorr,as_next,0,0); 1220 | HEADER(3,"UM+"); 1221 | int UPLUS=CODE(4,as_uplus,as_next,0,0); 1222 | HEADER(4,"?DUP"); 1223 | int QDUP=CODE(4,as_qdup,as_next,0,0); 1224 | HEADER(3,"ROT"); 1225 | int ROT=CODE(4,as_rot,as_next,0,0); 1226 | HEADER(5,"2DROP"); 1227 | int DDROP=CODE(4,as_ddrop,as_next,0,0); 1228 | HEADER(4,"2DUP"); 1229 | int DDUP=CODE(4,as_ddup,as_next,0,0); 1230 | HEADER(1,"+"); 1231 | int PLUS=CODE(4,as_plus,as_next,0,0); 1232 | HEADER(3,"NOT"); 1233 | int INVER=CODE(4,as_inver,as_next,0,0); 1234 | HEADER(6,"NEGATE"); 1235 | int NEGAT=CODE(4,as_negat,as_next,0,0); 1236 | HEADER(7,"DNEGATE"); 1237 | int DNEGA=CODE(4,as_dnega,as_next,0,0); 1238 | HEADER(1,"-"); 1239 | int SUBBB=CODE(4,as_subb,as_next,0,0); 1240 | HEADER(3,"ABS"); 1241 | int ABSS=CODE(4,as_abss,as_next,0,0); 1242 | HEADER(1,"="); 1243 | int EQUAL=CODE(4,as_equal,as_next,0,0); 1244 | HEADER(2,"U<"); 1245 | int ULESS=CODE(4,as_uless,as_next,0,0); 1246 | HEADER(1,"<"); 1247 | int LESS=CODE(4,as_less,as_next,0,0); 1248 | HEADER(6,"UM/MOD"); 1249 | int UMMOD=CODE(4,as_ummod,as_next,0,0); 1250 | HEADER(5,"M/MOD"); 1251 | int MSMOD=CODE(4,as_msmod,as_next,0,0); 1252 | HEADER(4,"/MOD"); 1253 | int SLMOD=CODE(4,as_slmod,as_next,0,0); 1254 | HEADER(3,"MOD"); 1255 | int MODD=CODE(4,as_mod,as_next,0,0); 1256 | HEADER(1,"/"); 1257 | int SLASH=CODE(4,as_slash,as_next,0,0); 1258 | HEADER(3,"UM*"); 1259 | int UMSTA=CODE(4,as_umsta,as_next,0,0); 1260 | HEADER(1,"*"); 1261 | int STAR=CODE(4,as_star,as_next,0,0); 1262 | HEADER(2,"M*"); 1263 | int MSTAR=CODE(4,as_mstar,as_next,0,0); 1264 | HEADER(5,"*/MOD"); 1265 | int SSMOD=CODE(4,as_ssmod,as_next,0,0); 1266 | HEADER(2,"*/"); 1267 | int STASL=CODE(4,as_stasl,as_next,0,0); 1268 | HEADER(4,"PICK"); 1269 | int PICK=CODE(4,as_pick,as_next,0,0); 1270 | HEADER(2,"+!"); 1271 | int PSTOR=CODE(4,as_pstor,as_next,0,0); 1272 | HEADER(2,"2!"); 1273 | int DSTOR=CODE(4,as_dstor,as_next,0,0); 1274 | HEADER(2,"2@"); 1275 | int DAT=CODE(4,as_dat,as_next,0,0); 1276 | HEADER(5,"COUNT"); 1277 | int COUNT=CODE(4,as_count,as_next,0,0); 1278 | HEADER(3,"MAX"); 1279 | int MAX=CODE(4,as_max,as_next,0,0); 1280 | HEADER(3,"MIN"); 1281 | int MIN=CODE(4,as_min,as_next,0,0); 1282 | HEADER(2,"BL"); 1283 | int BLANK=CODE(8,as_docon,as_next,0,0,32,0,0,0); 1284 | HEADER(4,"CELL"); 1285 | int CELL=CODE(8,as_docon,as_next,0,0, 4,0,0,0); 1286 | HEADER(5,"CELL+"); 1287 | int CELLP=CODE(8,as_docon,as_plus,as_next,0, 4,0,0,0); 1288 | HEADER(5,"CELL-"); 1289 | int CELLM=CODE(8,as_docon,as_subb,as_next,0,4,0,0,0); 1290 | HEADER(5,"CELLS"); 1291 | int CELLS=CODE(8,as_docon,as_star,as_next,0,4,0,0,0); 1292 | HEADER(5,"CELL/"); 1293 | int CELLD=CODE(8,as_docon,as_slash,as_next,0,4,0,0,0); 1294 | HEADER(2,"1+"); 1295 | int ONEP=CODE(8,as_docon,as_plus,as_next,0,1,0,0,0); 1296 | HEADER(2,"1-"); 1297 | int ONEM=CODE(8,as_docon,as_subb,as_next,0,1,0,0,0); 1298 | HEADER(2,"2+"); 1299 | int TWOP=CODE(8,as_docon,as_plus,as_next,0,2,0,0,0); 1300 | HEADER(2,"2-"); 1301 | int TWOM=CODE(8,as_docon,as_subb,as_next,0,2,0,0,0); 1302 | HEADER(2,"2*"); 1303 | int TWOST=CODE(8,as_docon,as_star,as_next,0,2,0,0,0); 1304 | HEADER(2,"2/"); 1305 | int TWOS=CODE(8,as_docon,as_slash,as_next,0,2,0,0,0); 1306 | HEADER(10,"sendPacket"); 1307 | int SENDP=CODE(4,as_sendPacket,as_next,0,0); 1308 | HEADER(4,"POKE"); 1309 | int POKE=CODE(4,as_poke,as_next,0,0); 1310 | HEADER(4,"PEEK"); 1311 | int PEEK=CODE(4,as_peek,as_next,0,0); 1312 | HEADER(3,"ADC"); 1313 | int ADC=CODE(4,as_adc,as_next,0,0); 1314 | HEADER(3,"PIN"); 1315 | int PIN=CODE(4,as_pin,as_next,0,0); 1316 | HEADER(4,"TONE"); 1317 | int TONE=CODE(4,as_tone,as_next,0,0); 1318 | HEADER(4,"DUTY"); 1319 | int DUTY=CODE(4,as_duty,as_next,0,0); 1320 | HEADER(4,"FREQ"); 1321 | int FREQ=CODE(4,as_freq,as_next,0,0); 1322 | HEADER(5,"TOUCH"); 1323 | int TOUCH=CODE(4,as_touch,as_next,0,0); 1324 | HEADER(3,"KEY"); 1325 | int KEY=COLON(0); 1326 | BEGIN(1,QKEY); 1327 | UNTIL(1,EXITT); 1328 | HEADER(6,"WITHIN"); 1329 | int WITHI=COLON(7,OVER,SUBBB,TOR,SUBBB,RFROM,ULESS,EXITT); 1330 | HEADER(5,">CHAR"); 1331 | int TCHAR=COLON(8,DOLIT,0x7F,ANDD,DUPP,DOLIT,127,BLANK,WITHI); 1332 | IF(3,DROP,DOLIT,0X5F); 1333 | THEN(1,EXITT); 1334 | HEADER(7,"ALIGNED"); 1335 | int ALIGN=COLON(7,DOLIT,3,PLUS,DOLIT,0XFFFFFFFC,ANDD,EXITT); 1336 | HEADER(4,"HERE"); 1337 | int HERE=COLON(3,CP,AT,EXITT); 1338 | HEADER(3,"PAD"); 1339 | int PAD=COLON(5,HERE,DOLIT,80,PLUS,EXITT); 1340 | HEADER(3,"TIB"); 1341 | int TIB=COLON(3,TTIB,AT,EXITT); 1342 | HEADER(8,"@EXECUTE"); 1343 | int ATEXE=COLON(2,AT,QDUP); 1344 | IF(1,EXECU); 1345 | THEN(1,EXITT); 1346 | HEADER(5,"CMOVE"); 1347 | int CMOVEE=COLON(0); 1348 | FOR(0); 1349 | AFT(8,OVER,CAT,OVER,CSTOR,TOR,ONEP,RFROM,ONEP); 1350 | THEN(0); 1351 | NEXT(2,DDROP,EXITT); 1352 | HEADER(4,"MOVE"); 1353 | int MOVE=COLON(1,CELLD); 1354 | FOR(0); 1355 | AFT(8,OVER,AT,OVER,STORE,TOR,CELLP,RFROM,CELLP); 1356 | THEN(0); 1357 | NEXT(2,DDROP,EXITT); 1358 | HEADER(4,"FILL"); 1359 | int FILL=COLON(1,SWAP); 1360 | FOR(1,SWAP); 1361 | AFT(3,DDUP,CSTOR,ONEP); 1362 | THEN(0); 1363 | NEXT(2,DDROP,EXITT); 1364 | HEADER(5,"DIGIT"); 1365 | int DIGIT=COLON(12,DOLIT,9,OVER,LESS,DOLIT,7,ANDD,PLUS,DOLIT,0X30,PLUS,EXITT); 1366 | HEADER(7,"EXTRACT"); 1367 | int EXTRC=COLON(7,DOLIT,0,SWAP,UMMOD,SWAP,DIGIT,EXITT); 1368 | HEADER(2,"<#"); 1369 | int BDIGS=COLON(4,PAD,HLD,STORE,EXITT); 1370 | HEADER(4,"HOLD"); 1371 | int HOLD=COLON(8,HLD,AT,ONEM,DUPP,HLD,STORE,CSTOR,EXITT); 1372 | HEADER(1,"#"); 1373 | int DIG=COLON(5,BASE,AT,EXTRC,HOLD,EXITT); 1374 | HEADER(2,"#S"); 1375 | int DIGS=COLON(0); 1376 | BEGIN(2,DIG,DUPP); 1377 | WHILE(0); 1378 | REPEAT(1,EXITT); 1379 | HEADER(4,"SIGN"); 1380 | int SIGN=COLON(1,ZLESS); 1381 | IF(3,DOLIT,0X2D,HOLD); 1382 | THEN(1,EXITT); 1383 | HEADER(2,"#>"); 1384 | int EDIGS=COLON(7,DROP,HLD,AT,PAD,OVER,SUBBB,EXITT); 1385 | HEADER(3,"str"); 1386 | int STRR=COLON(9,DUPP,TOR,ABSS,BDIGS,DIGS,RFROM,SIGN,EDIGS,EXITT); 1387 | HEADER(3,"HEX"); 1388 | int HEXX=COLON(5,DOLIT,16,BASE,STORE,EXITT); 1389 | HEADER(7,"DECIMAL"); 1390 | int DECIM=COLON(5,DOLIT,10,BASE,STORE,EXITT); 1391 | HEADER(6,"wupper"); 1392 | int UPPER=COLON(4,DOLIT,0x5F5F5F5F,ANDD,EXITT); 1393 | HEADER(6,">upper"); 1394 | int TOUPP=COLON(6,DUPP,DOLIT,0x61,DOLIT,0x7B,WITHI); 1395 | IF(3,DOLIT,0x5F,ANDD); 1396 | THEN(1,EXITT); 1397 | HEADER(6,"DIGIT?"); 1398 | int DIGTQ=COLON(9,TOR,TOUPP,DOLIT,0X30,SUBBB,DOLIT,9,OVER,LESS); 1399 | IF(8,DOLIT,7,SUBBB,DUPP,DOLIT,10,LESS,ORR); 1400 | THEN(4,DUPP,RFROM,ULESS,EXITT); 1401 | HEADER(7,"NUMBER?"); 1402 | int NUMBQ=COLON(12,BASE,AT,TOR,DOLIT,0,OVER,COUNT,OVER,CAT,DOLIT,0X24,EQUAL); 1403 | IF(5,HEXX,SWAP,ONEP,SWAP,ONEM); 1404 | THEN(13,OVER,CAT,DOLIT,0X2D,EQUAL,TOR,SWAP,RAT,SUBBB,SWAP,RAT,PLUS,QDUP); 1405 | IF(1,ONEM); 1406 | FOR(6,DUPP,TOR,CAT,BASE,AT,DIGTQ); 1407 | WHILE(7,SWAP,BASE,AT,STAR,PLUS,RFROM,ONEP); 1408 | NEXT(2,DROP,RAT); 1409 | IF(1,NEGAT); 1410 | THEN(1,SWAP); 1411 | ELSE(6,RFROM,RFROM,DDROP,DDROP,DOLIT,0); 1412 | THEN(1,DUPP); 1413 | THEN(6,RFROM,DDROP,RFROM,BASE,STORE,EXITT); 1414 | HEADER(5,"SPACE"); 1415 | int SPACE=COLON(3,BLANK,EMIT,EXITT); 1416 | HEADER(5,"CHARS"); 1417 | int CHARS=COLON(4,SWAP,DOLIT,0,MAX); 1418 | FOR(0); 1419 | AFT(2,DUPP,EMIT); 1420 | THEN(0); 1421 | NEXT(2,DROP,EXITT); 1422 | HEADER(6,"SPACES"); 1423 | int SPACS=COLON(3,BLANK,CHARS,EXITT); 1424 | HEADER(4,"TYPE"); 1425 | int TYPES=COLON(0); 1426 | FOR(0); 1427 | AFT(5,DUPP,CAT,TCHAR,EMIT,ONEP); 1428 | THEN(0); 1429 | NEXT(2,DROP,EXITT); 1430 | HEADER(2,"CR"); 1431 | int CR=COLON(7,DOLIT,10,DOLIT,13,EMIT,EMIT,EXITT); 1432 | HEADER(3,"do$"); 1433 | int DOSTR=COLON(10,RFROM,RAT,RFROM,COUNT,PLUS,ALIGN,TOR,SWAP,TOR,EXITT); 1434 | HEADER(3,"$\"|"); 1435 | int STRQP=COLON(2,DOSTR,EXITT); 1436 | HEADER(3,".\"|"); 1437 | DOTQP=COLON(4,DOSTR,COUNT,TYPES,EXITT); 1438 | HEADER(2,".R"); 1439 | int DOTR=COLON(8,TOR,STRR,RFROM,OVER,SUBBB,SPACS,TYPES,EXITT); 1440 | HEADER(3,"U.R"); 1441 | int UDOTR=COLON(10,TOR,BDIGS,DIGS,EDIGS,RFROM,OVER,SUBBB,SPACS,TYPES,EXITT); 1442 | HEADER(2,"U."); 1443 | int UDOT=COLON(6,BDIGS,DIGS,EDIGS,SPACE,TYPES,EXITT); 1444 | HEADER(1,"."); 1445 | int DOT=COLON(5,BASE,AT,DOLIT,10,XORR); 1446 | IF(3,UDOT,EXITT); 1447 | THEN(4,STRR,SPACE,TYPES,EXITT); 1448 | HEADER(1,"?"); 1449 | int QUEST=COLON(3,AT,DOT,EXITT); 1450 | HEADER(7,"(parse)"); 1451 | int PARS=COLON(5,TEMP,CSTOR,OVER,TOR,DUPP); 1452 | IF(5,ONEM,TEMP,CAT,BLANK,EQUAL); 1453 | IF(0); 1454 | FOR(6,BLANK,OVER,CAT,SUBBB,ZLESS,INVER); 1455 | WHILE(1,ONEP); 1456 | NEXT(6,RFROM,DROP,DOLIT,0,DUPP,EXITT); 1457 | THEN(1,RFROM); 1458 | THEN(2,OVER,SWAP); 1459 | FOR(9,TEMP,CAT,OVER,CAT,SUBBB,TEMP,CAT,BLANK,EQUAL); 1460 | IF(1,ZLESS); 1461 | THEN(0); 1462 | WHILE(1,ONEP); 1463 | NEXT(2,DUPP,TOR); 1464 | ELSE(5,RFROM,DROP,DUPP,ONEP,TOR); 1465 | THEN(6,OVER,SUBBB,RFROM,RFROM,SUBBB,EXITT); 1466 | THEN(4,OVER,RFROM,SUBBB,EXITT); 1467 | HEADER(5,"PACK$"); 1468 | int PACKS=COLON(18,DUPP,TOR,DDUP,PLUS,DOLIT,0xFFFFFFFC,ANDD,DOLIT,0,SWAP,STORE,DDUP,CSTOR,ONEP,SWAP,CMOVEE,RFROM,EXITT); 1469 | HEADER(5,"PARSE"); 1470 | int PARSE=COLON(15,TOR,TIB,INN,AT,PLUS,NTIB,AT,INN,AT,SUBBB,RFROM,PARS,INN,PSTOR,EXITT); 1471 | HEADER(5,"TOKEN"); 1472 | int TOKEN=COLON(9,BLANK,PARSE,DOLIT,0x1F,MIN,HERE,CELLP,PACKS,EXITT); 1473 | HEADER(4,"WORD"); 1474 | int WORDD=COLON(5,PARSE,HERE,CELLP,PACKS,EXITT); 1475 | HEADER(5,"NAME>"); 1476 | int NAMET=COLON(7,COUNT,DOLIT,0x1F,ANDD,PLUS,ALIGN,EXITT); 1477 | HEADER(5,"SAME?"); 1478 | int SAMEQ=COLON(4,DOLIT,0x1F,ANDD,CELLD); 1479 | FOR(0); 1480 | AFT(18,OVER,RAT,DOLIT,4,STAR,PLUS,AT,UPPER,OVER,RAT,DOLIT,4,STAR,PLUS,AT,UPPER,SUBBB,QDUP); 1481 | IF(3,RFROM,DROP,EXITT); 1482 | THEN(0); 1483 | THEN(0); 1484 | NEXT(3,DOLIT,0,EXITT); 1485 | HEADER(4,"find"); 1486 | int FIND=COLON(10,SWAP,DUPP,AT,TEMP,STORE,DUPP,AT,TOR,CELLP,SWAP); 1487 | BEGIN(2,AT,DUPP); 1488 | IF(9,DUPP,AT,DOLIT,0xFFFFFF3F,ANDD,UPPER,RAT,UPPER,XORR); 1489 | IF(3,CELLP,DOLIT,0XFFFFFFFF); 1490 | ELSE(4,CELLP,TEMP,AT,SAMEQ); 1491 | THEN(0); 1492 | ELSE(6,RFROM,DROP,SWAP,CELLM,SWAP,EXITT); 1493 | THEN(0); 1494 | WHILE(2,CELLM,CELLM); 1495 | REPEAT(9,RFROM,DROP,SWAP,DROP,CELLM,DUPP,NAMET,SWAP,EXITT); 1496 | HEADER(5,"NAME?"); 1497 | int NAMEQ=COLON(3,CNTXT,FIND,EXITT); 1498 | HEADER(6,"EXPECT"); 1499 | int EXPEC=COLON(5,ACCEP,SPAN,STORE,DROP,EXITT); 1500 | HEADER(5,"QUERY"); 1501 | int QUERY=COLON(12,TIB,DOLIT,0X100,ACCEP,NTIB,STORE,DROP,DOLIT,0,INN,STORE,EXITT); 1502 | HEADER(5,"ABORT"); 1503 | int ABORT=COLON(4,NOP,TABRT,ATEXE,EXITT); 1504 | HEADER(6,"abort\""); 1505 | ABORQP=COLON(0); 1506 | IF(4,DOSTR,COUNT,TYPES,ABORT); 1507 | THEN(3,DOSTR,DROP,EXITT); 1508 | HEADER(5,"ERROR"); 1509 | int ERRORR=COLON(8,SPACE,COUNT,TYPES,DOLIT,0x3F,EMIT,CR,ABORT); 1510 | HEADER(10,"$INTERPRET"); 1511 | int INTER=COLON(2,NAMEQ,QDUP); 1512 | IF(4,CAT,DOLIT,COMPO,ANDD); 1513 | ABORQ(" compile only"); 1514 | int INTER0=LABEL(2,EXECU,EXITT); 1515 | THEN(1,NUMBQ); 1516 | IF(1,EXITT); 1517 | THEN(1,ERRORR); 1518 | HEADER(IMEDD+1,"["); 1519 | int LBRAC=COLON(5,DOLIT,INTER,TEVAL,STORE,EXITT); 1520 | HEADER(3,".OK"); 1521 | int DOTOK=COLON(6,CR,DOLIT,INTER,TEVAL,AT,EQUAL); 1522 | IF(14,TOR,TOR,TOR,DUPP,DOT,RFROM,DUPP,DOT,RFROM,DUPP,DOT,RFROM,DUPP,DOT); 1523 | DOTQ(" ok>"); 1524 | THEN(1,EXITT); 1525 | HEADER(4,"EVAL"); 1526 | int EVAL=COLON(1,LBRAC); 1527 | BEGIN(3,TOKEN,DUPP,AT); 1528 | WHILE(2,TEVAL,ATEXE); 1529 | REPEAT(4,DROP,DOTOK,NOP,EXITT); 1530 | HEADER(4,"QUIT"); 1531 | int QUITT=COLON(1,LBRAC); 1532 | BEGIN(2,QUERY,EVAL); 1533 | AGAIN(0); 1534 | HEADER(4,"LOAD"); 1535 | int LOAD=COLON(10,NTIB,STORE,TTIB,STORE,DOLIT,0,INN,STORE,EVAL,EXITT); 1536 | HEADER(1,","); 1537 | int COMMA=COLON(7,HERE,DUPP,CELLP,CP,STORE,STORE,EXITT); 1538 | HEADER(IMEDD+7,"LITERAL"); 1539 | int LITER=COLON(5,DOLIT,DOLIT,COMMA,COMMA,EXITT); 1540 | HEADER(5,"ALLOT"); 1541 | int ALLOT=COLON(4,ALIGN,CP,PSTOR,EXITT); 1542 | HEADER(3,"$,\""); 1543 | int STRCQ=COLON(9,DOLIT,0X22,WORDD,COUNT,PLUS,ALIGN,CP,STORE,EXITT); 1544 | HEADER(7,"?UNIQUE"); 1545 | int UNIQU=COLON(3,DUPP,NAMEQ,QDUP); 1546 | IF(6,COUNT,DOLIT,0x1F,ANDD,SPACE,TYPES); 1547 | DOTQ(" reDef"); 1548 | THEN(2,DROP,EXITT); 1549 | HEADER(3,"$,n"); 1550 | int SNAME=COLON(2,DUPP,AT); 1551 | IF(14,UNIQU,DUPP,NAMET,CP,STORE,DUPP,LAST,STORE,CELLM,CNTXT,AT,SWAP,STORE,EXITT); 1552 | THEN(1,ERRORR); 1553 | HEADER(1,"'"); 1554 | int TICK=COLON(2,TOKEN,NAMEQ); 1555 | IF(1,EXITT); 1556 | THEN(1,ERRORR); 1557 | HEADER(IMEDD+9,"[COMPILE]"); 1558 | int BCOMP=COLON(3,TICK,COMMA,EXITT); 1559 | HEADER(7,"COMPILE"); 1560 | int COMPI=COLON(7,RFROM,DUPP,AT,COMMA,CELLP,TOR,EXITT); 1561 | HEADER(8,"$COMPILE"); 1562 | int SCOMP=COLON(2,NAMEQ,QDUP); 1563 | IF(4,AT,DOLIT,IMEDD,ANDD); 1564 | IF(1,EXECU); 1565 | ELSE(1,COMMA); 1566 | THEN(1,EXITT); 1567 | THEN(1,NUMBQ); 1568 | IF(2,LITER,EXITT); 1569 | THEN(1,ERRORR); 1570 | HEADER(5,"OVERT"); 1571 | int OVERT=COLON(5,LAST,AT,CNTXT,STORE,EXITT); 1572 | HEADER(1,"]"); 1573 | int RBRAC=COLON(5,DOLIT,SCOMP,TEVAL,STORE,EXITT); 1574 | HEADER(1,":"); 1575 | int COLN=COLON(7,TOKEN,SNAME,RBRAC,DOLIT,0x6,COMMA,EXITT); 1576 | HEADER(IMEDD+1,";"); 1577 | int SEMIS=COLON(6,DOLIT,EXITT,COMMA,LBRAC,OVERT,EXITT); 1578 | HEADER(3,"dm+"); 1579 | int DMP=COLON(4,OVER,DOLIT,6,UDOTR); 1580 | FOR(0); 1581 | AFT(6,DUPP,AT,DOLIT,9,UDOTR,CELLP); 1582 | THEN(0); 1583 | NEXT(1,EXITT); 1584 | HEADER(4,"DUMP"); 1585 | int DUMP=COLON(10,BASE,AT,TOR,HEXX,DOLIT,0x1F,PLUS,DOLIT,0x20,SLASH); 1586 | FOR(0); 1587 | AFT(10,CR,DOLIT,8,DDUP,DMP,TOR,SPACE,CELLS,TYPES,RFROM); 1588 | THEN(0); 1589 | NEXT(5,DROP,RFROM,BASE,STORE,EXITT); 1590 | HEADER(5,">NAME"); 1591 | int TNAME=COLON(1,CNTXT); 1592 | BEGIN(2,AT,DUPP); 1593 | WHILE(3,DDUP,NAMET,XORR); 1594 | IF(1,ONEM); 1595 | ELSE(3,SWAP,DROP,EXITT); 1596 | THEN(0); 1597 | REPEAT(3,SWAP,DROP,EXITT); 1598 | HEADER(3,".ID"); 1599 | int DOTID=COLON(7,COUNT,DOLIT,0x1F,ANDD,TYPES,SPACE,EXITT); 1600 | HEADER(5,"WORDS"); 1601 | int WORDS=COLON(6,CR,CNTXT,DOLIT,0,TEMP,STORE); 1602 | BEGIN(2,AT,QDUP); 1603 | WHILE(9,DUPP,SPACE,DOTID,CELLM,TEMP,AT,DOLIT,0x10,LESS); 1604 | IF(4,DOLIT,1,TEMP,PSTOR); 1605 | ELSE(5,CR,DOLIT,0,TEMP,STORE); 1606 | THEN(0); 1607 | REPEAT(1,EXITT); 1608 | HEADER(6,"FORGET"); 1609 | int FORGT=COLON(3,TOKEN,NAMEQ,QDUP); 1610 | IF(12,CELLM,DUPP,CP,STORE,AT,DUPP,CNTXT,STORE,LAST,STORE,DROP,EXITT); 1611 | THEN(1,ERRORR); 1612 | HEADER(4,"COLD"); 1613 | int COLD=COLON(1,CR); 1614 | DOTQ("esp32forth V6.3, 2019 "); 1615 | int DOTQ1=LABEL(2,CR,EXITT); 1616 | HEADER(4,"LINE"); 1617 | int LINE=COLON(2,DOLIT,0x7); 1618 | FOR(6,DUPP,PEEK,DOLIT,0x9,UDOTR,CELLP); 1619 | NEXT(1,EXITT); 1620 | HEADER(2,"PP"); 1621 | int PP=COLON(0); 1622 | FOR(0); 1623 | AFT(7,CR,DUPP,DOLIT,0x9,UDOTR,SPACE,LINE); 1624 | THEN(0); 1625 | NEXT(1,EXITT); 1626 | HEADER(2,"P0"); 1627 | int P0=COLON(4,DOLIT,0x3FF44004,POKE,EXITT); 1628 | HEADER(3,"P0S"); 1629 | int P0S=COLON(4,DOLIT,0x3FF44008,POKE,EXITT); 1630 | HEADER(3,"P0C"); 1631 | int P0C=COLON(4,DOLIT,0x3FF4400C,POKE,EXITT); 1632 | HEADER(2,"P1"); 1633 | int P1=COLON(4,DOLIT,0x3FF44010,POKE,EXITT); 1634 | HEADER(3,"P1S"); 1635 | int P1S=COLON(4,DOLIT,0x3FF44014,POKE,EXITT); 1636 | HEADER(3,"P1C"); 1637 | int P1C=COLON(4,DOLIT,0x3FF44018,POKE,EXITT); 1638 | HEADER(4,"P0EN"); 1639 | int P0EN=COLON(4,DOLIT,0x3FF44020,POKE,EXITT); 1640 | HEADER(5,"P0ENS"); 1641 | int P0ENS=COLON(4,DOLIT,0x3FF44024,POKE,EXITT); 1642 | HEADER(5,"P0ENC"); 1643 | int P0ENC=COLON(4,DOLIT,0x3FF44028,POKE,EXITT); 1644 | HEADER(4,"P1EN"); 1645 | int P1EN=COLON(4,DOLIT,0x3FF4402C,POKE,EXITT); 1646 | HEADER(5,"P1ENS"); 1647 | int P1ENS=COLON(4,DOLIT,0x3FF44030,POKE,EXITT); 1648 | HEADER(5,"P1ENC"); 1649 | int P1ENC=COLON(4,DOLIT,0x3FF44034,POKE,EXITT); 1650 | HEADER(4,"P0IN"); 1651 | int P0IN=COLON(5,DOLIT,0x3FF4403C,PEEK,DOT,EXITT); 1652 | HEADER(4,"P1IN"); 1653 | int P1IN=COLON(5,DOLIT,0x3FF44040,PEEK,DOT,EXITT); 1654 | HEADER(3,"PPP"); 1655 | int PPP=COLON(7,DOLIT,0x3FF44000,DOLIT,3,PP,DROP,EXITT); 1656 | HEADER(5,"EMITT"); 1657 | int EMITT=COLON(2,DOLIT,0x3); 1658 | FOR(8,DOLIT,0,DOLIT,0x100,MSMOD,SWAP,TCHAR,EMIT); 1659 | NEXT(2,DROP,EXITT); 1660 | HEADER(5,"TYPEE"); 1661 | int TYPEE=COLON(3,SPACE,DOLIT,0x7); 1662 | FOR(4,DUPP,PEEK,EMITT,CELLP); 1663 | NEXT(2,DROP,EXITT); 1664 | HEADER(4,"PPPP"); 1665 | int PPPP=COLON(0); 1666 | FOR(0); 1667 | AFT(10,CR,DUPP,DUPP,DOLIT,0x9,UDOTR,SPACE,LINE,SWAP,TYPEE); 1668 | THEN(0); 1669 | NEXT(1,EXITT); 1670 | HEADER(3,"KKK"); 1671 | int KKK=COLON(7,DOLIT,0x3FF59000,DOLIT,0x10,PP,DROP,EXITT); 1672 | HEADER(IMEDD+4,"THEN"); 1673 | int THENN=COLON(4,HERE,SWAP,STORE,EXITT); 1674 | HEADER(IMEDD+3,"FOR"); 1675 | int FORR=COLON(4,COMPI,TOR,HERE,EXITT); 1676 | HEADER(IMEDD+5,"BEGIN"); 1677 | int BEGIN=COLON(2,HERE,EXITT); 1678 | HEADER(IMEDD+4,"NEXT"); 1679 | int NEXT=COLON(4,COMPI,DONXT,COMMA,EXITT); 1680 | HEADER(IMEDD+5,"UNTIL"); 1681 | int UNTIL=COLON(4,COMPI,QBRAN,COMMA,EXITT); 1682 | HEADER(IMEDD+5,"AGAIN"); 1683 | int AGAIN=COLON(4,COMPI,BRAN,COMMA,EXITT); 1684 | HEADER(IMEDD+2,"IF"); 1685 | int IFF=COLON(7,COMPI,QBRAN,HERE,DOLIT,0,COMMA,EXITT); 1686 | HEADER(IMEDD+5,"AHEAD"); 1687 | int AHEAD=COLON(7,COMPI,BRAN,HERE,DOLIT,0,COMMA,EXITT); 1688 | HEADER(IMEDD+6,"REPEAT"); 1689 | int REPEA=COLON(3,AGAIN,THENN,EXITT); 1690 | HEADER(IMEDD+3,"AFT"); 1691 | int AFT=COLON(5,DROP,AHEAD,HERE,SWAP,EXITT); 1692 | HEADER(IMEDD+4,"ELSE"); 1693 | int ELSEE=COLON(4,AHEAD,SWAP,THENN,EXITT); 1694 | HEADER(IMEDD+5,"WHILE"); 1695 | int WHILEE=COLON(3,IFF,SWAP,EXITT); 1696 | HEADER(IMEDD+6,"ABORT\""); 1697 | int ABRTQ=COLON(6,DOLIT,ABORQP,HERE,STORE,STRCQ,EXITT); 1698 | HEADER(IMEDD+2,"$\""); 1699 | int STRQ=COLON(6,DOLIT,STRQP,HERE,STORE,STRCQ,EXITT); 1700 | HEADER(IMEDD+2,".\""); 1701 | int DOTQQ=COLON(6,DOLIT,DOTQP,HERE,STORE,STRCQ,EXITT); 1702 | HEADER(4,"CODE"); 1703 | int CODE=COLON(5,TOKEN,SNAME,OVERT,ALIGN,EXITT); 1704 | HEADER(6,"CREATE"); 1705 | int CREAT=COLON(5,CODE,DOLIT,0x203D,COMMA,EXITT); 1706 | HEADER(8,"VARIABLE"); 1707 | int VARIA=COLON(5,CREAT,DOLIT,0,COMMA,EXITT); 1708 | HEADER(8,"CONSTANT"); 1709 | int CONST=COLON(6,CODE,DOLIT,0x2004,COMMA,COMMA,EXITT); 1710 | HEADER(IMEDD+2,".("); 1711 | int DOTPR=COLON(5,DOLIT,0X29,PARSE,TYPES,EXITT); 1712 | HEADER(IMEDD+1,"\\"); 1713 | int BKSLA=COLON(5,DOLIT,0xA,WORDD,DROP,EXITT); 1714 | HEADER(IMEDD+1,"("); 1715 | int PAREN=COLON(5,DOLIT,0X29,PARSE,DDROP,EXITT); 1716 | HEADER(12,"COMPILE-ONLY"); 1717 | int ONLY=COLON(6,DOLIT,0x40,LAST,AT,PSTOR,EXITT); 1718 | HEADER(9,"IMMEDIATE"); 1719 | int IMMED=COLON(6,DOLIT,0x80,LAST,AT,PSTOR,EXITT); 1720 | int ENDD=IP; 1721 | Serial.println(); 1722 | Serial.print("IP="); 1723 | Serial.print(IP); 1724 | Serial.print(" R-stack= "); 1725 | Serial.print(popR<<2,HEX); 1726 | IP=0x180; 1727 | int USER=LABEL(16,6,EVAL,0,0,0,0,0,0,0,0x10,IMMED-12,ENDD,IMMED-12,INTER,EVAL,0); 1728 | 1729 | // dump dictionary 1730 | IP=0; 1731 | for (len=0;len<0x120;len++){CheckSum();} 1732 | 1733 | // compile \data\load.txt 1734 | if(!SPIFFS.begin(true)){Serial.println("Error mounting SPIFFS"); } 1735 | File file = SPIFFS.open("/load.txt"); 1736 | if(file) { 1737 | Serial.print("Load file: "); 1738 | len = file.read(cData+0x8000,0x7000); 1739 | Serial.print(len); 1740 | Serial.println(" bytes."); 1741 | data[0x66] = 0; // >IN 1742 | data[0x67] = len; // #TIB 1743 | data[0x68] = 0x8000; // 'TIB 1744 | P = 0x180; // EVAL 1745 | WP = 0x184; 1746 | evaluate(); 1747 | Serial.println(" Done loading."); 1748 | file.close(); 1749 | SPIFFS.end(); 1750 | } 1751 | // Setup web server handlers 1752 | server.on("/", HTTP_GET, []() { 1753 | server.send(200, "text/html", index_html); 1754 | }); 1755 | server.on("/input", HTTP_POST, handleInput); 1756 | server.begin(); 1757 | Serial.println("HTTP server started"); 1758 | } 1759 | void loop() { 1760 | server.handleClient(); 1761 | } 1762 | -------------------------------------------------------------------------------- /extra-stacks.txt: -------------------------------------------------------------------------------- 1 | \ Adding simple stacks to ESP32forth - adapted from code found at 2 | \ https://rosettacode.org/wiki/Stack#Forth by Bob Edwards Aug 2022 3 | \ No bounds checking 4 | 5 | : tuck ( n1 n2 -- n2 n1 n2 ) 6 | swap over 7 | ; 8 | 9 | cell negate value -cell 10 | 11 | : stack ( size -- ) 12 | create \ make a new dictionary entry using the name of the stack 13 | here cell+ , \ initialise the stack pointer as an empty stack 14 | cells allot \ allocate the storage space for the stack 15 | ; 16 | 17 | : push ( n st -- ) 18 | tuck ( st n st -- ) 19 | @ \ read the stack pointer ( st n -- ) 20 | ! \ store n on the top of stack ( st -- ) 21 | cell swap +! \ and increment the stack pointer 22 | ; 23 | 24 | : pop ( st -- n ) 25 | -cell over +! \ decrement the stack pointer ( st -- ) 26 | @ \ read the stack pointer 27 | @ \ read the value top of stack 28 | ; 29 | 30 | : empty? ( st -- ? ) 31 | dup @ - cell+ 0= 32 | ; 33 | 34 | \ Test words 35 | 36 | 10 stack st 37 | 38 | 1 st push 39 | 2 st push 40 | 3 st push 41 | 42 | st empty? . \ 0 (false) 43 | st pop . st pop . st pop . \ 3 2 1 44 | st empty? . \ -1 (true) 45 | 46 | \ end of code -------------------------------------------------------------------------------- /frank.lin/DHT11-12-FRANK-LIN.txt: -------------------------------------------------------------------------------- 1 | \ DHT11, DHT22 1-wire Control Code - ESP32FORTH 2 | \ Frank Lin 2022.7.20 3 | \ ORIGINAL ARTICLE : https://ohiyooo2.pixnet.net/blog/post/406078286 4 | \ Digital I/O Access Codes 5 | \ 6 | 7 | :>OUTPUT ( pin --) \ set the direction of digital I/O to output 8 | output pinMode 9 | ; 10 | : High ( pin --) \ put digital I/O to High 15 | high high digitalWrite 16 | ; 17 | : ->Low ( pin --) \ put digital I/O to Low 18 | low digitalWrite 19 | ; 20 | : Pin@ ( pin -- status) \ read the state of digital I/O, 0=low, 1=high 21 | digitalRead 22 | ; 23 | : ticks ( -- ticks ) 24 | ms-ticks 25 | ; 26 | 27 | \ 28 | \ extension for ESP32FORTH 29 | \ ESP32FORTH only has catch/throw, no standard ABORT, ABORT" 30 | \ 31 | 32 | : abort ( --) -1 throw ; 33 | : abort" ( flag "text" --) 34 | state @ 35 | if 36 | postpone if postpone s" postpone type postpone cr 37 | postpone abort 38 | postpone then 39 | else [char] " parse type cr abort then 40 | ; immediate 41 | 42 | 43 | \ 44 | \ DHT Sensor, 1-wire data Pin 45 | \ 46 | 47 | 14 constant DHTPin \ Pin14 as DHT data Pin 48 | 49 | : delay ( n--) for next ; \ used as the delay timer 50 | 51 | \ 52 | \ DIO and delay speed test 53 | \ 54 | : t1 ticks DHTPin 1000000 for DHTPin Pin@ 0= if then next drop ticks swap - . ; 55 | \ 56 | \ result: 642 ms / 1000000 = 0.642 uS per loop 57 | \ 58 | 59 | : t2 ticks 1000000 delay ticks swap - . ; 60 | \ 61 | \ result: 96.5 ms / 1000000 = 0.0965 uS for 1 delay 62 | \ 63 | 64 | : wait ( --) \ wait until pulse-high 65 | begin DHTPin Pin@ until 66 | ; 67 | 68 | \ 69 | \ DHT 1-wire signal: 70 | \ start: 50uS Low 71 | \ signal 1: 70 uS Pulse High 72 | \ signal 0: 26 - 28 uS Pulse High 73 | 74 | \ 75 | \ 112uS / 0.642uS = 174 76 | \ 67.175uS / 0.642uS = 104 77 | \ 78 | 79 | : signal@ ( -- true=1/false=0) 80 | 174 ( ~112uS) 81 | for 82 | DHTPin Pin@ 0= ( pulse low?) 83 | if r> 104 ( ~ 67.175uS) < exit ( length > 70 = 44.825 uS) 84 | then 85 | next 86 | ." Error! Signal not match with expectation!" cr 87 | abort 88 | ; 89 | 90 | : 8bits@ ( -- Data) 91 | 0 ( data) 92 | 7 for 93 | wait 94 | signal@ if 1 r@ lshift or then 95 | next 96 | ; 97 | : 40bits@ ( -- n1 n2 n3 n4 n5) 98 | 4 for 8bits@ next 99 | ; 100 | \ 101 | \ Start Signal 102 | \ 18mS Low, to active communication 103 | \ then 20 - 40uS High 104 | \ then wait DHT sends 80uS Low, 80uS High 105 | \ then receive 40bits data transmition from DHT 106 | \ 107 | \ 108 | \ 20uS = 20/0.0965 ~ 207 delay 109 | \ 82uS = 82/0.0965 ~ 850 delay 110 | \ 14uS = 14/0.0965 ~ 145 delay 111 | \ 112 | : start! ( --) 113 | DHTPin >OUTPUT 114 | DHTPin ->Low 115 | 20 ms 116 | DHTPin ->High 117 | 145 delay ( ~ 14uS) 118 | DHTPin DHT11 ( RHint RHdec Tint Tdec Checksum -- RH Temp) 130 | nip over - >r ( RHint RHdec Tint | R: checksum') 131 | nip over r> - 132 | abort" Error: CheckSum not match!!" 133 | ; 134 | 135 | : ?negate ( n1 n2 -- n3) 136 | $80 and if negate then 137 | ; 138 | 139 | : >DHT22 ( RH.H RH.L TH TL Checksum -- RH Temp) 140 | >r 2dup + >r 141 | swap 8 lshift or >r ( RH.H RH.LR: T CS1 CS) 142 | 2dup + >r ( RH.H RH.LR: CS2 T CS1 CS) 143 | swap 8 lshift or ( RH R: CS2 T CS1 CS) 144 | r> r> swap ( RH T CS2 R: CS1 CS) 145 | r> + ( RH T CS3 R: CS) 146 | 256 u/ mod drop 147 | r> <> 148 | abort" Error: CheckSum not match!!" 149 | 150 | $7fff over and swap ?negate 151 | ; 152 | : DHT11@ ( -- RH T) 153 | DHT@ >DHT11 154 | 10 * >r 10 * r> 155 | ; 156 | : DHT22@ ( -- RH T) 157 | DHT@ >DHT22 158 | ; 159 | 160 | : .[xx.x] dup <# # [char] . hold #s swap sign #> type ; 161 | 162 | : DHT11 163 | cr 164 | begin 165 | DHT11@ 166 | ." Temperature = " .[xx.x] ." C , " 167 | ." Relative Humidity = " .[xx.x] ." %" cr 168 | 2000 ms 169 | again 170 | ; 171 | 172 | : DHT22 173 | cr 174 | begin 175 | DHT22@ 176 | ." Temperature = " .[xx.x] ." C , " 177 | ." Relative Humidity = " .[xx.x] ." %" cr 178 | 2000 ms 179 | again 180 | ; -------------------------------------------------------------------------------- /frank.lin/FRANK-LIN-DHT11 DHT22 Temperature and Humidity Sensor[ESP32FORTH].pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/frank.lin/FRANK-LIN-DHT11 DHT22 Temperature and Humidity Sensor[ESP32FORTH].pdf -------------------------------------------------------------------------------- /frank.lin/readme.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /lcd-driver.txt: -------------------------------------------------------------------------------- 1 | \ this library was written by Tony Leff 2 | \ forth2020 group 16.March2021 3 | 4 | ledc 5 | 6 | : initpins 0 23 18 12 13 22 27 26 25 33 32 19 21 begin dup output pinmode 0 = until 7 | 0 1000 5000 ledcsetup ledcdetachpin 23 0 ledcattachpin ; ( define output pins ) 8 | 9 | : lcdbl 0 swap ledcwrite ; ( backlight brightness 0 - 255 ) 10 | : en 18 pin ; ( enable ) 11 | : rw 12 pin ; ( unused - rw on lcd is hardwired to ground ) 12 | : rs 13 pin ; ( register select ) 13 | : d7 22 pin ; 14 | : d0 27 pin ; 15 | : d1 26 pin ; 16 | : d2 25 pin ; 17 | : d3 33 pin ; 18 | : d4 32 pin ; 19 | : d5 19 pin ; 20 | : d6 21 pin ; 21 | 22 | : out ( sets bits on gpio as required ) 23 | dup 128 and 0 > d7 24 | dup 64 and 0 > d6 25 | dup 32 and 0 > d5 26 | dup 16 and 0 > d4 27 | dup 8 and 0 > d3 28 | dup 4 and 0 > d2 29 | dup 2 and 0 > d1 30 | 1 and 0 > d0 31 | ; 32 | 33 | : delay 1 ms ; 34 | 35 | : writed 1 rs delay out delay 0 en delay 1 en delay 0 en ; ( writes data to lcd ) 36 | : writec 0 rs delay out delay 0 en delay 1 en delay 0 en ; ( writes instruction to lcd ) 37 | 38 | : lcdinit initpins 0 12 06 01 08 56 48 48 48 begin dup writec 0 = until 0 rw ; ( initialization codes for lcd ) 39 | 40 | : lcdclr 01 writec ; ( clear lcd display ) 41 | 42 | : lcdhome 02 writec ; ( homes cursor for lcd ) 43 | 44 | : lcdpos 64 * + 128 + writec ; ( writes cursor position to lcd - x y lcdpos ) 45 | 46 | : lcddcb 8 or writec ; ( Display / Cursor / Blink control ) 47 | : lcdcds 16 or writec ; ( Cursor / Display / Shift control ) 48 | 49 | : lcd. over + swap do i c@ writed loop ; ( LCDtype definition - with thanks Chris Curl) 50 | 51 | 52 | : demo 53 | lcdinit ( initialize lcd ) 54 | 255 lcdbl ( set Backlight to max brightness ) 55 | 5 0 lcdpos s" Hello " lcd. ( display Hello at 5 column of first line ) 56 | 1 1 lcdpos s" You sexy Beast " lcd. ( display on 2nd line ) 57 | 3000 ms 58 | lcdclr ( clear lcd ) 59 | s" PWM of Backlight " lcd. 60 | 6 1 lcdpos s" lcdbl " lcd. 61 | 50 0 do i lcdbl 50 ms loop ( Turn up lcd backlight brightness ) 62 | 50 0 do i 50 swap - lcdbl 40 ms loop ( Turn down brightness ) 63 | 64 | 3000 ms 65 | lcdclr 66 | 255 lcdbl 67 | s" o shift screen " lcd. 68 | 0 1 lcdpos 69 | s" lcdcds " lcd. 70 | 16 0 do 12 lcdcds 300 ms loop ( shift screen right ) 71 | 16 0 do 8 lcdcds 300 ms loop ( shift screen left ) 72 | 3000 ms 73 | 74 | lcdclr 75 | 5 0 lcdpos s" Bye bye " lcd. 76 | 5 lcdbl 77 | ; 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /lm393-speedsensor.txt: -------------------------------------------------------------------------------- 1 | // LM393 Speedsensor for the Forthmobile project 2 | // 25June 2021 by PeterForth 3 | 4 | INTERRUPTS 5 | 6 | 0 VALUE leftwheel 0 value rightwheel 7 | 8 | 14 input pinMode 12 input pinMode 9 | 10 | : INT12 1 +TO leftwheel ; 11 | : INT14 1 +TO rightwheel ; 12 | 13 | : pinPosedge ( xt pin -- ) 14 | dup GPIO_INTR_POSEDGE gpio_set_intr_type throw 15 | swap 0 gpio_isr_handler_add throw ; 16 | 17 | 18 | ' INT12 12 pinPosedge 19 | ' INT14 14 pinPosedge 20 | -------------------------------------------------------------------------------- /mini-oof-BPaysan-by-bob-edwards.txt: -------------------------------------------------------------------------------- 1 | MINI-OOF by Bernd Paysan 1998 adapted by Bob Edwards 24th July 2021 2 | 3 | 4 | DEFINED? *MINI-OOF* [IF] forget *MINI-OOF* [THEN] 5 | : *MINI-OOF* ; 6 | 7 | 8 | \ Words missing from the esp32forth system 9 | 10 | 11 | : NOOP ; 12 | : /STRING 13 | DUP >R - 14 | SWAP R> + 15 | SWAP 16 | ; 17 | 18 | 19 | \ The object oriented extensions 20 | 21 | 22 | : METHOD 23 | CREATE 24 | OVER , SWAP 25 | CELL+ SWAP 26 | DOES> 27 | @ OVER @ + 28 | @ EXECUTE 29 | ; 30 | : VAR 31 | CREATE 32 | OVER , + 33 | DOES> 34 | @ + 35 | ; 36 | : CLASS 37 | DUP 38 | 2@ SWAP ; 39 | : END-CLASS 40 | CREATE 41 | HERE >R 42 | , DUP , 43 | 2 CELLS ?DO 44 | ['] NOOP , 45 | 1 CELLS +LOOP 46 | CELL+ DUP CELL+ R> 47 | ROT 48 | @ 49 | 2 CELLS 50 | /STRING 51 | CMOVE 52 | ; 53 | : DEFINES 54 | ' >BODY @ + ! 55 | ; 56 | : NEW 57 | HERE OVER @ ALLOT 58 | SWAP OVER ! 59 | ; 60 | : :: 61 | ' >BODY @ + @ , 62 | ; 63 | CREATE OBJECT 64 | 1 cells , 2 cells , 65 | 66 | 67 | 68 | 69 | \ Example MINI-OOF code 70 | 71 | 72 | object class 73 | cell var teeth# 74 | cell var height 75 | method speak 76 | method greet 77 | method walk 78 | method add. 79 | end-class pet 80 | :noname ." pet speaks" drop ; pet defines speak 81 | :noname ." pet greets" drop ; pet defines greet 82 | :noname ." pet walks" drop ; pet defines walk 83 | :noname drop + ." n1 + n2 = " . ; pet defines add. 84 | pet class 85 | method happy 86 | end-class cat 87 | :noname ." cat purrs" drop ; cat defines happy 88 | :noname ." cat says meow" drop ; cat defines speak 89 | :noname ." cat raises tail" drop ; cat defines greet 90 | pet class 91 | end-class dog 92 | :noname ." dog says wuff" drop ; dog defines speak 93 | :noname ." dog wags tail" drop ; dog defines greet 94 | cat new constant tibby 95 | dog new constant fido 96 | 20 tibby teeth# ! 97 | 30 fido teeth# ! 98 | 50 tibby height ! 99 | 75 fido height ! 100 | tibby teeth# @ . cr 101 | fido height @ . cr 102 | tibby greet 103 | fido speak 104 | tibby speak 105 | 34 56 fido add. 106 | tibby walk 107 | 108 | 109 | \ The above packs quite a lot of punch for very little code space 110 | \ and may make all the difference to an otherwise awkward-to-code job 111 | \ Bernd Paysans Mini-OOF pages 112 | \ An extension to Mini-OOF by Gerry Jackson 113 | 114 | 115 | -------------------------------------------------------------------------------- /pwm-forthmobile.txt: -------------------------------------------------------------------------------- 1 | ( Forthmobile@ project PeterForth & Atle Bergstrom@ ) 2 | ( thanks to Atle for his great ideas ! ) 3 | ( it works on the ESP32forth of Dr. Ting & Brad Nelson) 4 | 5 | FORTH DECIMAL 6 | 7 | 18 constant PWML 5 constant dirleft1 17 constant dirleft2 8 | 15 constant PWMR 4 constant dirright1 16 constant dirright2 9 | 10 | 1 constant chLEFT 11 | 2 constant chRIGHT 12 | 3 constant chBOTH 13 | 14 | 1 constant FORWARD 15 | 0 constant BACKWARD 16 | 17 | FORTH DEFINITIONS also LEDC ( vocabulary ) 18 | 19 | : init_dir_pins ( --) 20 | dirleft1 OUTPUT pinmode dirleft2 OUTPUT pinmode 21 | dirright1 OUTPUT pinmode dirright2 OUTPUT pinmode ; 22 | 23 | : init_pwm_pins ( --) 24 | PWML chLEFT ledcAttachPin PWMR chRIGHT ledcAttachPin 25 | chLEFT 40000 10 ledcSetup chRIGHT 40000 10 ledcSetup ; 26 | 27 | 28 | : SETPINS ( n n n n --) 29 | dirleft1 pin dirleft2 pin 30 | dirright1 pin dirright2 pin ; 31 | 32 | : FW 0 1 0 1 SETPINS ; 33 | : BW 1 0 1 0 SETPINS ; 34 | : LEFT 0 1 1 0 SETPINS ; 35 | : RIGHT 1 0 0 1 SETPINS ; 36 | 37 | 38 | : initall ( --) init_dir_pins init_pwm_pins FW ; 39 | 40 | : motleft ( speed -- ) DUP chLEFT swap ledcWrite chRIGHT swap ledcWrite ; 41 | : motright ( speed -- ) DUP chRIGHT swap ledcWrite ; 42 | 43 | ( abbreviations for fast typing) 44 | : ml motleft ; 45 | : mr motright ; 46 | 47 | ( MOTORS MOVE) 48 | : MM ( speed -- ) DUP chLEFT swap ledcWrite chRIGHT swap ledcWrite ; 49 | 50 | initall 51 | 52 | 260 value speed 53 | 260 value slowspeed 54 | 400 value fastspeed 55 | 56 | : run speed mm ; 57 | 58 | : STOP 0 mm ; 59 | 60 | : slow slowspeed to speed run ; 61 | : fast fastspeed to speed run ; 62 | 63 | 64 | ' slow is user1 65 | ' fast is user2 66 | ' fw is user3 67 | ' bw is user4 68 | ' left is user5 69 | ' right is user6 70 | ' RUN is user7 71 | ' stop is user8 72 | 73 | \\ more to follow , still on development 74 | -------------------------------------------------------------------------------- /robertedwards/.R for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ display n1 right justified in a field of n2 chars 2 | : .r ( n1 n2 -- ) 3 | swap dup >r abs 4 | <# 5 | 0 >r 6 | begin \ count how many numbers to print 7 | # 8 | r> 1+ >r 9 | dup 0= 10 | until 11 | r> r> 12 | dup 0< if 13 | swap 1+ swap \ add one for any negtaive sign 14 | then 15 | sign 16 | swap >r 17 | - dup 0 > if 18 | 0 do 19 | bl hold \ if there's roon, fill left with spaces 20 | loop 21 | then 22 | r> #> type 23 | ; 24 | 25 | \ test words 26 | 27 | 12345 12 .r 28 | -12345 12 .r 29 | 12345 2 .r 30 | -------------------------------------------------------------------------------- /robertedwards/Batch file for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ Batch file for ESP32forth ver 1 by Bob Edwards Oct 2022 2 | \ Typing INCLUDE /spiffs/mybatchfilename is a bit of a mouthful if 3 | \ you just want to run a few lines of forth from disk 4 | \ The dictionary will be searched for the word first, if not found then ... 5 | \ The spiffs drive will be searched for a file of the same name. If found it will load, else an error displayed 6 | \ the file can contain a list of commands to interpret or a words to compile, run & forget etc 7 | \ The feature can be turned on with ON BATCH and normal 'word not found' 8 | \ behaviour restored with OFF BATCH 9 | 10 | \ N.B. Requires loading this string library first - https://esp32.arduino-forth.com/listing/page/text/strings 11 | 12 | forth definitions 13 | only forth also internals 14 | 15 | DEFINED? *BATCH* [IF] forget *BATCH* [THEN] 16 | : *BATCH* ; 17 | 18 | 19 | 20 string filename \ 20 chr filename stringvar 20 | : root s" /spiffs/" ; \ the spiff root directory 21 | 22 | : ON -1 ; 23 | : OFF 0 ; 24 | 25 | \ add string a n to end of a stringvar - truncates string if too long 26 | : $+ ( a n stringvar -- ) 27 | swap dup >r swap 28 | maxlen$ 29 | over - 30 | >r + r> 31 | >r swap r> min 32 | dup >r 33 | cmove \ stringvar=stringvar + string 34 | r> r> 35 | cell - +! \ update the string length 36 | ; 37 | 38 | \ If flag=true, word a , n not found - try executing a batch file in the root folder of disk 39 | : (BATCH) ( a n flag -- ) 40 | IF 41 | S" /spiffs/" filename $! \ filename = root directory 42 | filename $+ \ append unknown word to filename 43 | filename included 44 | THEN 45 | ; 46 | 47 | variable save'notfound 48 | 49 | \ Turn on / off batch file execution if word not found in dictionary 50 | : BATCH ( ON | OFF -- ) 51 | IF 52 | 'notfound @ 53 | save'notfound ! 54 | ['] (BATCH) 'notfound ! 55 | ELSE 56 | save'notfound @ 57 | 'notfound ! 58 | THEN 59 | ; 60 | 61 | \ Turn on / off all display to the terminal 62 | \ Useful for hiding parts of a batch file operation 63 | : DISPLAY ( ON | OFF -- ) 64 | echo ! 65 | ; 66 | 67 | ON BATCH \ turn on the Batch file feature 68 | 69 | \ test file to put into the spiffs root directory 70 | 71 | \ off display 72 | \ : test 73 | \ ." Hi ESP32forth User - this is a count to 1000" cr 74 | \ 1000 0 do 75 | \ i . space 76 | \ loop 77 | \ cr ." We're all done now!" cr 78 | \ ; 79 | \ on display test 80 | \ off display 81 | \ forget test 82 | \ on display 83 | 84 | 85 | \ The above program loads from source, runs and displays, then the program is forgotten again 86 | \ Uncomment the above code and save to a file on the spiffs store and try it out 87 | \ The program displays very neatly, thanks to the ON DISPLAY and OFF DISPLAY commands 88 | -------------------------------------------------------------------------------- /robertedwards/Case for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ case structure for esp32forth 2 | 3 | DEFINED? *CASE* [IF] forget *CASE* [THEN] 4 | : *CASE* ; 5 | 6 | : ?dup dup if dup then ; 7 | internals 8 | : case 0 ; immediate 9 | : of ['] over , ['] = , ['] 0branch , here 0 , ['] drop , ; immediate 10 | : endof ['] branch , here 0 , swap here swap ! ; immediate 11 | : endcase ['] drop , begin ?dup while here swap ! repeat ; immediate 12 | 13 | \ end of case structure 14 | -------------------------------------------------------------------------------- /robertedwards/Pick for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ duplicate nth item on the data stack, 0 pick = dup, 1 pick = over 2 | : pick ( .... n - nth item ) 3 | sp@ swap 1+ cells - @ 4 | ; 5 | -------------------------------------------------------------------------------- /robertedwards/Programmer’s Guide to Mini_OOF.odt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/robertedwards/Programmer’s Guide to Mini_OOF.odt -------------------------------------------------------------------------------- /robertedwards/Programmer’s Guide to Mini_OOF.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/robertedwards/Programmer’s Guide to Mini_OOF.pdf -------------------------------------------------------------------------------- /robertedwards/Simple queue for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ Queues for ESP32forth ver1 - Bob Edwards Sept 2022 2 | \ Useful for passing messages between tasks in a multitask application 3 | \ sharing a resource between tasks etc. 4 | \ As many queues as you wish can be made using the QUEUE word - see below 5 | \ This is also an example of 'hand made' object oriented programming 6 | 7 | forth definitions 8 | hex 9 | 10 | \ print a byte as two hex digits 11 | : byte. ( byte -- ) 12 | base @ >R hex 13 | <# # #s 24 hold #> type space 14 | R> base ! 15 | ; 16 | 17 | \ better hex dump 18 | : hexdump ( a n -- ) 19 | hex 20 | cr 0 SWAP 1- ( a 0 n ) 21 | FOR ( a bytecount ) 22 | DUP 10 mod 0= 23 | IF 24 | cr 25 | 2dup + . 26 | THEN 27 | 2dup + C@ byte. 1+ 28 | NEXT 29 | 2drop cr 30 | r> base ! 31 | ; 32 | 33 | decimal 34 | 35 | \ primitive for abort" 36 | : (abort") ( f addr len -- ) 37 | rot if 38 | type 39 | quit 40 | else 41 | drop drop 42 | then 43 | ; 44 | 45 | \ stop execution of word and send error message if fl<>0 46 | : abort" ( comp: -- | exec: fl -- ) 47 | [ ' s" , ] 48 | postpone (abort") 49 | ; immediate 50 | 51 | INTERNALS DEFINITIONS 52 | 53 | : QSIZE@ ( queue -- queuesize ) 54 | 4 cells + @ 55 | ; 56 | 57 | : QUSED@ ( queue -- used ) 58 | 3 cells + @ 59 | ; 60 | 61 | : QUSED! ( n queue -- ) 62 | 3 cells + ! 63 | ; 64 | 65 | : QTAIL@ ( queue -- n ) 66 | 2 cells + @ 67 | ; 68 | 69 | : QTAIL! ( n queue -- ) 70 | 2 cells + ! 71 | ; 72 | 73 | : QHEAD@ ( queue -- n ) 74 | cell + @ 75 | ; 76 | 77 | : QHEAD! ( n queue -- ) 78 | cell + ! 79 | ; 80 | 81 | \ move a buffer address ptr to the next position with wrap around 82 | : QNEXT ( ptr1 queue -- ptr2 ) 83 | >R \ store queue on the R stack 84 | cell+ \ ( ptr+4 ) ptr=ptr+4 85 | DUP R@ @ = \ ( ptr+4 flag )compare ptr with END 86 | IF ( ptr+4 ) 87 | DROP 88 | R> 5 cells + \ wrap around to start of the data area 89 | ELSE 90 | R> DROP 91 | THEN 92 | ; 93 | 94 | FORTH DEFINITIONS 95 | FORTH ALSO INTERNALS 96 | 97 | \ create a new queue 98 | : QUEUE ( n "name" -- ) 99 | create \ make a new dictionary entry using the name of the stack 100 | dup >R 101 | cells here dup >R + 5 cells + , \ constant END, the end address of the queue at queue+0 102 | R> 5 cells + DUP , \ variable HEAD at queue+4 103 | , \ variable TAIL at queue+8 104 | 0 , \ variable USED at queue+12 105 | R> DUP , \ constant SIZE at queue+16 106 | cells ALLOT \ and the data starts at queue+20 107 | ; 108 | 109 | \ is the queue empty? 110 | : QEMPTY? ( queue -- flag ) 111 | QUSED@ 0= 112 | ; 113 | 114 | \ is the queue full? 115 | : QFULL? ( queue -- flag ) 116 | DUP QUSED@ 117 | SWAP QSIZE@ = 118 | ; 119 | 120 | \ insert n into the queue 121 | : QPUT ( n queue -- ) 122 | DUP QFULL? ABORT" queue full" >R 123 | R@ QTAIL@ ! \ store n in the queue 124 | R@ QTAIL@ R@ QNEXT R@ QTAIL! \ increment TAIL with wrap around 125 | 1 R@ QUSED@ + R> QUSED! \ and increment USED 126 | ; 127 | 128 | \ remove n from the queue 129 | : QGET ( queue -- n ) 130 | DUP QEMPTY? ABORT" buffer empty" >R 131 | R@ QHEAD@ @ \ read n from the queue 132 | R@ QHEAD@ R@ QNEXT R@ QHEAD! \ increment HEAD with wrap around 133 | -1 R@ QUSED@ + R> QUSED! \ and decrement USED 134 | ; 135 | 136 | \ display queue control variables for debug 137 | : Q. ( queue -- ) 138 | cr ." END = $" dup @ hex . 139 | cr ." HEAD = $" dup QHEAD@ . 140 | cr ." TAIL = $" dup QTAIL@ . 141 | cr ." USED = " dup QUSED@ decimal . 142 | cr ." SIZE = " QSIZE@ . 143 | cr 144 | ; 145 | 146 | ONLY 147 | 148 | \ Example code 149 | 150 | 4 queue myq 151 | 152 | \ check that a word that follows ism't overwritten by queue data 153 | : test 10 0 do i . loop ; 154 | 155 | myq qempty? . 156 | myq qfull? . 157 | \ so myq is empty 158 | 159 | 1 myq qput 160 | 2 myq qput 161 | 3 myq qput 162 | 4 myq qput 163 | 164 | myq qempty? . 165 | myq qfull? . 166 | \ so myq is now full 167 | 168 | 169 | \ So qempty? and qfull? are essential as semaphores regulating program flow in a task 170 | \ - putting or getting too much data causes program stop and an error message 171 | 172 | myq qget . 173 | myq qget . 174 | myq qget . 175 | myq qget . 176 | 177 | myq qempty? . 178 | myq qfull? . 179 | 180 | \ The queue's internal control registers can also be displayed" 181 | myq q. 182 | 183 | 10 myq qput 184 | 11 myq qput 185 | 186 | myq q. 187 | \ myq is part full 188 | 189 | myq qget . 190 | myq qget . 191 | 192 | myq q. 193 | \ myq is empty again 194 | 195 | test 196 | \ and the test word hasn't been overwritten by the data in myq - as a programming check 197 | -------------------------------------------------------------------------------- /robertedwards/String Library Glossary for ESP32forth v7073.odt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/robertedwards/String Library Glossary for ESP32forth v7073.odt -------------------------------------------------------------------------------- /robertedwards/String Library Glossary for ESP32forth v7073.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Esp32forth/forth2020group/ffa8a8cbe84b8a042ac94931dadd96beb7f680aa/robertedwards/String Library Glossary for ESP32forth v7073.pdf -------------------------------------------------------------------------------- /robertedwards/String library for esp32forth.fth: -------------------------------------------------------------------------------- 1 | \ Portable, Stack Based String Library for ESP32forth 2 | \ Original - Mark Wills February 2014 - http://turboforth.net/resources/string_library.html 3 | \ Based on a string stack concept developed by Brian Fox circa 1988 4 | \ Adapted for ESP32forth by Bob Edwards Oct 2022 5 | 6 | \ N.B. Needs X("U<", ULESS, tos = (ucell_t) *sp < (ucell_t) tos ? -1 : 0; --sp) \ 7 | \ adding to the ESP32forth source code to support the WITHIN definition below 8 | 9 | \ General Note: 10 | \ Words surrounded by parenthesis are for low-level internal use by the string 11 | \ library, and should not need to be called by higher-level application code 12 | 13 | DEFINED? *STRINGS* [IF] forget *STRINGS* [THEN] 14 | : *STRINGS* ; 15 | 16 | \ string format: 17 | \ String constants (held in STRING types): 18 | \ max_len actual_len 19 | \ | | | | 20 | \ cell cell chars padding (if required) 21 | \ Transient strings (held on the string stack): 22 | \ actual_len 23 | \ | | | 24 | \ cell chars padding (if required) 25 | 26 | \ Throw Code|Nature of Error 27 | \ ----------+----------------------------------------- 28 | \ 9900 | String stack underflow 29 | \ 9901 | String too large to assign 30 | \ 9902 | String stack is empty 31 | \ 9903 | Need at least 2 strings on string stack 32 | \ 9904 | String too large for string constant 33 | \ 9905 | Illegal LEN value 34 | \ 9906 | Need at least 3 strings on string stack 35 | \ 9907 | String is not a legal number 36 | \ 9908 | Illegal start value 37 | 38 | base @ \ save systems' current number base 39 | decimal 40 | 41 | forth definitions 42 | only forth also internals 43 | 44 | -1 constant true 45 | 0 constant false 46 | 47 | : within ( test low high -- flag ) OVER - >R - R> U< ; 48 | 49 | internals definitions 50 | only forth also internals 51 | 52 | \ Set up string stack. The stack grows towards lower memory addresses. 53 | 256 constant ($sSize) \ store stack size 54 | \ Adjust to your own needs. Choose a value that is a multiple of your 55 | \ systems' cell size. 56 | 57 | here ($sSize) allot \ reserve space for string stack 58 | constant ($sEnd) \ bottom of string stack 59 | variable ($sp) \ pointer to top of string stack 60 | ($sEnd) ($sSize) + ($sp) ! \ initialise it 61 | variable ($depth) \ count of items on the string stack 62 | variable ($temp0) \ reserved for internal use 63 | variable ($temp1) \ reserved for internal use 64 | variable ($temp2) \ reserved for internal use 65 | variable ($temp3) \ reserved for internal use 66 | 67 | : ($depth+) ( -- ) 68 | \ Increments the string stack item count 69 | 1 ($depth) +! ; 70 | 71 | : ($sp@) ( -- addr ) \ "string stack pointer fetch" 72 | \ Returns address of current top of string stack 73 | ($sp) @ ; 74 | 75 | : (sizeOf$) ( $addr - $size) 76 | \ Given an address of a transient string, compute the stack size in bytes 77 | \ required to hold it, rounded up to the nearest cell size, and including 78 | \ the length cell. 79 | @ aligned cell+ ; 80 | 81 | : (set$SP) ( $size -- ) 82 | \ Given the stack size of a transient string set the string stack pointer 83 | \ to the new address required to accomodate it. 84 | negate dup ($sp@) + ($sEnd) < if 9900 throw then 85 | ($sp) +! ; 86 | 87 | : (addrOf$) ( index -- addr ) 88 | \ Given an index into the string stack, return the start address of the 89 | \ string. addr points to the length cell. Topmost string is index 0, 90 | \ next string is index 1 and so on. 91 | ($sp@) swap dup if 0 do dup (sizeOf$) + loop else drop then ; 92 | 93 | : (lenOf$) ( $addr -- len ) 94 | \ Given the address of a transient string on the string stack (the address 95 | \ of the length cell), return the length of the string. 96 | \ Note: Immediate, compiling word for performance reasons. 97 | \ Modern compilers will inline this. 98 | state @ if postpone @ else @ then ; immediate 99 | 100 | forth definitions 101 | only forth also internals 102 | 103 | \ duplicate nth item on the data stack, 0 pick = dup, 1 pick = over 104 | : pick ( .... n - nth item ) 105 | sp@ swap 1+ cells - @ ; 106 | 107 | \ display n1 right justified in a field of n2 chars 108 | : .r ( n1 n2 -- ) 109 | swap dup >r abs 110 | <# 111 | 0 >r 112 | begin \ count how many numbers to print 113 | # 114 | r> 1+ >r 115 | dup 0= 116 | until 117 | r> r> 118 | dup 0< if 119 | swap 1+ swap \ add one for any negtaive sign 120 | then 121 | sign 122 | swap >r 123 | - dup 0 > if 124 | 0 do 125 | bl hold \ if there's roon, fill left with spaces 126 | loop 127 | then 128 | r> #> type 129 | ; 130 | 131 | : depth$ ( -- $sDepth) 132 | \ Returns the depth of the string stack. 133 | ($depth) @ ; 134 | 135 | : $const ( max_len tib:"name" -- ) ( runtime: -- $Caddr) \ "string constant" 136 | \ Creates a string constant. When "name" is referenced the address of the 137 | \ max_len field is pushed to the stack. 138 | \ e.g. 100 string msg 139 | \ The above creates a string called msg with capacity for 100 characters. 140 | create dup ( max_len) , ( actual_len) 0 , allot align ; 141 | 142 | : clen$ ( $Caddr -- len ) \ "string constant length" 143 | \ Given the address of a string constant, returns its length. 144 | cell+ @ ; 145 | 146 | : maxLen$ ( $Caddr -- max_len ) \ "maximum length of string" 147 | \ Given the address of a string constant, returns its maximum length. 148 | \ Dependencies: (lenOf$) 149 | (lenOf$) ; 150 | 151 | : .$const ( $Caddr -- ) \ "display string constant" 152 | \ Displays the string constant. e.g. fred .$const 153 | \ Dependencies: (lenOf$) 154 | cell+ dup (lenOf$) swap cell+ swap type ; 155 | 156 | : :=" ( $Caddr tib:"string" -- ) \ "assign string constant" 157 | \ Assigns the string "string" to the string constant. 158 | \ e.g. msg :=" hello mother!" 159 | \ Dependencies: PARSE (core ext, 6.2.2008) 160 | dup @ [char] " parse swap >r 161 | 2dup < if 9901 throw then 162 | nip 2dup swap cell+ ! 163 | >r [ 2 cells ] literal + r> r> -rot cmove ; 164 | 165 | internals definitions 166 | only forth also internals 167 | 168 | : ($") ( addr len -- ) ( ss: -- str ) 169 | \ Run-time action for $" (see below). 170 | \ Dependencies: aligned ($set$SP) ($sp) ($depth+) 171 | dup aligned cell+ (set$SP) 172 | dup ($sp@) ! ($sp@) cell+ swap cmove ($depth+) ; 173 | 174 | forth definitions 175 | only forth also internals 176 | 177 | : $" ( tib:"string" -- ) ( ss: -- str) \ "string to string stack" 178 | \ Pushes a string directly to the string stack. 179 | \ e.g. $" hello world" .$ 180 | \ Dependencies: ($") PARSE (core ext, 6.2.2008) 181 | \ Note: State smart word. Runtime behaviour is in ($") 182 | state @ if 183 | postpone s" postpone ($") 184 | else 185 | [char] " parse ($") 186 | then ; immediate 187 | 188 | : >$ ( $Caddr -- ) ( ss: -- str) \ "to string stack" 189 | \ Moves a string constant to the string stack 190 | \ e.g. msg >$ 191 | \ Dependencies: (lenOf$) ($") 192 | cell+ dup (lenOf$) swap cell+ swap ($") ; 193 | 194 | : pick$ ( n -- ) ( ss: -- strN) \ "pick string" 195 | \ Given an index into the string stack, copy the indexed string to the top 196 | \ of the string stack. 197 | \ 0 $pick is equivalent to $DUP 198 | \ 1 $pick is equivalent to $OVER etc. 199 | \ Dependencies: (lenOf$) depth$ ($addrOf$) ($") 200 | depth$ 0= if 9902 throw then 201 | (addrOf$) dup (lenOf$) swap cell+ swap ($") ; 202 | 203 | : dup$ ( -- ) ( ss: s1 -- s1 s1) \ "duplicate string" 204 | \ Duplicates a string on the string stack. 205 | \ Dependencies: depth$ pick$ 206 | depth$ 0= if 9902 throw then 207 | 0 pick$ ; 208 | 209 | : drop$ ( -- ) ( ss: str -- ) \ "drop string" 210 | \ Drops the top string from the string stack. 211 | \ Dependencies: depth$ (sizeOf$) (set$SP) 212 | depth$ 0= if 9900 throw then 213 | ($sp@) (sizeOf$) negate (set$SP) -1 ($depth) +! ; 214 | 215 | : swap$ ( -- ) ( ss: s1 s2 -- s2 s1) \ "swap string" 216 | \ Swaps the top two string items on the string stack. 217 | \ Dependencies: depth$ (sizeOf$) (addrOf$) HERE (core 6.1.1650) 218 | depth$ 2 < if 9903 throw then 219 | ($sp@) dup (sizeOf$) here swap cmove 220 | 1 (addrOf$) dup (sizeOf$) ($sp@) swap cmove 221 | here dup (sizeOf$) ($sp@) dup (sizeOf$) + swap cmove ; 222 | 223 | : nip$ ( -- ) ( ss: s1 s2 -- s2) \ "nip string" 224 | \ Remove the string under the top string. 225 | \ Dependencies: swap$ drop$ depth$ 226 | depth$ 2 < if 9903 throw then 227 | swap$ drop$ ; 228 | 229 | : over$ ( -- ) ( ss: s1 s2 -- s1 s2 s1) \ "over string" 230 | \ Move a copy of s1 to top of string stack. 231 | \ Dependencies: pick$ depth$ 232 | depth$ 2 < if 9903 throw then 233 | 1 pick$ ; 234 | 235 | : rot$ ( -- ) ( ss: s3 s2 s1 -- s2 s1 s3) \ "rotate strings" 236 | \ Rotates the top three string to the left. 237 | \ The third string moves to the top of the string stack. 238 | ($sp@) \ save this addr for stack pointer 239 | 2 pick$ 240 | ($sp@) 1 (addrOf$) \ source & destination 241 | ($sp@) (sizeOf$) 1 (addrOf$) (sizeOf$) 2 (addrOf$) (sizeOf$) + + \ number of bytes 242 | cmove> 243 | ($sp) ! \ save stack pointer 244 | -1 ($depth) +! \ and fix depth 245 | ; 246 | 247 | : -rot$ ( -- ) ( ss: s3 s2 s1 -- s1 s3 s2) \ "rotate strings" 248 | \ Rotates the top three string to the right. 249 | \ The top string moves to the third position. 250 | ($sp@) \ save this addr for stack pointer 251 | 2 pick$ 2 pick$ 252 | ($sp@) 2 (addrOf$) 253 | ($sp@) (sizeOf$) 1 (addrOf$) (sizeOf$) 2 (addrOf$) (sizeOf$) + + \ number of bytes 254 | cmove> 255 | ($sp) ! \ save stack pointer 256 | -2 ($depth) +! \ and fix depth 257 | ; 258 | 259 | : len$ ( -- len ) ( ss: -- ) \ "length of string" 260 | \ Returns the length of the topmost string. 261 | \ Dependencies: none 262 | depth$ 1 < if 9902 throw then 263 | ($sp@) @ ; 264 | 265 | : >$const ( $Caddr -- ) ( ss: str -- ) \ "to string constant" 266 | \ Move top of string stack to the string constant. 267 | \ e.g. $" blue" fred >$const fred .$const 268 | \ displays "blue" 269 | \ Dependencies: depth$ (sizeOf$) drop$ 270 | >r depth$ 1 < if 9902 throw then 271 | len$ r@ @ > if 9904 throw then 272 | ($sp@) dup (sizeOf$) r> cell+ swap cmove drop$ ; 273 | 274 | : +$ ( -- ) ( ss: s1 s2 -- s2+s1) \ concatenate strings 275 | \ Replaces the top most two strings on the string stack with their 276 | \ concatenated equivalent. 277 | \ eg: $" red" $" blue" +$ .$ 278 | \ displays "redblue" 279 | \ Dependencies: depth$ (addrOf$) (lenOf$) len$ drop$ HERE (core 6.1.1650) 280 | depth$ 2 < if 9903 throw then 281 | 1 (addrof$) cell+ here 1 (addrof$) (lenof$) cmove 282 | ($sp@) cell+ 1 (addrof$) (lenof$) here + len$ cmove 283 | here len$ 1 (addrof$) (lenof$) + drop$ drop$ ($") ; 284 | 285 | : mid$ ( start len -- ) ( ss: str1 -- str1 str2) \ "mid-string" 286 | \ The characters from start to start+len are pushed to the string stack 287 | \ as a new string. The original string is retained. 288 | \ Dependencies: len$ ($") 289 | depth$ 1 < if 9902 throw then 290 | dup len$ > over 1 < or if 9905 throw then 291 | over dup len$ > swap 0< or if 9908 throw then 292 | swap ($sp@) cell+ + swap ($") ; 293 | 294 | : left$ ( len -- ) ( ss: str1 -- str1 str2) \ "left of string" 295 | \ The leftmost len characters are pushed to the string stack as a new 296 | \ string. The original string is retained. 297 | \ Dependencies: mid$ 298 | depth$ 1 < if 9902 throw then 299 | dup len$ > over 1 < or if 9905 throw then 300 | 0 ($sp@) cell+ + swap ($") ; 301 | 302 | 303 | : right$ ( len -- ) ( ss: str1 -- str1 str2) \ "right of string" 304 | \ The rightmost len characters, pushed to the string stack as a new string. 305 | \ the original string is retained. 306 | \ Dependencies: (lenOf$) mid$ 307 | depth$ 1 < if 9902 throw then 308 | dup len$ > over 1 < or if 9905 throw then 309 | ($sp@) (lenOf$) over - ($sp@) cell+ + swap ($") ; 310 | 311 | : findc$ ( char -- pos|-1 ) ( ss: -- ) \ "find character in string" 312 | \ Returns the first occurance of the character char in the top string. 313 | \ The string is retained. Returns -1 if the char is not found. 314 | \ Dependencies: PICK (ANS core ext) depth$ 315 | depth$ 1 < if 9902 throw then 316 | ($sp@) cell+ ($sp@) (lenOf$) 0 do 317 | dup c@ 2 pick = if i -1 leave then 1+ loop 318 | -1 = if nip nip else drop -1 then ; 319 | 320 | : find$ ( offset -- pos|-1 ) ( ss: s1 s2 -- s1) \ "find string" 321 | \ Searches string s1, beginning at offset, for the substring s2. 322 | \ If the string is found, returns the position of the string relative 323 | \ to the offset, otherwise returns -1. 324 | \ Dependencies: depth$ len$ (addrOf$) (lenOf$) drop$ 325 | depth$ 2 < if 9903 throw then 326 | len$ ($temp1) ! 1 (addrOf$) (lenOf$) ($temp0) ! 327 | dup ($temp0) @ > if drop -1 exit then 328 | 1 (addrOf$) cell+ + ($temp2) ! ($sp@) cell+ ($temp3) ! 329 | ($temp1) @ ($temp0) @ > if drop -1 exit then 330 | 0 ($temp0) @ 0 do 331 | ($temp3) @ over + c@ 332 | ($temp2) @ i + c@ = if 333 | 1+ dup ($temp1) @ = if 334 | drop i ($temp1) @ - 1+ -2 leave then 335 | else drop 0 then 336 | loop 337 | dup -2 = if drop else drop -1 then drop$ ; 338 | 339 | : .$ ( -- ) ( ss: str -- ) \ "display string" 340 | \ Pop and display the topmost string from string stack. 341 | \ Dependencies: depth$ (lenOf$) drop$ 342 | depth$ 0= if 9902 throw then 343 | ($sp@) cell+ ($sp@) (lenOf$) type drop$ ; 344 | 345 | : rev$ ( -- ) ( ss: s1 -- s2 ) \ "reverse string" 346 | \ Reverse topmost string on string stack. 347 | \ Dependencies: depth$ (lenOf$) HERE (core 6.1.1650) 348 | depth$ 0= if 9902 throw then 349 | ($sp@) dup cell+ >r (lenOf$) r> swap here swap cmove 350 | ($sp@) (lenOf$) here 1- + 351 | ($sp@) cell+ dup ($sp@) (lenOf$) + swap do 352 | dup c@ i c! 1- loop drop ; 353 | 354 | : ltrim$ ( -- ) ( ss: s1 -- s2 ) \ "left trim string" 355 | \ Removes leading spaces from s1, resulting in s2. 356 | \ Dependencies: depth$ (lenOf$) (sizeOf$) drop$ HERE (core 6.1.1650) 357 | depth$ 0= if 9902 throw then 358 | ($sp@) dup (lenOf$) >r here over (sizeOf$) cmove 359 | 0 r> here cell+ dup >r + r> do 360 | i c@ bl = if 1+ else leave then loop 361 | dup 0 > if 362 | >r ($sp@) (lenOf$) drop$ 363 | here cell+ r@ + swap r> - ($") 364 | else drop then ; 365 | 366 | : rtrim$ ( -- ) ( ss: s1 -- s2 ) \ "right trim string" 367 | \ Removes trailing spaces from s1, resulting in s2. 368 | \ Dependencies: depth$ rev$ ltrim$ 369 | depth$ 0= if 9902 throw then 370 | rev$ ltrim$ rev$ ; 371 | 372 | : trim$ ( -- ) ( ss: s1 -- s2 ) \ "trim string" 373 | \ Remove both leading and trailing spaces from s1, resulting in s2. 374 | \ Dependencies: rtrim$ ltrim$ 375 | rtrim$ ltrim$ ; 376 | 377 | : replace$ ( -- pos ) ( found: ss: s1 s2 s3 -- s4 not found: s1 s2 -- s1 s2) 378 | \ In string s2 find s3 and replace with s1, resulting in s4. 379 | \ If a replacement is made, the starting position of the replacement is 380 | \ returned, otherwise -1 is returned. 381 | \ Dependencies: depth$ find$ (addrOf$) (lenOf$) drop$ ($") 382 | \ nip$ HERE (core 6.1.1650) 383 | depth$ 3 < if 9906 throw then 384 | len$ >r 385 | 0 find$ dup ($temp0) ! -1 > if 386 | ($sp@) cell+ here ($temp0) @ cmove 387 | 1 (addrOf$) cell+ here ($temp0) @ + 388 | 1 (addrOf$) (lenof$) cmove 389 | ($sp@) cell+ ($temp0) @ + r@ + 390 | here ($temp0) @ + 1 (addrOf$) (lenof$) + 391 | len$ r> - ($temp0) @ - dup >r cmove 392 | r> ($temp0) @ + 1 (addrOf$) (lenof$) + 393 | drop$ drop$ here swap ($") 394 | else r> drop ($temp0) @ then ; 395 | 396 | : ucase$ ( -- ) ( ss: str -- STR) \ "convert to upper case" 397 | \ On the topmost string, converts all lower case characters to upper case. 398 | \ Dependencies: WITHIN (core ext) (lenOf$) depth$ 399 | depth$ 1 < if 9902 throw then 400 | ($sp@) dup (lenOf$) + cell+ ($sp@) cell+ do 401 | i c@ dup [ char a ] literal [ char { ] literal within if 402 | 32 - i c! else drop then loop ; 403 | 404 | : lcase$ ( -- ) ( ss: STR -- str) \ "convert to lower case" 405 | \ On the topmost string, converts all upper case characters to lower case. 406 | \ Dependencies: WITHIN (core ext) (lenOf$) depth$ 407 | depth$ 1 < if 9902 throw then 408 | ($sp@) dup (lenOf$) + cell+ ($sp@) cell+ do 409 | i c@ dup [ char A ] literal [ char [ ] literal within if 410 | 32 + i c! else drop then loop ; 411 | 412 | : ==$? ( -- flag ) ( ss: -- ) \ "is equal to string" 413 | \ Performs a case-sensitive comparison of the topmost two strings on the 414 | \ string stack, returning true if their length and contents are identical, 415 | \ otherwise returning false. 416 | \ Dependencies: depth$ (addrOf$) (lenOf$) 417 | depth$ 2 < if 9903 throw then \ If the string stack has less than two items, throw an error 418 | len$ 1 (addrOf$) (lenOf$) = \ compare the two top string lengths: Are they equal? 419 | if \ yes, equal length strings 420 | 1 (addrOf$) cell+ \ point to 1st char of 2nd string on stack 421 | ($sp@) cell+ len$ + ($sp@) cell+ \ last char of tostringstack, first char of the same 422 | do 423 | dup c@ i c@ <> 424 | if 425 | drop false leave 426 | then 427 | 1+ loop 428 | dup 429 | if 430 | drop true 431 | then 432 | else \ no, unequal length strings 433 | false \ so return false 434 | then ; 435 | 436 | : $.s ( -- ) ( ss: -- ) 437 | \ Non-destructively displays the string stack. 438 | \ Dependencies: depth$ len$ .$ .R (core ext, 6.2.0210) 439 | cr depth$ 0 > if 440 | ($sp@) depth$ 441 | ." Index|Length|String" cr 442 | ." -----+------+------" cr 443 | 0 begin 444 | depth$ 0 > while 445 | dup 5 .r ." |" len$ 6 .r ." |" .$ 1+ cr 446 | repeat drop 447 | ($depth) ! ($sp) ! cr 448 | else 449 | ." String stack is empty." cr 450 | then 451 | ." Allocated stack space:" ($sEnd) ($sSize) + ($sp@) - 4 .r ." bytes" cr 452 | ." Total stack space:" ($sSize) 4 .r ." bytes" cr 453 | ." Stack space remaining:" ($sp@) ($sEnd) - 4 .r ." bytes" cr ; 454 | 455 | : $>n ( -- n ) ( ss: str -- ) 456 | \ Interprets the topmost string as a number, returning its value 457 | \ on the data stack as a signed integer 458 | \ Dependencies: (lenOf$) drop$ 459 | ( ud1) ($sp@) dup (lenOf$) swap cell+ swap ( c-addr1 u1) 460 | ['] evaluate catch 0<> if 9907 throw then 461 | drop$ ; 462 | 463 | : n>$ ( n -- ) ( ss: -- str ) 464 | \ Pushes the signed number on the data stack to the string stack. 465 | \ Dependencies: ($") 466 | dup abs 467 | <# #s swap sign #> ($") ; 468 | 469 | only forth 470 | 471 | base ! \ restore systems' current number base 472 | -------------------------------------------------------------------------------- /robertedwards/TCPptpcomm-ESP32forthDemo.txt: -------------------------------------------------------------------------------- 1 | \ TCP server and Client point-to-point demonstration 2 | 3 | \ This code demonstrates a point-to-point TCP server on ESP32Forth machine "forth1" sending a stream of values via TCP 4 | \ to another ESP32forth machine "forth2" 5 | \ How to use this code:- 6 | \ 1. Make sure you have two ESP32s loaded with ESP32forth v 7.0.7.2 or later, connected to terminals and in range of your WiFi 7 | \ 2. Load the Mini-OOF library on the two ESP32s - located at 8 | \ https://github.com/Esp32forth/forth2020group/blob/main/robertedwards/mini-oof-BPaysan-by-bob-edwards.txt 9 | \ 3. Edit the router name and password for your router in the code immediately below 10 | \ 4. Load the edited code onto the two ESP32s. 11 | \ 5. Run program TEST1 on one ESP32, then run program TEST2 on the other, you should see both machines connect 12 | \ to the WiFi ... followed by 13 | \ 6. A stream of numbers transmitted and numbers received on the terminals for each ESP32 14 | \ 7. The presence on the network of each machine can be checked by pinging at the P.C. command prompt: 15 | \ PING forth1 or PING forth2 16 | \ 8. The demo can be stopped by pressing any key and both machines should disconnect from the WiFi back to the forth prompt 17 | 18 | \ The mixture of variables and actions needed to program a tcp server or client mean that writing it in normal 19 | \ forth and ending up with something simple is not at all easy - especially if more than one connection is required. 20 | \ I chose to use Mini-OOF to create a TCP Class. As a result you can see that TEST1, (TEST1) and TEST2, (TEST2) 21 | \ are short, simple and very easy to understand - a classic goal of forthers everywhere. 22 | 23 | \ Certain methods in the TCP Class 'block' until their action can complete. A future version of this code will use non-blocking 24 | \ methods with timeouts e.g. if a connection isn't made in a certain time then the words will exit and flag a timeout has occurred 25 | 26 | only forth 27 | 28 | \ Some more WiFi words 29 | 30 | \ >>>>>>>>>>>>>>>>>>>>> EDIT THESE to suit your router name and password <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 31 | z" Yourroutersname" value routername \ <<<<<<<<<<<<<<< EDIT!! 32 | z" Yourrouterspassword" value password \ <<<<<<<<<<<<<<< EDIT!! 33 | 34 | 35 | \ case statement 36 | : ?dup dup if dup then ; 37 | internals 38 | : case 0 ; immediate 39 | : of ['] over , ['] = , ['] 0branch , here 0 , ['] drop , ; immediate 40 | : endof ['] branch , here 0 , swap here swap ! ; immediate 41 | : endcase ['] drop , begin ?dup while here swap ! repeat ; immediate 42 | \ end of case statement 43 | 44 | sockets also WiFi definitions 45 | 46 | : status. ( -- ) \ print WiFi connection status 47 | ." Current WiFi status = " 48 | WiFi.status 49 | case 50 | 0 of ." no SSID available" endof 51 | 1 of ." no SSID available" endof 52 | 2 of ." scan networks complete" endof 53 | 3 of ." connected" endof 54 | 4 of ." connection failed" endof 55 | 5 of ." connection lost" endof 56 | 6 of ." disconnected" endof 57 | . 58 | endcase 59 | cr 60 | ; 61 | 62 | : login ( z"machinename z"routername z"password -- ) 63 | WIFI_MODE_STA Wifi.mode 64 | WiFi.begin 65 | begin 66 | WiFi.localIP 0= 67 | while 68 | 100 ms 69 | repeat 70 | WiFi.localIP ." Address allotted is " ip. cr 71 | MDNS.begin 72 | if 73 | ." MDNS started" 74 | else 75 | ." MDNS failed" 76 | then 77 | cr ; 78 | 79 | : WiFiConnect ( z"machinename -- ) 80 | routername password login 81 | status. \ report our Wifi link status 82 | ; 83 | 84 | : WiFiDisconnect ( -- ) 85 | WiFi.disconnect \ disconnect 86 | ." Now disconnecting" cr 87 | 2000 ms 88 | status. \ report WiFi status again 89 | ; 90 | 91 | 92 | \ TCP point-to-point communication class using MiniOOF on ESP32forth 7.0.7.2+ 93 | \ Bob Edwards Sept 2022 94 | 95 | \ Requires Mini-OOF for ESP32forth loading before this file 96 | 97 | 98 | forth definitions 99 | only also WiFi also sockets 100 | 101 | \ duplicate the 3rd item on the stack to t.o.s. 102 | : 3rddup ( n1 n2 n3 -- n1 n2 n3 n1 ) 103 | >r over r> swap 104 | ; 105 | 106 | \ duplicate the top 3 stack items 107 | : 3dup ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3 ) 108 | 3rddup 3rddup 3rddup 109 | ; 110 | 111 | \ display decoded sockaddr structure 112 | : sockaddr. ( sockaddr -- ) 113 | ." sockaddr length = " dup C@ U. cr 114 | ." family = " dup 1+ C@ . cr 115 | ." port = " dup ->port@ U. cr 116 | ." address = " ->addr@ ip. 117 | ; 118 | 119 | \ initialise a sockaddr structure with AF_INET and 16 byte sockaddr size, the rest all zeros 120 | : sockaddr! ( addr -- ) 121 | DUP sizeof(sockaddr_in) swap C! 122 | 1+ DUP AF_INET swap C! 123 | 14 0 DO 124 | 1+ 125 | DUP 0 SWAP C! 126 | LOOP 127 | DROP 128 | ; 129 | 130 | \ TCP Class 131 | OBJECT CLASS 132 | 4 cells VAR locsockaddr \ local sockaddr_in 133 | cell VAR locsock \ local socket id 134 | 4 cells VAR remsockaddr \ remote sockaddr_in 135 | cell VAR remsock \ remote socket id 136 | cell VAR remaddrlen \ remote sockaddr_in length 137 | cell VAR timeout \ maximum period before timeout occurs 138 | METHOD TCPCONNECT \ Connect as TCP Client 139 | METHOD TCPLISTEN \ Connect as TCP Server 140 | METHOD READ \ Read a data bytes 141 | METHOD WRITE \ Write a data bytes 142 | METHOD CLOSE \ Close a TCP Client / Server connection 143 | METHOD VARS. \ Display all internal variables 144 | END-CLASS TCP 145 | 146 | \ TCP Class - Methods 147 | 148 | \ TCPCONNECT - Initialise a TCP Client connection 149 | :noname 150 | >R 151 | R@ locsockaddr sockaddr! 152 | R@ remsockaddr sockaddr! \ initialise the sockaddrs 153 | R@ locsockaddr ->port! \ save the port required in locsockaddr 154 | R@ locsockaddr ->addr! \ save ip address in locsockaddr 155 | AF_INET SOCK_STREAM 0 socket R@ locsock ! \ create a socket 156 | R@ locsock @ R> locsockaddr sizeof(sockaddr_in) connect \ and connect 157 | throw \ but throw on error 158 | ; TCP DEFINES TCPCONNECT ( ipaddrrange port obj -- ) 159 | 160 | \ TCPLISTEN - Initialise a TCP server connection - blocks execution until the client connects 161 | :noname 162 | >R 163 | R@ locsockaddr sockaddr! 164 | R@ remsockaddr sockaddr! \ initialise teh sockaddrs 165 | R@ locsockaddr ->port! \ save the port we're listening on 166 | R@ locsockaddr ->addr! \ save the ip address range we're listening out for 167 | AF_INET SOCK_STREAM 0 socket R@ locsock ! \ create a streaming socket 168 | R@ locsock @ R@ locsockaddr sizeof(sockaddr_in) 169 | bind throw \ bind the socket to the address 170 | R@ locsock @ 0 listen throw \ listen for someone to connect 171 | sizeof(sockaddr_in) R@ remaddrlen ! \ remsockaddr not received unless this preset 16 172 | R@ locsock @ R@ remsockaddr R@ remaddrlen 173 | sockaccept \ unblocks when a connection request is made 174 | dup -1 = 175 | IF 176 | throw 177 | ELSE 178 | R> remsock ! \ store the remote socket id received 179 | THEN 180 | ; TCP DEFINES TCPLISTEN ( ipaddrrange port obj -- ) 181 | 182 | \ Reads data from a buffer at addr, length n bytes 183 | :noname 184 | locsock @ -rot ( [locsock] addr nreqd ) 185 | begin 186 | 3dup ( [locsock] addr nreqd [locsock] addr nreqd ) 187 | 0 recv DUP 0< THROW ( [locsock] addr nreqd nrecvd ) 188 | dup >r - ( [locsock] addr nreqd-nrecvd : nrcvd ) 189 | swap r> + swap dup 0= ( [locsock] addr+nrcvd nreqd-nrecvd ) 190 | until 191 | 2drop drop ( -- ) 192 | ; TCP DEFINES READ ( addr n obj -- ) 193 | 194 | 195 | \ Write data to a buffer at addr, length n bytes 196 | :noname 197 | remsock @ -rot ( [remsock] addr nreqd ) 198 | begin 199 | 3dup ( [remsock] addr nreqd [remsock] addr nreqd ) 200 | 0 send DUP 0< THROW ( [remsock] addr nreqd nrecvd ) 201 | dup >r - ( [remsock] addr nreqd-nrecvd : nrcvd ) 202 | swap r> + swap dup 0= ( [remsock] addr+nrcvd nreqd-nrecvd flag ) 203 | until 204 | 2drop drop ( -- ) 205 | ; TCP DEFINES WRITE ( addr n1 -- ) 206 | 207 | \ Close the connection 208 | :noname 209 | >R 210 | R@ locsock @ CLOSE-FILE drop \ close local socket 211 | R> remsock @ CLOSE-FILE drop \ close remote socket 212 | ; TCP DEFINES CLOSE ( obj -- ) 213 | 214 | :noname 215 | >R 216 | cr ." locsockaddr : " R@ locsockaddr cr sockaddr. 217 | cr ." locksock = " R@ locsock @ . 218 | cr ." remaddrlen = " R@ remaddrlen @ . 219 | cr ." remsockaddr : " R@ remsockaddr cr sockaddr. 220 | cr ." remsock = " R@ remsock @ . 221 | cr ." timeout = " R> timeout @ . 222 | ; TCP DEFINES VARS. ( -- ) 223 | 224 | \ Decode errno and display an error code 225 | : .socketError ( -- ) 226 | errno 227 | case 228 | 1 of ." Not owner " endof 229 | 2 of ." No such file " endof 230 | 3 of ." No such process " endof 231 | 4 of ." Interrupted system " endof 232 | 5 of ." I/O error " endof 233 | 6 of ." No such device " endof 234 | 7 of ." Argument list too long " endof 235 | 8 of ." Exec format error " endof 236 | 9 of ." Bad file number " endof 237 | 10 of ." No children " endof 238 | 11 of ." No more processes " endof 239 | 12 of ." Not enough core" endof 240 | 13 of ." Permission denied " endof 241 | 14 of ." Bad address " endof 242 | 15 of ." Block device required " endof 243 | 16 of ." Mount device busy " endof 244 | 17 of ." File exists " endof 245 | 18 of ." Cross-device link " endof 246 | 19 of ." No such device " endof 247 | 20 of ." Not a directory " endof 248 | 21 of ." Is a directory " endof 249 | 22 of ." Invalid argument " endof 250 | 23 of ." File table overflow " endof 251 | 24 of ." Too many open file " endof 252 | 25 of ." Not a typewriter " endof 253 | 26 of ." Text file busy " endof 254 | 27 of ." File too large " endof 255 | 28 of ." No space left on " endof 256 | 29 of ." Illegal seek " endof 257 | 30 of ." Read-only file system " endof 258 | 31 of ." Too many links " endof 259 | 32 of ." Broken pipe " endof 260 | 35 of ." Operation would block " endof 261 | 36 of ." Operation now in progress " endof 262 | 37 of ." Operation already in progress " endof 263 | 38 of ." Socket operation on " endof 264 | 39 of ." Destination address required " endof 265 | 40 of ." Message too long " endof 266 | 41 of ." Protocol wrong typee " endof 267 | 42 of ." Protocol not available " endof 268 | 43 of ." Protocol not supported " endof 269 | 44 of ." Socket type not supported " endof 270 | 45 of ." Operation not supported " endof 271 | 46 of ." Protocol family not supported " endof 272 | 47 of ." Address family not supported " endof 273 | 48 of ." Address already in use " endof 274 | 49 of ." Can't assign requested address " endof 275 | 50 of ." Network is down " endof 276 | 51 of ." Network is unreachable " endof 277 | 52 of ." Network dropped connection " endof 278 | 53 of ." Software caused connection " endof 279 | 54 of ." Connection reset by peer " endof 280 | 55 of ." No buffer space available " endof 281 | 56 of ." Socket is already connected " endof 282 | 57 of ." Socket is not connected " endof 283 | 58 of ." Can't send after shutdown " endof 284 | 59 of ." Too many references " endof 285 | 60 of ." Connection timed out " endof 286 | 61 of ." Connection refused " endof 287 | 62 of ." Too many levels of nesting " endof 288 | 63 of ." File name too long " endof 289 | 64 of ." Host is down " endof 290 | ." Error " . 291 | endcase 292 | ; 293 | 294 | \ Test programs - notice how the TCP interface is greatly simplified by the TCP Class 295 | 296 | variable count 297 | 298 | TCP NEW CONSTANT MYTCP \ Create a TCP object called MYTCP to work with 299 | 300 | \ TCP Server that transmits a stream of longs, one at a time, from a sawtooth waveform 301 | : (TEST1) ( -- ) 302 | 0 9999 MYTCP TCPLISTEN \ Start a TCP Server and wait for a client to connect 303 | 0 count ! \ this is used to creat the sawtooth 304 | BEGIN 305 | count 4 MYTCP WRITE \ send the data counter 306 | cr ." transmitted data = " 307 | count @ . 308 | 1 count +! \ increment the data counter 309 | count @ 50 = if 0 count ! then \ limit the counter to 50 max 310 | 25 ms 311 | key? \ stop if key pressed 312 | UNTIL 313 | MYTCP CLOSE \ and close the connection 314 | ; 315 | 316 | \ TCP Server that transmits a stream of longs from a sawtooth waveform - with error reporting - start this first 317 | : TEST1 ( -- ) 318 | cr ." Connecting to the Wifi router ..." 319 | z" forth1" WiFiConnect 320 | cr ." Waiting for a client to connect..." 321 | ['] (TEST1) catch 0<> 322 | IF 323 | .socketError \ if an error is throwm, decode and display 324 | THEN 325 | WiFiDisconnect 326 | ; 327 | 328 | \ TCP Client which receives a stream of longs from the server - notice the m/c name is forth1.local not forth1 329 | : (TEST2) ( -- ) 330 | z" forth1.local" gethostbyname ->h_addr 9999 ( ipaddr port ) 331 | MYTCP TCPCONNECT \ Connect to the waiting server 332 | BEGIN 333 | count 4 MYTCP READ \ count = a 32 bit value from the server 334 | cr ." received data = " count @ . 335 | key? 336 | UNTIL 337 | MYTCP CLOSE 338 | ; 339 | 340 | \ TCP Client which receives a stream of longs from the server - with error reporting 341 | \ Start this after the server is started 342 | : TEST2 ( -- ) 343 | cr ." Connecting to the Wifi router ..." 344 | z" forth2" WiFiConnect 345 | ['] (TEST2) catch 0<> 346 | IF 347 | .socketError 348 | THEN 349 | WiFiDisconnect 350 | ; 351 | 352 | -------------------------------------------------------------------------------- /robertedwards/mini-oof demo.fth: -------------------------------------------------------------------------------- 1 | \ MINI-OOF demo - Bob Edwards July 2021 2 | 3 | \ include "mini-oof for esp32forth.fth" 4 | 5 | object class 6 | cell var teeth# 7 | cell var height 8 | method speak 9 | method greet 10 | method walk 11 | method add. 12 | end-class pet 13 | 14 | :noname ." pet speaks" drop ; pet defines speak 15 | :noname ." pet greets" drop ; pet defines greet 16 | :noname ." pet walks" drop ; pet defines walk 17 | :noname drop + ." n1 + n2 = " . ; pet defines add. ( n1 n2 -- ) 18 | 19 | pet class 20 | method happy \ cats can do more than pets 21 | end-class cat 22 | 23 | :noname ." cat purrs" drop ; cat defines happy 24 | 25 | \ cats override pets for these two methods 26 | :noname ." cat says meow" drop ; cat defines speak 27 | :noname ." cat raises tail" drop ; cat defines greet 28 | 29 | pet class 30 | end-class dog 31 | 32 | \ dogs override pets for these two methods 33 | :noname ." dog says wuff" drop ; dog defines speak 34 | :noname ." dog wags tail" drop ; dog defines greet 35 | 36 | \ create a cat and dog object to work with 37 | cat new constant tibby 38 | dog new constant fido 39 | 40 | 20 tibby teeth# ! 41 | 30 fido teeth# ! 42 | 43 | 50 tibby height ! 44 | 75 fido height ! 45 | 46 | tibby greet 47 | fido speak 48 | 49 | tibby teeth# @ . cr 50 | fido height @ . cr 51 | 52 | tibby walk \ notice tibby is a pet so she can walk OK 53 | 34 56 fido add. \ the parent methods are inherited 54 | -------------------------------------------------------------------------------- /robertedwards/mini-oof for esp32forth ver3.forth: -------------------------------------------------------------------------------- 1 | \ Mini-OOF by Bernd Paysan https://bernd-paysan.de/mini-oof.html 2 | \ Adapted for ESP32Forth32 7.0.5.4 and onwards by Bob Edwards July 2022 ver 3 3 | \ Mini-OOF offers no protection against programming errors, nor 'information hiding' 4 | \ This version of Mini-OOF is multitasker compatible 5 | 6 | ONLY FORTH DEFINITIONS 7 | 8 | DEFINED? *MINI-OOF* [IF] forget *MINI-OOF* [THEN] 9 | : *MINI-OOF* ; 10 | 11 | \ 'Do nothing' placeholder - overwritten later with a deferred word 12 | : NOOP ; 13 | 14 | \ remove n chrs from the front of the counted byte block 15 | : /STRING ( addr1 cnt1 n -- addr2 cnt2 ) 16 | DUP >R - \ reduce cnt1 17 | SWAP R> + \ increase start address 18 | SWAP \ cleanup 19 | ; 20 | 21 | \ subtract a 'cell' - 4 bytes - from n1 22 | : cell- ( n1 -- n1-4 ) 23 | 4 - 24 | ; 25 | 26 | 27 | \ The object oriented extensions 28 | 29 | \ define a method in a new class - this is what an object can do 30 | : METHOD 31 | CREATE ( m v -- m' v ) 32 | OVER , \ compile m 33 | SWAP CELL+ SWAP \ m' = m + cell 34 | DOES> ( ... O -- ... ) 35 | @ OVER @ + \ calculate the required method address from the object ref. 36 | @ EXECUTE \ read the xt of the method and execute it 37 | ; 38 | 39 | \ define data within a new class, needed to store an objects' state during operation 40 | : VAR ( m v size -- ) 41 | CREATE 42 | OVER , \ compile v 43 | + ( m v+size ) 44 | DOES> ( o -- addr ) 45 | @ + \ add the vla offset to the object ref to get the val address 46 | ; 47 | 48 | \ start the definition of a new class, derived from an existing class or the root OBJECT 49 | : CLASS ( class -- class methods vars ) 50 | DUP 51 | 2@ SWAP \ read methods and instvars and copy to the stack 52 | ; 53 | 54 | \ end the definition of a new class 55 | : END-CLASS ( CLASS METHODtotalspace VARtotalspace "name" -- ) 56 | CREATE \ create the class entry in the dict. with the name that follows 57 | HERE >R \ remember the current compilation address - contains VARtotalspace 58 | , DUP , \ compile VARtotalspace, then METHODtotalspace ( CLASS METHODtotalspace -- ) 59 | 2 CELLS ?DO \ if new methods have been defined in the class definition 60 | ['] NOOP , \ compile a temporary NOOP for each method defined 61 | 1 CELLS +LOOP ( CLASS -- ) 62 | CELL+ DUP CELL+ R> ( CLASS+4 CLASS+8 VARtotalspace -- ) 63 | ROT ( CLASS+8 VARtotalspace CLASS+4 -- ) 64 | @ ( CLASS+8 VARtotalspace METHODtotalspace -- ) 65 | 2 CELLS ( CLASS+8 VARtotalspace METHODtotalspace 8 -- ) 66 | /STRING 67 | CMOVE \ copy across the XTs from the parent class 68 | ; 69 | 70 | \ used to define what each method actually does 71 | : DEFINES ( xt class -- ) 72 | ' \ find the XT of the method name in the input stream 73 | >BODY @ + ! \ address [pfa]+class is set to XT, overwriting the NOOP 74 | ; \ in the class definition 75 | 76 | : NEW ( class -- o ) 77 | HERE \ find the next unused code location 78 | OVER @ ALLOT \ read the total var space reqd. and allot that space 79 | SWAP ( here class ) 80 | OVER ! \ store class at [here], leaving here on the stack as o 81 | ; 82 | 83 | \ HNEW is used to create an object, storing it's data on the heap. This is useful for creating objects 84 | \ at run-time. Such objects can remain nameless and can be destroyed by calling FREE ( obj -- ) 85 | \ Use HNEW when you don't know how many objects will be needed at compile time 86 | : HNEW ( class -- object ) 87 | DUP @ ALLOCATE THROW \ read the total var space reqd. and allot that space on the heap 88 | SWAP ( object class ) 89 | OVER ! \ store class in the 1st location in obj table & leave obj on stack 90 | ; 91 | 92 | 93 | \ And sometimes derived classes want to access the method of the parent object with early binding 94 | \ There are two ways to achieve this with this OOF: first, you could use named words, 95 | \ or second, you could look up the vtable of the parent object 96 | \ NB use this early binding word only within a definition, because it compiles the method's address in-line 97 | : :: ( class "name" -- ) 98 | ' >BODY @ + @ , 99 | ; 100 | \ Example use: : TEST1 TIMER1 [ TIMER :: TPRINT ] CR ; Early binding - the method address is calculated during compilation 101 | \ As opposed to : TEST2 TIMER1 TPRINT CR ; Late binding - the method address is calculated at runtime 102 | 103 | 104 | \ this is the root object that all new classes are ultimately derived from 105 | CREATE OBJECT 1 cells , 2 cells , 106 | 107 | \ If all classes are derived from a base class with a method INIT, then this is useful to 108 | \ make INIT automatically run when an object is created 109 | 110 | OBJECT CLASS 111 | method INIT 112 | END-CLASS INITOBJECT 113 | 114 | : NEW: ( ... o "name" -- ) 115 | NEW DUP CONSTANT INIT 116 | ; 117 | 118 | \ Further sub-Classes are created from INITOBJECT, each having INIT overrridden to suit that classes 119 | \ initialisation of VARs etc. 120 | 121 | \ e.g. here's a class that requires one VAR initialising from a value on the stack 122 | 123 | \ INITOBJECT CLASS 124 | \ cell VAR myvar 125 | \ END-CLASS BABA 126 | \ :noname myvar ! ; BABA DEFINES INIT 127 | \ An object would be created as here, and myvar = 80 automatically 128 | \ 80 BABA NEW: MYBABA 129 | 130 | 131 | \ In Mini-OOF, when a method executes, the 'current object' reference is placed top of data stack 132 | \ Mini-OOF expects the method to consume the 'current object' before finishing 133 | \ This 'current object' gets in the way when using the data stack within the method 134 | \ and it's quite useful to store it temporarily on the R stack 135 | \ Copies of the 'current object' can be made using R@ to call methods with 136 | \ Don't forget to drop it from the R stack before exiting the method. 137 | 138 | ONLY 139 | -------------------------------------------------------------------------------- /robertedwards/readme.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /robertedwards/rstack display.fth: -------------------------------------------------------------------------------- 1 | \ display the user application entries on the return stack 2 | 3 | RP@ 2 cells + value USERRP0 \ RSTACK base address prior to executing user word, and <> RP0 4 | 5 | : .rstack 6 | ." [ r-stack " 7 | USERRP0 RP@ <> IF 8 | RP@ USERRP0 DO 9 | I @ . 10 | cell +LOOP 11 | ELSE 12 | ." No user values" 13 | THEN 14 | ." ]" 15 | ; 16 | 17 | : TEST1 1 >R 2 >R 3 >R .rstack rdrop rdrop rdrop ; 18 | 19 | : TEST2 .rstack ; 20 | 21 | TEST1 CR 22 | TEST2 CR 23 | -------------------------------------------------------------------------------- /robertedwards/timeout for ESP32forth.fth: -------------------------------------------------------------------------------- 1 | \ ESP32forth Timeout function - Bob Edwards Aug 2022 2 | \ When you want a function to repeat for a limited period of time only 3 | 4 | \ returns true if period has expired; starttime, period or both in ms 5 | : timeout? ( starttime period -- starttime false , if not yet timed out | true , if timed out ) 6 | over + MS-TICKS <= 7 | ; 8 | 9 | \ run a loop for a limited period 10 | : test 11 | MS-TICKS \ read the current time 12 | begin 13 | ." try something " \ these words will run until a key is pressed or the timeout occurs 14 | 2000 timeout? key? or 15 | until 16 | ." timed out!" 17 | drop \ drop the original start time 18 | ; 19 | -------------------------------------------------------------------------------- /robertedwards/trace for esp32forth.fth: -------------------------------------------------------------------------------- 1 | TRACE - originally by Mark Wills - see https://www.bernd-paysan.de/screenful.html 2 | \ Adapted for ESP32forth by Bob Edwards Sept 2022 3 | \ A small piece of code, but very effective at showing word flow & entry and exit data stack conditions 4 | <<<<<<< HEAD 5 | \ It's very simple so easily understood and added to 6 | ======= 7 | \ It's very simple, so easily understood and added to 8 | >>>>>>> 350a8f7e998f83aea858cc8e82fe8969974baf0c 9 | 10 | DEFINED? *TRACE* [IF] forget *TRACE* [THEN] 11 | : *TRACE* ; 12 | 13 | 14 | -1 constant true 15 | 0 constant false 16 | 0 VALUE indents 17 | 0 VALUE tracing 18 | RP@ 2 cells + value USERRP0 19 | 20 | : .rstack 21 | ." [ r-stack " 22 | USERRP0 RP@ <> IF 23 | RP@ USERRP0 DO 24 | I @ . 25 | cell +LOOP 26 | ELSE 27 | ." No new entries" 28 | THEN 29 | ." ]" 30 | ; 31 | 32 | \ duplicate nth item on the data stack, 0 pick = dup, 1 pick = over 33 | : pick ( .... n - nth item ) 34 | sp@ swap 1+ cells - @ 35 | ; 36 | 37 | CREATE BLIST 15 CELLS ALLOT 38 | 39 | : BLIST[] indents CELLS BLIST + ; 40 | 41 | : TRACE TRUE TO tracing 0 TO indents ; 42 | 43 | : UNTRACE FALSE TO tracing ; 44 | 45 | : >indents ( -- ) 0 indents MAX 12 MIN SPACES ; 46 | 47 | <<<<<<< HEAD 48 | : .stack ( -- ) ." [ d-stack " DEPTH ?DUP IF 1 SWAP DO I 1- PICK . -1 49 | ======= 50 | : .stack ( -- ) ." [ " DEPTH ?DUP IF 1 SWAP DO I 1- PICK . -1 51 | >>>>>>> 350a8f7e998f83aea858cc8e82fe8969974baf0c 52 | +LOOP ." ]" ELSE ." empty ]" THEN ; 53 | 54 | : .name ( CFA -- ) >NAME TYPE ; 55 | 56 | : (:) 57 | R@ 2 CELLS - BLIST[] ! 58 | tracing 59 | IF 60 | >indents BLIST[] @ .name 61 | 58 EMIT .stack CR 62 | THEN 63 | 1 +TO indents 64 | ; 65 | 66 | : (;) 67 | tracing 68 | IF 69 | >indents ." Exit:" .stack CR 70 | THEN 71 | -1 +TO indents 72 | ; 73 | 74 | : : : POSTPONE (:) ; \ this has to be my favourite definition!! 75 | 76 | : ; POSTPONE (;) POSTPONE ; ; IMMEDIATE 77 | 78 | : BREAK CR ." **BREAK**" CR .stack CR 0 indents 2 - DO ." in " I 79 | CELLS BLIST + @ .name SPACE -1 +LOOP 0 TO indents CR QUIT ; 80 | 81 | 82 | \ Example: 83 | 84 | \ With TRACE loaded:- 85 | 86 | \ Use TRACE to switch on 87 | \ use UNTRACE to switch off 88 | \ Use BREAK in a definition to force a break-point and dump the stack to the screen 89 | \ e.g. : TEST IF BREAK ELSE .... THEN ; 90 | 91 | \ Here's an example 92 | 93 | : HARRY 4 ; 94 | : DICK 5 >R 6 >r 7 >r 3 HARRY RDROP RDROP RDROP ; 95 | : TOM 2 DICK BREAK ; 96 | : TEST 1 TOM ; 97 | 98 | TRACE 99 | TEST 100 | 2DROP 2DROP 101 | --------------------------------------------------------------------------------