Camel99 Forth Information goes here

[+TheBF]

1 hour ago, GDMike said:

Well, for starters...a windowed menu

Color code user data changes vs default setting 

Unless you just want it all to be a DOS - keyword command system.

With built-in help ofptions 

I wouldn't mind the latter

 

Well 1.0 would be a file system shell.  Make it work, then make it better.

Then we need to decide is it a TI compatible file system or something totally different like the P-Code does. 

 

[+TheBF]

After reading some posts about multi-color mode I went looking into TI-Forth to see how it was done.

Setting up the mode was quickly replicated but then I saw this monstrosity.

: TEXT   TEXT CHARSET PAGE ;

\ TI-FORTH HARNESS for Camel99 Forth 
: ENDIF  POSTPONE THEN ; IMMEDIATE 
: VSBW  S" VC!" EVALUATE ; IMMEDIATE 
: VSBR  S" VC@" EVALUATE ; IMMEDIATE 
: U*    S" UM*" EVALUATE ; IMMEDIATE 
: GCHAR ( c r -- c) S" >VPOS VC@" EVALUATE ; IMMEDIATE 

\ FROM TI-FORTH
VARIABLE ADR 
HEX 
: MCHAR ( COLOR C R --- ) 
    DUP >R 2 / SWAP 
    DUP >R 2 / SWAP
    DUP >R GCHAR  DUP 20 /  100 U* DROP 800 + >R 
    20 MOD  8 * R> + 
    R> 4 MOD 2 * + ADR ! 
    R> 2 MOD 
    R> 2 MOD SWAP
    IF  IF 3 ELSE 1 ENDIF  ELSE  IF 2 ELSE 0 ENDIF   ENDIF
    DUP 2 MOD 0= IF SWAP 10 * SWAP ENDIF
    CASE 0 OF ADR @ VSBR 0F ENDOF  1 OF ADR @ VSBR F0 ENDOF
    2 OF 1 ADR +! ADR @ VSBR 0F ENDOF
    3 OF 1 ADR +! ADR @ VSBR F0 ENDOF
    ENDCASE AND +   ADR @  VSBW ;

 

All that just to put a square pixel on the screen.  

 

I managed to make it a bit over 2X faster by remove all the MOD instructions and replaced them with AND.

I removed the 100 UM* DROP   and replaced it with a byte swap. ( >< in Camel Forth)  

Swapping bytes is like 256 * or 256 /   depending on which bytes you are concerned with.  

 

Here is the version that is 2x faster .

\ optimized with some Camel99 words 
HEX 
: MCHAR2 ( COLOR C R --- ) 
    DUP>R 2/ SWAP 
    DUP>R 2/ SWAP ( -- color c' r')
    DUP>R GCHAR DUP 5 RSHIFT  ><  800 + >R 
    1F AND 8* R> +  
    R>  3 AND 2* + ADR ! 
    R>  1 AND  
    R>  1 AND SWAP
    IF  
      IF 3 ELSE 1 ENDIF  
      ELSE  
           IF 2 ELSE 0 ENDIF   
      ENDIF
      DUP 2 MOD 0= IF SWAP 10 * SWAP 
    ENDIF
    
      CASE 
      0 OF ADR @ VC@ 0F ENDOF  
      1 OF ADR @ VC@ F0 ENDOF
      2 OF 1 ADR +! ADR @ VC@ 0F ENDOF
      3 OF 1 ADR +! ADR @ VC@ F0 ENDOF
    ENDCASE 
    AND +  ADR @  VC! ;

 

Here is a the test I used on each version

DECIMAL
: MTEST1
   MULTICOLOR 
   16 DO 
        64 0 
        DO  
          I I J MCHAR \ MCHAR2
        LOOP 
    LOOP 
   BEGIN  KEY? UNTIL 
   TEXT ;    

 

But there must be a better way to do this. 

 

I have the text from the 9918 manual so I guess I can start there. 

 

\ *equation for finding pattern table locations
\   first byte = 2 * row + name * 8
\   second byte = first byte + 1
\   row = mod4[truncate(pattern position/32)]
 

[+Lee Stewart]

Not sure if this will help, but perhaps my ALC version for fbForth 3.0 in the spoiler can offer some insight for high-level Forth:

 

Spoiler

