Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

Gotta love that repeat key process. 

In my assy I placed a counter that clears if a key is pressed, and clear if no key,  then increase it if a key was pressed, and if that value is one value higher then I start my repeat and clear again if key not pressed kinda thing.. something like that...

It just works... but I don't feel it's needed in Foxit so I've disabled that function.. but in forth I think I was able to do the same thing.. but it's been awhile. I'm glad you got that one..

 

Share this post


Link to post
Share on other sites
7 minutes ago, GDMike said:

Gotta love that repeat key process. 

In my assy I placed a counter that clears if a key is pressed, and clear if no key,  then increase it if a key was pressed, and if that value is one value higher then I start my repeat and clear again if key not pressed kinda thing.. something like that...

It just works... but I don't feel it's needed in Foxit so I've disabled that function.. but in forth I think I was able to do the same thing.. but it's been awhile. I'm glad you got that one..

 

It's one of those things that actually codes easier in Assembler I think because you can weave in and out anywhere you need to.

Structured programming makes a bit challenging. That's where the double WHILE comes. It lets you jump out of the loop under two conditions.

I am starting to appreciate it more despite the fact that it looks confusing as hell. 

 

I resorted to keeping a repeat flag so I could understand things.  Not very Forthish but Classic99 doesn't flag it anymore. :) 

 

  • Like 1
  • Thanks 1

Share this post


Link to post
Share on other sites

Sometimes I think I should have stuck to music as my hobby :)

 

Replicating a VI style editor without resorting to SAMS memory has proven to be "interesting".

Keeping the linked list of strings intact from all attack angles is trickier than I thought it would be.

 

I still have a lot of bugs especially when editing past the 40 column screen. Listing 80 columns is better.

 

It's interesting because the VI commands are just Forth definitions so as the program progresses it begins to be written a bit in VI. 

:) 

 

I have made some progress but I have a ways to go. Strikeout shows what is not implemented.

Input commands (end with Esc)

  • a Append after cursor
  • i Insert before cursor
  • o Open line below
  • O Open line above
  • :r file Insert file after current line

 

Cursor motions

  • H Upper left corner (home)
  • M Middle line
  • L Lower left corner
  • h Back a character
  • j Down a line
  • k Up a line
  • ^ Beginning of line
  • $ End of line
  • l Forward a character
  • w One word forward
  • b Back one word
  • fc Find c
  • ; Repeat find (find next c)
     

File management commands

  • :w name   Write edit buffer to file name
  • :wq Write to file and quit
  • :q! Quit without saving changes
  • ZZ Same as :wq
  • :sh Execute shell commands ( execute any Forth word  with ':<word>' ) 

 

Changes during insert mode

  • <ctrl>h Back one character
  • <ctrl>w Back one word
  • <ctrl>u Back to beginning of insert

Window motions

  • <ctrl>d Scroll down (half a screen)
  • <ctrl>u Scroll up (half a screen)
  • <ctrl>f Page forward
  • <ctrl>b Page backward
  • /string Search forward
  • ?string Search backward
  • <ctrl>l Redraw screen
  • <ctrl>g Display current line number and file information
  • n Repeat search
  • N Repeat search reverse
  • G Go to last line
  • nG Go to line n
  • :n Go to line n
  • z<CR> Reposition window: cursor at top
  • z. Reposition window: cursor in middle
  • z- Reposition window: cursor at bottom

 

 

Spoiler
\ VI99.FTH  Nov 28 2021  Brian FOX
CR .( VI99  A VI style editor for 40 column screen )

\ this version leverages the Forth interpreter for VI commands.

\ General buffer is in low RAM.
\ Data is stored as counted strings that are accessed as a single linked list.
\ Temp Buffer in VDP RAM for multiple chunks of General buffer data.

NEEDS MARKER    FROM DSK1.MARKER
NEEDS .S        FROM DSK1.LOWTOOLS

HERE
: TASK ;

