alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Tweak example.

Browse Source
This commit is contained in:
Brad Nelson
2024-11-14 20:56:28 -08:00
parent e79a432876
commit 8c010e1b24
3 changed files with 25 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
examples/gemini/arrays.fs
View File

@ -46,6 +46,8 @@ create array-sizes cell , 1 , cell , 4 ,
( Size of array data in bytes )
: bytes ( a -- n ) dup >type @ >esize swap >count @ * ;
( To string / array )
: range ( a -- a n ) dup >count @ ;
( Create an uninitialized array )
: array ( n type -- a )
@ -69,9 +71,12 @@ create array-sizes cell , 1 , cell , 4 ,
( Stack manipulation )
: adrop ( a: a -- ) apop unref ;
: a2drop ( a: a a -- ) adrop adrop ;
: anip ( a: a b -- b ) apop apop unref apush ;
: adup ( a: a -- a a ) top ref apush ;
: aswap ( a: a b -- b a ) apop apop swap apush apush ;
: aover ( a: a b -- a b a ) apop apop ref dup apush swap apush apush ;
: a2dup ( a: a b -- a b a b ) aover aover ;
( Index into the top of the stack )
: a@ ( n a: a -- a: a ) cells top + @ ref adrop apush ;
@ -90,7 +95,7 @@ create array-sizes cell , 1 , cell , 4 ,
( Convert integer array to floats )
: n>f
top >count @ REAL array
under top top >count @ 0 ?do over @ s>f dup sf! sfloat+ >r cell+ r> loop 2drop anip ;
under top range 0 ?do over @ s>f dup sf! sfloat+ >r cell+ r> loop 2drop anip ;
( Force integers to real. )
: binuminal

3
examples/gemini/gemini.fs
View File

@ -32,7 +32,8 @@ vocabulary gemini also json also arrays also gemini definitions
}}
;
r| What's the "time"?| askit adup a. cr cr >json a. cr cr
r| What's the "time"?| askit >json a. cr cr
r| What's the "time"?| askit _s" contents" dict@ 0 a@ _s" parts" dict@ 0 a@ _s" text" dict@ >json a. cr
0 [IF]
HTTPClient

19
examples/gemini/json.fs
View File

@ -32,6 +32,21 @@ s" DICTIONARY" _s aconstant DICT
: {{ [[ DICT ;
: }} ]] ;
( Dictionary lookup )
: as= ( a: a a -- f )
top >type @ STRING <> if a2drop 0 exit then
under >type @ STRING <> if a2drop 0 exit then
top range under range str= a2drop
;
: dict@ ( a: a key -- value )
aswap
top >count @ 1 ?do
a2dup i a@ 0 a@ as= if i a@ 1 a@ anip unloop exit then
loop
a2drop
_s" "
;
: space? ( ch -- f ) dup 8 = over 10 = or over 13 = or swap 32 = or ;
: <whitespace> begin token space? while skip repeat ;
@ -130,7 +145,7 @@ defer <value>
<whitespace>
; is <value>
: json> ( a -- a ) top top >count @ in <value> anip ;
: json> ( a -- a ) top range in <value> anip ;
: butlast? ( n -- f ) top >count @ 1- <> ;
@ -168,7 +183,7 @@ defer <value>
loop a> _s" ]" ,c
then
endof
STRING of [char] " _c >a top top >count @ a> escaped ,c [char] " _c ,c endof
STRING of [char] " _c >a top range a> escaped ,c [char] " _c ,c endof
INTEGER of
_s" " >a
top >count @ 0 ?do