;[*** MINIT ***      ( --- )
*        DATA DALL_N
* MINI_N .NAME_FIELD 5, 'MINIT'
* MINIT  DATA $+2
*        BL   @BLF2A
*        DATA _MINI->6000+BANK1

_MINI  
       BL   @__MINI
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
       
*++ body of MINIT routine to allow call by other routines in this bank
__MINI MOV  @$SSTRT(U),R0   ; SCRN_START to R0
       CLR  R2              ; starting char row
MINI01 MOV  R2,R1           ; next row
       SRL  R1,2            ; insure starting with same char code every 4 rows
       SLA  R1,5            ; starting char code
       LI   R3,32           ; inner loop counter
MINI02 SWPB R1              ; put in left byte for VSBW
       BLWP @VSBW           ; write character to SIT
       SWPB R1              ; restore to right byte for INC
       INC  R1              ; next char code
       INC  R0              ; next SIT address
       DEC  R3              ; decrement inner loop counter
       JNE  MINI02          ; done?
       INC  R2              ; increment row
       CI   R2,24           ; done?
       JLT  MINI01          ; nope, do next row
       RT                   ; return to caller
;]
;[*** MCHAR ***      ( color mc mr --- )
*        DATA MINI_N
* MCHR_N .NAME_FIELD 5, 'MCHAR'
* MCHAR  DATA $+2
*        BL   @BLF2A
*        DATA _MCHR->6000+BANK1
       
_MCHR  MOV  *SP+,R0         ; pop mr to R0
       MOV  R0,R2           ; copy to r2
       MOV  *SP+,R1         ; pop mc to R1
       MOV  R1,R3           ; copy to r3
       SRL  R0,1            ; get char row
       SRL  R1,1            ; get char column
       SLA  R0,5            ; char row's byte offset from SCRN_START
       A    R1,R0           ; char's offset from SCRN_START
       A    @$SSTRT(U),R0   ; VRAM address of char
       BLWP @VSBR           ; get char code
       SRL  R1,5            ; char pattern offset (*8) into PDT and move to right byte
       MOV  R1,R0           ; prepare to get color byte
       ANDI R2,7            ; byte offset for mr's color
       A    R2,R0           ; byte offset into PDT
       A    @$PDT(U),R0     ; color byte's address
       BLWP @VSBR           ; get color byte
       MOV  *SP+,R4         ; pop new color
       SWPB R4              ; to left byte
       ANDI R4,>0F00        ; insure color is legal
       ANDI R3,1            ; left or right nybble?
       JEQ  MCHR01          ; left nybble?
       ANDI R1,>F000        ; nope, clear right nybble
       JMP  MCHR02          ; finish up
MCHR01 ANDI R1,>0F00        ; clear left nybble
       SLA  R4,4            ; shift new color to left nybble
MCHR02 A    R4,R1           ; add new color
       BLWP @VSBW           ; store new color
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
;]                                 

 

 

...lee

[GDMike]

Dang what a difference

[+TheBF]

1 hour ago, Lee Stewart said:

Not sure if this will help, but perhaps my ALC version for fbForth 3.0 in the spoiler can offer some insight for high-level Forth:

 

  Hide contents

;[*** MINIT ***      ( --- )
*        DATA DALL_N
* MINI_N .NAME_FIELD 5, 'MINIT'
* MINIT  DATA $+2
*        BL   @BLF2A
*        DATA _MINI->6000+BANK1

_MINI  
       BL   @__MINI
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
       
*++ body of MINIT routine to allow call by other routines in this bank
__MINI MOV  @$SSTRT(U),R0   ; SCRN_START to R0
       CLR  R2              ; starting char row
MINI01 MOV  R2,R1           ; next row
       SRL  R1,2            ; insure starting with same char code every 4 rows
       SLA  R1,5            ; starting char code
       LI   R3,32           ; inner loop counter
MINI02 SWPB R1              ; put in left byte for VSBW
       BLWP @VSBW           ; write character to SIT
       SWPB R1              ; restore to right byte for INC
       INC  R1              ; next char code
       INC  R0              ; next SIT address
       DEC  R3              ; decrement inner loop counter
       JNE  MINI02          ; done?
       INC  R2              ; increment row
       CI   R2,24           ; done?
       JLT  MINI01          ; nope, do next row
       RT                   ; return to caller
;]
;[*** MCHAR ***      ( color mc mr --- )
*        DATA MINI_N
* MCHR_N .NAME_FIELD 5, 'MCHAR'
* MCHAR  DATA $+2
*        BL   @BLF2A
*        DATA _MCHR->6000+BANK1
       
_MCHR  MOV  *SP+,R0         ; pop mr to R0
       MOV  R0,R2           ; copy to r2
       MOV  *SP+,R1         ; pop mc to R1
       MOV  R1,R3           ; copy to r3
       SRL  R0,1            ; get char row
       SRL  R1,1            ; get char column
       SLA  R0,5            ; char row's byte offset from SCRN_START
       A    R1,R0           ; char's offset from SCRN_START
       A    @$SSTRT(U),R0   ; VRAM address of char
       BLWP @VSBR           ; get char code
       SRL  R1,5            ; char pattern offset (*8) into PDT and move to right byte
       MOV  R1,R0           ; prepare to get color byte
       ANDI R2,7            ; byte offset for mr's color
       A    R2,R0           ; byte offset into PDT
       A    @$PDT(U),R0     ; color byte's address
       BLWP @VSBR           ; get color byte
       MOV  *SP+,R4         ; pop new color
       SWPB R4              ; to left byte
       ANDI R4,>0F00        ; insure color is legal
       ANDI R3,1            ; left or right nybble?
       JEQ  MCHR01          ; left nybble?
       ANDI R1,>F000        ; nope, clear right nybble
       JMP  MCHR02          ; finish up
MCHR01 ANDI R1,>0F00        ; clear left nybble
       SLA  R4,4            ; shift new color to left nybble
MCHR02 A    R4,R1           ; add new color
       BLWP @VSBW           ; store new color
       B    @RTNEXT         ; back to bank 0 and the inner interpreter
;]                                 

 

 

...lee

 

This is really great help Lee. Thanks for all the heavy lifting. 

I think this can translate into something pretty straightforward in only Forth with a few CODE words for faster shifting.

I think I have a "shift maker" word somewhere that will help with that process.

 

[RickyDean]

Today is Chuck Moore's Birthday   https://en.wikipedia.org/wiki/Charles_H._Moore#:~:text=Charles Havice Moore II (born,Forth programming language in 1968.

 

"Charles Havice Moore II (born 9 September 1938), better known as Chuck Moore, is an American computer engineer and programmer, best known for inventing the Forth programming language in 1968."

[+TheBF]

45 minutes ago, RickyDean said:

