Difference between revisions of "Forth"

From eLinux.org
Jump to: navigation, search
(PIGPIO)
(BQ Aquaris command line compass)
 
(82 intermediate revisions by the same user not shown)
Line 1: Line 1:
 
Forth on Raspberry Pi
 
Forth on Raspberry Pi
  
Here we install atlast-1.2. There is also a 64 bit version, atlast-2.0 available from John Walker, fourmilab.
+
Here we install atlast-1.2. There is also a 64 bit version, atlast-2.0 https://www.fourmilab.ch/atlast/download/2.0/atlast-2.0.tar.gz available from John Walker, fourmilab. https://github.com/Fourmilab/atlast If you are using Raspberrypi OS -64 bit use atlast-2.0 (both versions will compile, but floats doesn't work as expected on atlast-1.2).
 
<pre>
 
<pre>
 
sudo apt-get install wget
 
sudo apt-get install wget
Line 9: Line 9:
 
make
 
make
 
</pre>
 
</pre>
Or, get it all, source code added from this tutorial:
+
Or, get it all, source code added from this tutorial. Make sure to comment out the "options" before the first make, see Readme on https://github.com/skvamme/atlast If you would like to run atlast on a Raspberry Pi Pico, look here https://github.com/skvamme/pico_atlast
 
<pre>
 
<pre>
 
sudo apt-get install git
 
sudo apt-get install git
Line 19: Line 19:
 
Start the Forth interpreter with ./atlast and exit with Ctrl + d.
 
Start the Forth interpreter with ./atlast and exit with Ctrl + d.
  
