+TheBF Posted September 8 Author Share Posted September 8 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. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 8 Author Share Posted September 8 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)] Classic99 QI399.046 2024-09-08 17-13-28.mp4 2 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 9 Share Posted September 9 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 1 Quote Link to comment Share on other sites More sharing options...
GDMike Posted September 9 Share Posted September 9 Dang what a difference Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 9 Author Share Posted September 9 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. 1 Quote Link to comment Share on other sites More sharing options...
RickyDean Posted September 9 Share Posted September 9 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." 2 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 9 Author Share Posted September 9 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. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted Friday at 07:16 PM Author Share Posted Friday at 07:16 PM 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 ; MCHAR original TI Forth.mp4 MCHAR Opt V3.mp4 MCHAR FbForth Assembler.mp4 3 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted Saturday at 08:47 PM Author Share Posted Saturday at 08:47 PM 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! ; mchar Camel99 using code.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted Tuesday at 01:28 AM Author Share Posted Tuesday at 01:28 AM 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 ; Classic99 QI399.046 2024-09-16 21-26-23.mp4 MULTIMODE 2 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.