|
| 1 | +\ Graphics2 Mode V2.8 for Camel99 Forth Dec 2022 BJF |
| 2 | +\ Referenced TI-FORTH: |
| 3 | +( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO) |
| 4 | + |
| 5 | +\ Test results using simple program |
| 6 | +\ V2.1 Forth with text macros |
| 7 | +\ 2.7 critical VOR VERASE and XY-offset as CODE |
| 8 | +\ 2.8 PIXPOS re-coded in ASM |
| 9 | + |
| 10 | +\ COMPILES under ITC ONLY |
| 11 | +CR .( Two colour bit map mode ) |
| 12 | + |
| 13 | +NEEDS DUMP FROM DSK1.TOOLS |
| 14 | +NEEDS MOV, FROM DSK1.ASM9900 |
| 15 | +NEEDS VALUE FROM DSK1.VALUES |
| 16 | +NEEDS CHARSET FROM DSK1.CHARSET |
| 17 | +NEEDS ARRAY FROM DSK1.ARRAYS |
| 18 | +NEEDS 4TH FROM DSK1.3RD4TH \ fast access to deep stack items |
| 19 | + |
| 20 | +HEX |
| 21 | +\ |
| 22 | +\ text mode so we can return to the Forth console |
| 23 | +\ KERNEL version does not init all registers |
| 24 | +\ |
| 25 | +83D4 CONSTANT VDPR1 |
| 26 | +CREATE 40COL |
| 27 | +\ CNT 0 1 2 3 4 5 6 7 |
| 28 | + 08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C, |
| 29 | + |
| 30 | +: VREGS ( addr len -- ) |
| 31 | + OVER 1+ C@ VDPR1 C! \ store the R1 value from the table |
| 32 | + 0 DO COUNT I VWTR LOOP DROP ; |
| 33 | + |
| 34 | +HEX |
| 35 | + 0000 VALUE CTAB \ color table |
| 36 | + 2000 VALUE PDT \ pattern descriptor table |
| 37 | + 1800 VALUE IMG |
| 38 | + |
| 39 | +: TEXT ( -- ) |
| 40 | + 40COL COUNT VREGS |
| 41 | + 800 TO PDT |
| 42 | + 380 TO CTAB |
| 43 | + VTOP OFF |
| 44 | + 2 VMODE ! |
| 45 | + 28 C/L! |
| 46 | + CHARSET \ restore charset because VDP memory is mangled |
| 47 | + PAGE ; |
| 48 | + |
| 49 | +: CLEAR ( -- ) PDT 1800 0 VFILL ; \ ERASE pattern table |
| 50 | + |
| 51 | +: COLOR ( fg bg --) |
| 52 | + SWAP 4 LSHIFT SWAP + \ merge colors into a byte |
| 53 | + CTAB 1800 ROT VFILL ; \ init color table |
| 54 | + |
| 55 | +: INIT-IMAGE ( -- ) |
| 56 | + -1 IMG 300 BOUNDS DO 1+ DUP 0FF AND I VC! LOOP DROP ; |
| 57 | + |
| 58 | +\ replacing text macro with code words |
| 59 | +HEX |
| 60 | +' VC! 2 CELLS + @ CONSTANT VWMODE \ Access VDP write address sub-routine |
| 61 | +' VC@ 2 CELLS + @ CONSTANT VRMODE \ Access VDP read address sub-routine |
| 62 | + |
| 63 | +8800 CONSTANT VDPRD \ vdp ram read data port |
| 64 | +8C00 CONSTANT VDPWD \ vdp ram write data port |
| 65 | + |
| 66 | +\ : VOR ( c Vaddr -- ) DUP>R VC@ OR R> VC! ; |
| 67 | +CODE VOR ( c Vaddr -- ) |
| 68 | + VRMODE @@ BL, \ set read address, disables Interrupts |
| 69 | + W CLR, |
| 70 | + VDPRD @@ W MOVB, \ read screen data to W |
| 71 | + W SWPB, |
| 72 | + *SP+ W SOC, \ OR C on stack with screen data |
| 73 | + W SWPB, |
| 74 | + VWMODE @@ BL, \ set the address for writing |
| 75 | + W VDPWD @@ MOVB, \ write back to screen |
| 76 | + TOS POP, |
| 77 | + 2 LIMI, |
| 78 | + NEXT, |
| 79 | +ENDCODE |
| 80 | + |
| 81 | +\ : VAND ( c Vaddr -- ) S" DUP>R VC@ AND R> VC!" EVALUATE ; IMMEDIATE |
| 82 | +\ : VERASE ( c Vaddr -- ) >R INVERT R> VAND ; |
| 83 | + |
| 84 | +CODE VERASE ( c Vaddr -- ) |
| 85 | + VRMODE @@ BL, \ set read address |
| 86 | + W CLR, |
| 87 | + VDPRD @@ W MOVB, \ read screen data to W |
| 88 | + W SWPB, |
| 89 | + *SP+ W SZC, \ AND C on stack with screen data |
| 90 | + W SWPB, |
| 91 | + VWMODE @@ BL, \ set the address for writing |
| 92 | + W VDPWD @@ MOVB, \ write back to screen |
| 93 | + 2 LIMI, |
| 94 | + TOS POP, |
| 95 | + NEXT, |
| 96 | +ENDCODE |
| 97 | + |
| 98 | +\ PENCIL and ERASER are "execution tokens" |
| 99 | +' VOR CONSTANT PENCIL |
| 100 | +' VERASE CONSTANT ERASER |
| 101 | + |
| 102 | +VARIABLE STYLUS \ usage: PENCIL STYLUS ! ERASER STYLUS ! |
| 103 | + |
| 104 | +\ setup VDP code ... |
| 105 | +: GRAPHICS2 |
| 106 | + 0000 TO CTAB \ color table |
| 107 | + 1800 TO IMG \ "name" table (TI nomenclature) |
| 108 | + 2000 TO PDT \ pattern descriptor table |
| 109 | + |
| 110 | + 0A0 1 VWTR \ VR1 >A0 16K, screen on |
| 111 | + INIT-IMAGE |
| 112 | + F 0 COLOR \ white on transparent |
| 113 | + CLEAR |
| 114 | + 20 C/L! 300 C/SCR ! |
| 115 | + 2 0 VWTR \ VR0 >02 Bitmap mode on |
| 116 | + 6 2 VWTR \ Screen image = 6*>400 = 1800 |
| 117 | + 07F 3 VWTR \ Color table at >0000 |
| 118 | + 7 4 VWTR \ PATTERN table= VR4*>800 = 2000 |
| 119 | + 70 5 VWTR \ sprite attribute table: VR5*>80 = >3800 |
| 120 | + 7 6 VWTR \ sprite pattern table: VR6 * >800 = >3800 |
| 121 | + F1 7 VWTR \ screen background colour white on transparent |
| 122 | + 0E0 DUP VDPR1 C! 1 VWTR \ set mode, copy into memory for system |
| 123 | + 4 VMODE ! |
| 124 | + 0 837A C! ; \ highest sprite in auto-motion |
| 125 | + |
| 126 | + |
| 127 | +\ Compute offset into pattern table per: |
| 128 | +\ TI Video Display Processors, Programmer's Guide |
| 129 | + |
| 130 | +CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 , |
| 131 | + |
| 132 | +\ ============================================= |
| 133 | +\ PIXPOS Register usage |
| 134 | +\ R0 X offset |
| 135 | +\ R1 dup of Y coordinate |
| 136 | +\ R2 Temp Y quotient |
| 137 | +\ R3 Y coordinate |
| 138 | +\ R4 Forth Accumulator, outputs PDT address |
| 139 | +\ R8 = W = X division remainder |
| 140 | + |
| 141 | +CODE PIXPOS ( x y -- bit Vaddr) |
| 142 | +\ mask x,y to 8 bit values |
| 143 | + TOS 00FF ANDI, |
| 144 | + *SP R0 MOV, \ get X into R0, leave stack position available |
| 145 | + R0 00FF ANDI, |
| 146 | + |
| 147 | +\ calc X offset |
| 148 | + R0 W MOV, \ copy x to W |
| 149 | + R0 3 SRA, \ divide by 8 |
| 150 | + R0 3 SLA, \ mult quot by 8. R0 = X offset |
| 151 | + R0 W SUB, \ sub-tract result -> W = remainder |
| 152 | + |
| 153 | +\ convert remainder to bit mask |
| 154 | + W 1 SLA, \ W 2* |
| 155 | + BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack |
| 156 | + |
| 157 | +\ calc Y offset |
| 158 | + TOS R1 MOV, \ DUP Y for subtraction later |
| 159 | + TOS 3 SRA, \ divide by 8 = Y quotient |
| 160 | + TOS R2 MOV, \ dup quotient result |
| 161 | + R2 3 SLA, \ mult quot by 8 |
| 162 | + R2 R1 SUB, \ sub-tract result = remainder |
| 163 | + TOS SWPB, \ Y quotient 256* |
| 164 | + |
| 165 | +\ compute pattern table address |
| 166 | + R1 TOS ADD, \ add remainder to quotient |
| 167 | + R0 TOS ADD, \ add X offset to Y offset |
| 168 | + TOS PDT AI, \ add index to pattern table base address |
| 169 | + NEXT, |
| 170 | +ENDCODE |
| 171 | + |
| 172 | +\ TEXT macro for speed |
| 173 | +: PLOT ( x y -- ) S" PIXPOS STYLUS PERFORM " EVALUATE ; IMMEDIATE |
| 174 | + |
| 175 | +\ ==================================== |
| 176 | +\ line drawing |
| 177 | +DECIMAL |
| 178 | +: 2ROT ( d1 d2 d3 -- d2 d3 d1) S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE |
| 179 | +: 4DUP ( d1 d2 -- d1 d2 d1) S" 4TH 4TH 4TH 4TH" EVALUATE ; IMMEDIATE |
| 180 | + |
| 181 | +HEX |
| 182 | +\ manual tail call optimizer. Improves LINE by 1.5% |
| 183 | +CODE GOTO C259 , ( *IP IP MOV,) NEXT, ENDCODE |
| 184 | +: -; ( -- ) |
| 185 | + HERE 2- @ >BODY \ get previous XT, compute data field |
| 186 | + -2 ALLOT \ erase the previous XT |
| 187 | + POSTPONE GOTO , \ compile the address for GOTO |
| 188 | + POSTPONE [ \ turn off compiler |
| 189 | + REVEAL |
| 190 | + ?CSP |
| 191 | +; IMMEDIATE |
| 192 | + |
| 193 | +: LINE ( x1 y1 x2 y2 -- ) |
| 194 | +\ ANS version of Dr. Ting's recursive line R.I.P. |
| 195 | + 4DUP ROT - ABS >R - ABS R> |
| 196 | + MAX 2 < |
| 197 | + IF 2DROP PLOT EXIT THEN |
| 198 | + 4DUP ROT + 1+ 2/ >R |
| 199 | + + 1+ 2/ R> |
| 200 | + 2DUP 2ROT |
| 201 | + RECURSE RECURSE -; |
| 202 | + |
| 203 | +0 VALUE x |
| 204 | +0 VALUE y |
| 205 | + |
| 206 | +: MOVETO ( x y -- ) TO y TO x ; |
| 207 | +: LINETO ( x y -- ) 2DUP x y LINE MOVETO ; |
| 208 | + |
| 209 | +\ no safety net !! |
| 210 | +: HLINE ( x y len ) >R MOVETO R> 0 DO x I + y PLOT LOOP ; |
| 211 | +: VLINE ( x y len ) >R MOVETO R> 0 DO y x I + PLOT LOOP ; |
| 212 | + |
0 commit comments