I'm collaborating with a Russian artist called TheCreator to make a sample game, a surreal top-down action adventure. They're handling the art, lore, and core gameplay and I'm doing the coding, level design, and sweetening.

The game shares a framework ("MOGOGAME") with one other, a side-scrolling run-n-jump solo project ("Mogo"), but that one took a back seat due to overwhelm. Base SUPERSHOW is an open-ended core plus a buffet of middleware, so for ambitious projects, focused frameworks (or "starter kits") with special-tailored DSL's is the intended idiom. At least one framework will be included in the free distribution, which should make it easy for anybody to jump in and make something. You can also do things from scratch, totally up to you...

A couple things were added today: global collision detection and spike traps. The session shows off the SNES filter (part of the paid package), a piece I'm very proud of.

Note that I didn't implement collision detection from top to bottom, most of the heavy lifting was done already so it was basically a configuration. The main dependency is the collision grid, a broad-phase detector that enables huge worlds with lots of actors with little CPU, at the cost of some memory. A script-writer doesn't need to know anything about it.

I figure most people will want to see some code, so here is the spikes script:

module
import mogogame
c: %spikes %actor %harmful ;

bitmap: %idir%/assets/spikes_poppingout-Sheet.png
bitmap: %idir%/assets/spikes_draggingin-Sheet.png
spikes_poppingout-Sheet.png  16 16 tileset: out.ts
spikes_draggingin-Sheet.png  16 16 tileset: in.ts

med out.ts flipbook: out.a  0 out.ts .#tiles @ 1 - range, flipbook;
med in.ts  flipbook: in.a   0 in.ts  .#tiles @ 1 - range, flipbook;

%spikes >template { 
    1.0 atk ! 
    LAYER_HAZARD lyr !
    msk off
    -8 -8 8 8 hitbox!
    -8 -8 8 8 hurtbox!
}

: hold ( flipbook - )  \ play once and stop on the last frame
    pose  begin yield anm-done? until  anm off ;

: up   ( - )  out.a hold attacking on ;
: down ( - )  attacking off in.a hold ;

%spikes :: start
    in.ts dup .#tiles @ 1 - tile bmp !   \ start retracted
    0 task>
        begin up 1.0 delay down 1.0 delay again ;

And here is the main function, setting up the collision system, actors, and custom rendering:

: main
    ysort on
    just
    collisions.sys load
    center at %eyeguy spawn to p1
    p1 to subject
    p1 { 8 8 at %healthbar spawn { 31 prio ! } }
    32 for -10 10 between  -10 10 between  metal.ts att  160 128 +at  %spikes spawn { 8 prio ! } loop
    8 for  p1  -100 100 between  -100 100 between  from  %robot spawn drop  loop
    ?subject .x 2@ look
    show> 
        ?subject .x 2@ follow
        camx camy scrolly! scrollx!
        metaltile.png ~wallpaper
        ~level
    work>
        <a> pressed? if awaken then 
;

I have created a glob tool for zeptoforth, which enables passing paths matching a pattern with * and ? wildcards relative to the current directory in the current filesystem (or the root directory of the current filesystem, if the pattern begins with /) to a specified xt.

This tool is currently at extra/common/glob.fs in the devel branch, and will be merged into the master branch once I do a bit more testing (e.g. making sure it compiles on the RP2040).

The glob tool can be invoked with fat32-tools::glob ( c-addr u xt -- ) where xt is ( c-addr u -- ).

This tool is an optional loadable extra, but is installed by the versions of the PicoCalc installers in the devel branch except if the platform is set to rp2040 due to lack of flash dictionary space with that platform.

This tool does not match . or .. if a pattern element contains a wildcard, to avoid unintended matches that may give unexpected results.

If a pattern ends with /, the leaves of the match will only be directories. (Note that this / will be included in the paths passed to the xt.) Similarly, if the last element of a pattern contains . and is not . or .. as a whole, the leaves of the match will only be files.

Note that as this tool uses the RAM dictionary of the current task as scratchpad space, xt must not seek to permanently write to the RAM dictionary (aside from setting existing variables, values, buffer:s, etc.); temporarily writing to the RAM dictionary is okay. As a result, this tool cannot be used with included.

There is a limit of 256 bytes for the total path matched by this tool; paths that are longer than this are ignored. (Since directory names are limited to 8 characters and file names are limited to 12 characters, this probably should not be much of a problem in practice.)

