diff --git a/examples/gemini/arrays.fs b/examples/gemini/arrays.fs old mode 100755 new mode 100644 index 14e7ca7..c7a59f1 --- a/examples/gemini/arrays.fs +++ b/examples/gemini/arrays.fs @@ -1,4 +1,16 @@ -#! /usr/bin/env ueforth +\ Copyright 2024 Bradley D. Nelson +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. vocabulary arrays also internals also arrays definitions diff --git a/examples/gemini/gemini.fs b/examples/gemini/gemini.fs old mode 100755 new mode 100644 index b3fa2f3..181c2e3 --- a/examples/gemini/gemini.fs +++ b/examples/gemini/gemini.fs @@ -1,4 +1,16 @@ -#! /usr/bin/env ueforth +\ Copyright 2024 Bradley D. Nelson +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. needs arrays.fs needs json.fs @@ -20,7 +32,7 @@ vocabulary gemini also json also arrays also gemini definitions }} ; -s" What's the time?" askit >json a. +r| What's the "time"?| askit adup a. cr cr >json a. cr cr 0 [IF] HTTPClient @@ -28,15 +40,6 @@ NetworkClientSecure.new constant nclient : 2constant create , , does> dup cell+ @ swap @ ; -: slurp-file ( a n -- a n ) - r/o open-file throw >r - r@ file-size throw ( sz ) - dup 1+ allocate throw swap ( data sz ) - 2dup r@ read-file throw drop - r> close-file throw - 2dup + 0 swap c! -; - s" /spiffs/gemini_cert" slurp-file drop constant cacert s" /spiffs/gemini_url" slurp-file drop constant url s" /spiffs/question" slurp-file 2constant question diff --git a/examples/gemini/json.fs b/examples/gemini/json.fs old mode 100755 new mode 100644 index 22547d5..6197378 --- a/examples/gemini/json.fs +++ b/examples/gemini/json.fs @@ -1,4 +1,16 @@ -#! /usr/bin/env ueforth +\ Copyright 2024 Bradley D. Nelson +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. needs arrays.fs @@ -21,12 +33,13 @@ s" DICTIONARY" _s aconstant DICT : }} ]] ; : space? ( ch -- f ) dup 8 = over 10 = or over 13 = or swap 32 = or ; -: whitespace begin token space? while skip repeat ; +: begin token space? while skip repeat ; + : expect ( a n -- ) for aft dup c@ token = assert 1+ skip then next drop ; : sliteral ( a n -- ) postpone $@ dup , zplace ; : e: bl parse sliteral postpone expect ; immediate -: escaped +: e: \ token skip case [char] " of [char] " _c catenate endof @@ -35,17 +48,17 @@ s" DICTIONARY" _s aconstant DICT [char] b of 8 _c catenate endof [char] n of nl _c catenate endof [char] r of 13 _c catenate endof - [char] t of 8 _c catenate endof + [char] t of 9 _c catenate endof [char] u of 255 _c catenate skip skip skip skip endof -1 throw endcase ; -: jstring +: e: " s" " _s begin token [char] " <> while token [char] \ = if - escaped + else token _c catenate skip @@ -54,31 +67,31 @@ s" DICTIONARY" _s aconstant DICT e: " ; -defer jvalue +defer -: jobject - e: { whitespace +: + e: { DICT box begin token [char] } = if skip exit then - jstring box whitespace e: : whitespace jvalue box + box e: : box catenate box catenate token [char] } = if skip exit then - e: , whitespace + e: , again e: } ; : digit? ( -- f ) token [char] 0 >= token [char] 9 <= and ; -: jdigit token [char] 0 - skip ; -: jinteger digit? assert jdigit - begin digit? while 10 * jdigit + repeat ; -: jfraction digit? assert 10 * jdigit + >r 1- r> - begin digit? while 10 * jdigit + >r 1- r> repeat ; -: jnumber +: token [char] 0 - skip ; +: digit? assert + begin digit? while 10 * + repeat ; +: digit? assert 10 * + >r 1- r> + begin digit? while 10 * + >r 1- r> repeat ; +: token [char] - = if skip -1 else 1 then - token [char] 0 = if skip 0 else jinteger then 0 swap - token [char] . = if skip jfraction then + token [char] 0 = if skip 0 else then 0 swap + token [char] . = if skip then swap >r * r> token [char] e = token [char] E = or if skip @@ -87,44 +100,62 @@ defer jvalue else token [char] + = if skip then 1 then - jinteger * + + * + then dup if 10e s>f f** s>f f* _f else drop _i then ; -: jarray - e: [ whitespace +: + e: [ 0 MIXED array begin token [char] ] = if skip exit then - jvalue box catenate whitespace + box catenate token [char] ] = if skip exit then - e: , whitespace + e: , again ; :noname - whitespace + token case - [char] " of jstring endof - [char] { of jobject endof - [char] [ of jarray endof + [char] " of endof + [char] { of endof + [char] [ of endof [char] t of e: true s" true" _s endof [char] f of e: false s" false" _s endof [char] n of e: null s" null" _s endof - jnumber + endcase - whitespace -; is jvalue + +; is -: json> ( a -- a ) top top >count @ in jvalue anip ; +: json> ( a -- a ) top top >count @ in anip ; : butlast? ( n -- f ) top >count @ 1- <> ; +: escaped ( a n -- a: a ) + _s" " + 0 ?do + dup i + c@ + case + [char] " of _s" \" ,c [char] " _c ,c endof + [char] / of _s" \/" ,c endof + [char] \ of _s" \\" ,c endof + 8 of _s" \b" ,c endof + nl of _s" \n" ,c endof + 13 of _s" \r" ,c endof + 9 of _s" \t" ,c endof + dup _c ,c + endcase + loop + drop +; + : >json ( a: a -- a ) top >type @ case MIXED of - top >count @ 1 > if top @ DICT top @ adrop = else 0 then if + top >count @ 1 > if top @ DICT top adrop = else 0 then if _s" {" >a top >count @ 1 ?do adup i a@ 0 a@ recurse _s" :" ,c a> aswap ,c >a adup i a@ 1 a@ recurse a> aswap ,c >a @@ -137,7 +168,7 @@ defer jvalue loop a> _s" ]" ,c then endof - STRING of [char] " _c >a top top >count @ a> _s ,c [char] " _c ,c endof + STRING of [char] " _c >a top top >count @ a> escaped ,c [char] " _c ,c endof INTEGER of _s" " >a top >count @ 0 ?do diff --git a/examples/gemini/slurp.fs b/examples/gemini/slurp.fs index a01c491..5e23da3 100644 --- a/examples/gemini/slurp.fs +++ b/examples/gemini/slurp.fs @@ -1,3 +1,17 @@ +\ Copyright 2024 Bradley D. Nelson +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. + : slurp-file ( a n -- a n ) r/o open-file throw >r r@ file-size throw ( sz )