Today is Chuck Moore's Birthday   https://en.wikipedia.org/wiki/Charles_H._Moore#:~:text=Charles Havice Moore II (born,Forth programming language in 1968.

 

"Charles Havice Moore II (born 9 September 1938), better known as Chuck Moore, is an American computer engineer and programmer, best known for inventing the Forth programming language in 1968."

And I would add that Chuck gave us the 2 stack "ultra-RISC" computer architecture and a number of real chips in that form. 

A few more EE grad students need to explore that further and see where it goes IMHO. 

 

[+TheBF]

I have been playing with the TI-FORTH MCHAR code to see what else could be improved.

I was staring that this part:

( ? ? -- ?) 
\      SWAP 
\      IF    IF 3 ELSE 1 THEN  
\      ELSE  IF 2 ELSE 0 THEN   
\      THEN

Seemed like a lot of stuff.

 

I rolled it up into a word and tested it at the console.

Here is the truth table:

col row | out
--------------
0   0   | 0
0   1   | 1
1   0   | 2
1   1   | 3

 

Hmm, that looks familiar.  

I threw it away and replace all that branching with:

   2*  +

 

So using better word choices from the Camel99 kernel and a thing I call a "TABLE:'  I got this little benchmark down to 2.5 secs.

This is about 2.8X faster than the original's 7 second timing. 

But it doesn't hold a candle to Lee's all CODE version which comes in at 1 second.

 

Spoiler

\ REFERENCE VERSION FROM TI-FORTH 
NEEDS MULTICOLOR  FROM DSK1.MULTIMODE 
NEEDS CASE  FROM DSK1.CASE 
\ LEVEL 1 OPTIMIZATION: Use optimizing words in Camel99 Forth 
\ LEVEL 2 OPTIMIZATION 
\ >> Replace all of this:
\ : LOGIC  ( n n -- ?) 
\      SWAP 
\      IF    IF 3 ELSE 1 THEN  
\      ELSE  IF 2 ELSE 0 THEN   
\      THEN
\ ;
\ With:   2* +  

\ LEVEL 3 OPTIMIZATION : REMOVE THE VARIABLE 

: GCHAR ( c r -- c) S" >VPOS VC@" EVALUATE ; IMMEDIATE 

NEEDS TABLE: FROM DSK1.TABLES
HEX 800 TABLE: ]PDT \ convert base address to byte array 

HEX
: MCHAR ( COLOR C R --- ) 
     DUP>R 2/ SWAP DUP>R 2/ SWAP
     DUP>R GCHAR  DUP  5 RSHIFT >< ]PDT >R 
     1F AND 8* R> + R>  3 AND 2* +  ( ADR !  removed)

     R> 1 AND  
     R> 1 AND  ( -- color Vaddr  ? ?) 
     2* +      ( -- color Vaddr n)    \ convert bits to digit   
     SWAP >R   ( -- color n)  \ save the Pattern table address 
      
     DUP 1 AND 0= IF SWAP 4 LSHIFT SWAP THEN
     
     CASE 
          0 OF R@ VC@ 0F ENDOF 
          1 OF R@ VC@ F0 ENDOF
          2 OF R> 1+ DUP>R VC@ 0F ENDOF
          3 OF R> 1+ DUP>R VC@ F0 ENDOF
     ENDCASE 
     AND +  R> VC! ;


DECIMAL 
: TEST
    MULTICOLOR 
    48 0 DO  
        15  0 I +  I MCHAR 
        1   1 I +  I MCHAR 
        2   2 I +  I MCHAR 
        3   3 I +  I MCHAR 
        4   4 I +  I MCHAR 
        5   5 I +  I MCHAR 
        6   6 I +  I MCHAR 
        7   7 I +  I MCHAR 
        8   8 I +  I MCHAR 
        9   9 I +  I MCHAR
        10 10 I +  I MCHAR
        11 11 I +  I MCHAR
        12 12 I +  I MCHAR
        13 13 I +  I MCHAR
        14 14 I +  I MCHAR
        15 15 I +  I MCHAR
   LOOP 
   BEGIN ?TERMINAL UNTIL 
   TEXT 
;

 

 

[+TheBF]

It took me a while to get all the byte reversals corrected,   but using Lee's excellent example code, I create three code words.

These are married together using Forth and the performance is very similar to using one large code word.

 

\ REFERENCE VERSION FROM TI-FORTH 

NEEDS MULTICOLOR  FROM DSK1.MULTIMODE 

\ LEVEL 5 OPTIMIZATION : Write code words using Lee's method

HEX 
CODE >NAME ( col row -- Vaddr)
      *SP+ R1 MOV, 
       R1   1 SRL,  \ 2/ 
       TOS  1 SRL,  \ 2/  
       TOS  5 SLA,  \ 32* 
       R1 TOS ADD, 
       NEXT,
ENDCODE         

CODE ]PATTERN ( row char -- Vaddr) \ address of color byte
       TOS  3 SLA,    \ char offset 8*
       TOS PDT AI,    \ add the base address 
      *SP+ R2 MOV,    \ row -> R2 
       R2  7  ANDI,   \ byte offset for row's color   
       R2  TOS ADD,           
       NEXT,
ENDCODE        