\ HEX
: NEXTLN  ( addr -- addr')  COUNT + ALIGNED ;
\ CODE NEXTLN ( Caddr -- Caddr') \ optimized
\             *TOS R1 MOVB,  \ read count byte
\              R1   8 SRL,
\                R1 INC,   \ 1+
\            R1 TOS ADD,   \ add to Caddr
\               TOS INC,   \ Align to even address
\          TOS FFFE ANDI,
\                   NEXT,
\ ENDCODE


\ 10x faster than do/loop
CODE FILLW   ( addr cnt n -- ) \ n is written into sequential cells
             R0 POP,           \ cnt->R0
             R0 DECT,
             R1 POP,           \ addr->R1
             BEGIN,
                TOS R1 *+ MOV, \ 2 chars are in TOS register
                R0 DECT,       \ decr. count
             NC UNTIL,         \ loop until R0 < 0
             TOS POP,          \ refill the TOS register
             NEXT,
             ENDCODE

\ CODE SOL+ ( addr len -- addr' len )
\          SOL @@ *SP ADD,
\          NEXT,
\ ENDCODE

REMOVE-TOOLS

NEEDS ELAPSE    FROM DSK1.ELAPSE
NEEDS CASE      FROM DSK1.CASE
NEEDS READ-LINE FROM DSK1.ANSFILES
NEEDS TO        FROM DSK1.VALUES
NEEDS RKEY      FROM DSK1.RKEY
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS RESERVE   FROM DSK2.VIMEMORY
NEEDS FORTH     FROM DSK1.WORDLISTS

VOCABULARY EDITOR
\ \\\\\\\\\\\\\\\\\\\\\\\ D A T A \\\\\\\\\\\\\\\\\\\\\\\\\\
ONLY FORTH ALSO EDITOR DEFINITIONS
DECIMAL
80     CONSTANT #80
#80 1- CONSTANT WIDTH   \ 0..79 chars is one line
23     CONSTANT L/PAGE
80     CONSTANT EC/L

C/L @ 1- CONSTANT SCR-WIDTH

HEX
2000  CONSTANT BUFFER    \ This is the 'GENERAL BUFFER".
2000  CONSTANT MEMSIZE   \ use all of low RAM

31    CONSTANT GRN/BLK
17    CONSTANT BLK/CYN
017E  CONSTANT "~"       \ data for a counted string. Len=1

\ \\\ CURSOR SHAPES \\\\
\ Camel99 uses a two-byte cursor that is byte-swapped to display on/off
201E  CONSTANT BAR
201F  CONSTANT SQUARE
205F  CONSTANT ULINE

\ TI-99 key values
02    CONSTANT <PGDN>    \ pg down key
08    CONSTANT <BS>      \ function S
09    CONSTANT <RIGHT>   \ function D
0A    CONSTANT <DOWN>    \ function X
0B    CONSTANT <UP>      \ function W
0C    CONSTANT <PGUP>    \ page up key
0D    CONSTANT <CR>      \ enter
0F    CONSTANT <ESC>     \ function 9

VARIABLE TOPLINE        \ topline that is displayed by LISTPAGE
VARIABLE EMODE          \ command or inserting
VARIABLE #LINES         \ NO. lines loaded by READ-FILE
VARIABLE LINE#          \ the file line that has the cursor on it
VARIABLE SOL     \ "start of line" on screen display (for 40 col support)
VARIABLE #BYTES  \ holds number bytes in BUFFER


\ editor screen coordinates kept as double variable
CREATE COL/ROW  0 , 0 ,
COL/ROW CELL+ CONSTANT COL  \ Access col or row as separate variables
COL/ROW       CONSTANT ROW
0 VALUE LINE$  \ holds address of ROW's counted string
0 VALUE HNDL
HEX
\ utility words
DECIMAL
: CURSOR  ( n -- )  CURS ! ;
: ERASE ( addr len -- )  0 FILL ;
: BLANK ( addr len -- )  BL FILL ;
: CLR-MEM   ( addr len -- ) OVER H !  ERASE ;
: >=     1- > ;
: DECR  ( var -- ) DUP 1-! DUP @  0 MAX SWAP ! ; \ decrement. don't go below 0
: BETWEEN ( c lo hi -- ? ) 1+ WITHIN ;
: CLIP    ( n lo hi -- n') ROT MIN MAX ;
: TAB     ( n -- )  0  C/[email protected] 1- CLIP  VCOL ! ;

: ASCII?   ( c -- ?) BL  [CHAR] ~ BETWEEN ;
: LOWER?   ( c -- ?) [CHAR] a [CHAR] z BETWEEN ;

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

: CTRL     ( char -- ^char) \ convert ASCII to TI-99 control character
        ?COMP  CHAR  [CHAR] @ - 80 OR  POSTPONE LITERAL ; IMMEDIATE

DECIMAL
: UCASE  ( Caddr len -- Caddr len )
     2DUP BOUNDS ?DO   I [email protected] TOUPPER  I C!   LOOP ;

\ \\\\\\\\\\\\\\\\\\\\ file stuff \\\\\\\\\\\\\\\\\\\\\
HEX
: NEW-VI
     BUFFER DUP H ! 0120 OVER !  \ line 0 contains nil
     NEXTLN MEMSIZE "~" FILLW    \ data starts at line 1
     #LINES OFF  #BYTES OFF
     SOL OFF
     1 LINE# !
     0 TOPLINE !
;

DECIMAL
CREATE FNAME   20 ALLOT

\ READ  text file into HEAP as counted strings
: READF ( $add len -- )
        DV80 R/O OPEN-FILE ?FILERR TO HNDL
        BUFFER CELL+ H !
        BEGIN
           HNDL EOF 0=
        WHILE
           #LINES 1+!
           PAD DUP #80 HNDL READ-LINE  ?FILERR DROP
           HEAP$,
        REPEAT
        HNDL CLOSE-FILE ?FILERR ;

: READ-FILE  ( $addr len -- ) NEW-VI READF ;

DECIMAL
: NTH       ( Caddr n -- addr)  0 ?DO  NEXTLN  LOOP ;

: SEEK2LINE ( line# -- Caddr) BUFFER SWAP NTH ;

: MORE?   1+ [email protected] [CHAR] ~ <> ;

: SEEK2END  ( Start-Caddr -- Caddr)
      BEGIN
        DUP MORE?
      WHILE
        NEXTLN
      REPEAT
      2- ;

: WRITE-FILE ( addr len -- )
        DV80 W/O OPEN-FILE ?FILERR TO HNDL
        BUFFER
        BEGIN
          NEXTLN DUP MORE?
        WHILE
           DUP COUNT -TRAILING  1 MAX  HNDL WRITE-LINE ?FILERR
        REPEAT
        DROP
        HNDL CLOSE-FILE ?FILERR ;

DECIMAL
: HOME     ( -- ) 0 0 2DUP COL/ROW 2!  AT-XY  ;
: BLANKLN  ( -- ) VPOS C/[email protected] BL VFILL ;
: PROMPT   ( -- ) 0 23 AT-XY  BLANKLN ;

: VTYPE ( adr len  ) TUCK VPOS SWAP VWRITE  VCOL +! ; \ Fast type

: PRINTLN ( $addr -- ) \ print fast. do not alter VCOL
  COUNT SOL @ /STRING  1 39 CLIP  VPOS SWAP VWRITE ;

: LISTPAGE ( -- ) \ for showing file lines in cmd mode.
       0 0 AT-XY
       BUFFER NEXTLN TOPLINE @ NTH
       L/PAGE 0
       DO
          BLANKLN
          DUP PRINTLN CR
          NEXTLN
       LOOP
       DROP
;

\ temporary buffer in VDP RAM
: BUFFER2VDP ( $addr -- )
      DUP SEEK2END 2+  ( -- start end )
      OVER -          ( -- start len )
      DUP RESERVE     ( -- start len Vaddr )
      SWAP VWRITE     ( -- )
;

: VDP2BUFFER ( $addr -- ) VBLOCK ( Vaddr len )>R SWAP R> VREAD VFREE ;

\ : ?MEMORY   ( -- )  EOD @ [ HEX ] 3FFF > ABORT" MEM FULL" ;

: MOVE    ( src dst n -- ) \ Forth 94 word works reliably for this stuff
      >R  2DUP SWAP DUP [email protected] +  \ -- src dst dst src src+n
      WITHIN
      IF    R> CMOVE>         \ src <= dst < src+n
      ELSE  R> CMOVE
      THEN ;

HEX
: YANK ( n row#  --)
        SEEK2LINE DUP [email protected] >R  \ save length we will yank
        DUP ROT NTH  TUCK    ( -- src dest src )
        DUP SEEK2END DUP>R   \ save end of general buffer data
        SWAP - CELL+ MOVE   \ slide buffer upwards
        2R>  ( -- len buffend ) \ get saved values
        -    ( -- lastline )  \ compute
        WIDTH "~" FILLW      \ erase whole line at end of buffer
        #LINES DECR
;

\ temp pointers to stop my brain from overloading
0 VALUE $(1)
0 VALUE $(2)
0 VALUE DEST$

: GET2  ( line# -- ) SEEK2LINE DUP TO $(1)  NEXTLN TO $(2) ;

: BYTES2END ( line$ --  bytes) DUP SEEK2END 2+ SWAP - ;

: REPLACE$ ( Caddr len line#1 -- )
        OVER >R    \ keep the length
        GET2
        $(1) OVER + 1+ ALIGNED TO DEST$
        $(2)  DEST$  $(2) BYTES2END R> + MOVE
        ( addr len) $(1) PLACE ;

\ \\\\\\\\\\\\\\\\\\\\\ SCREEN CONTROL \\\\\\\\\\\\\\\\\\\\\\\\\
DECIMAL
: PUTCURS ( -- )   COL/ROW [email protected]  AT-XY  ;
: SCREEN  ( c -- ) 7 VWTR ;
: '"'     ( -- )   [CHAR] " EMIT ;
: BYTES   ( -- n ) HEAP BUFFER -  #LINES @ - ;

\ \\\\\\\\\\\\\\\\\\\\\\ CURSOR CONTROL \\\\\\\\\\\\\\\\\\\\\\\\\\
\
: 'CURS     ( -- n )    COL @  SOL @  + ;  \ need both for 40 cols.
\ cursor control with protections
: SOL+!     ( n -- )
      SOL @ +      0  C/[email protected] CLIP  SOL !
      SOL @ 0 <> IF LISTPAGE THEN  ;

: COL+!    ( n -- ) COL @ +  0 SCR-WIDTH CLIP  COL ! ;


\ \\\\\\\\\\\\\\\\\\\\ FORMATTED NUMBERS \\\\\\\\\\\\\\\\\\\\\\\\\
: .###    ( n -- ) 0 <#  # # #  #> VTYPE ;   \ print 3 digits unsigned
: .####   ( n -- ) 0 <#  # # # #  #> VTYPE ; \ print 4 digits unsigned

DECIMAL
: .FNAME    FNAME COUNT '"'  VTYPE '"' SPACE ;
: .LINES    #LINES @ .### ." L, " ;
: .BYTES    BYTES    .#### ." C written" ;
: .LINE#S  LINE# @ .### ." /" #LINES @ .###  ;

: .STATS
   PROMPT 'CURS . ."  |"  DEPTH .  8 TAB .FNAME    24 TAB .LINE#S ;

: ?STRING  ( addr len -- addr len ) DUP 0= ABORT" string expected" ;
: ?PATH    ( addr len -- )
          2DUP [CHAR] . SCAN NIP 0=   \ test for '.'
          ABORT" File path expected" ;

: GET-PATH ( <dsk1.name> ) PARSE-NAME ?STRING UCASE ?PATH   ;

: TOPLINE+!  ( n -- )  TOPLINE @ +  0  #LINES @ CLIP  TOPLINE ! ;
: LINE#+!    ( n -- )  LINE# @ +    1  #LINES @ CLIP  LINE# ! ;

: TOP?    ( -- ?) LINE# @ 1 = ;
: BOT?    ( -- ?) LINE# @  #LINES @ >= ;

\ fast escape from am IF statement
: END;    POSTPONE EXIT POSTPONE THEN ;  IMMEDIATE

: PGUP  ( -- )
      TOP? IF BEEP END;
      L/PAGE NEGATE DUP  TOPLINE+!  LINE#+!
      LISTPAGE HOME  ;

: PGDN  ( -- )
     BOT? IF BEEP  END;
     L/PAGE DUP  TOPLINE+!  LINE#+!
     LISTPAGE HOME   ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ vi COMMANDS
: h   \ cursor left
        COL DECR
        COL @ 0=     \ ie: in second 1/2 of line
        IF  -1 SOL+! THEN  ;

: l    \ cursor right
        COL @ SCR-WIDTH >=
        IF   1 SOL+!
        ELSE 1 COL+!
        THEN  ;

: j     \ *cursdown*
        BOT? IF  BEEP  END;
        1 LINE#+!
        ROW @ 22 >=
        IF    1 TOPLINE+!
              LISTPAGE
        ELSE
              ROW DUP @ 1+
              23 MIN SWAP !
        THEN  ;

: k    \ *cursup*
        TOP? IF BEEP END;
        LINE# DECR
        ROW @ 0=
        IF  TOPLINE DECR  LISTPAGE
        ELSE ROW DECR
        THEN  ;

: q        CR ." Forth"  ABORT ;
: q!       q ;

: w         GET-PATH FNAME PLACE
            FNAME COUNT WRITE-FILE
            PROMPT .FNAME .LINES .BYTES
            1000 MS  PUTCURS ;

: wq        w q ;
: $         #LINES @ L/PAGE - TOPLINE ! LISTPAGE ;

: y         KEY [CHAR] y = IF  1 LINE# @ YANK  THEN ;

: ENTER     COL OFF  SOL OFF  j ; \ go to next line

: CMDLINE  ( -- addr len) PROMPT ." :" TIB DUP 32 ACCEPT EVALUATE ;

\ : G         CMDLINE  SEEK2LINE LINE# ! LISTPAGE

: H         TOPLINE @ LINE# !   HOME  ;
: L         TOPLINE @ 22 + DUP LINE# !  0 22 COL/ROW 2! PUTCURS ;

: r         LINE# @ SEEK2LINE DUP ( $addr )
            BUFFER2VDP DUP H !    \ set heap pointer to line# location
            GET-PATH READF  \ read new file in the buffer
            SEEK2END ( $addr) VDP2BUFFER ;

: ^   ( -- )  COL OFF SOL OFF  LISTPAGE  ;

: $   ( -- )  LINE# @ SEEK2LINE COUNT -TRAILING  NIP 1- COL !
              COL @  39 > IF  39 SOL !  THEN  ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ INSERT mode

\ Editor Method:
\ Read the screen into an 80 byte buffer (PAD)
\ Editing takes place in the PAD buffer
\ On <ENTER> open enough space for the new text in the BUFFER
\ and write the PAD into general buffer

DECIMAL
: PUTCHAR   ( c -- )
     DUP EMIT               \ show c & move screen cursor
     PAD 1+  'CURS + C!     \ PAD+1 is the start of text
     PAD 1+ #80 -TRAILING NIP  \ scan for length of text in buffer
     PAD C!                 \ update count byte
     l                      \ move editor cursor
;

: LINE2PAD  ( -- )        \ use Forth PAD memory as line buffer
    PAD  84 BLANK           \ fill buffer with spaces
    LINE# @ SEEK2LINE COUNT PAD PLACE ; \ place file string in PAD

: RELINE ( -- )  SOL @ IF LISTPAGE THEN  0 ROW @ AT-XY PAD PRINTLN ;

: INS-ENTER
    PAD COUNT LINE# @ REPLACE$ \ put PAD contents into file buffer
    ENTER                      \ cursor down
    LINE2PAD              \ read new line into PAD
    PAD @ "~" =                \ if the line is empty
    IF  BL 1 FUSE PAD !        \ make PAD empty line
        #LINES 1+!             \ count the new line
    THEN ;

: IMODE ( -- )
    EMODE ON   SQUARE CURSOR
    PROMPT ." --INSERT--"  24 TAB .LINE#S ;

: i ( -- )
       IMODE
       LINE2PAD
       BEGIN
          RELINE PUTCURS
          RKEY
          CASE
                <BS> OF   h                         ENDOF
             <RIGHT> OF   l                         ENDOF
               <CR>  OF   INS-ENTER                 ENDOF
              <ESC>  OF   EXIT                      ENDOF
                    DUP  BL 126 CLIP PUTCHAR \ default, edit the character
           ENDCASE
      AGAIN
;

: CTRLKEY ( ^c -- )
    CASE ( Some keys are TI-99 conventions )
          <BS> OF h                  ENDOF
       <RIGHT> OF l                  ENDOF
        <DOWN> OF j                  ENDOF
          <UP> OF k                  ENDOF
        <PGUP> OF  PGUP              ENDOF
        <PGDN> OF  PGDN              ENDOF
         <CR>  OF  ENTER             ENDOF
        CTRL B OF PGUP               ENDOF
        CTRL F OF PGDN               ENDOF
        CTRL G OF .STATS  KEY DROP   ENDOF
        CTRL L OF LISTPAGE           ENDOF
    ENDCASE
;

CREATE CMD$ 1 C, 0 C,  \ make a 1 byte string

: COMMANDER ( c -- )
       DUP    BL <    IF CTRLKEY      END; \ special case 1
       DUP [CHAR] : = IF DROP CMDLINE END; \ special case 2

       DUP ASCII?
       IF
          1 FUSE CMD$ !   \ combine (FUSE) the char with 1 to make a CMD$
          CMD$ FIND       \ look up the command in WORDLIST
          IF  EXECUTE     \ do it
          ELSE HONK       \ or honk
          THEN
       ELSE
          HONK
       THEN
;

: CMODE ( -- )
      EMODE OFF
      ULINE CURSOR
      PROMPT .FNAME  24 TAB .LINE#S ;


\ \\\\\\\\\\\\\\\ user commands \\\\\\\\\\\\\

: EDIT
      PAGE
      HOME
      GRN/BLK SCREEN
      LISTPAGE
      BEGIN
        CMODE
        PUTCURS
        RKEY COMMANDER
      AGAIN ;

: e  ( new file)  NEW-VI  EDIT ;

: vi
    GET-PATH 2DUP FNAME PLACE  \ new file stored in FNAME
    READ-FILE
    1 LINE# !
    LINE# @ SEEK2LINE
    EDIT                       \ continue with same file
;

\ upper case aliases
: VI    vi ;
: E     e  ;

CR HERE SWAP - DECIMAL .  .( BYTES)

 

 

  • Like 4

Share this post


Link to post
Share on other sites

My eyes were starting to cross working on the editor so I looked around the site and saw Mark Will's game of life in the post about John Conway's passing.

I took a look at the Assembler code and thought this might be a good test of my linker.

I made a few simple changes:

  1. Removed large amount of text to make sure it was less than 8K as a binary image
  2. Moved the Workspace to high end of LOW RAM to keep GPL workspace un-touched
  3. Remove the AORG directive so it would be relocatable 

The video shows what happened. It works but there are some artifacts on the screen that means I have something wrong still.

The linker is naturally much slower at reading the object code than an ALC version would be, about 9 times!. I am just happy that it loaded. :)

So finding the cause of the artifacts and looking at some optimization in the text interpretation are two goals.

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Reviewing the linker code showed me that I was being especially careful in how I was coding, probably because I barely understood what I had to accomplish in the beginning.  :

This meant there were a number of sub-optimal things I have changed.

I also found out that reading the the object file is only one second of the time used.

So processing the object data is the biggest slowdown.  I suspect it is that enormous case statement.

 

I got a significant speedup by putting the most common object code tags earlier in the case statement. 

This version in the spoiler is about 19% faster so 21.5 seconds for the scaled back LIFE code by Mark. (versus 26.2 before) 

I suspect a jump-table replacing the case statement would make a big difference.

My experimenting with jump tables verse CASE/ENDCASE gave me about a 2X improvement.

 

I am wondering if I could parse character by character faster with SCAN. That might be worth a try as well.

The 3 second load time of the E/A linker/loader will be very hard match. 

 

Spoiler
CR .( EA3 object file LINKER, Aug 10 2021 Fox)
\ Dec 2021 improved linking speed by 19%

NEEDS WORDLIST FROM DSK1.WORDLISTS
ONLY FORTH DEFINITIONS

\ NEEDS .S        FROM DSK1.TOOLS
NEEDS +TO       FROM DSK1.VALUES
NEEDS CASE      FROM DSK1.CASE
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS ELAPSE    FROM DSK1.ELAPSE
NEEDS 3RD       FROM DSK1.3RD4TH
NEEDS MARKER    FROM DSK1.MARKER

HERE
VOCABULARY DEFS

MARKER /LINKER  \ remove LINKER

ONLY FORTH DEFINITIONS
DECIMAL
0 VALUE #1  \ a file handle

HEX
 2000 CONSTANT $2000
$2000 VALUE BASE-MEM  \ where we load OBJECT files

: ?BREAK  ( -- ) ?TERMINAL ABORT" *BREAK*" ;
: SPACEBAR ( -- ) KEY? BL = IF  KEY DROP  THEN ;

\ add words so we don't need to include tools
HEX
: .ID     ( NFAaddr --) COUNT 1F AND TYPE ;
DECIMAL
.( ..)
: WORDS   ( -- )
           0 >R  ( word counter on Rstack)
           CONTEXT @ DUP CR .WID CR
           @
           BEGIN DUP
           WHILE
              ?BREAK  SPACEBAR
              DUP ( -- nfa) .ID SPACE
              R> 1+ >R
              NFA>LFA @
           REPEAT
           DROP
           CR R>
           BASE @ >R
           DECIMAL . SPACE ." words"
           R> BASE ! ;

\ heap memory management
: HEAP   ( -- addr) H @ ;  \ current heap pointer
: HALLOT ( n -- )  H +! ;  \ move heap pointer
: HEAP,  ( n -- )  HEAP ! 2 HALLOT ; \ compile n into heap

HEX
: NEW.
          $2000 H !
          HEAP $2000 FF FILL  \ erase low ram
          HEAP TO BASE-MEM
          ['] DEFS  >BODY OFF  ;  \ remove all DEFS words

\ string utilities
: CHOP   ( addr len n --  addr' len' addr2 len2 )
      S" 3RD OVER 2>R  1- /STRING  2R>"  EVALUATE ; IMMEDIATE

: /TAG     ( addr len -- addr' len') \ cut tag character
      S" 1 /STRING" EVALUATE  ;  IMMEDIATE

: ?#ERROR    ABORT" Bad number" ;

: PARSE# ( addr len -- n )
        /TAG  4 CHOP NUMBER? ?#ERROR ;

: GETLABEL  ( addr len -- addr' len' label len)
        /TAG  6 CHOP  -TRAILING ;

: DODEF ( addr len n -- )
        >R         ( -- addr' len') ( r: -- ref_addr)
        GETLABEL ( addr' len'  label len)
        HEADER,  COMPILE DOCON  R> ,  \ make a Forth Constant
;

VARIABLE PROGLENGTH
CREATE PROGNAME  10 ALLOT

: PROG-ID  ( addr len -- addr len)
          PARSE# PROGLENGTH !
          8 CHOP  PROGNAME PLACE ;

: .TOOLVER  ( addr len -- addr 0)
          /TAG  40 CHOP -TRAILING CR TYPE  DROP 0 ;

: ?TAG    CR ." Unknown TAG -> "  EMIT ABORT ;

: RELOCATE ( addr -- addr')  BASE-MEM + ;

\ See E/A manual page 309 for meanings of object file tags.
: ParseObject ( add len -- )
      BEGIN
        DUP ( len<>0)
      WHILE
        OVER [email protected] ( tag)
        CASE
          [CHAR] 0 OF  PROG-ID              ENDOF

          [CHAR] 3 OF  PARSE# RELOCATE ( ref)
                       GETLABEL EVALUATE ( ref def)
                       SWAP ( def ref) !    ENDOF

          [CHAR] 4 OF  PARSE# ( ref)
                       GETLABEL EVALUATE ( ref def)
                       SWAP  ( def ref) !   ENDOF

         [CHAR] 5 OF  PARSE# RELOCATE DODEF ENDOF
         [CHAR] 6 OF  PARSE# DODEF          ENDOF
         [CHAR] A OF  PARSE# RELOCATE H !   ENDOF
         [CHAR] C OF  PARSE# RELOCATE HEAP, ENDOF

          [CHAR] 9 OF  PARSE# H !           ENDOF
          [CHAR] B OF  PARSE# HEAP,         ENDOF
          [CHAR] F OF  DROP 0               ENDOF \ end of record
          [CHAR] : OF  .TOOLVER             ENDOF

          [CHAR] D OF  [CHAR] D ?TAG        ENDOF
          [CHAR] E OF  [CHAR] E ?TAG        ENDOF
          [CHAR] 1 OF  [CHAR] 1 ?TAG        ENDOF
          [CHAR] 2 OF  [CHAR] 2 ?TAG        ENDOF
          [CHAR] 7 OF  4 /STRING            ENDOF
          [CHAR] 8 OF  4 /STRING            ENDOF

        ENDCASE
        1 /STRING 0 MAX  \ advance to next char
     REPEAT
     2DROP ;


DECIMAL
: EA3LOAD ( caddr len -- )
           CR ." Linking " 2DUP TYPE
           SOURCE-ID @ >IN @ 2>R           \ save source-ID, input pointer
           PSZ NEGATE ^PAB +!              \ make new PAB, on pab stack
           ( $ len ) 80 04 FOPEN ?FILERR   \ OPEN as DISPLAY FIXED 80 INPUT
           SOURCE-ID 1+!                   \ incr. source ID (1st file is 1)
           LINES OFF                       \ reset the line counter
           BEGIN
             2 FILEOP 0=                   \ file read operation
           WHILE
             HERE 200 + DUP FGET ( addr n) \ read line to temp mem buffer
             ParseObject                   \ interpret line of object code
             LINES 1+!                     \ count the line
           REPEAT
           PSZ ^PAB +!                     \ remove PAB from pab stack
           2R> >IN !  SOURCE-ID !          \ restore >IN, SOURCE-ID
;

: ?PATH ( addr len -- addr len)
       2DUP [CHAR] . SCAN NIP 0= ABORT" Path expected" ;

: LINK ( <PATH> )
       TICKER OFF
       BASE @ >R
       HEX
       ONLY FORTH ALSO DEFS DEFINITIONS
       PARSE-NAME ?PATH EA3LOAD
       R> BASE !

       HEAP TO BASE-MEM
       CR DEFS WORDS
       .ELAPSED ;

\ Linkage to Forth
HEX
CODE RUN  ( def --)  0454 ,  C136 , NEXT, ENDCODE  \ B  *TOS    DROP
CODE CALL ( def --)  0694 ,  C136 , NEXT, ENDCODE  \ BL *TOS    DROP
CODE BLWP ( def --)  0414 ,  C136 , NEXT, ENDCODE  \ BLWP *TOS  DROP

: EXTERN:   ( def --)  CODE  0460 , ( addr) ,  NEXT,  ;   \ B @def
: EXT-SUB:  ( def --)  CODE  06A0 , ( addr)  ,  NEXT,  ;  \ BL @def
: EXT-PROG: ( def --)  CODE  0420 , ( vector) ,  NEXT,  ; \ BLWP @def

ONLY FORTH DEFINITIONS ALSO DEFS

PAGE .( Camel99 Linker  Dec 2021)
CR
CR .( Usage: )
CR .( NEW.  clear low ram for code)
CR .( LINK DSK?.FILENAME   load object)
CR .( Commands:)
CR .( <def> RUN     branch to def)
CR .( <def> CALL    BL to def)
CR .( <def> BLWP    blwp to def)
CR
CR .( Declare DEFs as Forth code: )
CR .( <def> EXTERN: <name>  branches to DEF)
CR .( <def> EXT-SUB: <name> BL to DEF)
CR .( <def> EXT-PROG: <name> BLWP to DEF)
CR .( <def> EXT-DATA: <name> def ->Forth constant)
CR
NEW.
CR .( Low RAM initialized)
CR HERE SWAP - DECIMAL . .( bytes)

 

 

 

  • Like 3

Share this post


Link to post
Share on other sites

Here is a neat little compiler extension I just made to optimize some code. 

 

It always bugged me that to mask a number in Forth we had to run a literal number or a constant and the AND word like:

( n ) 7 AND 

That takes an extra pass through the Forth inner interpreter for the literal number, when the 9900 has two very nice ways to do masking in a single instruction.

 

So how about this?

The trick here is that we INVERT the mask value at compile time, so we don't have to do it at run time. ;)

I think this needs one extra MOV on the Forth systems that keep TOS in memory. (?) But it is still going to be faster than using AND and a literal number. 

HEX
: MASK:  CREATE INVERT ,  
        ;CODE 4118 ,  ( *W TOS SZC,) 
              NEXT, 
        ENDCODE

7 MASK: 7AND
2 MASK: 2AND

By extending the compiler we can create "MASK" directives. With those we can do a MASK in one instruction in Forth.

 

I can imagine some other applications of this idea where you need words to do other operations with a constant or literal parameter.

I did it before come to think of it with +CONSTANT that creates words that adds themselves to the top of stack.

 

 : +CONSTANT    CREATE   ,  
               ;CODE 
                   *W TOS ADD, 
                   NEXT, 
                ENDCODE

 

  • Like 2
  • Thanks 1

Share this post


Link to post
Share on other sites
3 hours ago, TheBF said:

Here is a neat little compiler extension I just made to optimize some code.

 

Aw, man—|:) now I gotta do that for fbForth:

HEX
: MASK:  <BUILDS 
            FFFF XOR ,  
         DOES>CODE: 
            465A ,  ( *W *SP SZC,) 
         ;CODE

7 MASK: 7AND
2 MASK: 2AND

...lee

  • Like 2
  • Haha 1

Share this post


Link to post
Share on other sites
10 hours ago, TheBF said:

Here is a neat little compiler extension I just made to optimize some code. 

 

It always bugged me that to mask a number in Forth we had to run a literal number or a constant and the AND word like:

( n ) 7 AND 

That takes an extra pass through the Forth inner interpreter for the literal number, when the 9900 has two very nice ways to do masking in a single instruction.

 

So how about this?

The trick here is that we INVERT the mask value at compile time, so we don't have to do it at run time. ;)

I think this needs one extra MOV on the Forth systems that keep TOS in memory. (?) But it is still going to be faster than using AND and a literal number. 

HEX
: MASK:  CREATE INVERT ,  
        ;CODE 4118 ,  ( *W TOS SZC,) 
              NEXT, 
        ENDCODE

7 MASK: 7AND
2 MASK: 2AND

By extending the compiler we can create "MASK" directives. With those we can do a MASK in one instruction in Forth.

 

I can imagine some other applications of this idea where you need words to do other operations with a constant or literal parameter.

I did it before come to think of it with +CONSTANT that creates words that adds themselves to the top of stack.

 

 : +CONSTANT    CREATE   ,  
               ;CODE 
                   *W TOS ADD, 
                   NEXT, 
                ENDCODE

 

Thx so much for this. I just love these code snippets with a function AND explanation.

Edited by GDMike
  • Like 2

Share this post


Link to post
Share on other sites

Inline Code Simplified

 

I tried this kind of thing a few years ago but it seemed overly complicated.

I think this code is better and it is smaller.  I also think it is easily applicable to other indirect threaded Forth systems.

The big surprise to me was the new way I return to Forth.  See  ;CODE]  

 

It adds only 54 bytes to the system and you could use machine code between  [CODE     ;CODE]   

The total overhead for inserting CODE is  4 byte header + 6 byte return= 10 bytes which is about the same size as adding a short word header so not much saving, but sometimes it is clearer to see short code snippets inline.

\ INLINEASM.FTH headless code words inside Forth definition   DEC 30 2021 FOX
\ example below for usage

NEEDS .S     FROM DSK1.TOOLS
NEEDS MOV,   FROM DSK1.ASM9900

HERE
HEX
: [CODE ( -- )
          HERE CELL+ ,
          HERE CELL+ ,      \ create the ITC header for a CODE word
          POSTPONE [        \ turn off the Forth compiler
; IMMEDIATE

: ;CODE] ( -- )
          IP HERE 6 + LI,    \ (points to Forth after NEXT,)
          NEXT,              \ compile next into headless code word
          ]                  \ turn on the Forth compiler
;   IMMEDIATE

HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR

 

 

 

\ example
VARIABLE X    2 X !
VARIABLE Y    3 Y !

: TEST  ( -- )  [CODE  Y @@ X @@ ADD,  ;CODE]   X @ .   ;

 

  • Like 1

Share this post


Link to post
Share on other sites

From Rosetta code: "Reverse words in a string"

 

Every now and then you see some code that makes you go huh!  I would NEVER have thought of that.

 

I made some edits to the explanation and changed the code to upper case for Camel Forth and also put the CR before (REVERSE) 

The video shows the operation. 

\ From rosetta code
\ The word "parse-name" consumes a word from input stream and places it on the
\ stack as a two element stack string. (addr,len)
\ The word "type" consumes a stack string and prints it.
\ Calling these two words before and after the recursive call effectively
\ reverses a string.

: NOT-EMPTY?  DUP 0 > ;
: (REVERSE)   PARSE-NAME NOT-EMPTY? IF RECURSE THEN TYPE SPACE ;
: REVERSE    CR (REVERSE) ;

REVERSE ---------- Ice and Fire ------------
REVERSE
REVERSE fire, in end will world the say Some
REVERSE ice. in say Some
REVERSE desire of tasted I've what From
REVERSE fire. favor who those with hold I
REVERSE
REVERSE ... elided paragraph last ...
REVERSE
REVERSE Frost Robert -----------------------
CR 

 

  • Like 2

Share this post


Link to post
Share on other sites
On 12/30/2021 at 1:35 PM, TheBF said:

 

: [CODE ( -- DP xt)          \ Returns address where code has been copied
          HERE CELL+ ,
          HERE CELL+ ,      \ create the ITC header for a CODE word
          POSTPONE [        \ turn off the Forth compiler
; IMMEDIATE

 

 

OK...This does not compute. I do not see where [CODE leaves anything on the stack.  [EDIT: Corrected. See original post, 2 posts back.]

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

LOL. You caught me in the dreaded copy and paste error.

I started with code from my inliner and modified it but didn't correct the comment.

I will correct the post. :) 

 

Share this post


Link to post
Share on other sites

After making the MASK: directive I wondered if there were other places where I could apply this ability to mix Forth data and Assembly language actions.

 

I realized that all the tables in VDP RAM could be a good use since they are base address with offsets. 

So I re-worked my sprite attribute table with with this:

HEX
: TABLE4: ( Vaddr -- )  \ create a table of 4 byte records
         CREATE    ,             \ compile base address into this word
        ;CODE ( n -- Vaddr')     \ RUN time
             0A24 ,  \ TOS 2 SLA,  ( tos = n x 4 )
             A118 ,  \ *W TOS ADD,
             NEXT,
ENDCODE
300    CONSTANT SAT      \ sprite attribute table VDP RAM base address

SAT     TABLE4: SP.Y
SAT 1+  TABLE4: SP.X
SAT 2+  TABLE4: SP.PAT
SAT 3 + TABLE4: SP.COLR

We can give each field in the table a different base address and it makes each sprite parameter look like a 1 dimensional array. :) 

 

So the Motion table becomes:

0780 TABLE4: ]SMT       \ SPRITE motion table as VDP array

The neat thing about a TABLE4:  is you can use it on CPU RAM as well since it just computes offsets. It doesn't care where the base address is.

 

For pattern tables I needed TABLE8:  for 8 byte records 

and for colors I needed a TABLE of 1 byte records which I just call a TABLE: 

It seems like a good solution to VDP memory access. 

 

This making me wonder if the "name" table as TI calls is should also be accessed this way. 

  • Like 2

Share this post


Link to post
Share on other sites

I finally got a bit more disciplined about how to build this system. I created a "make" file that is not a "make" file but just a little Forth file.

This makes it easier to see the what's going on in terms of what is being built.  There are other include files inside the primary files but this seems a bit easier to manage when I want to make different flavours of this system.

 

While doing this I was forced to fix a bug that had prevented me from build a SuperCart version on these sources.

Got that one fixed but still not sure how it is happening inside the cross-compiler. 

Here is FORTHITC.MAK.   As you can see there are some compiler switches. Hashing the dictionary is not yet implemented but its in the roadmap.

I am just going to test these new kernels and will post them later tonight.

 

For the curious writing a Forth system in Forth is pretty weird, probably because I was feeling my way along, but it's how I got it to work. 

  • First thing loaded is code to teach the compiler how to compiler Forth's simple data types (CONSTANT VARIABLE CREATE USER) and a primitive colon definer.
    I kept these are external because there are at four different ways to make a Forth system. 
  • Next come the parts of the language written in Forth Assembler
  • Once we have the primitives in memory, we use them to teach the compiler how to generated IF THEN ELSE, loop structures and Forth "colon" definitions. 
  • After we have almost everything compiled, only then do we compile the Forth code for the TI-99 "target" system to have IF THEN & loops and finally colon definitions.

You can see the slightly updated code here: CAMEL99-V2/CC9900/SRC.ITC at master · bfox9900/CAMEL99-V2 · GitHub

\ MAKE CAMEL99 indirect threaded Forth               Jan 2022 B Fox

CROSS-COMPILING

\ compiler switches
TRUE  VALUE ITC          \ used to prevent directly compiling HILEVEL.HSF
FALSE VALUE SLOWER       \ TRUE saves 22 bytes
FALSE VALUE HASHING
TRUE  VALUE SUPERCART

 INCLUDE CC9900\SRC.ITC\ITCTYPES.HSF   \ CROSS-Compiler Extensions

\ compile the Forth kernel
 INCLUDE CC9900\SRC.ITC\9900CODE.HSF   \ ASM primitives for TMS9900
 INCLUDE CC9900\SRC.ITC\TI99IOX.HSF    \ VDP driver & KEY code

 INCLUDE CC9900\SRC.ITC\BOOTSTRP.HSF   \ cross-compiler looping & branching

 INCLUDE CC9900\SRC.ITC\HILEVEL.HSF   \ CORE Forth words

 

  • Like 1

Share this post


Link to post
Share on other sites

Sometimes I wish I was smart. :roll:

 

What began as a maintenance exercise turned into a revelation about an fundamental mistake in my cross-compiler that I had fixed with chewing gum and toe-nail clippers. 

The problem was in what I call the executors: DOVAR DOCON  DOUSER.  The hints had been shouting at me all this time.

In trying to get a new Super Cart version running I had to dig in and really understand what was going on.

 

Anyway its good now and the photo is the proof.

 

The zip file has two new kernel programs. One for regular Editor/Assembler cartridges and one for SuperCart.

(Note SuperCart version does not work properly with DSK1.SAVESYS.  I will need to make to some changes for that)

 

Here is what changed.


V2.68G
 

#### JIFFS timer is Removed
The JIFFS timer had more overhead than needed. It is replaced with TICKS.
TICKS uses the 9901 timer as it's reference. TICKS is now used to create MS.
MS resolution has been improved to ~10 milli-seconds. 

Greatly reduces multi-tasking overhead with MS delay word. 

 

#### VDP Driver changes
- A return to a common address setting sub-routine to save space in the kernel.
The performance difference was not worth worrying about.
- Some VDP routines now exist in memory as "BL" sub-routines but are not in
the dictionary.

 

#### "EXECUTOR" word Changes
- A fix was made to DOCON DOVAR DOUSER due my own misunderstanding. These words
were compiled as CODE words with an ITC pointer in the CFA. WRONG!
Each CFA of these words should have started with the actual code.

 

#### SuperCart Forth
With the Executor words fixed we could reliably create a SUPERCART version of
Camel99 Forth that resides in lower RAM, cartridge space when an Editor
Assembler cart has the 8K RAM chip installed.

 

#### Changes to Code in Hi-Speed RAM
Commonly used code snippets are copied to hi-speed RAM at boot-up. We removed
DROP and added DUP and +  which are deemed to be more frequently used in the
literature.

Routines in 16bit RAM: EXIT NEXT ?BRANCH BRANCH ENTER LIT @ DUP +

 

#### Source code Re-Org
- FORTHITC.MAK file was created for easier understanding of the file
compiling order and compiler switches.
- Hi level Forth words and a few CODE words are now in HILEVEL.HSF.

  Other INCLUDE statements are still embedded in the HILEVEL.HSF file.
 

 

IMG-1156.jpg

CAMEL99-2.68G.ZIP

  • Like 3

Share this post


Link to post
Share on other sites

"A funny thing happened on the way to the coliseum"

 

Just in case anybody is asking "How the hell did the BF's Forth system even work if he had pointers where there shouldn't be any?

 

The answer:

I put bandaids in place in the kernel code to adjust pointers to make it compile correctly.

The cross-compiler was being forced to generate the correct code structure so the system booted fine.

 

However later, when you made your own variables, constants or user variables something really funny was happening.

I saw it over and over but didn't understand why. After all my code was correct. :) 

 

Example: The address of DOVAR  just happened to start its code at >A070

>A070 contains A072,  as a CODE word should, pointing to the next address cell where some code begins. 

 

When you made a VARIABLE  X  in your program, then you used X, it has to run DOVAR.

DOVAR jumped to address >A070  and ran the code there!!! 

It contained >A072...

By sheer coincidence that is this instruction:  😆

A *R2+,R1  

Since both those registers are scratch in Camel99 Forth it didn't cause any trouble except running an extra useless instruction.

 

The same thing was happening for CONSTANTS  BUT when I tried to move the code to different addresses those "pointers" changed into some different instruction and blew things up.

So getting it all correct feels pretty good right now and pretty stupid at the same time. ;) 


 

  • Like 3

Share this post


Link to post
Share on other sites

I recently made changes to the kernel program but also have changed the way I access VDP RAM in both the GRAFIX and DIRSPRIT library files.

They use the TABLEx:  concept posted earlier for faster indexing into VDP tables. 

 

I saw the B52 demo in another post by @oddemann and thought that it would be a nice way to test my changes. 

 

EDIT:  The B52 program was written by @SteveB to demonstrate his structured programming environment for BASIC programmers.

 

To my chagrin, it took me way longer than I wanted to make a "proper" Forth version but once the foundation was laid it was easy to modify.

I have to admit that getting started with a Forth program requires way more decisions if you want to do it the "Forth way".

(I couldn't resist adding a few more features once it was running)

 

I am fascinated by how different a Forth program is than a BASIC program.  All the Forth system creators have taken the time to make bridges between their Forth systems and TI-99 features but despite having those, the way you approach the task is very different.

 

Some interesting differences from the BASIC version.

  • Forth can use automotion for the aircraft because it can scan for a collision more reliably than BASIC due to interpreter speed.
    This frees up the program to do other things as well. 
  • Even though the BASIC version is nicely factored into sub-routines the Forth version benefits from way more factoring. It can help sometimes with readability if the names are chosen well. 
  • There is no array used to draw the city. There is instead a Skyscraper function that takes random Y coordinate. Then you just put Skyscraper in a loop to make the city. 
  • The DropBomb word demonstrates the more functional nature of Forth. The task is to release a bomb from the aircraft. We can replace the x,y coordinates in SPRITE creation with a call to another sprite's POSITION. The numbers just drop onto the data stack ready for SPRITE to consume them. :) 
: DropBomb
\  char  colr     x   y        spr#
   bomb  11   #1 POSITION 12 +  #2 SPRITE  \ make sprite at bomber position
   24 0 #2 MOTION                          \ let it fall
;
  • This collision word lets us check if any SPRITE has moved over a non-space character. The coordinate conversion has been factored into PIX>CHAR 
: COLLISION?  ( spr# -- ?) POSITION PIX>CHAR GCHAR  BL <>  ;
  • Sprite library has LOCATE and POSITION but also now has: SP.X  SP.Y 
    These words make some things simpler in Forth where you only want one item on the data stack and they allow faster manipulation of sprite coordinates when you only want to change one of the values.
  • You can see how factoring the sound control into  HZ  and DB  lets you add a descending tone to the bomb drop without needing to remember all the other parameters.

 

And finally this little demo was a great way to show how to make a binary program from your Camel99 Forth program, shown at the end of the program.

The video shows the build time at normal 99 speed.

Zip file has the binary program and source if anyone wants to play. 

(Known BUG: The airplane collisions need a correction in the vertical plane due to layout of the airplane sprite) 

 

Spoiler
\ translation of SteveB52 from Extended BASIC to Forth
\ Original author unknown at this time

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

\ 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

: 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
   2 MAGNIFY
   AUTOMOTION
   2 MOVING
;

: ScrInit ( fg bg -- )
  DUP SCREEN         \ use bg color for screen
  DELALL
  1 19 2SWAP COLORS  \ does the range of color sets 1..19
  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
;

: DropBomb
\  char  colr     x   y        spr#
   bomb  11   #1 POSITION 12 +  #2 SPRITE  \ make sprite at bomber position
   24 0 #2 MOTION                          \ let it fall
;

: VC+!  ( n Vaddr -- ) TUCK [email protected]  +  SWAP VC! ; \ add 'n' to VDP byte

: Descend
      #1 SP.X [email protected]  250 >
      IF
         1 #1 SP.X VC!  \ reset sprite to left side
         4 #1 SP.Y VC+! \ plane falls down 4 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 -- ) 16 0 DO  I DB  DUP MS  LOOP DROP  MUTE ;

: Detonate
      0 0 #2 MOTION
      #2 POSITION PIX>CHAR 2DUP AT-XY
      GCHAR building =     \ test for building
      IF    BL   HITS 1+!      \ blank char
      ELSE crater  MISSES 1+!  \ we missed
      THEN (EMIT)          \ draw the character
      #2 DELSPRITE
     -2 NOISE 40 FADER     \ explosion with fade out
;

: BombsAway
     GEN1                      \ select sound channel 1
     5000 DUP HZ               \ Set freq. Leave freq. copy on stack
     -8 DB                      \ volume
     BEGIN
        ( freq) 10 - DUP HZ    \ reduce freq in each loop.
        #2 COLLISION?
     UNTIL
     DROP MUTE                 \ remove freq. mute the sound channel
     Detonate ;

: GameLoop
  DrawCity
  FlyPlane
  BEGIN
     Descend
     KEY? IF
       DropBomb  BombsAway
     ENDIF
     .SCORE
     #1 COLLISION? ?TERMINAL OR
  UNTIL
  0 0 #1 MOTION   #2 DELSPRITE
;

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

: RUN
   BEGIN
      STARTUP
      GameLoop
      8 10 AT-XY ." Game Over"
      12 8 AT-XY ." Play again? (Y/N)"
      KEY [CHAR] N =
   UNTIL
   END
;

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

\ This is only needed if you want to make a binary program
: B52   WARM         \ Boot Forth machine (40 column mode )
        GRAPHICS     \ switch VDP mode
        RUN          \ word to start the program
        BYE          \ exits Forth system to title screen
;


LOCK  \ lock the dictionary to this point at boot time ...

INCLUDE DSK1.SAVESYS  \ ... so this will not be retained when we boot the game

' B52 SAVESYS DSK2.B52EXE

 

 

FORTHB52.ZIP

  • Like 6

Share this post


Link to post
Share on other sites
2 hours ago, TheBF said:

Forth can use automotion for the aircraft because it can scan for a collision more reliably than BASIC due to interpreter speed.

Does this change in cl99 at overspend ? Or do the basic misses just happen faster?

Oh, btw. What's the code for your include look like? I was playing with TF and it's uses

of S" xxx" USE but the filename, (block), is downstream from my word.

I'd like to be able to leave my current block file as a boot file and USE any other block file the way you do, with a, include file.

Currently, TF does allow S" DSK4.BLKFIL" USE for my fulfilment.

 

Edited by GDMike

Share this post


Link to post
Share on other sites
21 minutes ago, GDMike said:

Does this change in cl99 at overspend ? Or do the basic misses just happen faster?

Oh, btw. What's the code for your include look like? I was playing with TF and it's uses

of S" xxx" USE but the filename, (block), is downstream from my word.

I'd like to be able to leave my current block file as a boot file and USE any other block file the way you do, with a, include file.

Currently, TF does allow S" DSK4.BLKFIL" USE for my fulfilment.

 

I think in Overspeed BASIC would scan for a collision at about the same speed as Forth does natively so it might work just fine although it means Classic99 would have to slow down the Sprite Automotion as well.

Don't know if that happens. ??

 

My INCLUDE is based on the ANS Forth view of the world so it's different than older Forth systems. The source code wouldn't help.

I am pretty sure Mark has a BLOCK with an include word defined somewhere. Look at the docs web site.

 

The old days Forth answer to your problem is just make a bigger block file and put everything you need in it. :) 

In the old days my DOS Forth with two 360K floppy drives started at BLOCK 0 and went up to BLOCK 719.

Seamless.

TI-FORTH does the same thing. With two DSSD drives I think you have BLOCK 0..359 (I have to double check)

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites

Just created a 1500 block file... but of, course I'm showing off..lol...I like the style of keeping a small but relatively large enough block file and including a block file that I don't want permanent or as testing would see it. And just drop it as not needed. I can already do that in TF, just not exactly the same smoothness as your include makes it. Lol thx 

Share this post


Link to post
Share on other sites
39 minutes ago, GDMike said:

Just created a 1500 block file... but of, course I'm showing off..lol...I like the style of keeping a small but relatively large enough block file and including a block file that I don't want permanent or as testing would see it. And just drop it as not needed. I can already do that in TF, just not exactly the same smoothness as your include makes it. Lol thx 

Wow! 1500 blocks is enough for a very big system.

The thing with blocks is that you can do everything with them. code, data, binary programs. So it's not a big sacrifice.

  • Like 1

Share this post


Link to post
Share on other sites

I've got SAMs up and loaded first, and it reports byte's free,used in the bank, and ram available. And it's reported each time a new word is created. Just love it 

Can't do any work with it rt now, as we're working, well, I'm working on a water break on a Line that just happened when I got here..so I can't play for a bit until people get here and fix  this. Boooo hooo

Share this post


Link to post
Share on other sites

We could probably adapt my work to run under TF to save dictionary space. That's a big problem because you are consuming a lot of main memory for each new word.

  • Like 1

Share this post


Link to post
Share on other sites

I noticed that.if I redefine the character set, I consume SAMs I see...I'm still working on the assembler, and getting that intact, not sure if I want audio as part of my so called foundation..

Edited by GDMike

Share this post


Link to post
Share on other sites

I suppose since I don't have BLOAD/BSAVE mechanism I should spell out how one makes a custom "loaded" system for yourself 

This assumes you have your Camel99 disk in DSK1. 

It's not quite as tidy as  30 BSAVE.   :)   

Chuck Moore had a gift for simplicity.

 

(I need to do one of these for the SuperCart system as well. That is just slightly more complicated but doable)

\ Edit this script to build a Custom Forth system the way you want it

INCLUDE DSK1.MARKER

MARKER  Kernel   \ this will remove everything  except the kernel
\                  (case sensitive)

\ add the files you want in the final program
INCLUDE DSK1.ASM9900
INCLUDE DSK1.ELAPSE
INCLUDE DSK1.TOOLS
INCLUDE DSK1.SOUND

\ Add your favourite words here
: SCREEN  ( fg bg -- ) SWAP 4 LSHIFT SWAP OR  7 VWTR ;

\ make a new boot word to start the way you like things
HEX
: COLD
     WARM        \ Must have this to "warm" boot Forth first.
     F 1 SCREEN  \ white on black
     DECIMAL
     ABORT
;

LOCK  \ locks the dictionary to everything before this point on boot

INCLUDE DSK1.SAVESYS  \ Now this will not be saved in the final program

\ save your new forth system
' COLD SAVESYS DSK5.MYFORTH

 

 

  • Like 2
  • Thanks 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   1 member

×
×
  • Create New...