atlast.html and atlast.pdf is included and is an extensive ATLAST Forth manual. Read it online [http://www.fourmilab.ch/atlast/] and read about Forth itself here [http://www.forth.com/starting-forth/sf0/sf0.html] and here [http://home.iae.nl/users/mhx/sf.html] (Beware that the Forth dialect in the book Starting Forth is a bit outdated compared to ATLAST Forth). Leo Brodie wrote another book, Thinking Forth, read it here [http://www.dnd.utwente.nl/~tim/colorforth/Leo-Brodie/thinking-forth.pdf] and here [http://prdownloads.sourceforge.net/thinking-forth]
+
atlast.html and atlast.pdf are included and is an extensive ATLAST Forth manual. Read it online [http://www.fourmilab.ch/atlast/] and read about Forth itself here [http://www.forth.com/starting-forth/sf0/sf0.html] and here [http://home.iae.nl/users/mhx/sf.html] (Beware that the Forth dialect in the book Starting Forth is a bit outdated compared to ATLAST Forth). Leo Brodie wrote another book, Thinking Forth, read it here [http://www.dnd.utwente.nl/~tim/colorforth/Leo-Brodie/thinking-forth.pdf] and here [http://prdownloads.sourceforge.net/thinking-forth]. Charles Moore, the inventor of forth gave an interview here [http://www.ultratechnology.com/1xforth.htm]and a presentation here [https://www.youtube.com/watch?v=0PclgBd6_Zs] Here is a nice tutorial from Shropshire LUG - Oct 2020 https://www.youtube.com/watch?v=EADDOnRtFrI
 +
 
 +
== SIXEL GRAPHICS ==
 +
Create graphics in an ordinary terminal emulator.
 +
 
 +
The following terminal emulators can do sixel graphics: XTerm (360 or later), KDE Konsole (latest), MLterm (3.8.4), Contour (0.1.1), WezTerm (20210502), Mintty (3.5.0), RLogin (2.25.3), XQuartz, MacTerm and Reflection Desktop (16.2.0).
 +
 
 +
Install the latest version of Xterm (sixel graphics is enabled by default).
 +
<pre>
 +
sudo apt install xterm (if you are on OSX, upgrade to the latest XQuartz).
 +
</pre>
 +
 
 +
Create a file .Xresources in your home directory and insert the following line
 +
<pre>
 +
xterm*decTerminalID: vt340
 +
</pre>
 +
 
 +
Start Xterm and check that X11 recognize the terminal type vt340, if not, reboot. If you are in XQuarts, restart XQuarts. The font 'fixed' with size 9 is working on some systems but you may have to experiment to get the right one for your setup.
 +
<pre>
 +
xterm -fn 6x12
 +
xrdb -query
 +
</pre>
 +
 
 +
Start atlast
 +
<pre>
 +
./atlast -isixel.atl
 +
RUN
 +
</pre>
 +
[[File:sixel.png]]
 +
 
 +
Here is sixel.atl Get the latest version at https://github.com/skvamme
 +
<pre>
 +
( Draw sixel graphics in a terminal emulator, Xterm -fn 6x12 )
 +
 
 +
8 string num
 +
variable row
 +
500 1 1 ARRAY data
 +
 
 +
: color "#0;2;50;50;50#1;2;100;0;0#2;2;0;100;00#3;2;0;0;100" type ;
 +
: start 27 emit "Pq" type ;
 +
: end 27 emit 92 emit ;
 +
: cr_ "$" type ;
 +
: crlf  "-" type ;
 +
: up 27 emit 91 emit "%d" num strform num type "A" type ; ( n -- )
 +
: noscroll 27 emit 91 emit "?80l" type ; ( disable sixel scrolling, will change to ?80h in xterm 369 )
 +
: scroll 27 emit 91 emit "?80h" type ;  ( ?80l in xterm <= 369 )
 +
 
 +
 
 +
: filldata  450 1 do i float  3.14 f* 180.0 f/ sin 50.0 f* fix 130 + 2 / i data c! loop ;
 +
 
 +
: plot  6 * row !
 +
"#1!35?" type
 +
    450 1 do
 +
row @ 0 + i data c@ = if "@" type ( 1 )
 +
else
 +
row @ 1 + i data c@ = if "A" type ( 2 )
 +
else
 +
row @ 2 + i data c@ = if "C" type ( 4 )
 +
else
 +
row @ 3 + i data c@ = if "G" type ( 8 )
 +
else
 +
row @ 4 + i data c@ = if "O" type ( 16 )
 +
else
 +
row @ 5 + i data c@ = if "_" type ( 32 )
 +
else
 +
"?" type then then then then then then loop cr_ ;
 +
 
 +
: y_arrow "#0------!33?~~" type crlf "!32?~~~" type crlf "!31?!4~" type crlf "!30?!5~" type
 +
crlf "!34?~" type crlf "!34?~" type crlf ;
 +
: yaxis "#0!29?!5@~" type crlf ;
 +
: hor_line "#0!24?!10@" type 65 1 do "~!6@" type loop "!4~!4^!4N!4F!4B!4@" type crlf ;
 +
: hor_ticks  "#0!34?" type 14 1 do "N!34?" type loop crlf ;
 +
: hor_num "    0    1    2    3    4    5    6    7    8    9  10    11    12" type ;
 +
: ver_num "400 -" type cr cr "300 -" type cr cr "200 -" type cr cr "100 -" type cr cr "  0" type ;
 +
 
 +
 
 +
: run noscroll filldata cr cr cr cr ver_num cr cr hor_num cr start color y_arrow
 +
20 1 do i plot yaxis loop hor_line hor_ticks end ;
 +
</pre>
 +
 
 +
Here is another take on 7-seg sixel graphics. Disable sixel scrolling on the middle mouse button menu in Xterm.
 +
 
 +
<pre>
 +
./atlast -i7-seg.atl
 +
</pre>
 +
 
 +
Type any name between ZERO and NINE. RED SEVEN does what it says.
 +
 
 +
7-seg.atl is here:
 +
<pre>
 +
\ Draw 7-seg sixel graphics in a terminal emulator, Xterm
 +
\ Turn OFF sixel scrolling, middle mouse button menu in Xterm
 +
 
 +
15 string pos
 +
 
 +
: color "#0;2;100;100;100#1;2;100;0;0#2;2;0;100;00#3;2;0;0;100" type ; ( Adjust #0 to match your background color )
 +
: end 27 emit 92 emit ;
 +
: cr_ "$" type ;
 +
: crlf  "-" type ;
 +
: left "!9?" pos strcpy ;
 +
: right "!49?" pos strcpy ;
 +
: red "#1" type ;
 +
: bg "#0" type ;
 +
: pad 10 1 do crlf loop ; ( top margin )
 +
: hi ;
 +
: mid 8 1 do crlf loop ;
 +
: lo 15 1 do crlf loop ;
 +
: start 27 emit "Pq" type color pad red ;
 +
 
 +
: horizontal "!17?_ow{}!26~}{wo_" type crlf "!17?@BFN^!26~^NFB@" type crlf ;
 +
: vertical crlf pos type "!2?_ow{{wo_" type crlf pos type 6 1 do "!12~"
 +
type crlf pos type loop "!2?@BFNNFB@" type crlf ;
 +
 
 +
: wipe start bg 17 1 do "!61~" type crlf loop end ;
 +
 
 +
: one start hi right vertical end start mid right vertical end ;
 +
 
 +
: two start hi horizontal end start hi right vertical end start mid horizontal end
 +
start mid left vertical end start lo horizontal end ;
 +
 
 +
: three one start hi horizontal end start mid horizontal end start lo horizontal end ;
 +
 
 +
: four one start hi left vertical end start mid horizontal end ;
 +
 
 +
: five start hi horizontal end start hi left vertical end start mid horizontal end
 +
start mid right vertical end start lo horizontal end ;
 +
 
 +
: six five start mid left vertical end ;
 +
 
 +
: seven one start hi horizontal end ;
 +
 
 +
: nine four start hi horizontal end ;
 +
 
 +
: zero one start hi horizontal end start hi left vertical end
 +
start mid left vertical end start lo horizontal end ;
 +
 
 +
: eight zero start mid horizontal end ;
 +
</pre>
 +
 
 +
Get the latest version at https://github.com/skvamme
  
 
== PIGPIO ==
 
== PIGPIO ==
Parts of the pigpio C interface is now implemented in https://github.com/skvamme/atlast.git Look in http://abyz.me.uk/rpi/pigpio/cif.html for a detailed description of each function.
+
Parts of the pigpio C interface are now implemented in https://github.com/skvamme/atlast.git Look in http://abyz.me.uk/rpi/pigpio/cif.html for a detailed description of each function. If there is some function you want to add, take a look at section 4 in this document to get a short tutorial on how to do it.
  
 
<pre>
 
<pre>
Line 35: Line 174:
 
GPIOALERTEX  ( pin name -- result ) Define word "name" ( pin level timestamp -- )
 
GPIOALERTEX  ( pin name -- result ) Define word "name" ( pin level timestamp -- )
 
GPIOTRIGGER  ( pin micros level -- result )
 
GPIOTRIGGER  ( pin micros level -- result )
GPIOSETTIMERFUNC      ( timer millis -- result ) Define word TIMER.
+
GPIOSETTIMERFUNC      ( timer millis -- result ) You define the word TIMER.
 
GPIOSETTIMERFUNCEX    ( timer millis name -- result ) Define word "name".
 
GPIOSETTIMERFUNCEX    ( timer millis name -- result ) Define word "name".
 +
GPIOSETWATCHDOG        ( pin millis -- result )
 +
SPIOPEN      ( chan baud flags -- handle )
 +
SPICLOSE    ( handle -- result )
 +
SPIREAD      ( handle strbuffer count -- result )
 +
SPIWRITE    ( handle strbuffer count -- result )
 +
SPIXFER      ( handle txstrbuf rxstrbuf count -- result )
 
</pre>
 
</pre>
  
 
Install pigpio, follow the guide in http://abyz.me.uk/rpi/pigpio/download.html
 
Install pigpio, follow the guide in http://abyz.me.uk/rpi/pigpio/download.html
  
cd to atlast and type: make clean and then make
+
Clone atlast and cd to atlast
 +
 
 +
Open Makefile and uncomment the LIBRARIES line withe the -lpigpio
 +
<pre>
 +
LIBRARIES = -lrt -lm -L/usr/local/lib -lpigpio
 +
</pre>
 +
Save the file and type make
 +
 
 +
Make sure the pigpiod id NOT running by typing sudo killall pigpiod
  
Here is how to run an ultrasonic sensor MB 1010, any SRF05/04 should also work.
+
Here is how to run an ultrasonic sensor MB 1010, any SRF05/04 should also work. The latest version is at https://github.com/skvamme/atlast
  
 
Connect the trig input to gpio 24 and pulsewidth output to gpio 25.
 
Connect the trig input to gpio 24 and pulsewidth output to gpio 25.
 
<pre>
 
<pre>
The word PIGPIO should take 3 items off the stack: ( pin level timestamp -- )
+
The word ALERT should take 3 items off the stack: ( pin level timestamp -- )
 
Here I wait for a rising edge and a falling edge, then I take 6 items off the stack.
 
Here I wait for a rising edge and a falling edge, then I take 6 items off the stack.
: pigpio depth 6 >= if 3 roll -  147 / 254 * 100 / ." "Distance: " . ." "cm" cr drop drop drop drop then ;
+
: alert depth 6 >= if 3 roll -  147 / 254 * 100 / ." "Distance: " . ." "cm" cr drop drop drop drop then ;
  
 
: setup 24 1 gpiosetmode . 25 0 gpiosetmode . 25 1 gpiosetpullupdown . 25 gpioalert . ;
 
: setup 24 1 gpiosetmode . 25 0 gpiosetmode . 25 1 gpiosetpullupdown . 25 gpioalert . ;
Line 57: Line 210:
 
<pre>
 
<pre>
 
Type GPIOSTART DROP SETUP and then TRIG will give you the distance in cm to the object in front of your MB 1010.
 
Type GPIOSTART DROP SETUP and then TRIG will give you the distance in cm to the object in front of your MB 1010.
 +
</pre>
 +
 +
Here is another example of using pigpio. Read the hx711 24 bit adc load cell device. The latest version is at https://github.com/skvamme/atlast
 +
<pre>
 +
( hx711 )
 +
( SCK is gpiopin 23, DOUT is gpiopin 24, VDD is 3.3V, VCC is 5V )
 +
( Type GPIOSTART DROP SETUP )
 +
 +
: setup 24 0 gpiosetmode . 23 1 gpiosetmode . 23 0 gpiowrite . 24 1 gpiosetpullupdown . 0 1000 gpiosettimerfunc . ;
 +
 +
: get24bits 0 24 0 do 23 1 1 gpiotrigger drop 1 sleep 24 gpioread 23 i - shift + loop 23 1 1 gpiotrigger drop 23 1 1 gpiotrigger drop 23 1 1 gpiotrigger drop ; ( 27 pulses = 64 gain )
 +
 +
: timer 24 gpioread 0 = if get24bits . cr then ;
 +
: reset 23 100 1 gpiotrigger drop ;
 +
</pre>
 +
 +
An example of reading the inputs from the analog zero board, any MCP3008 based ADC should also work. The latest version is at https://github.com/skvamme/atlast
 +
<pre>
 +
( analogzero )
 +
variable inbuf
 +
variable outbuf
 +
33554431 constant ch7 ( channel 7 single-ended )
 +
 +
: setup 0 1000000 0 spiopen . ch7 inbuf ! ; ( ch7 is input closest to prototype area )
 +
 +
: test 0 inbuf outbuf 3 spixfer . outbuf @ -8 shift 1023 and . cr ; ( output 0 to 1023 )
 +
 +
gpiostart . setup
 
</pre>
 
</pre>
  
 
== BQ Aquaris command line compass ==
 
== BQ Aquaris command line compass ==
I noticed the other day that I can compile ATLAST on my Raspberry Pi 2 and run it on my BQ Aquaris, Ubuntu Touch @UBports mobile phone. Just copy the compiled ATLAST program from your Raspberry Pi to the phablet home directory on Ubuntu Touch. And here's Forth code for a command line compass that you can try. The latest version is at https://github.com/skvamme/command-line-compass
+
I noticed the other day that I can compile ATLAST on my Raspberry Pi and run it on my BQ Aquaris, Ubuntu Touch @UBports mobile phone. Just copy the compiled ATLAST program from your Raspberry Pi to the phablet home directory on Ubuntu Touch. And here's Forth code for a command line compass that you can try. The latest version is at https://github.com/skvamme/command-line-compass
 
<pre>
 
<pre>
 
( Calibrate and read bq aquaris magnetometer )
 
( Calibrate and read bq aquaris magnetometer )
( author Stina Kvamme )
+
( author skvamme )
  
 
FILE fd
 
FILE fd
Line 107: Line 288:
 
: run begin heading 1000000 sleep again ;
 
: run begin heading 1000000 sleep again ;
  
( ********************************* Calibration words ********************************************************* )
+
( ******** Calibration words **************************** )
  
 
( find the extremes of x y and z. Puts result in variables )
 
( find the extremes of x y and z. Puts result in variables )
Line 646: Line 827:
 
sudo apt-get install wget
 
sudo apt-get install wget
 
sudo apt-get install libssl-dev
 
sudo apt-get install libssl-dev
wget www.aspl.es/nopoll/downloads/nopoll-0.4.6.b400.tar.gz
+
wget www.aspl.es/nopoll/downloads/nopoll-0.4.7.b429.tar.gz
tar -xzvf nopoll-0.4.6.b400.tar.gz
+
tar -xzvf nopoll-0.4.7.b429.tar.gz
cd nopoll-0.4.6.b400/
+
cd nopoll-0.4.7.b429/
 
./configure
 
./configure
 
make
 
make

Latest revision as of 23:38, 4 June 2022

Forth on Raspberry Pi

Here we install atlast-1.2. There is also a 64 bit version, atlast-2.0 https://www.fourmilab.ch/atlast/download/2.0/atlast-2.0.tar.gz available from John Walker, fourmilab. https://github.com/Fourmilab/atlast If you are using Raspberrypi OS -64 bit use atlast-2.0 (both versions will compile, but floats doesn't work as expected on atlast-1.2).

sudo apt-get install wget
wget http://www.fourmilab.ch/atlast/download/1.2/atlast-1.2.tar.gz
tar -xzvf atlast-1.2.tar.gz
cd atlast-1.2/
make

Or, get it all, source code added from this tutorial. Make sure to comment out the "options" before the first make, see Readme on https://github.com/skvamme/atlast If you would like to run atlast on a Raspberry Pi Pico, look here https://github.com/skvamme/pico_atlast

sudo apt-get install git
git clone https://github.com/skvamme/atlast.git
cd atlast
make

Start the Forth interpreter with ./atlast and exit with Ctrl + d.

atlast.html and atlast.pdf are included and is an extensive ATLAST Forth manual. Read it online [1] and read about Forth itself here [2] and here [3] (Beware that the Forth dialect in the book Starting Forth is a bit outdated compared to ATLAST Forth). Leo Brodie wrote another book, Thinking Forth, read it here [4] and here [5]. Charles Moore, the inventor of forth gave an interview here [6]and a presentation here [7] Here is a nice tutorial from Shropshire LUG - Oct 2020 https://www.youtube.com/watch?v=EADDOnRtFrI

SIXEL GRAPHICS

Create graphics in an ordinary terminal emulator.

The following terminal emulators can do sixel graphics: XTerm (360 or later), KDE Konsole (latest), MLterm (3.8.4), Contour (0.1.1), WezTerm (20210502), Mintty (3.5.0), RLogin (2.25.3), XQuartz, MacTerm and Reflection Desktop (16.2.0).

Install the latest version of Xterm (sixel graphics is enabled by default).

sudo apt install xterm (if you are on OSX, upgrade to the latest XQuartz).

Create a file .Xresources in your home directory and insert the following line

xterm*decTerminalID: vt340

Start Xterm and check that X11 recognize the terminal type vt340, if not, reboot. If you are in XQuarts, restart XQuarts. The font 'fixed' with size 9 is working on some systems but you may have to experiment to get the right one for your setup.

xterm -fn 6x12
xrdb -query

Start atlast

./atlast -isixel.atl
RUN

Sixel.png

Here is sixel.atl Get the latest version at https://github.com/skvamme

( Draw sixel graphics in a terminal emulator, Xterm -fn 6x12 )

8 string num
variable row
500 1 1 ARRAY data

: color "#0;2;50;50;50#1;2;100;0;0#2;2;0;100;00#3;2;0;0;100" type ;
: start 27 emit "Pq" type ;
: end 27 emit 92 emit ;
: cr_ "$" type ;
: crlf  "-" type ;
: up 27 emit 91 emit "%d" num strform num type "A" type ; ( n -- )
: noscroll 27 emit 91 emit "?80l" type ; ( disable sixel scrolling, will change to ?80h in xterm 369 )
: scroll 27 emit 91 emit "?80h" type ;   ( ?80l in xterm <= 369 )


: filldata  450 1 do i float  3.14 f* 180.0 f/ sin 50.0 f* fix 130 + 2 / i data c! loop ;

: plot  6 * row ! 
		"#1!35?" type
	    450 1 do 
		row @ 0 + i data c@ = if "@" type ( 1 )
		else
		row @ 1 + i data c@ = if "A" type ( 2 )
		else
		row @ 2 + i data c@ = if "C" type ( 4 )
		else
		row @ 3 + i data c@ = if "G" type ( 8 )
		else
		row @ 4 + i data c@ = if "O" type ( 16 )
		else
		row @ 5 + i data c@ = if "_" type ( 32 )
		else 
		"?" type then then then then then then loop cr_ ;

: y_arrow "#0------!33?~~" type crlf "!32?~~~" type crlf "!31?!4~" type crlf "!30?!5~" type 
	crlf "!34?~" type crlf "!34?~" type crlf ;
: yaxis "#0!29?!5@~" type crlf ;
: hor_line "#0!24?!10@" type 65 1 do "~!6@" type loop "!4~!4^!4N!4F!4B!4@" type crlf ;
: hor_ticks  "#0!34?" type 14 1 do "N!34?" type loop crlf ;
: hor_num "     0     1     2     3     4     5     6     7     8     9   10    11    12" type ;
: ver_num "400 -" type cr cr "300 -" type cr cr "200 -" type cr cr "100 -" type cr cr "  0" type ;


: run noscroll filldata cr cr cr cr ver_num cr cr hor_num cr start color y_arrow 
	20 1 do i plot yaxis loop hor_line hor_ticks end ;

Here is another take on 7-seg sixel graphics. Disable sixel scrolling on the middle mouse button menu in Xterm.

./atlast -i7-seg.atl

Type any name between ZERO and NINE. RED SEVEN does what it says.

7-seg.atl is here:

\ Draw 7-seg sixel graphics in a terminal emulator, Xterm
\ Turn OFF sixel scrolling, middle mouse button menu in Xterm

15 string pos

: color "#0;2;100;100;100#1;2;100;0;0#2;2;0;100;00#3;2;0;0;100" type ; ( Adjust #0 to match your background color )
: end 27 emit 92 emit ;
: cr_ "$" type ;
: crlf  "-" type ;
: left "!9?" pos strcpy ;
: right "!49?" pos strcpy ;
: red "#1" type ;
: bg "#0" type ; 
: pad 10 1 do crlf loop ; ( top margin )
: hi ;
: mid 8 1 do crlf loop ;
: lo 15 1 do crlf loop ;
: start 27 emit "Pq" type color pad red ;

: horizontal "!17?_ow{}!26~}{wo_" type crlf "!17?@BFN^!26~^NFB@" type crlf ;
: vertical crlf pos type "!2?_ow{{wo_" type crlf pos type 6 1 do "!12~" 
	type crlf pos type loop "!2?@BFNNFB@" type crlf ;

: wipe start bg 17 1 do "!61~" type crlf loop end ; 

: one start hi right vertical end start mid right vertical end ;

: two start hi horizontal end start hi right vertical end start mid horizontal end 
	start mid left vertical end start lo horizontal end ;

: three one start hi horizontal end start mid horizontal end start lo horizontal end ;

: four one start hi left vertical end start mid horizontal end ;

: five start hi horizontal end start hi left vertical end start mid horizontal end 
	start mid right vertical end start lo horizontal end ;

: six five start mid left vertical end ;

: seven one start hi horizontal end ;

: nine four start hi horizontal end ;

: zero one start hi horizontal end start hi left vertical end 
	start mid left vertical end start lo horizontal end ;

: eight zero start mid horizontal end ;

Get the latest version at https://github.com/skvamme

PIGPIO

Parts of the pigpio C interface are now implemented in https://github.com/skvamme/atlast.git Look in http://abyz.me.uk/rpi/pigpio/cif.html for a detailed description of each function. If there is some function you want to add, take a look at section 4 in this document to get a short tutorial on how to do it.

GPIOSTART    ( -- result ) Result is the version number of the pigpio library.
GPIOSTOP     ( -- ) I renamed gpioInitialise and gpioTerminate to gpiostart and gpiostop.
GPIOSETMODE  ( pin mode -- result )
GPIOGETMODE  ( pin -- result )
GPIOSETPULLUPDOWN     ( pin mode -- result )
GPIOREAD     ( pin -- result )
GPIOWRITE    ( pin level -- result )
GPIOALERT    ( pin -- result ) This word runs a word ALERT that you have to define.
GPIOALERTEX  ( pin name -- result ) Define word "name" ( pin level timestamp -- )
GPIOTRIGGER  ( pin micros level -- result )
GPIOSETTIMERFUNC       ( timer millis -- result ) You define the word TIMER.
GPIOSETTIMERFUNCEX     ( timer millis name -- result ) Define word "name".
GPIOSETWATCHDOG        ( pin millis -- result )
SPIOPEN      ( chan baud flags -- handle )
SPICLOSE     ( handle -- result )
SPIREAD      ( handle strbuffer count -- result )
SPIWRITE     ( handle strbuffer count -- result )
SPIXFER      ( handle txstrbuf rxstrbuf count -- result )

Install pigpio, follow the guide in http://abyz.me.uk/rpi/pigpio/download.html

Clone atlast and cd to atlast

Open Makefile and uncomment the LIBRARIES line withe the -lpigpio

LIBRARIES = -lrt -lm -L/usr/local/lib -lpigpio

Save the file and type make

Make sure the pigpiod id NOT running by typing sudo killall pigpiod

Here is how to run an ultrasonic sensor MB 1010, any SRF05/04 should also work. The latest version is at https://github.com/skvamme/atlast

Connect the trig input to gpio 24 and pulsewidth output to gpio 25.

The word ALERT should take 3 items off the stack: ( pin level timestamp -- )
Here I wait for a rising edge and a falling edge, then I take 6 items off the stack.
: alert  depth 6 >= if 3 roll -  147 / 254 * 100 / ." "Distance: " . ." "cm" cr drop drop drop drop then ;

: setup 24 1 gpiosetmode . 25 0 gpiosetmode . 25 1 gpiosetpullupdown . 25 gpioalert . ;

: trig 24 20 1 gpiotrigger drop ;
Type GPIOSTART DROP SETUP and then TRIG will give you the distance in cm to the object in front of your MB 1010.

Here is another example of using pigpio. Read the hx711 24 bit adc load cell device. The latest version is at https://github.com/skvamme/atlast

( hx711 )
( SCK is gpiopin 23, DOUT is gpiopin 24, VDD is 3.3V, VCC is 5V )
( Type GPIOSTART DROP SETUP )

: setup 24 0 gpiosetmode . 23 1 gpiosetmode . 23 0 gpiowrite . 24 1 gpiosetpullupdown . 0 1000 gpiosettimerfunc . ;

: get24bits 0 24 0 do 23 1 1 gpiotrigger drop 1 sleep 24 gpioread 23 i - shift + loop 23 1 1 gpiotrigger drop 23 1 1 gpiotrigger drop 23 1 1 gpiotrigger drop ; ( 27 pulses = 64 gain )

: timer 24 gpioread 0 = if get24bits . cr then ;
: reset 23 100 1 gpiotrigger drop ;

An example of reading the inputs from the analog zero board, any MCP3008 based ADC should also work. The latest version is at https://github.com/skvamme/atlast

( analogzero )
variable inbuf
variable outbuf
33554431 constant ch7 ( channel 7 single-ended )

: setup 0 1000000 0 spiopen . ch7 inbuf ! ; ( ch7 is input closest to prototype area )

: test 0 inbuf outbuf 3 spixfer . outbuf @ -8 shift 1023 and . cr ; ( output 0 to 1023 )

gpiostart . setup

BQ Aquaris command line compass

I noticed the other day that I can compile ATLAST on my Raspberry Pi and run it on my BQ Aquaris, Ubuntu Touch @UBports mobile phone. Just copy the compiled ATLAST program from your Raspberry Pi to the phablet home directory on Ubuntu Touch. And here's Forth code for a command line compass that you can try. The latest version is at https://github.com/skvamme/command-line-compass

( Calibrate and read bq aquaris magnetometer )
( author skvamme )

FILE fd
32 string magraw
32 string accraw
2variable xmin
2variable xmax
2variable ymin
2variable ymax
2variable zmin
2variable zmax
2variable x
2variable y
2variable z
3.14159265358979323846 2constant pi
( values from last findextremes hardcoded )
19.0 xmax 2!
-87.0 xmin 2!
-12.0 ymax 2!
-125.0 ymin 2!
136.0 zmax 2!
33.0 zmin 2!



( Read string from magnetometer: "-38 -91 125". Put in string magraw )
( -- )
: magdevread "/sys/devices/platform/msensor/driver/sensordata" 1 fd fopen drop fd magraw fgets drop fd fclose ;

( str -- z y x )
: tofloat strint swap strint swap strint swap drop float rot float 4 roll float ;

( Remove hard iron distortion )
( z y x -- z1 y1 x1 )
: calibrate xmax 2@ xmin 2@ f+ 2.0 f/ f- 2rot
			zmax 2@ zmin 2@ f+ 2.0 f/ f- 2rot
			ymax 2@ ymin 2@ f+ 2.0 f/ f- 2rot ;


( -- )
: heading magdevread magraw tofloat calibrate 2swap atan2 180.0 f* pi f/ -1.0 f* 2dup 0.0 f< if 360.0 f+ then fix . cr 2drop ;

: run begin heading 1000000 sleep again ;

( ******** Calibration words **************************** )

( find the extremes of x y and z. Puts result in variables )
( z y x -- )
: minormax x 2! y 2! z 2!
			z 2@ zmax 2@ f> if z 2@ zmax 2! then 
		   	z 2@ zmin 2@ f< if z 2@ zmin 2! then
		   	y 2@ ymax 2@ f> if y 2@ ymax 2! then
		   	y 2@ ymin 2@ f< if y 2@ ymin 2! then
		   	x 2@ xmax 2@ f> if x 2@ xmax 2! then 
		   	x 2@ xmin 2@ f< if x 2@ xmin 2! then ;

: printval 
	." "xmax: " xmax 2@ f. ." " xmin: " xmin 2@ f. cr
	." "ymax: " ymax 2@ f. ." " ymin: " ymin 2@ f. cr
 	." "zmax: " zmax 2@ f. ." " zmin: " zmin 2@ f. cr ;

( loop the minormax to find the extremes. Let it run for a few minutes while moving the phone in all directions )
( -- )
: findextremes 1000.0 xmin 2! -1000.0 xmax 2! 1000.0 ymin 2! -1000.0 ymax 2! 1000.0 zmin 2! -1000.0 zmax 2!
	begin magdevread magraw tofloat minormax printval again ;

Put the code in a file compass.atl and start ATLAST

./atlast -icompass.atl
run

Adding new Gertboard words

Most of the power of ATLAST Forth derives from the ease with which C coded primitives can be added to the language. In my case I will add some words for controlling my Gertboard. There is a detailed description on how to add new words in the ATLAST Forth manual. And you can copy much of the word implementations from the gertboard_sw directory if you have downloaded and compiled the gertboard demo files.

wget http://www.raspberrypi.org/phpBB3/download/file.php?id=2510
unzip gertboard_sw.zip
cd gertboard_sw
make

UPDATE: If you have Raspberry Pi 2 the Gertboard demo is not working due to a change in memory layout. Open gb_common.c in an editor and change at line 38 #define BCM2708_PERI_BASE 0x20000000 to #define BCM2708_PERI_BASE 0x3F000000 save, exit and make again.

It is easy to add your own words, just add a "define GERTBOARD" to atlast.c around line 56.

#define EVALUATE                      /* The EVALUATE primitive */
#define FILEIO                        /* File I/O primitives */
#define GERTBOARD                     /* Gertboard functions */

Include gb_common.h and gb_spi.h right after include <math.h>:

#ifdef MATH
#include <math.h>
#endif

#ifdef GERTBOARD
#include "gb_common.h"
#include "gb_spi.h"
#endif

Then add your own word definitions at the end of the section with word definitions, around line 2704, right after #endif /* COMPILERW */ in atlast.c:

#ifdef GERTBOARD

prim P_gert_io() // state ---
{ // Setup and restore I/O
  Sl(1);
  if(S0 == 1)
    setup_io(); // Map the I/O sections
  else
    restore_io(); // Unmap and free memory
  Pop;
}

prim P_gert_setport() // Channel state ---
{ // Set a digital io port to a specified state
  int rev;
  Sl(2);
  if (S1 == 21)
    { // Find out which revision of Raspberry Pi we have
      rev = pi_revision();
      if (rev != 1)
        S1 = 27; // GP21 on Gertboard is controlled by GPIO27
  }
  INP_GPIO(S1);
  OUT_GPIO(S1);
  if (S0 == 1)
    GPIO_SET0 = (1<<S1);
  else
    GPIO_CLR0 = (1<<S1);
  Pop2;
}

prim P_gert_getport() // channel --- state
{ // Get a digital I/O port
  int rev;
  Sl(1);
  if (S0 == 21)
    { // Find out which revision of Raspberry Pi we have
      rev = pi_revision();
      if (rev != 1)
        S0 = 27; // GP21 on Gertboard is controlled by GPIO27
  }
  INP_GPIO(S0);
  S0 = !!(GPIO_IN0 & (1 << S0));
}

#endif /* GERTBOARD */

And finally, add the actual words to the Table of primitive words, right after #endif /* EVALUATE */ at line 2960 or so.

#ifdef EVALUATE
    {"0EVALUATE", P_evaluate},
#endif /* EVALUATE */

#ifdef GERTBOARD
	 {"0GERTBOARD", P_gert_io},	
	 {"0SETIO", P_gert_setport},		
	 {"0GETIO", P_gert_getport},		
#endif /* GERTBOARD */

As we are using code from the Gertboard demos, softlink the files gb_common.o, gb_common.h, gb_spi.o and gb_spi.h from the gertboard_sw directory to atlast-1.2 directory.

ln -s ~/gertboard_sw/gb_common.o gb_common.o
ln -s ~/gertboard_sw/gb_common.h gb_common.h
ln -s ~/gertboard_sw/gb_spi.o gb_spi.o
ln -s ~/gertboard_sw/gb_spi.h gb_spi.h

Add gb_common.o and gb_spi.o to the file Makefile in atlast-1.2.

ATLOBJ = atlast.o gb_common.o gb_spi.o atlmain.o

Now, save and run "make" again to recompile atlast.c.

Test the new words

Wire up the Gertboard according to the information you get when you run the command sudo ./leds in the Gertboard demo directory.

Run sudo ./atlast in the atlast-1.2 directory.

Type 1 gertboard

Type 22 1 setio and press enter, the corresponding LED will go on.

Type 22 0 setio and the LED will go off.

Type 0 gertboard

Play with it

Define your own LED demo, start the interpreter with sudo ./atlast. Define these words:

: use 1 ;
: free 0 ;
: leds 25 24 23 22 21 18 17 11 10 9 8 7 ;
: on 12 0 do 1 setio loop ;
: off 12 0 do 0 setio loop ;

Now type:

use gertboard 
leds on
leds off 
free gertboard

A real Use Case

I have a kWh meter that I would like to read with the Raspberry Pi. On the meter there is a small LED that blinks once per 3.6 sec at 1 kW. So I need a way to detect time between pulses. I mounted a simple LDR (2k - 20k) for around €2 over the blinking light and connected it to Gertboard Buf1 and ground. Set B1 as an input with a jumper on the board and connect GP25 to B1.

Now that you know how to add a primitive word to ATLAST, I just list the code for the word:

prim P_gert_getnegedge() // channel --- clocks  clocks_per_sec
{ // Get a digital I/O port negative edge
  unsigned int i;
  clock_t start, end;

  start = clock();
  Sl(1);
  if (S0 == 21)
    { // Find out which rev of Raspberry Pi we have
      rev = pi_revision();
      if (rev != 1)
        S0 = 27; // GP21 on Gertboard is controlled by GPIO27
  }
  INP_GPIO(S0);
  i = 0;
  while(GPIO_IN0 & (1 << S0))
  {
    i++;
    if(i > 100000000) break; // Timeout after 10 seconds
  }
  long_wait(1);
  end = clock();
  S0 = (double) (end - start);
  So(1);
  Push = (stackitem) CLOCKS_PER_SEC;
}
 
Add #include <time.h> at line 20 in atlast.c
Add fflush(stdout); to prim P_cr() at line 1460 or so.

prim P_cr()                           /* Carriage return */
{
    V printf("\n");
    fflush(stdout);
}

Start the interpreter with sudo ./atlast. Test the commands

1 gertboard

: w 25 getnegedge 2drop 25 getnegedge 36 * swap 100 / / ." "w=" . cr ;

w

0 gertboard

Result: Jolly good, or as they say in USA, awesome! Tests shows an accuracy down to a single watt.

More Fun

To play a little more with the demo I need another primary word: SLEEP that takes one item on the stack, sleep time in microseconds. This very simple word should have been the word to start with, it actually shows three fundamental things for a primary word in three lines of code. Sl(1) to make sure there is at least one item on the stack. usleep(S0) is using the top stack item S0. Pop; pops the S0 stack item off the stack when it has been used.

Add this primary word to atlast.c. Put it right after the function prim P_quit()

prim P_sleep() // microsec ---
{ 
  Sl(1);
  usleep(S0);
  Pop;
}

Remember to wire up the Gertboard according to the information you get when you run the command sudo ./leds in the Gertboard demo directory. Now we can do:

sudo ./atlast

: use 1 ;
: free 0 ;
: leds 25 24 23 22 21 18 17 11 10 9 8 7 ;
: on 12 0 do 1 setio 500000 sleep loop ;
: off 12 0 do 0 setio 500000 sleep loop ;

Now define the word leddemo:

: leddemo use gertboard leds on leds off leds on leds off free gertboard ;

( and try it )
leddemo

Reflective Sensor

The edge trigger word can be used for other sensors as well, I tried it with this Reflective Sensor [8] and it works right out of the box. Connect VCC to a digital output and the "Out" to a digital input. Gnd to Gnd. I found it more convenient to look for positive edges so here is the word for that:

prim P_gert_getposedge() // channel wait_microsec --- clocks clocks_per_second
{ // Get a digital I/O port positive edge
  unsigned int i; // wait is duration until port is low again
  clock_t start, end;

  start = clock();
  Sl(1);
  if (S1 == 21)
    S1 = 27;
  INP_GPIO(S1);
  i = 0;
  while(!(GPIO_IN0 & (1 << S1)))
  {
    i++;
    if(i > 100000000) break;
  }
  usleep(S0);
  end = clock();
  S1 = (double) (end - start);
  S0 = CLOCKS_PER_SEC;
}

Define a word COUNT to test the setup (output on the sensor is connected to Buf2 on Gertboard and VCC is connected to Buf3):

1 gertboard
23 1 setio
: count 1 100 1 do 24 100000 getposedge 2drop 1 + .s cr loop ;
count

More Gertboard Words

Here are some more words for reading and writing the analog input and output (DtoA and AtoD). First GETATOD, it takes a channel on the stack and leaves a voltage.

prim P_gert_getatod() // chan --- voltage 
{ // V will be in range 0-1023 (0-3.3 V)
    Sl(1);
	INP_GPIO(8);  SET_GPIO_ALT(8,0);
	INP_GPIO(9);  SET_GPIO_ALT(9,0);
	INP_GPIO(10); SET_GPIO_ALT(10,0);
	INP_GPIO(11); SET_GPIO_ALT(11,0);
	setup_spi();
    S0 = read_adc(S0);	
}

And SETDTOA expects a channel and a voltage on the stack and sets the output accordingly.

prim P_gert_setdtoa() // chan volt --
{ // V between 0 and 255
    Sl(2);
    INP_GPIO(7);  SET_GPIO_ALT(7,0);
    INP_GPIO(9);  SET_GPIO_ALT(9,0);
    INP_GPIO(10); SET_GPIO_ALT(10,0);
    INP_GPIO(11); SET_GPIO_ALT(11,0);
	setup_spi();
    write_dac(S1, S0*16); // V_out = S0*16 / 256 * 2.048	
    Pop2;
}

If you would like to read a burst of values from an analog input, here's how to do it. The word GETBURST expects a channel, a delay in microseconds between samples, and the number of samples you want. It leaves the samples on stack. You may want to increase the stack length constant at line 138 like this: atl_int atl_stklen = 1000; /* Evaluation stack length */

prim P_gert_burst() // chan delay samples --- n1, n2, nn
{
    unsigned int i, num, chan, delay; 
	
    Sl(3);
	So(S0 - 3);
	INP_GPIO(8);  SET_GPIO_ALT(8,0);
	INP_GPIO(9);  SET_GPIO_ALT(9,0);
	INP_GPIO(10); SET_GPIO_ALT(10,0);
	INP_GPIO(11); SET_GPIO_ALT(11,0);
	setup_spi();
	num = S0;
	delay = S1;
	chan = S2;
	Pop;
	Pop;
	Pop;
	for(i = 0; i < num; i++){
	    Push = (stackitem) read_adc(chan);
		usleep(delay);
	}
}

And finally, add the new words to the list of primitives:

	{"0GETATOD", P_gert_getatod},
	{"0GETBURST", P_gert_burst},
	{"0SETDTOA", P_gert_setdtoa},	

If you want a simple way to inspect the values captured with the getburst word, one way is to let ATLAST Forth create an HTML page. Here is the code for that:

FILE fd
: printstring ( s1 -- )
  fd fputs drop
;

: printreal ( f1 -- )
  "                    " dup 2swap "%f" 4 roll fstrform dup " " swap strcat printstring
;

: printint ( n -- )
  "                    " dup -rot "%ld" swap strform dup " " swap strcat printstring
;

: htmlcanvas ( s1 -- )
  10 fd fopen drop
  "<html><head><title>Burstdemo</title></head><body>" printstring
  "<canvas id='burst' height='1023' width='1000' style='position:absolute; left:0; top:0; z-index:0;'></canvas>" printstring
  "<script> var canvas = document.getElementById('burst'); var ctx = canvas.getContext('2d'); ctx.lineWidth=1; " printstring
  "ctx.strokeStyle ='#000000'; ctx.beginPath(); " printstring
  0 100000 100 getburst 100 0 do "ctx.lineTo(" printstring 10 i * printint "," printstring printint "); " printstring loop
  "ctx.stroke(); </script></body></html>" printstring
  fd fclose
;

The word htmlcanvas takes a filename on stack. It runs getburst and writes the result as a line diagram in a canvas element.

"test.html" htmlcanvas .( "ok" cr

Tellstick

In order to have a safe way to handle mains switching, a Tellstick [9] is an excellent choice. It can control many consumer brands of wireless controlled sockets and dimmers. Implementing some words in Forth for switching mains on and off leaves the safe voltages for sensing through the Gertboard interface.

Download and install the development kit from Telldus: (UPDATE: I could not make 2.1.2 to work. Use 2.1.1 and add a line in /home/pi/telldus-core-2.1.1/common/Socket.h before you run the make command, right after line 9, see below.)

#ifdef _WINDOWS
7	 #include <windows.h>
8	 typedef HANDLE SOCKET_T;
9	#else
Add this line here  #include <unistd.h>
10	 typedef int SOCKET_T;
11	#endif
wget http://download.telldus.se/TellStick/Software/telldus-core/telldus-core-2.1.1.tar.gz
tar -xzvf telldus-core-2.1.1.tar.gz
sudo apt-get install libconfuse-dev
sudo apt-get install libftdi-dev
sudo apt-get install cmake
cd telldus-core-2.1.1
cmake .
make
sudo make install

In case of trouble, here is another Tellstick wikipage R-Pi_Tellstick_core

When that installation is done you can copy two files over to the ATLAST Forth directory:

cd /home/pi/atlast-1.2
cp ../telldus-core-2.1.1/client/telldus-core.h .
cp ../telldus-core-2.1.1/client/libtelldus-core.so .

Then add the lib libtelldus-core.so to the Makefile, at the top, right after -lm:

LIBRARIES = -lm libtelldus-core.so

In atlast.c, add define TELLDUS right before #define MATH;

#define TELLDUS                       /* Tellstick functions */

In atlast.c, include the telldus_core.h file:

#ifdef TELLDUS
#include "telldus_core.h"
#endif

In atlast.c, right after #endif /* COMPILERW */ add the following Tellstick primitives:

#ifdef TELLDUS

prim P_tell_init() // ---
{
  tdInit();
}

prim P_tell_close() // ---
{
  tdClose();
}

prim P_tell_on() // device ---
{
  Sl(1);
  tdTurnOn(S0);
  Pop;
}

prim P_tell_off() // device ---
{
  Sl(1);
  tdTurnOff(S0);
  Pop;
}

#endif /* TELLDUS */

And finally, add the new words to the list of primitives:

#ifdef TELLDUS
  {"0TELLON", P_tell_on},
  {"0TELLOFF", P_tell_off},
  {"0TELLINIT", P_tell_init},
  {"0TELLCLOSE", P_tell_close},
#endif /* TELLDUS */

Save atlast.c and re-run make to compile and you can try your new words. Remember to configure /etc/tellstick.conf according to the brands of hardware you are using, read the Tellstick documentation. First, start telldusd and then ATLAST.

telldusd
./atlast

In the ATLAST console, type your new Forth words:

tellinit
1 tellon
1 telloff
tellclose

Tellstick duo

If you are fortunate enough to have a Tellstick Duo [10], you probably want to listen for incoming 433 MHz signals so here we go. But first follow the Tellstick instructions above, and test that they work as expected.

Add this primitive word to atlast.c. We will use it to register a callback. (A callback is an ordinary function, nothing strange, but it will be called not by you but by the Tellstick Duo when there is data coming in).

prim P_tell_rawevent() // string ---
{
   Sl(1);
   tdRegisterRawDeviceEvent( rawcallback, S0);
   Pop;
}

Then add the callback function. This is the function that will be called. Add it around line 295, just above the line /* TOKEN -- Scan a token and return its type. */

#ifdef TELLDUS
static void rawcallback(const char *data, int controllerId, int callbackId, void *context)
{
    dictword *dw; 
    V strcpy((char *)context, data);
    dw = atl_lookup("rawevent");
    atl_exec(dw);
}
#endif

Finally, add the new primitive word to the list of primitives

	  {"0TELLRAWCALLBACK", P_tell_rawevent},

Now, to try it out, save and re-compile with make and then start telldusd and ./atlast. Type the following in the ATLAST console:

127 string raw
: rawevent raw type cr ;
raw tellrawcallback

The word rawevent is executed by the callback function. You can re-define it, and it will use the latest definition. With this definition it will just type the incoming data in the console. If you take a Nexa remote control and press a few buttons, the incoming data should print as a string, for example,

"class:command;protocol:waveman;model:codeswitch;house:A;unit:1;method:turnoff;"

You can even put the three lines of Forth code in a file, for example, telldus.atl and start ATLAST like this

./atlast -i./telldus.atl

Websockets

With all these sensor signals coming in from Gertboard and Tellstick Duo it would be nice to be able to connect to a web server and upload data in real time. Websockets is a new way to create a full duplex communication pipe between a websocket client and a web server. Download and install noPoll http://www.aspl.es/nopoll

sudo apt-get install cmake
sudo apt-get install wget
sudo apt-get install libssl-dev
wget www.aspl.es/nopoll/downloads/nopoll-0.4.7.b429.tar.gz
tar -xzvf nopoll-0.4.7.b429.tar.gz
cd nopoll-0.4.7.b429/
./configure
make
sudo make install

Add the lib nopoll to the Atlast Makefile so that the lines LIBRARIES and INCLUDE looks like this:

LIBRARIES = -lrt -lm -L/usr/local/lib  -lnopoll

INCLUDE = -I/usr/local/include/nopoll -Wl,-rpath -Wl,/usr/local/lib

In atlast.c, add #define WEBSOCKETS right before #define MATH;

#define WEBSOCKETS		      /* Websockets functions */

In atlast.c, include the nopoll.h file:

#ifdef WEBSOCKETS
#include <nopoll.h>
#endif

In atlast.c, right before /* TOKEN -- Scan a token and return its type. */ add the following nopoll globals:

#ifdef WEBSOCKETS
noPollCtx *ctx; 
noPollConn *conn;
#endif

In atlast.c, right before /* Table of primitive words */ add the following nopoll primitives:

#ifdef WEBSOCKETS
prim P_ws_connect() // "localhost" "1234" "/wsh" -- bool
{
	Sl(3);
	Hpc(S0);
	Hpc(S1);
	Hpc(S2);
	ctx = nopoll_ctx_new();
	conn = nopoll_conn_new (ctx, (char *) S2, (char *) S1, NULL, (char *) S0, NULL, NULL);
	nopoll_conn_wait_until_connection_ready (conn, 5);
	Pop;
	Pop;
	S0 = (nopoll_conn_is_ok (conn)) ? Truth : Falsity;
}

prim P_ws_close() // --
{
	nopoll_conn_close (conn);
	nopoll_ctx_unref(ctx);
}

prim P_ws_send() // string -- length
{
	Sl(1);
	int bytes_written, length;
	Hpc(S0);
	length = strlen((char *) S0);
	bytes_written = nopoll_conn_send_text(conn, (char *) S0, length);
	if(bytes_written != length)
		bytes_written = nopoll_conn_flush_writes(conn, 2000000, bytes_written);
	S0 = bytes_written;
}

prim P_ws_receive() // buffer length timeout_ms -- result
{
	Sl(3);
	Hpc(S2);
	int result;
	result = nopoll_conn_read(conn,(char *) S2,S1,nopoll_true, S0);
	Pop;
	Pop;
	S0 = result;	
}
#endif /* WEBSOCKETS */

And finally, add the new words to the list of primitives:

#ifdef WEBSOCKETS
	  {"0WSCONNECT", P_ws_connect},
	  {"0WSSEND", P_ws_send},
	  {"0WSREC", P_ws_receive},
	  {"0WSCLOSE", P_ws_close},
#endif /* WEBSOCKETS */

Save atlast.c and re-run make to compile and you can try your new words.

make clean
make

To connect to the echo server:

./atlast
256 string raw
"echo.websocket.org" "80" "/" wsconnect .
"test" wssend .
raw 127 1000 wsrec .
raw type cr
"send some more" wssend .
raw 127 1000 wsrec .
raw type cr
wsclose

The dot after wsconnect will print out a -1 if connected, 0 otherwise. The dot after wssend will print the number of characters sent. The dot after wsrec will print the number of characters received.

A websockets example

We have a nice temperature sensor connected to our gertboard atod channel 0 and wants to send the temp value up to a server every second. A common wire protocol for websockets communication is json. Here's some words for encoding a json object.

( jsonencoder )

127 string json
32 string tmp
32 string voltage
32 string id
1 constant use
"voltage" voltage strcat
"id" id strcat
: printstring "\"" tmp strcat tmp strcat "\"" tmp strcat tmp ;
: printreal "%.4f" tmp fstrform tmp ;
: printint "%ld" tmp strform tmp ;
: realorint 2dup = if printreal else printint then ; 
: realorstring dup 1000000000 > if printreal else printstring then ; 
: print dup 1000000 < if realorint else realorstring then ; 
: jsonencode 0 json c! 0 do 0 tmp c! i 0 = if "{" json strcat else "," json strcat then print swap 
	"\"" json strcat json strcat "\"" json strcat ":" json strcat json strcat loop "}" json strcat ;

The word jsonencode takes name-value pairs on the stack and the pair count and puts a json string in the buffer json. I have defined two names, id and voltage. You may want to increase the number of temporary string buffers in atlast.c at line 137. A temporary string buffer is a buffer not defined with size and the word string.

id "outdoorsensor" voltage 0.345 2 jsonencode
json type

So, the code for temperature sensor upload could be something like this:

: connect "192.168.0.114" "8080" "/washer" wsconnect . cr ;
: sendsample id "outdoor" voltage 0 getatod 2 jsonencode json wssend . cr ;
: run use gertboard connect begin sendsample 1000000 sleep again ;

run