HEX 
CODE NYBBLES ( color column colorbyte -- colorbyte')   
      *SP+ R2 MOV,      \ column to R2
      *SP+ R3 MOV,      \ new color to R3 
       R3  0F ANDI,     \ insure color is legal
       R2  1  ANDI, 
       NE IF, 
            TOS F0 ANDI,  
       ELSE,
            TOS 0F ANDI,
            R3  4 SLA, 
       ENDIF, 
       R3 TOS ADD, 
       NEXT,
ENDCODE        

: MCHAR  ( color col row --)
    2DUP 
    >NAME VC@ ]PATTERN DUP>R VC@ 
    NYBBLES  R> VC! ;

 

[+TheBF]

I got myself committed to a few music things recently that are cramping my coding time.

 

Anyway here is the MULTIMODE library file that let's you play with multicolor mode under Camel99. 

 

• The mode is changed with the word MULTICOLOR. (Camel99 already uses the word MULTI to enable the multi-tasker.)
   
• I added  (n x y) HLINE and ( n x y ) VLINE  which give you the equivalent of HCHAR and VCHAR.
   
• You position the cursor with AT-XY like standard Forth. 
   
• There are a set of color words that I borrowed from TI LOGO. They seemed like good names for the colors we have. 
  Each color word sets the variable MCOLOR when invoked.  This reduces the number of items on the stack for HLINE and VLINE.
  It may be a bad decision for some applications, but you always have MCHAR,  the lower level word to to what you need. 
   
• I kept the word CLEAR for multi-color mode as I used it in Graphics 1 mode as well. It's nostalgic.
    ( and IF you absolutely need it you could define CALL like this:

: CALL ; IMMEDIATE  

 

... and your code would not be one bit slower. 

 

 

The binary file for TI-99 disks is attached for your Camel99 Forth library disk and the spoiler has the text form if you want a copy. 

There is also a little test program that I made to exercise this thing. 

 

Spoiler

\ multicolor.fth   for Camel99 Forth    2024 Brian Fox 
\ Setup code based on TI-Forth and 
\ code words derived from FbForth 3 by Lee Stewart 

NEEDS CHARSET FROM DSK1.CHARSET 
HERE 

HEX 
800 CONSTANT PDT
300 CONSTANT SPRITE_ATTR
380 CONSTANT SPRITE_TAB 
\ 000 CONSTANT NAME_TAB 

\ Name vdp registers
HEX 
\ : VDPMODE     0 VWTR ;
\ : VDPCONTROL  1 VWTR ;
\ : NAMETABLE   2 VWTR ;
\ : COLORTABLE  3 VWTR ;
\ : PATTERNS    4 VWTR ;
\ : SPRITEATTR  5 VWTR ;
\ : SPRITEPATT  6 VWTR ;
\ : SCREENCOLOR 7 VWTR ;

: SETVDP2 ( n -- ) 
    0  0 VWTR
    0  2 VWTR
    0E 3 VWTR
    1  4 VWTR 
    6  5 VWTR
    3E0 836E !      \ VSPTR  routine
    0 837A C!
    DUP 83D4 C! 1 VWTR ; 

: HIDESCREEN ( --) 0B0 1 VWTR ;

: NIBBLES  ( n --) 2 RSHIFT 0FF SWAP DO  1+ I OVER  VC!  8 +LOOP ;

: MINIT    ( -- ) -1  18 0 DO  I NIBBLES  LOOP DROP ;

\ like call clear but cursor homes to 0,0 
: CLEAR    PDT 800 0 VFILL 0 0 AT-XY ;  \ erase char patterns 

HEX
: MULTICOLOR      
    HIDESCREEN
    MINIT 
    SPRITE_ATTR  80   0 VFILL    \ erase sprite table 
    SPRITE_TAB   20 0F4 VFILL    \   
    20 C/L!  
    300 C/SCR ! 
    0 TOPLN ! 
    3 VMODE !
    4  6 VWTR 
    11 7 VWTR
    0EB SETVDP2 
    CLEAR 
;

\ After MULTI mode, we need to restore character pattern in VDP
\ CHARSET reads in the default characters from GROM 

: TEXT   TEXT CHARSET PAGE ;

\ MCHAR for Camel99 Forth   Sept 14 2024 Brian fox 
\ Derived from code by Lee Stewart 
HEX 
CODE >NAME ( col row -- Vaddr)
    C076 , \ *SP+ R1 MOV, 
    0911 , \  R1   1 SRL,  \ 2/ 
    0914 , \  TOS  1 SRL,  \ 2/  
    0A54 , \  TOS  5 SLA,  \ 32* 
    A101 , \  R1 TOS ADD, 
    NEXT,
ENDCODE         

CODE ]PATTERN ( row char -- Vaddr) \ address of color byte
    0A34 ,          \ TOS  3 SLA,    \ char offset 8*
    0224 , PDT ,    \ TOS PDT AI,    \ add the base address 
    C0B6 ,          \ *SP+ R2 MOV,  \ row -> R2 
    0242 , 0007 ,   \ R2  7  ANDI, \ byte offset for row's color   
    A102 ,          \ R2  TOS ADD,           
    NEXT,
ENDCODE        

HEX 
CODE NYBBLES ( color column colorbyte -- colorbyte')   
    C0B6 ,          \ *SP+ R2 MOV,      \ column to R2
    C0F6 ,          \ *SP+ R3 MOV,      \ new color to R3 
    0243 , 000F ,   \ R3  0F ANDI,     \ insure color is legal
    0242 , 0001 ,   \ R2  1  ANDI, 
    1303 ,          \ NE IF, 
    0244 , 00F0 ,   \        TOS F0 ANDI,  
    1003 ,          \ ELSE,
    0244 , 000F ,   \        TOS 0F ANDI,
    0A43 ,          \ R3  4 SLA, 
                    \ ENDIF, 
    A103 ,          \ R3 TOS ADD, 
    NEXT,
ENDCODE        

: MCHAR  ( color col row --)
    2DUP >NAME VC@ ]PATTERN DUP>R VC@  NYBBLES  R> VC! ;

