Forth experiments

csarray.fs

\ === Create a constant string array ===

: count  ( addr -- addr size )
  \ this function may be standard in some forths
  dup +1 swap c@
;

: csarray  ( here nstrings -- )
  create
    0 do
	    dup , dup c@ 1+ + aligned
    loop
    drop
  does>  ( idx -- addr size )
    swap cells + @ count
;

\ usage
here
," Monday"
," Tuesday"
," Wednesday"
," Thursday"
," Friday"
," Saturday"
," Sunday"
7 csarray day-names

6 day-names cr type \ >> "Sunday"
0 day-names cr type \ >> "Monday"


\ === Convert units back and forth ===

\ use this word as a parameter for UNITS
variable current-as  0 current-as !
: as  true current-as ! ;
: ~as  false current-as ! ;

: d,  ( hi lo -- )  swap , , ;
: d@  ( addr -- hi lo )  dup @ swap cell+ @ ;
: units
  create d,
  does> d@ current-as @ if swap then */ ~as
;

\ units approximations based on the millimeter
254 10      units inches
254 12 * 10 units feet
254 36 * 10 units yards
10   1      units centimeters
1000 1      units meters

\ usage
10 feet . \ >> 3048
3048 as feet . \ >> 10


\ === pForth structs ===

:struct  song
  long  song-num-notes  \ define 32 bit structure member named SONG_NUMNOTES
  short song-seconds    \ define 16 bit structure member
  byte  song-quality    \ define 8 bit member
  long  song-num-bytes  \ auto aligns after SHORT or BYTE
  rptr  song-data       \ relocatable pointer to data
;struct

\ usage
song happy
400 happy s! song-num-notes
17 happy s! song-seconds

create NOTES 23 , 17 , 19 , 27 ,
NOTES happy s! song-data

\ dump struct
happy dst song

happy s@ song-num-notes . \ >> 400