lsparrish

{{
: :find ( a-af ) last repeat @ 2dup =if drop @ -1 ;; else dup 0 =if ;then then again ;
: .vocab ( a- ) dup 1+ @ :find nip if shut else open then ;
---reveal---
: as-vocab ( a- ) last @ d->class ['] .vocab swap ! ;
}}

vocab foo ((
stub bar
stub baz

lsparrish

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( >last and expose -- move a dictionary header to the top of )
( the dictionary.                                            )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

{{
  : tod     (  -a  ) last @ ;
  : nod     (  -a  ) tod @ ;  
  : d'      ( "-a  ) ' drop which @ ;
  : after   ( a-a  ) last repeat @ 2dup @ =if nip ;then again ;

lsparrish

export OFFSET=4967232
alias extract="dd if=retroImage of=blocks.blk skip=$OFFSET ibs=4"
alias inject="dd if=blocks.blk of=retroImage ibs=4 bs=4 seek=$OFFSET"

alias text="tr -d '\000' < blocks.blk > blocks.txt"
alias block="sed -e 's/\(.\)/\1\x00\x00\x00/g' < blocks.txt > blocks.blk"

alias readable="fold -w 64 blocks.txt > readable.txt"
alias writable="tr -d '\012' < readable.txt > blocks.txt"

lsparrish

( tokens in a linked list )

variable last
: new ( "- ) 32 accept     ( "-   Get a little text )
  tib keepString           (  -$  Make a permanent string of it )
  here last @ , last !     (  -   Link in last, set the pointer as the new last )
  , ;                      ( $-   compile in the text address after the link )
: access ( a-$ ) 1+ @ ;    ( a-$  From the link, go to string pointer and access it )
: next   ( a-a )
  dup access type @ ;      ( a-a  Type the text by the current link, follow the link. )

lsparrish

The program:

( buffering input )

{{
64 constant width
4  constant lines
variable num

lsparrish

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( do ... until                                                )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Value n is taken from the stack and stored to a virtual     )
( variable. When this number is equal to the TOS at the time  )
( until is executed, the loop terminates.                     )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

{{
: skipped-nop ( - ) 8 , here 2 + ,  0 , ;

lsparrish

: | char: | accept ;
{{
  | find   $-   ::: true if $ is a word. |
  | accept c"-  ::: parsed text (delimited by c) goes at tib |
  | tib     -$  ::: used to access text after parsing. |
  | nip   xy-y  ::: shorthand for swap drop |
  | dup    n-nn ::: duplicate top of stack |
  | char:  "-c  ::: macro, gets a char at compile time. |
  | if     f-   ::: jump to then if flag is false (at execute time) |
  | then    -   ::: macro for the place that if jumps to when flag is false. |

lsparrish

( A macro for appending code blocks. )
{{
: prepend ( $$-$ ) here -rot 2 for dup here swap getLength dup allot copy next 0 , ;
: $space ( $-$ ) s"  " prepend ;
---reveal---
: append-block 32 accept tib @ char: { =if 
    char: } accept tib tempString keepString literal,
    ` $space ` swap ` prepend then ; compile-only
: code ( "- ) ` append-block ` dup ` getLength ` eval ; compile-only
}}

lsparrish

( Stack and list manipulation. )

: allot heap +! ;
: -allot heap -! ;

: sav ` dup ` push ; immediate

: tempsave ( ?n- ) for here r 1- + ! next ;
: tempload ( n-? ) for here r 1- + @ next ;

lsparrish

( This is an attempt at creating some rather sophisticated macros )
( using fori/nexti. It does not work yet. )

{{
  variable addr

  : pad       ( -    ) addr @ @ 6 for dup base @ r pow <if 32 emit then next ;

  : .wrap     ( -   ) ." ( " later ."  )" ;
  : .name     ( a-  ) .wrap d->name type ;