VARIABLE MCOLOR       \ holds active color 

: ENUM-COLOR  ( 0 <text> -- n) 
  DUP CREATE   , 1+  DOES> @ MCOLOR ! ;   

\ named TI-99 colors set MCOLOR when invoked 
0 ( set 1st color)
ENUM-COLOR TRANS    ENUM-COLOR BLACK    ENUM-COLOR GREEN    ENUM-COLOR LIME
ENUM-COLOR BLUE     ENUM-COLOR SKY      ENUM-COLOR RED      ENUM-COLOR CYAN
ENUM-COLOR RUST     ENUM-COLOR ORANGE   ENUM-COLOR YELLOW   ENUM-COLOR LEMON
ENUM-COLOR OLIVE    ENUM-COLOR MAGENTA  ENUM-COLOR GRAY     ENUM-COLOR WHITE
DROP

: MM.PLOT  ( x y -- ) MCOLOR @ -ROT  MCHAR ;

: XY@      ( -- x y) VROW 2@ ; 
: HLINE    ( n x y --) AT-XY 0 ?DO MCOLOR @ XY@ MCHAR  VCOL 1+! LOOP ;
: VLINE    ( n x y --) AT-XY 0 ?DO MCOLOR @ XY@ MCHAR  VROW 1+! LOOP ; 

HERE SWAP - DECIMAL . .( bytes)

 

 

Multicolor test program. Start with: TEST 

Spoiler

\  multicolor mode  tests  

NEEDS HLINE  FROM DSK1.MULTIMODE 
NEEDS RDN    FROM DSK1.RANDOM 

DECIMAL 
: RNDCOLOR ( -- )  16 RND  MCOLOR ! ;
: RNDX     ( -- n) 64 RND ;
: RNDY     ( -- n) 48 RND ;
: RNDLEN   ( -- n) 10 RND 2+ ;

: ANGLES  
   RNDCOLOR  40 0 0 HLINE   16 0 0 VLINE 
   RNDCOLOR  48 2 2 HLINE   24 2 2 VLINE 
   RNDCOLOR  56 4 4 HLINE   32 4 4 VLINE 
   RNDCOLOR  58 6 6 HLINE   40 6 6 VLINE 
;

: RNDLINES 
    CLEAR 
    100 0 
    DO 
      RNDCOLOR  RNDLEN RNDX RNDY HLINE 
      RNDCOLOR  RNDLEN RNDX RNDY VLINE 
    LOOP 
;

: DIAGONALS
    16 1
    DO 
       I MCOLOR !   
       32 12 
       DO  I  I J +  MM.PLOT  LOOP 
       100 MS  
    LOOP    
; 

: TEST 
   MULTICOLOR  
   BEGIN
        CLEAR
        ANGLES 
        DIAGONALS
        RNDLINES 
        500 MS 
        ?TERMINAL 
   UNTIL  
   TEXT ;

 

 

 

 

MULTIMODE

[+FarmerPotato]

On 9/16/2024 at 8:28 PM, TheBF said:

Multicolor test program.

The diagonal lines suggested to me a LINES demo in multicolor mode would be neat. 

[+TheBF]

11 hours ago, FarmerPotato said:

The diagonal lines suggested to me a LINES demo in multicolor mode would be neat. 

I have Dr. Ting's (RIP) recursive line drawing routine, but it's not that speedy.

Once I get past a few things I may give it a go.

[+TheBF]

Ok I got my practicing done and I had to give it a go. 

 

I added this code to the MULTIMODE library file. 

DECIMAL 
\ Text macros make LINE clearer but run full speed 
: 2ROT ( d1 d2 d3 -- d2 d3 d1) 
       S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE 
: 4DUP ( a b c d -- a b c d a b c d) 
       S" 3 PICK 3 PICK 3 PICK 3 PICK" EVALUATE ; IMMEDIATE 

: LINE ( x1 y1 x2 y2 -- )
\ ANS version of Dr. Ting's recursive line.  R.I.P.
    4DUP  ROT - ABS >R - ABS R>          \ compute dx dy 
    MAX 2 < IF  2DROP MM.PLOT  EXIT THEN \ nothing do, get out  

    4DUP ROT 
    + 1+ 2/ >R    \ compute mid points 
    + 1+ 2/ R>           
    2DUP 2ROT RECURSE RECURSE ;

: MOVETO ( x y -- )  S" AT-XY" EVALUATE ; IMMEDIATE ( alias)
: LINETO  ( x y -- ) 2DUP XY@ LINE MOVETO ;

 

Then slammed together this random line "scribbler" to see if the performance was ok. 

: TESTLINE2 
   MULTICOLOR 
   BEGIN 
      CLEAR 
      RNDX RNDY MOVETO 
      20 0 
      DO  
         RNDCOLOR RNDX RNDY LINETO 
         ?TERMINAL 
         IF 
           UNLOOP TEXT ABORT 
         THEN 
      LOOP 
   AGAIN 
; 

 

It's reasonable.

 

 

[D-Type]

Perhaps...?

: 4DUP 2OVER 2OVER ; 

[+TheBF]

19 minutes ago, D-Type said:

Perhaps...?

: 4DUP 2OVER 2OVER ; 

