Camel99 Forth Information goes here

[+Lee Stewart]

46 minutes ago, TheBF said:

While looking around for some information on local variables in Forth I found this huge repository of Forth related information maintained by Anton Ertl I believe at the Technical University of Vienna:  Index of /forth (tuwien.ac.at)

 

One of the cool things an archive of Forth Dimensions magazines and there is a quicksort done as one definition.

Index of /forth/forth-dimensions (tuwien.ac.at)

 

I slightly modified it for Camel99 Forth.  This version sorts an array of characters. 

Spoiler

\ FORTH DIMENSIONS jAN/FEB 1984 Vol5,No.5  QUICK SORT BY MARK PERCEL
\ Ported to Camel99 Forth with small modification  Brian Fox

INCLUDE DSK1.TOOLS

\ harness for CAMEL99
: 2OVER    3 PICK 3 PICK ;

VARIABLE PIVOT \ changed from MIDDLE to PIVOT

\ Replaced ROT ROT with -ROT
\ Replaced NOT with 0=
\ Replaced MYSELF with RECURSE
: EXCHANGE  ( adr adr -- ) 2DUP C@ SWAP C@ ROT C! SWAP C! ;

: QSORT ( start len -- )
     OVER +  ( 'start 'end )
     2DUP 2DUP  OVER - 2/ + C@ PIVOT !
     BEGIN
        SWAP BEGIN DUP C@ PIVOT @ < WHILE 1+ REPEAT
        SWAP BEGIN DUP C@ PIVOT @ > WHILE 1- REPEAT
        2DUP > 0= IF 2DUP  EXCHANGE 1 -1  D+  THEN
        2DUP > ( loop until partitions cross)
     UNTIL SWAP ROT
     2OVER 2OVER - -ROT -  < IF 2SWAP THEN
     2DUP < IF RECURSE  ELSE 2DROP THEN
     2DUP < IF RECURSE  ELSE 2DROP THEN ;

 

 

 

FYI: I have used the Forth Dimensions repository on Forth.org for years.

 

Also, do you know what the potential hit on the return stack would be by the recursion?

 

...lee

[+TheBF]

Ah yes, I forgot they had one too.

 

I only tested this on a 60 char string so I don't have data on the return stack depth.

 

I just did a quick search and it was mentioned that under a worst case condition the partition might create  one array of size 1 and another of n-1. 

That might be the worst case for recursion. I am not sure.

 

If we think about it a bit we need two addresses for each partitioning.

The number of partitions would be what...  2^n ?

So R stack depth would be  2(2^n) ?

 

A little more research and the stack depth is worst case Log2(n) best case 1.

 

 

 

 

 

 

 

 

[Willsy]

13 hours ago, TheBF said:

While looking around for some information on local variables in Forth [snipped]...

 

In case it's of interest, I did yet another implementation of locals for TF back in February or so. It's only had minimal testing so far.

 

https://github.com/Mark-Wills/TF-MegaLocals

[+TheBF]

5 hours ago, Willsy said:

 

In case it's of interest, I did yet another implementation of locals for TF back in February or so. It's only had minimal testing so far.

 

https://github.com/Mark-Wills/TF-MegaLocals

This is very neat.

Did you have a chance to benchmark it against stack operators?

 

[GDMike]

Interesting 

[+TheBF]

While looking over the old Forth Dimensions magazines I found the original writeup by Dr. Eaker and his CASE statement for the CASE statement contest. 

 

He suggested that a code word called (OF) be created  to optimize his case statement because OF in Forth compiles four words for each use of OF.  ( OVER = IF DROP )  His assembler for 6809 was a bit hard for me to translate so I just made OVER= as a code word.

 

With OVER= the case statement is 27% faster if you hit each case sequentially in a loop. 

It is 42% faster accessing the last case in a CASE statement!

We save 2 bytes per OF as well. 

A pretty big win for little effort.

 

It's probably not worth the effort to completely re-write (OF) as CODE.

 

 

Spoiler

\ ANS-Forth CASE statement
\ Original by Chuck E. Eaker
\ 9/80 FORTH DIMENSIONS II/3 PG 37
\ Ported to CAMEL99 Mar 7 2017
\ Added OVER=   27%..42% speedup, saves 2 bytes per OF use.
HEX
CODE OVER= ( n1 n2 -- ?)
8116 ,        \ *SP TOS CMP,
04C4 ,        \  TOS CLR,
1601 , 0704 , \  EQ IF, TOS SETO, ENDIF,
NEXT,
ENDCODE

HERE
: CASE  ( -- 0 ) 0 ; IMMEDIATE
: OF    ( n -- )    POSTPONE OVER=  POSTPONE IF  POSTPONE DROP ; IMMEDIATE
: ?OF   ( flag -- ) POSTPONE OVER   POSTPONE IF  POSTPONE DROP ; IMMEDIATE
: ENDOF ( -- ) POSTPONE ELSE ; IMMEDIATE
: ENDCASE ( -- )
  POSTPONE DROP  BEGIN ?DUP  WHILE  POSTPONE THEN  REPEAT ; IMMEDIATE

SPACE HERE SWAP -  DECIMAL . .( bytes)

 

 

 

[GDMike]

I thought I've seen OF in TF? Or somewhere..hmmm...I could of sworn.. maybe it was in bill's Forth, is that GForth? But I know I've seen it..oh come on... where did I see that...

Edited August 12, 2022 by GDMike

[+TheBF]

CASE 
    1 OF  ." #1"   ENDOF
    2 OF  ." #2"   ENDOF 
    3 OF  ." #3"   ENDOF
         ." HUH?"
ENDCASE 

 

[+TheBF]

So of course I could not resist trying to make it smaller and faster.

It took me some trial and error to get the stack dropping correct for the CODE word (OF).

TOS POP,   is just a DROP in my system. 

CODE (OF)
     *SP TOS CMP,
     NE IF,
         TOS POP,
        *IP IP ADD, \ do Forth branch
         NEXT,
     ENDIF,
     TOS POP,
     TOS POP,
     *IP INCT,   \ no branch. Advance IP 
     NEXT,