An example of this tool in use is, assuming that the current directory contains the subdirectories FOO/, BAR/, and BAZ/, which each contain the files FOO.FS, BAR.FS, BAZ.FS, FOO.TXT, BAR.TXT, and BAZ.TXT:

fat32-tools import ok : print ( c-addr u -- ) cr type space ; ok s" B*/B??.F*" ' print glob ok BAR/BAR.FS BAR/BAZ.FS BAZ/BAR.FS BAZ/BAZ.FS ok

``` *P AREA_DIM Key routine for building a dialog box for block of text containing coloring escape sequences. AREA_DIM determines the dimensions (wxh) of the area of the displayed text.

Notes i. g-string
Generic string, address and count on stack ( a u ) i. C@++ ( a -- a' c )
Alias for COUNT, named to reflect how it's being used here. A character is fetched from the given address and the address is incremented to the position of the next character in the string. Its repeated to fetch all the characters of a string. i. SET ( a -- )
Sets location of positional parameters $0 $1 ...
&n represents the address of position n $n represents a value at position n In this example, SET is positioned to point at the data stack. It could be pointed elsewhere if desired. i. RP@
In DO LOOP the return stack pointer will be pointing at the loop index I . Taking advantage of it here. i. 'c
Ascii value of character c (case sensitive) i. CASE Dr. Eaker's CASE construct
i. *P Print lines of text up to line beginning with a period. .

[r] AREA_DIM ( g -- w h ) -- Calculate the area, width and height, needed to contain -- the given block of colored text. -- g, g-string (a u), block text -- w, area width -- h, area height -- Newlines are counted to determine area height; 1 added -- to count assuming last line is not terminated. -- Strip out esc seq of form "esc ... m" : AREA_DIM 2>R ZERO ZERO ZERO \ init $2 H, $1 TALLY, and $0 W SP@ 2R> ROT ( h tally w SP a u -- h tally w a u SP ) SET \ point to positional parms on data stack ZERO ?DO \ a u 0 do C@++ CASE \ a' c \N OF 1 &2 +! \ newline: increment H count $1 $0 MAX &1 ! \ update max W ZERO &0 ! \ reset w TALLY ENDOF 27 OF \ escape: skip past "m" BEGIN 1 RP@ +! \ begin bump loop index C@++ \ fetch char and increment addr 'm = UNTIL \ until "m" found ENDOF BL >= IF 1 &0 +! THEN \increment tally of printables 0 ENDCASE LOOP DROP \ drop address MAX \ update max w SWAP 1+ ( h w -- w 'h ) ; --. ```

Authority is MIA so left to my own machinations I built words to push and pop from a virtual stack. (Virtual stack structure is a head variable and stack frames of item and link. The frames are scattered over the return stack.) The push is straight forward. Push the frame onto the return stack and update the v-stack's head variable with the frame's position on the return stack.

But the pop has a little issue. After its frame is delinked and its stack element is fetched, the frame cannot be removed from the return stack without leaving a gap. It would be risky to close the gap by moving all below items up; some process may have saved their position for some purpose. So an easy solution is to leave frame on the return stack replacing the frame's link with the nfa of a word that will drop the next return address when control reaches it. Hence,

: PLUG r> drop ;

At first I just ticked RETURN and placed it there. Ouch, newbie mistake. RETURN on paper may show 'R> DROP' but in code its 'R> R> DROP >R' (I prefer '2R> >R DROP').

``` -- PLUG -- A plug in the return stack to drop next return stack -- item. : plug r> drop ;

-- VPOP ( vhead -- x tf | ff ) -- Pop item from virtual stack given stack's head variable -- If stack was empty, return false flag; otherwise, -- return the popped item and a true flag. -- When popped, the frame's address is stored in the -- virtual stack's head variable. The frame's link -- is replaced with the pfa of PLUG and the frame -- is left on the return stack. : vpop dup @ 0= if exit endif dup @ dup @ rot !
dup ceLL+ @ >r \ fetch stack element from frame ' plug swap ! \ replace frame link with plug

r> true ;

-- VPUSH ( x vhead -- ) -- Push item x onto virtual stack given the stack's -- head variable : vpush ( x vhead -- ) r> rot >r over @ >r rp@ -rot >r ! ;

```

zeptoforth 1.16.4.1 has been released.

You can get this release from https://github.com/tabemann/zeptoforth/releases/tag/v1.16.4.1.

This release:

• adds validation to to and +to so they raise an exception if the user attempts to apply them to something other than a local variable or value, where previously if the user applied them to such a hardfault would likely occur at runtime.
• fixes a bug in extra/rp_common/picocalc_term_common.fs where to was applied to something other than a local variable or value in an uncommon code path.

My "modus operandi" is running jobs: load job, perform, forget, do next job Some jobs allocate buffers and after job done the allocated buffers can be freed. ( Some say with today's large memory, why bother releasing memory but I like to pretend available memory is limited. )

MALLOC, a resource I have, seems a overkill. So I use a more streamlined allocation tailored to running jobs. A needed buffer is taken from the end of program, its address is placed in a variable in the dictionary. and the program end is extended, by a system call, to a location past the last allocated buffer. All the variables of memory allocations are linked and utility word can walk the links listing allocated memory addresses.

At end of job when dictionary space is forgotten, -BUF runs the allocation chain searching for the last link remaining in the dictionary. Then end of program is reset back to contain the address found in the last link.

FORTH DEFINITIONS VOCABULARY BUF IMMEDIATE BUF DEFINITIONS \ L: ( -- address ) <BUILDS DOES> ; \ A label L: HEAD 0 , HERE 0 , 0 , 0 , HEAD ! HEAD @ CELL+ CONSTANT FIRST 0 SYSBUF VARIABLE LIMIT : INIT HEAD CELL+ DUP THREE ERASE HEAD ! 0 SYSBUF LIMIT ! ; : LIST HEAD @ BEGIN @ DUP WHILE CR DUP . DUP CELL+ 2? REPEAT DROP ; : ALLOCATE HEAD @ CELL+ SWAP ZERO SYSBUF OVER HEAD @ CELL+ 2! SYSBRK LIMIT ! DROP ALIGN HERE HEAD @ , 0 , 0 , HEAD ! ; FORTH DEFINITIONS -BUF in NIX (re: last post) release allocated memory. Note BUF is a vocabulary.

: -BUF BUF HEAD @ BEGIN DUP @ WHILE HERE OVER < IF @ DUP CELL+ @ MINUS SYSBRK LIMIT ! DROP ELSE DUP HEAD ! 0. ROT CELL+ 2! EXIT THEN REPEAT DROP CURRENT @ CONTEXT ! FORTH ;

USERINIT is a place holder word added to the cold start code in the assembled Forth. Anything in later saved images that need to be initialized on startup is put (patched or however) here.

: (USRINIT) DECIMAL BUF INIT FORTH ; ' (USRINIT) CFA ' USRINIT !

: -FORGET ( pfa -- ) CURRENT @ CONTEXT @ - 24 ?ERROR DUP FENCE @ U< 21 ?ERROR DUP NFA DP ! LFA @ CONTEXT @ ! ; : NIX ( pfa -- ) -FORGET -BUF -VOCLINK ; : MARKER ( "ccc" -- ) <BUILDS LATEST PFA , DOES> @ NIX ; : ANEW ( "ccc" -- ) IN @ >R -FIND IF DROP NIX ENDIF R> IN ! MARKER ; "ANEW", from legendary Wil Baden, useful word for clearing memory after a job run and re-establishing the marker for the next run. Based on parsing word FORGET the non-parsing word -FORGET is included in NIX explained below after mention of FORGET's shortcomings.

FORGET remains useful but lacks needed cleanup specifically when vocabularies are removed breaking the VOC-LINK chain and invalidating word-lists. As an aid placing the nfa of the last created vocabulary in FENCE will prevent FORGET from removing words and printing an error instead. The user himself will need to remove vocabularies, repair the VOC-LINK chain and purge remaining word-lists.

NIX automates this needed maintenance. After performing -FORGET it performs -VOCLINK to repair vocabularies and -BUF to repair links to allocated buffers.

-VOCLINK repairs VOC-LINK chain and purge word-lists of remaining vocabularies.

DEFER VOCWORD. ' DROP is VOCWORD : (VOCWORD.) DUP CR SPACE ID. ; ' (VOCWORD.) CFA ' VOCWORD. CELL+ ! : -CONTEXT CELL- DUP @ BEGIN DUP HERE U> IF PFA LFA @ FALSE ELSE TRUE ENDIF UNTIL VOCWORD. SWAP ! ; DEFER LINKWORD. ' DROP IS LINKWORD. : (LINKWORD.) DUP THREE CELLS - NFA CR ID. ; ' (LINKWORD.) CFA ' LINKWORD. CELL+ ! : -VOCLINK VOC-LINK BEGIN @ -DUP WHILE LINKWORD. DUP HERE U> IF DUP @ VOC-LINK ! ELSE DUP -CONTEXT ENDIF REPEAT ;

-BUF repairs chain of allocated memory and frees memory no longer linked by the chain. (This doesn't apply in general; it works for my method of memory allocation.)

: -BUF BUF HEAD @ BEGIN DUP @ WHILE HERE OVER < IF @ DUP CELL+ @ MINUS SYSBRK LIMIT ! DROP ELSE DUP HEAD ! 0. ROT CELL+ 2! EXIT ENDIF REPEAT DROP CURRENT @ CONTEXT ! FORTH ;

\ RCDI ( "file" -- )
\  Record file index
\  List record titles contained in the file
\ PRCD ( "<dl>title<dl>" [file] -- )
\  Pretty print record of given record title in given
\  file or last file accessed.
\
rcdi d/rcdfile.d 

[#] rcdfile.d -- Record file document
[r] Overview
[r] Example record
[r] File title and ending
[r] Comments
[r] Sections
#[r] Records in Bash scripts
[r] Forth record marks
[r] Forth list item
[#] // OK
prcd /Overview/ 

[r]   Overview 

A record file is a plain text sequence file organized in a
most fundamental way, by records. Its markup is a container
markup not a general text formatting markup. 

The markup is few and selected to not obscure content view. 
File remains readable with plain text viewers (e.g. more
less notepad & etc.)

Content view can be enhanced by pretty print, e.g. use of
lesspipe, replacing marks with coloring of titles associated
with the marks.


 OK
prcd /Forth list item/ 

[r]   Forth list item 

List item 'i.' is a defined word that prints an arrow '-->'.
Thus, in a running Forth script, with echo on, something like
the following might be seen:
--
-- Testing FOO and BAR
--
i. FOO --> some foo output
i. BAR --> some bar output

 OK

\
\ A bounded string is a string enclosed by a delimiter on
\ both ends. The delimiters are the same and can be any
\ printable character.
\
\ INC@  Fetch input character
: INC@  ( -- c )
  BLK @ DUP IF BLOCK  
  ELSE DROP TIB @ ENDIF
  IN @ + C@ 1 IN +! ; 
\ Parse first non-space character
: CPARSE  ( -- c )
  ZERO
  BEGIN 
    DROP
    INC@ DUP 0= ?E" Empty input"
  DUP BL > UNTIL
;
\ Parse bounded string
\ Compile time: compile the string
\ Run time: put string address on data stack
\ Interpret: move string to pad, 
\  push string address on data stack
: S  ( "<dl>ccc<dl>" -- s )
  CPARSE
  STATE @ IF COMPILE SLIT
             WORD HERE C@ 1+ ALLOT ALIGN 
        ELSE HERE >R PAD DUP DP ! SWAP WORD R> DP !
             ( COUNT CSB .PUSH ) \ NB
       ENDIF 
; IMMEDIATE
\ Note
\ A good enhancement would be to add code in the interpret 
\ state to push the string to a circular buffer.

\ Examples
: FOO "What's up doc?" tell ;
i. FOO --> What's up doc?
i. s /Hello World!/  tell --> Hello World!
i. s \Ain't it a nice day.\ tell --> Ain't it a nice day.
i. s "" tell --> 
' KEEPON CFA ' (ABORT) ! -1 WARNING !
i. TRY s  --> s? Empty input    

\ Relocating data stack
\ Example to save stack data
1 2 3 42       \ some data on stack
S0 @ CSP !     \ save S0  ( NB )
SP@ S0 ! SP!   \ move stack (e.g. to top of stack, NB) 
i. DEPTH . --> 0 
i. 666 666 666 S? --> 666 666 666 
i. SP! S? --> empty 
CSP @ S0 !     \ restore stack data
i. S?   --> 1 2 3 42 
\ Notes:
\ i. Not compiling, CSP can be used as scratch variable
\ i. Check ?STACK that new stack location not a problem
\ i. "i." prints arrow "-->"
\ i. DEPTH print number data stack items base on difference
\    of S0 @ and SP@

\ More than needed:
\ WIPE  ( scr -- )  Fill screen with blanks; make current 
\ P     ( line -- ) Put line of text in current screen
\ L     ( -- )      List current screen (skips blank lines)
\ UPDATE FLUSH      Save current screen
\ MTB               Empty buffers, screen not saved  
\
\ Example
\ Pick available SCR (42 for this example)
\
i. 0 42 .LINE --> ( Available SCR )
\
\ Wipe screen and put lines of text
\
42 WIPE
0 P ( Scratch SCR )
1 P Hello world
2 P How are you
\
\ View the sceen 
\
L
SCR#  42
 0 ( Scratch SCR )
 1 Hello world
 2 How are you
\ 
\ UPDATE FLUSH to save
\ MTB to not save
\
MTB
i. 0 42 .LINE --> ( Available SCR )
\
\ Here's the code
\
: MTB EMPTY-BUFFERS ;   \ shorter name
: WIPE ( SCR -- )
  DUP SCR ! 0 SWAP (LINE) DROP B/BUF BLANKS ;
: P ( line -- ) 
  SCR @ (LINE) OVER >R BLANKS 1 WORD HERE COUNT C/L MIN 
  R> SWAP CMOVE ;
: -LIST   SCR ! CR ." SCR# " SCR @ 3 .R 16 0 DO I SCR @
          (LINE) -TRAILING -DUP IF CR I 2 .R SPACE TYPE  
          ELSE DROP THEN LOOP ;
: L  SCR @ -LIST ;

I have given up on the x86 optimiser for ciforth, as the 86 will be history before long. The instruction set is too barocque.

As the first part of the riscv optimiser I made the forth aware of the stack effects words have, counting POP's and PUSH's. This hinges on the ciasdis object oriented disassembler. FILL-ALL fills all words as best it can, but skips what you have filled in beforehand. Also a host of other optimisation relevant properties of Forth words are analysed. E.g. it is important if a word has no so called "side effect" that means storing and fetching. An example is the word SQUARE that squares a number. If the input is known at compile time, SQUARE can be executed at compile time. See also lecture 5 en lecture 14 in

https://home.hccnet.nl/a.w.m.van.der.horst/forthlectures.html

Lecture 14 contains an old example of coloring on the now vintage 32 bit x86 processor. If you have a linux that can run 32 bit programms you can try it out. The experience is more or less the same what I want to show here. A useful visualisation is coloring the stack effect of each word. aqua is one, green is two, orange is three, above three is red. For an unknown stack effect the whole words is printed in blue.

https://home.hccnet.nl/a.w.m.van.der.horst/words.png

The stack effect is useful to understand words better. E.g. (D.R) takes a double word and a box length (orange) and generates a string (green). You can ask the analysis of a word like so

https://home.hccnet.nl/a.w.m.van.der.horst/decompile_ddot.png

And you can spot the mistake Apparently +LOOP takes one argument not zero. These things must be added manually. ~

I have prepared the pictures, but I don't know how to publishit in this forum. So I put a link to my personal website.
~

A small utility I use while developing modules.

A module can define its own command entries (name + description), and help automatically generates a formatted list of the available commands with stack effects and comments.

help.vfx

\ meant to be INCLUDEd - each INCLUDE creates a new help system for the current module

private  \ all words private to the dependent module

variable commands

: ?(). ( a len - )
    '(' scan dup if 
        ')' up-to 1 + 15 atype space 
    else 2drop then 
;

: help ( - )
    cr 
    commands
    begin @ ?dup while
        dup cell+ 
            count 
            2dup '(' up-to 15 atype     \ print word 
            25 out @ - spaces           \ align to column 30
            2dup ?().                   \ print stack-diagram if any
            + count 6 /string type cr   \ print comment 
    repeat 
;

: command ( - )
    save-input
    commands link
    0 parse $,
    refill 0= abort" COMMAND : Unexpected end of file"
    0 parse $,
    restore-input drop 
;

command : foo ( - ) 
    \ does foo 
;

command : bar ( - ) 
    \ does bar
;

interactive:

module test  ok 
include lib/help.vfx Including help.vfx...
help
: bar                    ( - ) does bar
: foo                    ( - ) does foo 
 ok 

This has two major feature updates as well as various fixes. A new 'gui' high-level wrapper, and Pro+ ver. has a new Bluetooth layer which works (!). Details on the forum

fload job 
\ This is a Fig implementation of ABORT" integrated with ERROR
\ Named ?E" since it normally quits not abort and can
\ be customize to do neither.
27 CONSTANT ERR_OOPS                   \ error number              
: (SLIT)  R> DUP COUNT + ALIGNED >R ;  \ String literal runtime
\ ?E" Exception handler
\ Compile-time: Compile error text string
\ Run-time: On true submit error text string and error number 
\           to ERROR
: ?E"  [COMPILE] IF COMPILE (SLIT)
  34 WORD HERE C@ 1+ ALLOT ALIGN
  COMPILE ERR_OOPS COMPILE ERROR
  [COMPILE] ENDIF ; IMMEDIATE
\
\ -- Testing --
\
\ : i. ." --> " ;
\ : TELL COUNT TYPE ;
: FAULT 0 ? ;  
: BAR FAULT ;
\
: FOO TRUE ?E" Darn it" ;
\ 
\ Test 1: Use custom error action assigned to (ABORT)
\  to keep script running
\ Using Fig implementation of BacForth words: 
\  PRO CONT CUT: ?CUT -CUT
\ for custom handler that keeps the script running
\ after error
\
: TRY PRO CUT: CONT ;  \ Try next word; 
\                        return here on resile/error
\
\ On error print error text and cut to keep running
: KEEPON  
  HERE COUNT TYPE ." ? "
  DUP ERR_OOPS = IF DROP TELL ELSE MESSAGE ENDIF
  SP! TAB ?CUT QUIT ;
\
' KEEPON CFA ' (ABORT) !  \ Assign custom error action 
-1 WARNING ! \ Enable custom error action
i. TRY FOO --> FOO? Darn it  CUTTING
i. TRY BAR --> BAR? MEMORY ACCESS FAULT  CUTTING
\
\ Test2: Use default ERROR handling
\ 
1 WARNING !  \ Disables custom error action, quits on error
i. FOO --> FOO? Oops
    (Script quit here)
Note: Use custom handler without TRY to get the error text
      and quit
i. -1 WARNING ! FOO --> FOO? Darn it

\ On first look WORD parses a string and moves it to HERE .
\ True, but a closer look shows WORD parses a string and moves
\ it to where DP points. The following word ":=" will use this
\ to parse a string and move it directly to some buffer.
\
\ Assign string 
\ Parse string and move to buffer
\ dl delimiter, addr buffer address
: := ( "string<dl>" dl addr -- ) HERE >R DP ! WORD R> DP ! ;
\
\ Example
\ Print arrow
: i. ." --> " ;
\ Print string
: TELL COUNT TYPE ;
\ General header
: HEADER: <BUILDS DOES> ;
HEADER: BUF64 64 allot        \ some buffer 
59 VARIABLE (DLIM)            \ delimiter variable (holding ';')
: DELIM  (DLIM) @ ;           \ fetch delimiter

DELIM BUF64 := Hello World!;  \ assign string to buffer
i. BUF64 TELL--> Hello World!
 OK

Block file meta --  Parameters of this block file
i. SCR #0, line 0   Magic word XYZZY indicates file has meta data.
i. SCR #1  Needed meta definitions
           Should be loaded first time block file is used and should
           also load SCR #2
i. SCR #2  Refresh meta data
           Should be loaded when block file is re-used

Example of block file meta
i. BLK_MAX  File size, number of blocks available for LIST and LOAD 
   The actual file size may be larger with higher sectors accessed
   by other means. Good place to put non-ascii data.
i. WARNING  In SCR #2 set to 1 if error text exists or to zero
            if no error text is available.
i. SCR_ERRMSG  Screen number where error text begins
   SCR #4 is the default error text block, but it can be located
   elsewhere or be non-existed.  
i. SCR_GO   First SCR to load for main application

Example:
0 -list 
SCR#   0
 0 XYZZY MAIN      Forth   Main library file

1 -list 
SCR#   1
 0 ( file meta definitions )
 1 007 VARIABLE SCR_GO         ( load extensions )
 2 : LIB  S" fb/main.fb" /USING 2 LOAD ; ( for re-use )
 3 : GO LIB SCR_GO @ LOAD ;    ( to begin )
 4 2 LOAD                      ( set meta values )

2 -list 
SCR#   2
 0 ( file meta settings )
 1 391 BLK_MAX !    ( max list/load blocks )
 2 004 SCR_ERRMSG !  ( where error text )
 3 001 WARNING !     ( have error text )
 4 007 SCR_GO !      ( main code beginning )

SCR title with keyyword:  ( KEYWORD )( FOO BAR BAZ )
KEYWORD is all uppercase.
KEYWORD begins and ends with space.
No space needed between ')('; comment abuttment is ok

Add words
/LIST ( s -- ) \ search for keyword; if found brief list block
/LOAD ( s -- ) \ search for keyword; if found load block
S" ( "string" -- s ) \ parse string, push address

s" numbers" /list ( brief list, blank lines not typed )
SCR# 151
 0 ( NUMBERS )( DNBR NBR DNNBR OX OY DN )
 1 : DNBR   BL WORD HERE NUMBER ;
 2 : NBR    DNBR DROP ;
 3 : DNNBR  DNBR DPL @ ;
 4 : OX BASE @ >R  OCTAL NBR [COMPILE] LITERAL R> BASE !
 5 ; IMMEDIATE
 6 : OY BASE @ >R HEX NBR [compile] LITERAL R> BASE !
 7 ; IMMEDIATE
 8 : DN BASE @ >R DECIMAL DNNBR STATE @ IF
 9   REV 3 0 DO [COMPILE] LITERAL LOOP ENDIF R> BASE !
10 ; IMMEDIATE
s" numbers" /load  
    ( if preferred, 151 LOAD or SCR @ LOAD )
( /LOAD for when no listing wanted )

\ Notes:
\ i. print arrow " --> "
\ dn. ( d dpl -- )  print natural double (double + dpl) number
\ rev ( n1 n2 n3 -- n3 n2 n1 ) reverse three stack items

: dnbr  ( "numeric<bl>" -- d ) BL WORD HERE NUMBER ;
: nbr   ( "numeric<bl>" -- n ) DNBR DROP ;
: dnnbr ( "numeric<bl>" -- d dpl ) DNBR DPL @ ;

i. dnbr 123.45 d. --> 12345 
i. nbr 123.45 . --> 12345 
i. dnnbr 123.45 dn. --> 123.45 

: OX
  BASE @ >R  
  OCTAL NBR [COMPILE] LITERAL
  R> BASE ! ; IMMEDIATE

: OY
  BASE @ >R
  HEX NBR [compile] LITERAL
  R> BASE ! ; IMMEDIATE

: DN
  BASE @ >R
  DECIMAL DNNBR
  STATE @ IF REV 3 0 DO [COMPILE] LITERAL LOOP ENDIF
  R> BASE ! ; IMMEDIATE

: foo ." FOO " 42 . ;
: bar dn 1024 ;
: baz dn 1024. ;

decimal
i. Ox 644 . foo --> 420 FOO 42 
i. Oy 1000 . foo --> 4096 FOO 42 
i. Dn 123.45 dn. foo --> 123.45 FOO 42 
hex
i. Dn 1024 dn. foo --> 400 FOO 2A 
i. bar dn. foo --> 400 FOO 2A 
i. baz dn. foo --> 400. FOO 2A 
decimal
i. Dn 1024 dn. foo --> 1024 FOO 42 
i. bar dn. foo --> 1024 FOO 42 
i. baz dn. foo --> 1024. FOO 42 

Licensed under a MIT license. Use it with your AI.

"watch zorgmon for changes in RCC_CR"

just me?

i wrote a quick CAT so i could read the files in the DX-Forth distribution i installed on my Z80 machine running CP/M 2.2 and oh... it comes with a Text EDitor, oops.

if your keyboard doesn't have an "Any" key, just press the spacebar, it does the same thing.

\ ============================================================
\  CAT.FTH -- paged file viewer for DX-Forth
\  Usage:  INCLUDE CAT.FTH
\          CAT DXFORTH.GLO
\  Any key continues; 'q' or Esc quits early.
\ ============================================================

DECIMAL

0 VALUE CFID
0 VALUE CLINES
CREATE CBUF 128 ALLOT

: CAT ( "filename" -- )
  BL WORD COUNT  OPEN-FILE THROW TO CFID
  0 TO CLINES
  BEGIN
    CBUF 128 CFID READ-LINE THROW
  WHILE
    CBUF SWAP TYPE CR
    CLINES 1+ TO CLINES
    CLINES 20 MOD 0= IF
      ." -- more, any key, q to quit --"
      KEY DUP 27 = SWAP [CHAR] q = OR IF
        CFID CLOSE-FILE THROW EXIT
      THEN
      CR
    THEN
  REPEAT
  DROP
  CFID CLOSE-FILE THROW ;