Yes that would work. but 2OVER not in my kernel.

 

Here are some options I have played with. 

CODE 4TH  ( a b c d e--  a b c d e a) \ ANS: 3 PICK
          0646 , C584 ,  \ TOS PUSH,    
          C126 , 0006 ,  \ 6 (SP) TOS MOV,
          NEXT,      
          ENDCODE

 

: 2OVER   4TH 4TH ; 

 

 

Or just do it all in code:

CODE 2OVER ( d1 d2 -- d1 d2 d1)   \ 2x faster
       0646 , C584 ,   \ TOS PUSH,
       C126 , 0006 ,   \ 6 (SP) TOS MOV,
       0646 , C584 ,   \ TOS PUSH,
       C126 , 0006 ,   \ 6 (SP) TOS MOV,
       NEXT,           \ 100
ENDCODE         \ 16 bytes

 

 

Interestingly PICK has the same number of instructions as OVER on 9900 but incurs the overhead of LIT. 

(PUSH is a 2 instruction macro)

CODE OVER   ( w1 w2 -- w1 w2 w1 )
            TOS PUSH,  
            2 (SP) TOS MOV,  
            NEXT,   
            ENDCODE

 

CODE PICK   ( n -- n)   \ GForth ITC takes 8 intel instructions for PICK
              TOS  1 SLA,  
              SP TOS ADD,  
             *TOS TOS MOV,  
              NEXT, 
              ENDCODE

 

I think I went through this trying to optimize LINE in bit-map mode and it was not the big bottleneck. 

 

[+Vorticon]

What is the Dr. Ting recursive line algorithm? 

[+TheBF]

1 hour ago, Vorticon said:

What is the Dr. Ting recursive line algorithm? 

This code

DECIMAL 
\ Text macros make LINE clearer but run full speed 
: 2ROT ( d1 d2 d3 -- d2 d3 d1) 
       S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE 
: 4DUP ( a b c d -- a b c d a b c d) 
       S" 3 PICK 3 PICK 3 PICK 3 PICK" EVALUATE ; IMMEDIATE 

: LINE ( x1 y1 x2 y2 -- )
\ ANS version of Dr. Ting's recursive line.  R.I.P.
    4DUP  ROT - ABS >R - ABS R>          \ compute dx dy 
    MAX 2 < IF  2DROP MM.PLOT  EXIT THEN \ plot a point & return

    4DUP ROT 
    + 1+ 2/ >R    \ compute mid points 
    + 1+ 2/ R>           
    2DUP 2ROT RECURSE RECURSE ;

 

I think it would be pretty simple in Pascal.

 

[+Vorticon]

Still clear as mud 😅 Perhaps a flowchart would be better? Is it a faster process than the venerable Bresenham algorithm?

And yes, I definitely want to try this is Pascal!

[+Lee Stewart]

3 hours ago, TheBF said:

This code

DECIMAL 
\ Text macros make LINE clearer but run full speed 
: 2ROT ( d1 d2 d3 -- d2 d3 d1) 
       S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE 
: 4DUP ( a b c d -- a b c d a b c d) 
       S" 3 PICK 3 PICK 3 PICK 3 PICK" EVALUATE ; IMMEDIATE 

: LINE ( x1 y1 x2 y2 -- )
\ ANS version of Dr. Ting's recursive line.  R.I.P.
    4DUP  ROT - ABS >R - ABS R>          \ compute dx dy 
    MAX 2 < IF  2DROP MM.PLOT  EXIT THEN \ plot a point & return

    4DUP ROT 
    + 1+ 2/ >R    \ compute mid points 
    + 1+ 2/ R>           
    2DUP 2ROT RECURSE RECURSE ;

 

I think it would be pretty simple in Pascal.

 

 

1 hour ago, Vorticon said:

Still clear as mud 😅 Perhaps a flowchart would be better? Is it a faster process than the venerable Bresenham algorithm?

And yes, I definitely want to try this is Pascal!

 

FWIW here is my ALC, integer, no-divide version of the Bresenham line algorithm for Bitmap mode. It would need to be tweaked for Multicolor mode. The call to __DTBM should obviously be replaced with an ALC version of MM.PLOT:

Spoiler

;[*** LINE ***   ( x1 y1 x2 y2 --- )
*++ This is an integer, no-divide version of the Bresenham line algorithm

* LINE does the following:
*     1) Computes dy = y2-y1 and dx =  x2-x1
*     2) Determines which direction, x or y, has slope <= 1
*         x) Flips dx and dy
*         y) Leaves dx and dy alone
*     3) sets DOTCNT = dx in R4
*     4) Computes D = 2*dy-dx
*     5) Forces plotting direction to be positive for independent variable
*     6) Sets starting y|x accumulator as acc = (y|x)
*     7) Finds accumulator increment as inc = +1|-1
*     8) Plots first dot
*     9) Each time through dot plotting loop:
*         a) Loop counter check
*         b) x|y = x|y + 1
*         c) D > 0?
*             yes)
*                 y1) acc = acc + inc
*                 y2) D = D+2*(dy-dx)
*             no) D = D+2*dy
*         d) y|x = acc
*         e) Plot dot
*         f) Decrement point counter

*        DATA DTBM_N
* LINE_N .NAME_FIELD 4, 'LINE '
* LINE   DATA $+2
*        BL   @BLF2A
*        DATA _LINE->6000+BANK1