ENDCODE

 

(OF)  is just special version of ?BRANCH and so we need to use AHEAD to record the memory address and put a place holder in the code for the jump offset. The jump offset is filled in later by ENDOF which is just an alias for ELSE 

 

This makes the final definition look like this:

: OF    ( n -- )    POSTPONE (OF) AHEAD ; IMMEDIATE

 

Now we are saving 6 bytes on every use of the word OF.  In a 10 item case statement that is 60 bytes.

In terms of performance this version is 55% faster hitting each case in a 10 selection case statement and 81% faster seeking to the last item in the 10 item case statement.

And the code size to add the Eaker Case statement is 4 bytes smaller than the way I did it in hi level Forth only.

I think I will take Dr. Eaker's advice on this one.

 

 

[GDMike]

Oh..ok .I see

[+TheBF]

5 hours ago, TheBF said:

So of course I could not resist trying to make it smaller and faster.

It took me some trial and error to get the stack dropping correct for the CODE word (OF).

TOS POP,   is just a DROP in my system. 

Edit:  Tested this on some real programs and found out that it did not work with *IP INCT,   

         but only with *IP 2 AI,     Not sure why. ?  For another day. It seems reliable like this. 

5 hours ago, TheBF said:

 

CODE (OF)
 *SP TOS CMP,
  NE IF,
       TOS POP,
      *IP IP ADD, \ do Forth branch
       NEXT,
  ENDIF,
 *IP 2 AI,
  TOS POP,
  TOS POP,
NEXT,
ENDCODE

 

\ This makes the final definition look like this:
: OF    ( n -- )    POSTPONE (OF) AHEAD ; IMMEDIATE

 

(OF)  is just special version of ?BRANCH and so we need to use AHEAD to record the memory address and put a place holder in the code for the jump offset. The jump offset is filled in later by ENDOF which is just an alias for

ELSE.

 

Now we are saving 6 bytes on every use of the word OF.  In a 10 item case statement that is 60 bytes.

In terms of performance this version is 55% faster hitting each case in a 10 selection case statement and 81% faster seeking to the last item in the 10 item case statement.

And the code size to add the Eaker Case statement is 4 bytes smaller than the way I did it in hi level Forth only.

I think I will take Dr. Eaker's advice on this one.

 

[+TheBF]

So many options...

 

I now realize I was not measuring the total size of the case statement code.

I was not including the CODE definition of (OF). duh!.

 

I came back to this to stare at it and realized that I might be able to use subtraction rather than compare. 

This lets me refill the TOS of stack register after the subtraction and use the carry flag for the logic.

I do this in ?BRANCH in the kernel.

 

I tried it and it works.

CODE (OF)
*SP TOS SUB,
 TOS POP, \ MOV changes L> A> EQ flags, BUT does not change carry flag :-)
 NC IF,
     *IP IP ADD, \ do Forth branch
      NEXT,
 ENDIF,
 *IP 2 AI,       \ no branch. Advance IP
 TOS POP,
 NEXT,
ENDCODE

This version uses 128 bytes of dictionary for the code but reduces each call to  OF to 2 bytes.

 

Then I realized with compile time address math, I could branch into the 2ND instruction of ?branch & uses what's there!

HEX
CODE (OF)
  *SP TOS SUB,
 ' ?BRANCH @ CELL+ @@ B,
ENDCODE

This version uses 120 bytes of dictionary but each call to OF  is  4 bytes because DROP needs be compiled by OF 

 

This was my original thinking making a super instruction OVER=

CODE OVER= ( n1 n2 -- ?)
 *SP TOS CMP,
  TOS CLR,
  EQ IF, TOS SETO, ENDIF,
NEXT,
ENDCODE

126 bytes of dictionary but calling OF consumes 6 bytes. 

 

The Forth only version uses 108 bytes of dictionary but calling OF uses up 8 bytes.

That is really expensive so making that 2 bytes per call is real improvement even if speed was the same.

 

So I think I have exhausted this and I like the reworked version at the top.

I need to really beat it up now.

 

 

 

[+TheBF]

Final Version of (OF) 

 

I used my LINKER project as a real world test because it has a 16 item case statement and is doing some fancy stuff.

Sure enough it would compile and run fine with the vanilla Forth CASE statement but would fail with my various code versions.

 

I re-worked OVER= a bit and that worked but the program size savings were not good enough for me.

So I combined the working OVER=  with a branch into fast RAM to run ?BRANCH and that proved to be a winner.

 

The total implementation of the CASE statement with this addition is only 18 bytes bigger than using all Forth (126 vs 108 bytes)

 

HEX
CODE  (OF)
 6116 ,                \ *SP TOS CMP, ( OVER = )
 04C4 ,                \     TOS CLR,
 1601 ,                \ EQ IF,
 0704 ,                \     TOS SETO,
                       \ ENDIF,
 0460 , ' ?BRANCH @ ,  \ ' ?BRANCH @ @@ B, 
ENDCODE

 

So now with all the smoke cleared I can show this table of results with a 10 item case statement tested in two scenarios

             SIZE Saving      1000X hit all         3000x Hit last 
---------------------------------------------------------------------
FORTH          0                  14.3 secs          7.3 secs  
OVER=        20 bytes             11.2 secs          5.1 secs
(OF)         40 bytes             10.5 secs          4.6 secs

 

So if you use 5 or more items in a CASE statement you are ahead on size and speed is also improved. 

[+TheBF]

I noodling on what the best way to do background sounds in a video Game in Forth.

I tried it first with the multi-tasker and it worked ok but I found that to make things smoother I needed to change the definition of SND!.

 

It was:

HEX 
: SND!   ( c -- )  8400 C! ; 

 

Going forward it is:

HEX 
: SND!   ( c -- )  PAUSE 8400 C! ; 

 

That little pause causes all the words in the sound library to behave much better when multi-tasking. I should have caught that as this is primary "rule of thumb" that came from Poly-Forth.  All I/O operations should pass control to another task.