* Register usage in LINE's own workspace (FAC)---
*       R0:  varies
*       R1:  varies
*       R2:  y2
*       R3:  x2
*       R4:  y1, then, point (dot) count for line (DOTCNT)
*       R5:  x1, then, increment for dependent coordinate (INC) (+1|-1)
*       R6:  accumulator for dependent coordinate (ACC)
*       R7:  current independent coordinate       (COORD)
*       R8:  dx, then, 2*dx
*       R9:  dy, then, 2*dy
*      R10:  sign of dy/dx or dx/dy, then, D
*      R12:  contains flag for principal axis (1 = x axis, 0 = y axis)

_LINE  
       LI   R0,FAC+4       point to R2 of LINE's workspace
       MOV  *SP+,*R0+      pop y2 to LINE's R2
       MOV  *SP+,*R0+      pop x2 to LINE's R3
       MOV  *SP+,*R0+      pop y1 to LINE's R4
       MOV  *SP+,*R0       pop x1 to LINE's R5
       LWPI FAC            switch to LINE's workspace
       SETO R10            initially, store -1 as sign of slope
       MOV  R2,R0          calculate dy
       S    R4,R0
       MOV  R0,R1          prepare for sign calculation
       ABS  R0
       MOV  R0,R9
       MOV  R3,R0          calculate dx
       S    R5,R0
       XOR  R0,R1          calculate sign of slope (dy/dx|dx/dy)
       JLT  LINE01         negative slope?
       NEG  R10            change sign to +1
LINE01 ABS  R0
       MOV  R0,R8
       MOV  R9,R1
       C    R1,R0          compare|dy| to |dx|
       JLT  LINE04         dy < dx?
       MOV  R0,R9          no, flip dy
       MOV  R1,R8                 and dx
       MOV  R4,R7          assume starting with y1
       MOV  R5,R6            and x1 (to ACC)
       C    R4,R2          should we switch?
       JGT  LINE02         yes
       JMP  LINE03         no
LINE02 MOV  R2,R7          we're starting with y2
       MOV  R3,R6            and x2 (to ACC)
LINE03 CLR  CRU            0 to CRU (R12) to indicate y-axis processing
       JMP  LINE07
LINE04 MOV  R5,R7          assume starting with x1
       MOV  R4,R6            and y1 (to ACC)
       C    R5,R3          should we switch?
       JGT  LINE05         yes
       JMP  LINE06         no
LINE05 MOV  R3,R7          we're starting with x2
       MOV  R2,R6            and y2 (to ACC)
LINE06 LI   CRU,1          1 to CRU (R12) to indicate x-axis processing
LINE07 MOV  R10,R5         get sign to INC register before we destroy it!
       SLA  R9,1           dy = 2*dy (we don't need dy by itself any more)
       MOV  R9,R0          calculate D
       S    R8,R0          D = 2*dy-dx
       MOV  R0,R10         store D in DYXSN
       MOV  R8,R4          load point counter
       SLA  R8,1           2*dx (we don't need dx by itself any more)
       MOV  CRU,CRU        x or y axis?
       JNE  LINE08         x-axis
       MOV  R7,R0          y-axis, COORD to y for DOT
       MOV  R6,R1          ACC to x for DOT
       JMP LNLOOP          to first plot
LINE08 MOV  R7,R1          x-axis, COORD to x for DOT
       MOV  R6,R0          ACC to y for DOT
LNLOOP BL   @__DTBM        plot first dot (R0 = y, R1 = x)
       MOV  R4,R4          are we done?
       JEQ  LINEX          yup!
       DEC  R4             decrement counter
       INC  R7             increment principal coordinate
*++ Calculate D
       MOV  R9,R1          get 2*dy
       MOV  R10,R0         D > 0?
       JGT  LINE09         yup
       JMP  LINE10         nope
LINE09 A    R5,R6          inc/dec dependent variable
       S    R8,R1          2*dy-2*dx
LINE10 A    R1,R10         D = D+[2*dy or 2*dy-2*dx)]
       MOV  CRU,CRU        x-axis or y-axis?
       JEQ  LNYAX          y-axis
       MOV  R7,R1          x-axis, get next x for DOT
       MOV  R6,R0          get accumulator contents to y for DOT
       JMP  LNLOOP         go to plot
LNYAX  MOV  R7,R0          y-axis, get next y for DOT
       MOV  R6,R1          get accumulator contents to x for DOT
       JMP  LNLOOP         plot the dot (R0 = y, R1 = x) & on to next point
LINEX  LWPI MAINWS         RESTORE MAIN WS
       B    @RTNEXT        back to bank 0 and the inner interpreter
;]

 

 

...lee

[+TheBF]

6 hours ago, Vorticon said:

Still clear as mud 😅 Perhaps a flowchart would be better? Is it a faster process than the venerable Bresenham algorithm?

And yes, I definitely want to try this is Pascal!

I have been running around all day and have to leave again shortly but I will see if I can translate the Forth into "pseudo-pascal".

I only started to get it last year when I looked at trying to optimize it. 

From what I can gather it works a bit like quicksort.

Trying translate it will expose my lack of understanding. 

 

 

 

 

 

[+TheBF]

@Vorticon I don't remember my Pascal syntax after 35 years. I did some quick review online but forgive any errors.

 

I think this is Ting's algorithm.  

procedure TingsLine (x1, y1, x2, y2: integer)
         var 
           dx,dy,midx,midy: integer;
         Begin
           dx := abs(x2-x1);
           dy := abs(y2-y1);

           if max(dx,dy)<2 then
              plot( x1,y1);
              return ;  { don't know how this is done }

           midx := ((x2+x1)+1)/2;
           midy := ((y2+y1)+1)/2;
           Tingsline(x1,y1,midx,midy);
           Tingsline(midx,midy,x2,y2);
         End;
End;

 

I also went looking for recursive line drawing in other languages.

I found this one in Java which looks like it might suite Pascal better. ??

public static void drawLine(double x1, double y1, double x2, double y2){         
        if(equals(x1,x2) && equals(y1,y2))
            return;
        double mid_x = (x2+x1)/2;
        double mid_y = (y2+y1)/2;
        StdDraw.point(mid_x, mid_y);
        drawLine(x1,y1,mid_x,mid_y);
        drawLine(mid_x,mid_y,x2,y2);
}

 

As far as being faster than Bresnham, It will never be as fast because you have to build a stack frame and destroy it for every call to Tingsline. 

And nothing will be faster than Lee's ALC version. I use Ting's line because it is pretty small.

[+Vorticon]

Thanks! I'll play with this and see what I can come up with.

[+TheBF]

Awhile back I commented somewhere that TI-Forth was not finished and many people didn't agree.

 

Armed with Lee Stewarts masterful translation of the math to compute placing squares in multicolor mode, I translated it to Forth so we can compare the code to the TI-Forth version. 

 

Here is MCHAR in TI-Forth 

VARIABLE PADR 
HEX
: MCHAR ( COLOR C R --- ) 
      DUP >R 2 / SWAP DUP >R 2 / SWAP
      DUP >R GCHAR  DUP 20 /  100 UM* DROP 800 + >R  
      20 MOD 8 * R> + R>  4 MOD 2 * + PADR ! 
      R> 2 MOD 
      R> 2 MOD SWAP
      IF    IF 3 ELSE 1 THEN  
      ELSE  IF 2 ELSE 0 THEN   
      THEN
      DUP 2 MOD 0= IF SWAP 10 * SWAP THEN
      CASE 
           0 OF PADR @ VC@ 0F ENDOF  
           1 OF PADR @ VC@ F0 ENDOF
           2 OF 1 PADR +! PADR @ VC@ 0F ENDOF
           3 OF 1 PADR +! PADR @ VC@ F0 ENDOF
      ENDCASE 
      AND +   PADR @  VC! ;

\ * 107 words plus a variable

 

And here is Lee's method translated to Forth with some factoring to make it simpler to debug. 

I also used some optimizing words that are in Camel99 Forth but are not in TI-Forth.  (  2/  8*  >VPOS  DUP>R ) 

\ Derived from code by Lee Stewart 
: >NAME    ( row col -- Vaddr ) 2/ SWAP 2/ SWAP >VPOS ;
: ]PATTERN ( row char -- Vaddr)  8* PDT +  SWAP 7 AND + ;

HEX 
: NYBBLES ( color Vaddr colorbyte -- colorbyte')   
    SWAP 1 AND 
    IF   F0 AND  
    ELSE 0F AND  SWAP 4 LSHIFT 
    THEN +  ;

: MCHAR  ( color col row --)
    2DUP >NAME VC@ ]PATTERN DUP>R VC@  NYBBLES  R> VC! ;

\ * 35 words used in total, factored into 4 hi-level words.  no variable. 

 

This is an example of what I meant. It seems like, in fact I am pretty certain, given the end of life of TI-99 at the time,

the guys at TI were in a rush to make everything work, but they were not given any time for finesse.

 

And the Forth version performs pretty well. 

Here is TESTLINE2 using this version of MCHAR.  You can compare it to the version above that uses Forth Assembler to do the same three sub-routines, >NAME, ]PATTERN and NYBBLES.  It's a bit slower, but I think the line drawing code is swamping much of the difference. 

 

 

[+FarmerPotato]

On 9/29/2024 at 6:59 PM, TheBF said:

It seems like, in fact I am pretty certain, given the end of life of TI-99 at the time,

the guys at TI were in a rush to make everything work, but they were not given any time for finesse

I think I have found part of that story. 
 

First, my dad's copy of the TI Forth manual is November 82. It is a spiral bound manual, corporate card stock cover, little window cutout revealing the title on page i. It seems identical to the docs that were released to public domain later. 
 

Early 1983. Frank Spitznogle presents his plan (and budget?) for the Armadillo/Pegasus team.  Leon Tietz has been assigned to it.   Notable achievements: porting Forth. Expert in p-Code. Amazing optimism in Frank's memo.  It seems like rockets at full blast.  

 

I surmise that Leon Tietz worked on p-Code. Never any rumor about  Forth on the 99/8, right? 
 

Then, in March 83, the s**t hit the fan. Inventory is being returned to TI and Home Computer is burning money.  Fred Bucy came down to Lubbock, kicking asses and taking names. I wonder what  happens to the plan for those personnel assignments? 

Also, TIPC is projected to need lots of capital over two years. 
 

UCSD p-System ships for TIPC (so the magazines say?) and the 99/8 version is, well, coming along, when the ban-hammer comes down in Nov 83.

 

Suppose nobody's looked at TI Forth for a year. Maybe they were going to get around to it after Pascal, or after CES. 

 

There was a thorough post-Mortem of the Home Computer (all documents remain with TI, not archived at SMU.)  One folder documented this: Licenses and 3rd party contracts have to be settled. 

Forth is not encumbered by any licenses.   So the version from Nov 82 can be given away. They add a note saying it has not been extensively reviewed or tested. 

 

(This is a conjecture.  Using the known facts, but still conjecture “how it might have happened.”)