I have seen PAUSE placed before the  I/O operation in other systems so I am just following the example. It could work after the C! as well. 

 

Of course when you drink your own Kool-Aid be prepared for it to sometimes taste bad.  I also found that my task "restarter" called RESTART was only resetting the task's return stack.  This had worked in the past but if I restarted a task while it was still running it piled up new things onto it's data stack and would eventually crash.

 

For example if I assigned a sound to a task and then triggered the task to run the sound in the background to drop a bomb and whistle.

This was of those conditions that takes some time and so you could shoot again while the sound was still running.

 

So once I debugged my system a little more   it worked quite well.

 

I put these ideas into the simple B52 program for testing.  I added a 2nd task that tries (badly) to simulate fire where the bombs hit.  

 

Spoiler

\ translation of SteveB52 from Extended BASIC to Forth
\ Original concept on Atariage.com
\ Uses Multi-tasking for background sound


\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.MARKER    \ need LOCK from this file
INCLUDE DSK1.CASE
INCLUDE DSK1.RANDOM
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.DIRSPRIT
INCLUDE DSK1.AUTOMOTION
INCLUDE DSK1.RANDOM
INCLUDE DSK1.SOUND
INCLUDE DSK1.VALUES
INCLUDE DSK1.MALLOC
INCLUDE DSK1.MTASK99

\ some high level multi-tasker commands using primitives
: NEWTASK ( -- addr) USIZE MALLOC DUP FORK ; \ create task area in LOW RAM
: STOP    ( -- )     MYSELF SLEEP  PAUSE ;   \ go to sleep and pass control


\ names for the background tasks
\ we will create the task when the program starts
0 VALUE BOMBER
0 VALUE FIRE

\ ENDIF is easier to understand for Non-Forth speakers
: ENDIF   POSTPONE THEN ; IMMEDIATE

\ scoreboard manager
VARIABLE HITS
VARIABLE MISSES

: .HITS      6 0 AT-XY  HITS @ U. ;  \ U. prints numbers unsigned
: .MISSES   28 0 AT-XY  MISSES @ U. ;
: .SCORE    .HITS  .MISSES ;

\ numbered sprites like XB
0 CONSTANT #1
1 CONSTANT #2

\ name the characters for clarity
DECIMAL
124 CONSTANT bomber
128 CONSTANT bomb
132 CONSTANT building
133 CONSTANT ground
134 CONSTANT crater

136 CONSTANT fire

HEX
CREATE flame0   01C2 , 2246 , 2434 , 7EDE ,
CREATE flame1   40A0 , 3018 , 083E , 2FFA ,
CREATE flame2   020F , 0C0C , 1038 , 79FF ,
CREATE flame3   0000 , 2010 , 1438 , 6ECF ,

DECIMAL
\ animation sequence
CREATE FLAMES  flame0 ,  flame1 , flame2 , flame3 ,

\ choose a random flame pattern
: ]FLAME     ( n -- addr) CELLS FLAMES + ;
: [RND]FLAME ( -- addr) 4 RND ]FLAME ;

: BURNTASK
       0 ( 1st flame #)
       BEGIN
         [RND]FLAME @ fire CHARDEF
         fire SET#
         DUP  9 1 COLOR 900 RND TICKS
         DUP  7 1 COLOR 900 RND TICKS
             11 1 COLOR 600 RND TICKS
       AGAIN ;

DECIMAL
: InitGraphics
  S" 2810383838100000000000000000000000000000000000000000000000000000"
  bomb CALLCHAR ( 80 char line limit in DV80 files)
  S" 00000080C0E070FFFF070F1C3800000000000000000000FEFFC0000000000000"
  bomber CALLCHAR

  S" FE929292FE929292" building CALLCHAR
  S" FFFFFFFF00000000" ground CALLCHAR
  S" 8183E7FF00000000" crater CALLCHAR
  S" 01C2224624347EDE"  fire CALLCHAR

  2 MAGNIFY  AUTOMOTION   2 MOVING
;

: ScrInit ( fg bg -- )
  DUP SCREEN         \ use bg color for screen
  DELALL
  1 17 2SWAP COLORS  \ does the range of color sets 1..19
  fire SET# 9 1 COLOR
  CLEAR
;


: FlyPlane   ( -- ) bomber 13 1 12 #1 SPRITE   0 16 #1 MOTION  ;
: DrawGround ( -- ) 0 20 ground 32 HCHAR ;
: SkyScraper ( col row ) building  OVER 20 SWAP - 0 MAX VCHAR ;

: RNDY       ( -- n) 7 RND 14 + ;
: DrawCity   ( -- ) DrawGround  22 8 DO  I RNDY SkyScraper   LOOP ;

: STARTUP
   16  2 ScrInit
   HITS OFF   MISSES OFF
   10 23 AT-XY ." Foxy's B52"
   0 0 AT-XY ." Hits:" .HITS    20 0 AT-XY ." Misses:"
   InitGraphics
   DrawCity
   FlyPlane
;

: VC+!  ( n Vaddr -- ) TUCK VC@  +  SWAP VC! ; \ add 'n' to VDP byte

: DescendPlane
      #1 SP.X VC@  250 >
      IF
         1 #1 SP.X VC!  \ reset sprite to left side
         4 #1 SP.Y VC+! \ plane falls down 2 pixels
      ENDIF ;

: 8/  ( n -- n' ) 3 RSHIFT ;  \ divide by 8
: PIX>CHAR  ( col row -- col' row')  8/ SWAP  8/ 1+ SWAP ;

\ test if sprite is over a character that is not a blank (space)
: COLLISION?  ( spr# -- ?) POSITION PIX>CHAR GCHAR  BL <>  ;

: DELSPRITE ( spr# -- ) DUP>R  SP.Y 4 BL VFILL  0 0 R> MOTION ;

\ volume fader
: FADER   ( speed -- ) \ fades down to -28 DB. Does not MUTE
  29 0
   DO
     I DB  DUP TICKS \ MS passes to next task while it waits
     PAUSE
  LOOP
  DROP
;

\ ***************************************************************
\                       background sounds
\
: Whistler   \ factored our as a word for testing.
     GEN4 MUTE   ( make any previous bomb quiet)
     GEN1 4600 DUP HZ ( -- freq)
     -8 DB                     \ volume
     400 0                     \ finite # iterations with 10 HZ reduction
     DO
        ( freq)  20 - DUP HZ    \ reduce freq in each loop.
        #2 COLLISION? IF LEAVE THEN
     LOOP
     MUTE
     ( freq) DROP
;

: Exploder    -2 NOISE 400 FADER 500 TICKS MUTE  ;
\ ***************************************************************

: WAIT-COLLISION ( char -- )  BEGIN  PAUSE #2 COLLISION?   UNTIL  ;

: DIRECT-HIT    fire VPUT  HITS 1+!  ;
: RE-HIT        BL VPUT  VROW 1+!   fire VPUT   HITS 1+! ;
: GROUND-HIT       crater VPUT  MISSES 1+! ;

: END    2 8 ScrInit ." ** DONE ** "  ;  \ imitate BASIC'S END  :)

: DRAW-DAMAGE
     #2 POSITION PIX>CHAR 2DUP AT-XY \ set cursor for (EMIT)
     GCHAR
     CASE
       building  OF  DIRECT-HIT   ENDOF
       fire      OF  RE-HIT       ENDOF
       ground    OF  GROUND-HIT   ENDOF
    ENDCASE
;

\ This background task must end with STOP. It puts itself to sleep
\ and passes control back to the console task.
: DropBomb
\  char  colr     x        y   spr#
   bomb  11   #1 POSITION 12 +  #2 SPRITE  \ make sprite at bomber position
   24 0 #2 MOTION                          \ fall with automotion
    Whistler                \ start the falling bomb sound
    0 0 #2 MOTION           \ stop bomb sprite when whistler collides
   #2 DELSPRITE
   Exploder                 \ run the explosion
   STOP
;

HEX
\ multi-tasking friendly KEY with no cursor
: GKEY ( -- c | 0)  BEGIN PAUSE DescendPlane  KEY? ?DUP UNTIL ;

DECIMAL
: GameLoop
  DrawCity
  FlyPlane
  BEGIN
     GKEY BL =
     IF
       BOMBER RESTART
       WAIT-COLLISION
       DRAW-DAMAGE
     ENDIF
     PAUSE .SCORE
     #1 COLLISION? ?TERMINAL OR
  UNTIL
  0 0 #1 MOTION   #2 DELSPRITE
;

: RUN
   NEWTASK TO BOMBER
   NEWTASK TO FIRE
   ['] DropBomb BOMBER ASSIGN
   ['] BURNTASK FIRE ASSIGN   FIRE WAKE
   GRAPHICS     \ switch VDP mode
   MULTI        \ enable multi-tasking
   BEGIN
      STARTUP
      GameLoop
      8 10 AT-XY ." Game Over"
      12 8 AT-XY ." Play again? (Y/N)"
      KEY [CHAR] N =
   UNTIL
   SINGLE      \ turn off multi-tasking
   END
;

\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\

 

 

 

 

 

Next I will re-worked some code to generate sound lists in VDP RAM and let the ISR play them.

My feeling is this may be good for some situations but like Sprite automotion it may also make control harder. 

 

[HOME AUTOMATION]

Careful!🪂 My building has S.A.M.S..🚀

[+TheBF]

While reading comp.lang.forth I found this version of ROLL published by Stephen Pelc of MPE.

Looks like it would be faster than the recursive version on very deep stacks. 

 

\ ROLL.FTH from MPE posted on comp.lang.forth
\ modified for Camel99 Forth DUP>R
: ROLL \ nn..n0 n -- nn-1..n0 nn ; 6.2.2150
  DUP>R PICK
  SP@ DUP CELL+ R> 1+ CELLS CMOVE> DROP
;

 

[GDMike]

On 8/23/2022 at 9:11 PM, TheBF said:

While reading comp.lang.forth I found this version of ROLL published by Stephen Pelc of MPE.

Looks like it would be faster than the recursive version on very deep stacks. 

 

\ ROLL.FTH from MPE posted on comp.lang.forth
\ modified for Camel99 Forth DUP>R
: ROLL \ nn..n0 n -- nn-1..n0 nn ; 6.2.2150
  DUP>R PICK
  SP@ DUP CELL+ R> 1+ CELLS CMOVE> DROP
;

 

That's pretty cool. 

[+TheBF]

I just found Lee's link to the WHTECH ftp site and there I found the Wycove Forth manual.

It's really enjoyable to read through the manual for tidbits.

 

I found this code snippet: (~16 bytes without header)

: (OF)     OVER = IF DROP 1   ELSE  0  THEN ;

 

Which is used to make CASE statements smaller. 

LOL. I guess I should have thought of that but the one I landed on is faster and a bit smaller too so no worries.

 

[+TheBF]

OK so here's the deal.

 

Reading the Wycove  Forth manual I read about the BLOCK editor that uses the 40x24 line screen in it's natural format.

I like that idea. It's what we have on the stock system.

 

My little Forth system would benefit from a resident editor but I want to use DV80 text files. 

I have the monster ED99 that needs the SAMS card and all but what about something for the guy with only 32K expansion? 

The ANS Forth file word set alone consumes 1200 bytes! Not needed for and editor. 

 

 I have an editor that lets you edit the screen like a big buffer. 

( I even have one that works like the Wycove editor on BLOCKs in a DF128 file) 

 

I needed a smallish file/memory manager,  to read a text file into low ram in a compressed format and save it back out.

I have that now in 590 bytes. 

It can load the biggest source file in my system, the assembler (5217 bytes),  into Low RAM in 1.2 seconds and still have 2K left over. 

It can seek to the last line, line 190, in  .1 seconds. 

 

This is done using counted strings as a poor man's single linked list. Compact but still quite fast.

It will slow down when I have to insert strings into it but the plan so far, is go VI style and only edit in the screen buffer and then update the data buffer when you commit the line of text ( or maybe the whole screen) to the data buffer. Should be acceptable. 

 

Now I have marry these two things, the editor and the 590 byte file manager. Target is to make the editor use 2K bytes.

It's gonna be tight. 

 

 

Spoiler

\ textfiles.fth  minimal text file access words  Aug 27 2022 Brian Fox
\ The ANS Forth FILE wordset use 1200 bytes in our little TI-99.
\ This minimalist system takes treats PAB addresses like handles.

\ This version compiles file data as counted strings in low RAM.
\ This is a fast way to seek to a line while having variable length data.

 NEEDS .S   FROM DSK1.TOOLS
 NEEDS ELAPSE FROM DSK1.ELAPSE

HERE

\ ===[ heap management ]====
\ low RAM is file buffer
HEX
2000 CONSTANT BUFFER  \ base address of the heap
2000 CONSTANT 8K      \ max size of the heap

DECIMAL
\ variable H is our memory management pointer
: HALLOT ( n --)  H +! ;
: HEAP   H @ ;
: HC,   ( c --)  HEAP C!  1 HALLOT ;  \ compile c into heap

\ ===[ PAB management ]====
\ PAB: pre-computes VDP PAB address for PAB with size PSZ (300)
\ The PAB is 300 bytes and has the file buffer built in after the filename.
: PAB: ( n -- )
  CREATE
    PSZ *  VDPTOP SWAP - ,
\ runtime:  set the active PAB in the ^PAB variable
  DOES>  @   ^PAB ! ;

1 PAB: #1
2 PAB: #2
3 PAB: #3

\ DV80 (text) file access modes (FAM)
HEX
10 CONSTANT R/W \ read/write
12 CONSTANT W/O \ write only
14 CONSTANT R/O \ read only
16 CONSTANT W/A \ write append

DECIMAL
: FSIZE    ( -- n )  HEAP BUFFER - ;

: ?PAB     ^PAB @ VDPTOP = ABORT" File #" ;
: OPEN     ( addr len fam -- ) 80 SWAP ?PAB FOPEN ?FILERR ;
: CLOSE    ( -- ) ?PAB 1 FILEOP ?FILERR  VDPTOP ^PAB ! ;

\ purge sets the heap to use addr and then erases it
: PURGE    ( addr len -- ) OVER H !  0 FILL   LINES OFF  ;
: NEXT$    ( addr -- addr' ) COUNT + ALIGN ;
: LEN      S" C@" EVALUATE ; IMMEDIATE  \ syntax sugar

: V$,  ( Vaddr u -- ) \ compile VDP stack string as counted string in HEAP
      TUCK                \ tuck a copy of length under Vaddr
      DUP HC,             \ compile the length in heap
      HEAP SWAP VREAD     \ copy VRAM to RAM
      HALLOT ALIGN ;      \ Allocate the heap space, align for TMS9900

: FDATA  ( -- Vaddr len ) [PAB FBUFF] V@  [PAB CHARS] VC@ ;

\ usage:  #1  S" DSK1.MYFILE" READ-FILE
: READ-FILE ( addr len -- )
        BUFFER 8K PURGE
        R/O OPEN
        LINES OFF
        BEGIN
           2 FILEOP 0=
        WHILE
           FDATA V$,
           LINES 1+!
        REPEAT
        CLOSE
;

: NTH ( addr n -- Caddr)  0 ?DO  NEXT$  LOOP ; \ seek to nth line

: WRITELN ( addr len -- ior)
  DUP [PAB CHARS] VC!        \ set the record length
  [PAB FBUFF] V@ SWAP VWRITE \ write addr,len to Pab file buffer
  3 FILEOP  ;                \ hit the system

\ usage:  #1 S" DSK1.MYFILE" WRITE-FILE
: WRITE-FILE ( addr len -- )
       W/O  OPEN
       BUFFER ( caddr )
       BEGIN
          DUP LEN
       WHILE
          DUP COUNT WRITELN ?FILERR
          NEXT$
       REPEAT
       DROP
       CLOSE ;

DECIMAL HERE SWAP - CR . .( bytes)

\ test code
\ : PRINT ( $ -- ) COUNT ( C/L@ 1- MIN)  CR TYPE ;
\ : .HEAP ( -- ) BUFFER BEGIN  DUP LEN WHILE   DUP PRINT NEXT$   REPEAT ;

 

 

Edited August 29, 2022 by TheBF
comment removed

[GDMike]

How bout a multi cross editor that saves in both formats? I like snp with it's gradual progress in saving it's screens as dv80 or program image. I hope to get it completed one day.

The snp dv80 is basically just a screenshot saved, while the complete DATA of all screens saved end up as program image saves because of the amount of data to save.

But, maybe I should add an option for Saving a screenshot as DF128 as well, or maybe adding a menu and let the user pick from a selection of predefined saves / loads for the screen wanting to be saved or loaded..

I suppose I need to add "DISK DIRECTORY" ability to. Geez

 

 

 

 

Edited August 31, 2022 by GDMike

[+TheBF]

3 hours ago, GDMike said:

How bout a multi cross editor that saves in both formats? I like snp with it's gradual progress in saving it's screens as dv80 or program image. I hope to get it completed one day.

The snp dv80 is basically just a screenshot saved, while the complete DATA of all screens saved end up as program image saves because of the amount of data to save.

But, maybe I should add an option for Saving a screenshot as DF128 as well, or maybe adding a menu and let the user pick from a selection of predefined saves / loads for the screen wanting to be saved or loaded..

I suppose I need to add "DISK DIRECTORY" ability to. Geez

Could be done of course, but saving twice might slow down the user experience.

Another approach would be to make a easy to use file conversion utility or offer a "save as" option with file format selector as we see on most modern programs.

Yes a directory viewer is essential for these type of tools. I am going to add one to this editor as well. 

 

[+TheBF]

So my "ultra-tiny" editor kind of went out the window once I started playing.   I will come back to that later. 

 

I went all-in on the VI idea and have a working skeleton that lets me browse a file in "command" mode using VI keyboard mapping. 

I never used VI much but it is an interesting idea for a compact editor.  The Forth interpreter is used for the VI command line which means numeric parameters must have a space between them and the command. Not a big compromise IMHO.

At moment if you enter a bad command you bounce out to the Forth command line. I will change that if this becomes a stand alone program.

 

The OTHER interesting idea to me is, can I use the screen as the ONLY editing buffer? I have the file contents in VDP RAM for each line. 

It should be possible.  I need to develop some code to transfer lines of the screen to the correct place in the counted string array in memory.

Not there yet. It might be tricky. We shall see.

 

The video shows progress so far. For preliminary purposes here I am limiting the file lines to 40 chars on the screen. The full length lines are in the buffer. 

 

Here is what the VI command line commands look like once you have the "domain specific language" created.

\ vi style user commands interpreted by Forth

: (Q)     BLK/CYAN SCREEN   LINECURS  ; \ Common factor

: x       #1  FILENAME COUNT WRITE-FILE (Q) ABORT ;

: q       x  (Q)  ABORT ;
: Q  q ;

: q!     (Q)  CR  S" Not saved" TYPE ABORT ;
: Q!     q! ;

: w      #1 PARSE-NAME
          DUP 0=
          IF  2DROP FILENAME COUNT ( addr len)
          ELSE 2DUP FILENAME PLACE
          THEN WRITE-FILE ;

: w!      w ;  \ There is no overwrite protection in this version

: vi
          #1 PARSE-NAME 2DUP FILENAME PLACE
           DUP 0=
           IF    2DROP NEW
           ELSE  READ-FILE
           THEN EDIT ;

: VI   vi ;  ( alias upper case )

: G      ( n -- ) TOPLINE !  LIST ; \ 123 G *MUST HAVE SPACE AFTER NO.*
: 0      TOPLINE OFF LIST ;
: $      LINES @ 1- G ;

 

[+TheBF]

Well that was painful. 

Insert/overwrite/delete into a counted string array without using variables took a lot of inter-active debugging.  

Now that I have the functions however I can use them for a tiny editor.

 

I took the trouble to make the source code for the editor to stay within 40 columns.

The new editor can hold all 345 lines in low ram using the counted string array. 

There is still a bug when I tried to paste the entire file into VI99 on Classic99 so more work to do, but the concept is working. 

 

I am not sure I am a fan yet of the VI method of operation but I will give it a try. 

There are still a lot of functions that I have not implemented but they are just more time on task. 

 

Here is the code so far.   I need a break.

Spoiler

\ VI99.FTH  DV80 editor for TI-99
\ Aug 26 2022 Brian Fox

\ VI99 concepts:
\ Use VI key mappings.
\ Use Forth interpreter
\ Read files into low ram
\ Edit text directly in VDP RAM

NEEDS DUMP       FROM DSK1.TOOLS

NEEDS #1         FROM DSK5.TEXTFILES
NEEDS CASE       FROM DSK1.CASE
NEEDS RKEY       FROM DSK1.RKEY
NEEDS -TRAILING  FROM DSK1.TRAILING
NEEDS NOCASE     FROM DSK1.NOCASE
NEEDS MOVE       FROM DSK1.MOVE

UCASE ( case sensitive on )

NEEDS WORDLIST   FROM DSK1.WORDLISTS

HERE
VOCABULARY EDITOR
ONLY FORTH ALSO EDITOR DEFINITIONS

\ future undo buffer in VDP RAM
HEX 1000 CONSTANT UNDOBUFF

DECIMAL
VARIABLE INSERTING
VARIABLE LINESTK
VARIABLE LINE#
VARIABLE TOPLINE
VARIABLE STOL
VARIABLE CMDMODE

CREATE FILENAME  16 ALLOT

\ ========================
\ Helpers
: BETWEEN ( n lo hi -- ?) 1+ WITHIN ;
: CLIP   ( n lo hi -- n) ROT MIN MAX ;
: ERASE   ( addr len -- )  0 FILL ;
: BLANK   ( addr len -- )  BL FILL ;
: VBLANK  ( vaddr len -- ) BL VFILL ;
: VBLANKLN ( -- ) VPOS C/L@ VBLANK ;
: HLINE   ( col row -- )
  >VPOS C/L@  [CHAR] __ VFILL ;

: GETXY   ( -- x y ) VROW 2@ ;
: SAVECURS
  S" GETXY 2>R" EVALUATE ; IMMEDIATE
: RESTCURS
  S" 2R> AT-XY" EVALUATE ; IMMEDIATE
: PROMPT  ( -- ) 0 23 AT-XY VBLANKLN ;
: SCRLINE  ( -- Vaddr) VROW @ C/L@ * ;
: VTYPE ( $ len ) VPOS SWAP VWRITE ;

: HOME    0 0 AT-XY ;

\ clears top 21 lines
: CLS   ( -- )
  HOME
  VTOP @ [ C/SCR @ C/L@ 2* - ]
  LITERAL VBLANK ;

: LIST  ( -- )
  BUFFER TOPLINE @ NTH
  CLS
  SAVECURS
  22 0
  DO
    DUP C@ 0=
    IF   [CHAR] ~ CPUT DROP
    ELSE DUP
         COUNT 39 MIN -TRAILING VTYPE
    THEN CR
    NEXT$
  LOOP
  DROP
  RESTCURS
;

\ cursor movement controls
: TOPLINE+! ( n --)
  TOPLINE @ SWAP +  0 2000 CLIP
  TOPLINE ! ;

: MOVESCR  ( n --) TOPLINE+! LIST ;

: CUP
  VROW @ 1- 0 MAX
  DUP 0= IF -1 MOVESCR THEN VROW ! ;

: CDOWN
  VROW @ 1+ 21 MIN
  DUP 21 = IF 1 MOVESCR THEN VROW ! ;

: CRGHT
  VCOL @ 1+ [ C/L@ 1- ] LITERAL MIN
  VCOL ! ;

: CLEFT   VCOL @ 1-  0 MAX VCOL ! ;

: NEWLINE   CDOWN  VCOL OFF ;
: EOL       C/L@ 1- VCOL ! ;

HEX
: LINECURS    5F CURS ! ;
: BARCURS     1E CURS ! ;
: BOXCURS     1F CURS ! ;

DECIMAL
: INS/DEL
  INSERTING @ -1 XOR INSERTING !
  INSERTING @
  IF    BARCURS
  ELSE  LINECURS
  THEN ;

\ "right of cursor"  as a stack string
: ROC  ( -- VDPaddr len)
  SCRLINE C/L@  VCOL @ /STRING ;

\ "left of cursor"  as a stack string
: LOC   ( -- VDPaddr len)
  SCRLINE VCOL @ ;

\ =======================
\ text manipulation

: DELCHAR    ( -- )
  PAD C/L@ 2+ BLANK
  ROC TUCK 1 /STRING
  PAD SWAP  VREAD
  PAD VPOS ROT VWRITE
;

: PUSHRIGHT ( -- )
  ROC TUCK
  PAD SWAP VREAD
  BL VPUT
  PAD VPOS 1+ ROT 1- VWRITE ;

DECIMAL
: '"'     [CHAR] " EMIT ;

: ."FILE" ( $ -- )
  COUNT DUP 0=
  IF 2DROP S" new file"  THEN
  PROMPT '"' TYPE '"' SPACE LINES @ .
  ." lines, "  FSIZE . ." chars"
;

\ ===[ "INSERT" MODE primitives ]===
: V$! ( Vaddr len addr -- )
  2DUP C! 1+ SWAP VREAD ;

\ line# of the cursor
: ELINE#  ( -- n )
  TOPLINE @  VROW @  + ;

\ seek to the address of the ELINE#
: ELINE$  ( line# -- Caddr)
  BUFFER SWAP NTH ;

\ -trailing for a VDP string
: V-TRAILING ( V$ len -- V$ len')
  1-
  BEGIN
     2DUP + VC@ BL =
  WHILE
     1-
  REPEAT
  1+ ;

: SCREEN$ ( -- Vaddr len)
  SCRLINE 39 V-TRAILING 1 MAX ;

\ open space for a string of len bytes
\ return the HEAP address
: MAKEROOM ( len line# -- addr)
  ELINE$ DUP>R ( len $ ) ( r: eline$)
  OVER R@ + 1+ ( len $ $+len+1 )
  HEAP R@ - 0 MAX  ( len $ $' size )
  MOVE R> ;

: OVERWRITE ( len line# -- addr)
  ELINE$ DUP>R
  DUP NEXT$ SWAP
  2 PICK + 1+
  HEAP OVER - 0 MAX 1+
  MOVE R> ;

: DELETELN ( line# -- )
  ELINE$  DUP NEXT$ SWAP ( $2 $1)
  HEAP OVER C@ - 1+  MOVE ;

\ store VDP string at addr in CPU RAM
: INSERTLN  ( Vaddr len ELINE# --)
  MAKEROOM  V$! ;
: PLACELN   ( Vaddr len ELINE# --)
  OVERWRITE V$! ;

\ ====================================
DECIMAL
: INSERT-MODE
  BARCURS
  CMDMODE OFF
  BEGIN
    VPOS VC@ [CHAR] ~ =
    IF BL VPOS VC! THEN

    RKEY DUP BL [CHAR] ~ BETWEEN
    IF
      INSERTING @
      IF PUSHRIGHT THEN (EMIT)
    ELSE
      CASE
       3 OF  DELCHAR       ENDOF
       4 OF  INS/DEL       ENDOF
       8 OF  CLEFT         ENDOF

      13 OF  SCREEN$ ELINE#
             PLACELN
             NEWLINE        ENDOF

      15 OF  CMDMODE ON  BOXCURS
             EXIT           ENDOF
    ENDCASE
    THEN
  AGAIN
;

: GETCMD ( -- )
  SAVECURS
  PROMPT [CHAR] : EMIT
  PAD DUP C/L@ 2-  ACCEPT EVALUATE
  FILENAME ."FILE"
  RESTCURS ;

DECIMAL
21 CONSTANT 1SCR
11 CONSTANT 1/2SCR

HEX
: UPPER   ( c -- c')
  DUP LOWER? IF 5F AND THEN ;

\ ===[ VI Command Mode keys ]===
: COMMANDS ( char -- )
CASE
  82 OF 1SCR NEGATE MOVESCR ENDOF \ ^B
  86 OF  1SCR MOVESCR       ENDOF \ ^F
\ 83 OF  COPYLINE           ENDOF \ ^C
  84 OF  1/2SCR MOVESCR     ENDOF \ ^D
  8C OF  LIST               ENDOF \ ^L
  91 OF  ABORT              ENDOF \ ^Q
  95 OF  1/2SCR NEGATE MOVESCR ENDOF
\ 96 OF  PASTELINE NEWLINE  ENDOF \ ^V
[CHAR] h OF  CLEFT          ENDOF
[CHAR] I OF  INSERT-MODE    ENDOF
[CHAR] j OF  CUP            ENDOF
[CHAR] k OF  CDOWN          ENDOF
[CHAR] l OF  CRGHT          ENDOF
[CHAR] $ OF  EOL            ENDOF
[CHAR] 0 OF  VCOL OFF       ENDOF

[CHAR] D OF  SAVECURS
             ELINE# DELETELN
             LIST  RESTCURS ENDOF

[CHAR] : OF  GETCMD   LIST  ENDOF

ENDCASE
;

\ text/screen color combos
HEX
17 CONSTANT BLK/CYAN
E4 CONSTANT WHT/BLU
21 CONSTANT GRN/BLK

DECIMAL
: SCREEN  ( c -- ) 7 VWTR ;

: NEW     CLS
          BUFFER 8K PURGE
          FILENAME OFF
          TOPLINE OFF ;

: EDIT ( -- )
         GRN/BLK SCREEN
         INSERTING ON
         CMDMODE ON  BOXCURS
         TOPLINE OFF
         0 22 HLINE
         FILENAME ."FILE"
         LIST
         HOME
         BEGIN
            RKEY COMMANDS
         AGAIN ;

: GET-FILENAME ( -- addr len)
  PARSE-NAME TOUPPER ;

: SAVE      ( -- )
  FILENAME COUNT  #2 WRITE-FILE ;

\ ===[ vi style user commands ]===

: (Q)   BLK/CYAN SCREEN   LINECURS  ;

: x     SAVE  (Q) ABORT ;

: q     x     (Q) ABORT ;
: Q     q ;

: q!   (Q)  CR  ." Not saved" ABORT ;
: Q!    q! ;

: w
  GET-FILENAME ( addr len)
  DUP IF  FILENAME PLACE THEN SAVE ;

: W       w ;
: w!      w ;

: vi
  GET-FILENAME 2DUP FILENAME PLACE
  DUP 0=
  IF    2DROP NEW
  ELSE #1 READ-FILE
  THEN EDIT ;

: VI   vi ;  ( alias upper case )

\ 123 G *MUST HAVE SPACE AFTER NO.*
: G      ( n -- ) TOPLINE !  LIST ;
: 0      TOPLINE OFF LIST ;
: $      LINES @ 1- G ;

HERE SWAP - DECIMAL .

 

 

 

 

 

 

 

 

[+TheBF]

I took a page out of the VIBE block editor by SAM Falvo to expand the command set of VI99.

It is I nice way to code this thing. I am really liking how this is going. 

 

I am reading a VI manual to add more features.

Searching should be fast since I can search the entire 8K buffer as one block.

 

Sam's VIBE editor used command strings that were created on the fly. He took the two digits of the ASCII character and appended them to a string.

The name of the strings created this way are Forth words in the program so that makes them easy to run.  

 

I simplified things because it is easier to see what VI key you are working on so I just append the ASCII letter to the end of the command string.

I was not a purist and use the case statement for non-printable key commands and put the command string handler in the default line for everything else.

 

So here are the VI99 key commands. The last letter is what you press in VI to make it do something.

\ Command mode KEY commands
\ Ideas from VIBE by Sam Falvo
\ Word name key:  $$ _ - _
\                    |   |
\ c = command mode --+   |
\ i = ins/repl mode      |
\                        |
\ ASCII code       ------+
\
\ Define formated command words
DECIMAL
: $$c-d \ delete line
  KEY [CHAR] d <> IF  EXIT THEN
  SAVECURS ELINE# DELETELN
  LIST  RESTCURS ;

: $$c-h \ Cleft
  VCOL @ 1-  0 MAX VCOL ! ;

: $$c-j  \ CUP
  VROW @ 1- 0 MAX
  DUP 0= IF -1 MOVESCR THEN VROW ! ;

: $$c-k  \ CDOWN
  VROW @ 1+ 21 MIN
  DUP 21 = IF 1 MOVESCR THEN VROW ! ;

: NEWLINE   $$c-k  VCOL OFF ;

: $$c-l  \ CRGHT
  VCOL @ 1+ [ C/L@ 1- ] LITERAL MIN
  VCOL ! ;

: $$c-$  C/L@ 1- VCOL ! ;
: $$c-0  VCOL OFF ;

: $$c-x \ delchar at cursor
  DELCHAR UPDATELN ;

: $$c-:
  SAVECURS
  PROMPT [CHAR] : EMIT
  PAD DUP C/L@ 2-  ACCEPT EVALUATE
  FILENAME ."FILE"
  RESTCURS LIST ;

: $$c-i INSERTING ON
        VCOL @ PUSHRIGHT EDIT-AT ;

: $$c-I INSERTING ON   0 EDIT-AT ;

: $$c-a INSERTING OFF \ append @ curs
        VCOL @ 1+ EDIT-AT ;

: $$c-A INSERTING OFF \ append line
        SCRLINE C/L@ V-TRAILING NIP
        EDIT-AT ;

: $$c-r  INSERTING OFF
  LINECURS GETKEY ;

 

The command interpreter then becomes this, where k is the ascii key parameter.

\ ===================
\ command interpreter
\ ===================
: HANDLER ( k -- )
  CMD!
  CMD$ FIND 0=
  IF  DROP BEEP EXIT
  THEN EXECUTE ;

 

The primary case statement is then simplified to:

\ ===[ VI Command Mode keys ]===
: COMMANDS ( char -- )
CASE
   \ control keys
  ^ F OF  1SCR MOVESCR        ENDOF
  ^ B OF  1SCR NEGATE MOVESCR ENDOF
  ^ D OF  1/2SCR MOVESCR      ENDOF
  ^ U OF  1/2SCR NEGATE MOVESCR ENDOF
  ^ L OF  LIST                ENDOF
  ^ Q OF  ABORT               ENDOF
^M OF   NEWLINE          ENDOF

\ otherwise interpret the key command
    DUP ( ascii ) HANDLER
ENDCASE ;

( Created ^ to make it easier to used control key values)

HEX
: ^ ( c -- ) \ compile ctrl char
  ?COMP  CHAR  1F AND
  POSTPONE LITERAL ; IMMEDIATE

 

[+TheBF]

The stuff people do with Forth still amazes me.

 

Over on Reddit an OP put up an alternative way to make CONSTANT and VARIABLE.

 

: CONSTANT ( x "name" -- ) >R : R> POSTPONE LITERAL POSTPONE ; ;

: VARIABLE ( "name" -- ) ALIGN HERE 0 , CONSTANT ;

 

It needs a few mods for FIG-Forth but I think it would work with  POSTPONE -> [COMPILE]   and   ALIGN  -> EVEN