Retrospect Posted May 6, 2017 Author Share Posted May 6, 2017 I don't know what happened with this one Lee but the screen screwed up again during the pasting ... this was using the 2.09 version too Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 6, 2017 Author Share Posted May 6, 2017 In the meantime, I've got another TI Basic example, this time , documented, (a nod to lee's documentation style) I'd love to see this one running in Forth with a slight delay. As it is you're gonna need CPU Overdrive in Classic99 REM / WATERFALL REM / CHARS 104 TO 111 ARE WATER STRAIGHT REM / CHARS 112 TO 119 ARE WATER DOWN REM / CHAR 120 IS GROUND REM / CHAR 128 TO 131 IS CLOUDS REM / CHAR 132 & 133 IS A BIRD 10 CALL CLEAR 20 FOR N=104 TO 119 30 READ X$ 40 CALL CHAR(N,X$) 50 NEXT N 60 DATA FFC7BB7DFFFFFFFF,FF8F77FAFFFFFFFF,FF1FEEF5FFFFFFFF,FF3EDDEBFFFFFFFF,FF7CBBD7FFFFFFFF 70 DATA FFF877AFFFFFFFFF,FFF1EE5FFFFFFFFF,FFE3DDBEFFFFFFFF 80 DATA FDFDFBDBDBBFBFBF,BFFDFDFBDBDBBFBF,BFBFFDFDFBDBDBBF,BFBFBFFDFDFBDBDB,DBBFBFBFFDFDFBDB 90 DATA DBDBBFBFBFFDFDFB,FBDBDBBFBFBFFDFD,FDFBDBDBBFBFBFFD 100 CALL CHAR(120,"423865D085D24D38") 110 CALL CHAR(128,"000003070F0F3F7F") 120 CALL CHAR(129,"FFFFFFFF7F0F0000") 130 CALL CHAR(130,"0000C0E0F0F0FCFE") 140 CALL CHAR(131,"FFFFFFFFFEF00000") 141 CALL CHAR(132,"000000C628100000") 142 CALL CHAR(133,"0000285482000000") REM / BLANK THE SCREEN AND DRAW EVERYTHING 150 CALL SCREEN(2) 160 FOR N=2 TO 12 170 CALL COLOR(N,2,2) 180 NEXT N REM / DRAW THE GROUND 190 FOR N=6 TO 24 200 CALL HCHAR(N,16,120,16) 210 NEXT N REM / DRAW THE WATER STRAIGHT AND DOWN USING WA AND WB VARIABLES FOR THE CHARS 104 AND 112 REM / BIRD IS CHARS BA AND IT'S POSITION IS Y 214 WA=104 215 WB=112 216 BA=132 218 Y=1 220 CALL HCHAR(5,16,WA,16) 230 CALL VCHAR(5,15,WB,19) 240 CALL HCHAR(24,1,WA,15) REM / DRAW CLOUDS USING CX,CY AND SUB TO 1000 250 CX=1 260 CY=5 270 GOSUB 1000 280 CX=2 290 CY=9 300 GOSUB 1000 310 CX=2 320 CY=17 330 GOSUB 1000 340 CX=1 350 CY=25 360 GOSUB 1000 REM / MAKE SCREEN BLUE AND SWITCH COLOR ON 370 CALL SCREEN(6) 380 CALL COLOR(10,5,16) 390 CALL COLOR(11,5,16) 400 CALL COLOR(12,7,10) 410 CALL COLOR(13,16,1) REM / ANIMATE THE WATER & BIRD REM / BIRD MOVES 1 CHAR POSITION EVERYTIME THE WATER GETS TO CHAR 111 430 WA=WA+1 440 WB=WB+1 450 IF WA>111 THEN 451 ELSE 460 451 WA=104 452 CALL HCHAR(4,1,32,32) 453 BA=BA+1 454 IF BA>133 THEN 455 ELSE 456 455 BA=132 456 Y=Y+1 457 IF Y>32 THEN 458 ELSE 460 458 Y=1 460 IF WB>119 THEN 461 ELSE 470 461 WB=112 470 CALL HCHAR(5,16,WA,16) 480 CALL VCHAR(5,15,WB,19) 490 CALL HCHAR(24,1,WA,15) 495 CALL HCHAR(4,Y,BA) 500 GOTO 430 REM / DRAW THE CLOUDS SUBROUTINE FOR CX,CY 1000 CALL HCHAR(CX,CY,128) 1010 CALL HCHAR(CX,CY+1,130) 1020 CALL HCHAR(CX+1,CY,129) 1030 CALL HCHAR(CX+1,CY+1,131) 1040 RETURN Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 6, 2017 Share Posted May 6, 2017 I don't know what happened with this one Lee but the screen screwed up again during the pasting ... this was using the 2.09 version too Sorry about that. I did not expect this one to be pasted into fbForth. It was only explanatory. The operating code is identical to the earlier post. The reason the last version will not work is that several lines are longer than 80 characters. The fbForth terminal input mechanism will only accept 80 characters per line. This results in the remainder of lines longer than 80 characters being pasted in as a second new line. That second new line almost certainly will result in an error. ...lee 2 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 6, 2017 Author Share Posted May 6, 2017 Sorry about that. I did not expect this one to be pasted into fbForth. It was only explanatory. The operating code is identical to the earlier post. The reason the last version will not work is that several lines are longer than 80 characters. The fbForth terminal input mechanism will only accept 80 characters per line. This results in the remainder of lines longer than 80 characters being pasted in as a second new line. That second new line almost certainly will result in an error. ...lee ahh my mistake ... I notice the errors start right away, this is due to the nature of forth, it doesn't have to wait for an execution command as such? Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 6, 2017 Share Posted May 6, 2017 ahh my mistake ... I notice the errors start right away, this is due to the nature of forth, it doesn't have to wait for an execution command as such? Yeah—When typing at the “command line”, you are in the hands of the outer or text interpreter. After a line is entered with <ENTER> or typing the 80th character of a line, the interpreter parses the line as space-delimited tokens, each of which it looks up in the dictionary. If it finds it, it either executes it or compiles it depending on STATE (executing or compiling). If you are defining a word, you are compiling. Otherwise, you are executing. If the interpreter does not find the word, it tries to convert the token to a number to push onto the stack. Failing that, you immediately get an error message and the interpreter aborts, which clears the stacks and restarts the interpreter—it is an infinite loop. ...lee 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 8, 2017 Share Posted May 8, 2017 In the meantime, I've got another TI Basic example, this time , documented, (a nod to lee's documentation style) ... I'd love to see this one running in Forth with a slight delay. As it is you're gonna need CPU Overdrive in Classic99 Here ya go, Joe: HEX \ chars 104 - 120 : CHR1 ( --- ) DATA[ FFC7 BB7D FFFF FFFF ( river ) FF8F 77FA FFFF FFFF ( . ) FF1F EEF5 FFFF FFFF ( . ) FF3E DDEB FFFF FFFF ( . ) FF7C BBD7 FFFF FFFF ( . ) FFF8 77AF FFFF FFFF ( . ) FFF1 EE5F FFFF FFFF ( . ) FFE3 DDBE FFFF FFFF ( . ) FDFD FBDB DBBF BFBF ( waterfall ) BFFD FDFB DBDB BFBF ( . ) BFBF FDFD FBDB DBBF ( . ) BFBF BFFD FDFB DBDB ( . ) DBBF BFBF FDFD FBDB ( . ) DBDB BFBF BFFD FDFB ( . ) FBDB DBBF BFBF FDFD ( . ) FDFB DBDB BFBF BFFD ( . ) 4238 65D0 85D2 4D38 ( ground ) ]DATA 68 DCHAR ; \ load 17 char patterns starting at 104 \ chars 128 - 133 : CHR2 ( --- ) DATA[ 0000 0307 0F0F 3F7F ( clouds ) FFFF FFFF 7F0F 0000 ( . ) 0000 C0E0 F0F0 FCFE ( . ) FFFF FFFF FEF0 0000 ( . ) 0000 00C6 2810 0000 ( bird ) 0000 2854 8200 0000 ( . ) ]DATA 80 DCHAR ; \ load 6 char patterns starting at 128 DECIMAL \ "constants"--- 0 CONSTANT WATERPOS \ current char pos for river and waterfall 0 CONSTANT BIRDPOS \ current char pos for bird 0 CONSTANT BIRDCOL \ current bird column \ ~1 msec delay : msec ( n --- ) 0 DO \ loop 0 to n-1 11 0 DO \ loop 0 to 11-1 LOOP LOOP ; \ blank to black screen : SCR_OFF ( --- ) 1 SCREEN \ blank screen 16 4 DO \ loop through char sets 4 - 15 1 1 I COLOR \ char set I to black on black LOOP ; \ make drawn screen appear : SCR_ON ( --- ) 5 SCREEN \ lt blue screen 5 5 4 COLOR \ char set with "space": lt blue on lt blue 4 15 13 COLOR \ char set 13: dk blue on white 4 15 14 COLOR \ char set 14: dk blue on white 6 9 15 COLOR \ char set 15: dk red on lt red 15 0 16 COLOR \ char set 16: white on transparent ; \ draw the ground : GROUND ( --- ) 24 5 DO \ loop rows 5 - 23 15 I 16 120 HCHAR \ draw row I LOOP ; \ toggle bird character (it will be 0 or 1) : FLAP ( --- ) BIRDPOS \ get bird char pos 1 XOR \ toggle it to 1 or 0 ' BIRDPOS \ get pfa of BIRDPOS constant ! \ store new value in parameter field ; \ move bird column by 1 : BIRD+ ( --- ) BIRDCOL 1+ \ get bird col and increment DUP 31 > \ dup and test for off screen pos IF DROP 0 \ too far; drop new val for 0 THEN ' BIRDCOL ! \ store new value in parameter field ; \ make bird fly : FLY ( --- ) WATERPOS 0= \ test for first water char IF \ fly bird only if on first water char FLAP \ flap wings by changing char pattern BIRD+ \ move bird 1 col right 0 3 32 32 HCHAR \ clear bird from sky BIRDCOL 3 1 \ col, row, cnt 132 BIRDPOS + \ get bird char HCHAR \ put bird back in sky at new position THEN ; \ advance char position for river and waterfall : WATER+ ( --- ) WATERPOS 1+ \ get water chars position and increment 7 AND \ force to 0 - 7 ' WATERPOS ! \ store new char position in parameter field ; \ draw water in next position : WATER ( --- ) \ draw top river 15 4 16 \ col, row, count 104 WATERPOS + \ calculate river char HCHAR \ draw top river \ draw waterfall 14 4 19 \ col, row, count 112 WATERPOS + \ calculate waterfall char VCHAR \ draw waterfall \ draw bottom river 0 23 15 \ col, row, count 104 WATERPOS + \ calculate river char HCHAR \ draw bottom river FLY \ fly bird WATER+ \ increment water chars ; \ draw a cloud : CLOUD ( col row --- ) OVER OVER \ copy col & row 1 128 HCHAR \ draw top left of cloud OVER 1+ OVER \ copy col; col + 1; copy row 1 130 HCHAR \ draw top right of cloud OVER OVER 1+ \ copy col & row; row + 1 1 129 HCHAR \ draw bottom left of cloud 1+ SWAP 1+ SWAP \ col + 1; row + 1 1 131 HCHAR \ draw bottom right of cloud ; \ draw 4 clouds : CLOUDS ( --- ) 4 0 CLOUD \ draw 1st cloud 8 1 CLOUD \ draw 2nd cloud 16 1 CLOUD \ draw 3rd cloud 24 0 CLOUD \ draw 4th cloud ; \ set waterfall scene in motion : WATERFALL ( --- ) VDPMDE @ \ save screen mode to stack GRAPHICS \ set Graphics mode SCR_OFF \ blank screen CHR1 CHR2 \ set up characters for scene GROUND \ draw ground CLOUDS \ draw clouds WATER \ draw rivers, waterfall and bird SCR_ON \ turn screen on BEGIN \ indefinite loop for animation 10 msec \ pause WATER \ next position of rivers, waterfall and bird ?TERMINAL \ break? UNTIL \ again? VMODE \ restore screen mode (value on stack) ; The waterfall and bird are moving with a ~10 ms delay. Sorry it took me so long. After I was sure there was nothing wrong with the code, there was still something wrong. It turned out the problem was my using "Paste XB" to paste the code into fbForth—bad move! ‘ ! ’ is a Forth word but a rest-of-line comment in XB (like \ in fbForth) and the Classic99 manual clearly states you should not use “Paste XB” without the XB cartridge. It obviously swallowed my ! words. ...lee 1 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 8, 2017 Author Share Posted May 8, 2017 That's brilliant Lee ... that slight delay seems to be just right. Of course, I'll be attempting to study all this Forth later tonight in the hope that I can start learning some of it even though it's such a steep learning curve for me at the moment. Your comments in the code will help a lot though! I might start out with something simple like a little Dopewars selling/buying game. 1 Quote Link to comment Share on other sites More sharing options...
Willsy Posted May 8, 2017 Share Posted May 8, 2017 This should help: http://turboforth.net/tutorials/tutorials.html Most of it will apply equally well to fbForth. 3 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 8, 2017 Author Share Posted May 8, 2017 This should help: http://turboforth.net/tutorials/tutorials.html Most of it will apply equally well to fbForth. Nice one Willsy. I'm having a look at it Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 9, 2017 Share Posted May 9, 2017 Here is a variation that has the waterfall going 8 times the speed of the upper and lower rivers. Tthe rivers are now updated at the same time as the bird. HEX \ chars 104 - 120 : CHR1 ( --- ) DATA[ FFC7 BB7D FFFF FFFF ( river ) FF8F 77FA FFFF FFFF ( . ) FF1F EEF5 FFFF FFFF ( . ) FF3E DDEB FFFF FFFF ( . ) FF7C BBD7 FFFF FFFF ( . ) FFF8 77AF FFFF FFFF ( . ) FFF1 EE5F FFFF FFFF ( . ) FFE3 DDBE FFFF FFFF ( . ) FDFD FBDB DBBF BFBF ( waterfall ) BFFD FDFB DBDB BFBF ( . ) BFBF FDFD FBDB DBBF ( . ) BFBF BFFD FDFB DBDB ( . ) DBBF BFBF FDFD FBDB ( . ) DBDB BFBF BFFD FDFB ( . ) FBDB DBBF BFBF FDFD ( . ) FDFB DBDB BFBF BFFD ( . ) 4238 65D0 85D2 4D38 ( ground ) ]DATA 68 DCHAR ; \ load 17 char patterns starting at 104 \ chars 128 - 133 : CHR2 ( --- ) DATA[ 0000 0307 0F0F 3F7F ( clouds ) FFFF FFFF 7F0F 0000 ( . ) 0000 C0E0 F0F0 FCFE ( . ) FFFF FFFF FEF0 0000 ( . ) 0000 00C6 2810 0000 ( bird ) 0000 2854 8200 0000 ( . ) ]DATA 80 DCHAR ; \ load 6 char patterns starting at 128 DECIMAL \ "constants"--- 0 CONSTANT RIVERPOS \ current char pos for river 0 CONSTANT FALLPOS \ current char pos for waterfall 0 CONSTANT BIRDPOS \ current char pos for bird 0 CONSTANT BIRDCOL \ current bird column \ ~1 msec delay : msec ( n --- ) 0 DO \ loop 0 to n-1 11 0 DO \ loop 0 to 11-1 LOOP LOOP ; \ blank to black screen : SCR_OFF ( --- ) 1 SCREEN \ blank screen 16 4 DO \ loop through char sets 4 - 15 1 1 I COLOR \ char set I to black on black LOOP ; \ make drawn screen appear : SCR_ON ( --- ) 5 SCREEN \ lt blue screen 5 5 4 COLOR \ char set with "space": lt blue on lt blue 4 15 13 COLOR \ char set 13: dk blue on white 4 15 14 COLOR \ char set 14: dk blue on white 6 9 15 COLOR \ char set 15: dk red on lt red 15 0 16 COLOR \ char set 16: white on transparent ; \ draw the ground : GROUND ( --- ) 24 5 DO \ loop rows 5 - 23 15 I 16 120 HCHAR \ draw row I LOOP ; \ toggle bird character (it will be 0 or 1) : FLAP ( --- ) BIRDPOS \ get bird char pos 1 XOR \ toggle it to 1 or 0 ' BIRDPOS \ get pfa of BIRDPOS constant ! \ store new value in parameter field ; \ move bird column by 1 : BIRD+ ( --- ) BIRDCOL 1+ \ get bird col and increment DUP 31 > \ dup and test for off screen pos IF DROP 0 \ too far; drop new val for 0 THEN ' BIRDCOL ! \ store new value in parameter field ; \ make bird fly : FLY ( --- ) FLAP \ flap wings by changing char pattern BIRD+ \ move bird 1 col right 0 3 32 32 HCHAR \ clear bird from sky BIRDCOL 3 1 \ col, row, cnt 132 BIRDPOS + \ get bird char HCHAR \ put bird back in sky at new position ; \ increment cyclicly (0 - 7) param field of supplied constant : CHAR+ ( pfa --- ) DUP \ dup pfa of constant @ \ get value in param field 1+ \ increment it 7 AND \ force to 0 - 7 SWAP \ get correct stack order for ! (store) ! \ store in parameter field ; \ advance char position for river : RIVER+ ( --- ) ' RIVERPOS \ get river char position's pfa CHAR+ \ cyclicly increment 0 - 7 ; \ advance char position for waterfall : FALL+ ( --- ) ' FALLPOS \ get waterfall char position's pfa CHAR+ \ cyclicly increment 0 - 7 ; \ draw water in next position : WATER ( --- ) \ draw waterfall 14 4 19 \ col, row, count 112 FALLPOS + \ calculate waterfall char VCHAR \ draw waterfall FALLPOS 0= \ test for first waterfall char IF \ flow rivers and fly bird only if on first waterfall char \ draw top river 15 4 16 \ col, row, count 104 RIVERPOS + \ calculate river char HCHAR \ draw top river \ draw bottom river 0 23 15 \ col, row, count 104 RIVERPOS + \ calculate river char HCHAR \ draw bottom river FLY \ fly bird RIVER+ \ increment RIVER char THEN FALL+ \ increment FALL char ; \ draw a cloud : CLOUD ( col row --- ) OVER OVER \ copy col & row 1 128 HCHAR \ draw top left of cloud OVER 1+ OVER \ copy col; col + 1; copy row 1 130 HCHAR \ draw top right of cloud OVER OVER 1+ \ copy col & row; row + 1 1 129 HCHAR \ draw bottom left of cloud 1+ SWAP 1+ SWAP \ col + 1; row + 1 1 131 HCHAR \ draw bottom right of cloud ; \ draw 4 clouds : CLOUDS ( --- ) 4 0 CLOUD \ draw 1st cloud 8 1 CLOUD \ draw 2nd cloud 16 1 CLOUD \ draw 3rd cloud 24 0 CLOUD \ draw 4th cloud ; \ set waterfall scene in motion : WATERFALL ( --- ) VDPMDE @ \ save screen mode to stack GRAPHICS \ set Graphics mode SCR_OFF \ blank screen CHR1 CHR2 \ set up characters for scene GROUND \ draw ground CLOUDS \ draw clouds WATER \ draw rivers, waterfall and bird SCR_ON \ turn screen on BEGIN \ indefinite loop for animation 10 msec \ pause WATER \ next position of rivers, waterfall and bird ?TERMINAL \ break? UNTIL \ again? VMODE \ restore screen mode (value on stack) ; ...lee 1 Quote Link to comment Share on other sites More sharing options...
Asmusr Posted May 9, 2017 Share Posted May 9, 2017 Are you using it with v2.0:9? When I selected "software", it brought up v2.0:5---that definitely will not work! ...lee I have updated the bundled version in js99er.net to 2.0.9. 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 9, 2017 Share Posted May 9, 2017 I have updated the bundled version in js99er.net to 2.0.9. Thank you, Sir! I was going to ask, but you beat me to it—thanks again. ...lee 1 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 10, 2017 Author Share Posted May 10, 2017 Lee that's brill! Love how the waterfall is in the new one. Cheers Rasmus for updating forth. I have a little something planned for later on, to show, it's not quite "there" yet ... but it's gonna be good. 2 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 10, 2017 Author Share Posted May 10, 2017 (edited) Just a rough bit of code, I'm sat on the Chromebook at work, taking a slightly longer than expected break due to not much happenings ... Right, this one needs XB. Couple of issues with it, * For some strange reason it REALLY slows down when you fire. I'm talking worse than Nintendo SNES slowdown. This needs looking at. * once an alien has been shot, for some reason the "getting shot" thing happens again and again until it counts to 8 (the number of aliens on screen) and then congratulates you. * When the aliens have moved down to the lowest assigned position, the congratulatory noise happens and the screen re-draws. (this is done on purpose for now) * Collision detection is barely there but you CAN shoot some of them * Control with S and D and space to shoot * Needs compiling! if you do , change the ticker in line 291 to max out at something like 64 instead of 8 INVASION.zip THE INVASION.txt Edited May 10, 2017 by Retrospect 1 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted May 10, 2017 Author Share Posted May 10, 2017 Here is a variation that has the waterfall going 8 times the speed of the upper and lower rivers. Tthe rivers are now updated at the same time as the bird. HEX \ chars 104 - 120 : CHR1 ( --- ) DATA[ FFC7 BB7D FFFF FFFF ( river ) FF8F 77FA FFFF FFFF ( . ) FF1F EEF5 FFFF FFFF ( . ) FF3E DDEB FFFF FFFF ( . ) FF7C BBD7 FFFF FFFF ( . ) FFF8 77AF FFFF FFFF ( . ) FFF1 EE5F FFFF FFFF ( . ) FFE3 DDBE FFFF FFFF ( . ) FDFD FBDB DBBF BFBF ( waterfall ) BFFD FDFB DBDB BFBF ( . ) BFBF FDFD FBDB DBBF ( . ) BFBF BFFD FDFB DBDB ( . ) DBBF BFBF FDFD FBDB ( . ) DBDB BFBF BFFD FDFB ( . ) FBDB DBBF BFBF FDFD ( . ) FDFB DBDB BFBF BFFD ( . ) 4238 65D0 85D2 4D38 ( ground ) ]DATA 68 DCHAR ; \ load 17 char patterns starting at 104 \ chars 128 - 133 : CHR2 ( --- ) DATA[ 0000 0307 0F0F 3F7F ( clouds ) FFFF FFFF 7F0F 0000 ( . ) 0000 C0E0 F0F0 FCFE ( . ) FFFF FFFF FEF0 0000 ( . ) 0000 00C6 2810 0000 ( bird ) 0000 2854 8200 0000 ( . ) ]DATA 80 DCHAR ; \ load 6 char patterns starting at 128 DECIMAL \ "constants"--- 0 CONSTANT RIVERPOS \ current char pos for river 0 CONSTANT FALLPOS \ current char pos for waterfall 0 CONSTANT BIRDPOS \ current char pos for bird 0 CONSTANT BIRDCOL \ current bird column \ ~1 msec delay : msec ( n --- ) 0 DO \ loop 0 to n-1 11 0 DO \ loop 0 to 11-1 LOOP LOOP ; \ blank to black screen : SCR_OFF ( --- ) 1 SCREEN \ blank screen 16 4 DO \ loop through char sets 4 - 15 1 1 I COLOR \ char set I to black on black LOOP ; \ make drawn screen appear : SCR_ON ( --- ) 5 SCREEN \ lt blue screen 5 5 4 COLOR \ char set with "space": lt blue on lt blue 4 15 13 COLOR \ char set 13: dk blue on white 4 15 14 COLOR \ char set 14: dk blue on white 6 9 15 COLOR \ char set 15: dk red on lt red 15 0 16 COLOR \ char set 16: white on transparent ; \ draw the ground : GROUND ( --- ) 24 5 DO \ loop rows 5 - 23 15 I 16 120 HCHAR \ draw row I LOOP ; \ toggle bird character (it will be 0 or 1) : FLAP ( --- ) BIRDPOS \ get bird char pos 1 XOR \ toggle it to 1 or 0 ' BIRDPOS \ get pfa of BIRDPOS constant ! \ store new value in parameter field ; \ move bird column by 1 : BIRD+ ( --- ) BIRDCOL 1+ \ get bird col and increment DUP 31 > \ dup and test for off screen pos IF DROP 0 \ too far; drop new val for 0 THEN ' BIRDCOL ! \ store new value in parameter field ; \ make bird fly : FLY ( --- ) FLAP \ flap wings by changing char pattern BIRD+ \ move bird 1 col right 0 3 32 32 HCHAR \ clear bird from sky BIRDCOL 3 1 \ col, row, cnt 132 BIRDPOS + \ get bird char HCHAR \ put bird back in sky at new position ; \ increment cyclicly (0 - 7) param field of supplied constant : CHAR+ ( pfa --- ) DUP \ dup pfa of constant @ \ get value in param field 1+ \ increment it 7 AND \ force to 0 - 7 SWAP \ get correct stack order for ! (store) ! \ store in parameter field ; \ advance char position for river : RIVER+ ( --- ) ' RIVERPOS \ get river char position's pfa CHAR+ \ cyclicly increment 0 - 7 ; \ advance char position for waterfall : FALL+ ( --- ) ' FALLPOS \ get waterfall char position's pfa CHAR+ \ cyclicly increment 0 - 7 ; \ draw water in next position : WATER ( --- ) \ draw waterfall 14 4 19 \ col, row, count 112 FALLPOS + \ calculate waterfall char VCHAR \ draw waterfall FALLPOS 0= \ test for first waterfall char IF \ flow rivers and fly bird only if on first waterfall char \ draw top river 15 4 16 \ col, row, count 104 RIVERPOS + \ calculate river char HCHAR \ draw top river \ draw bottom river 0 23 15 \ col, row, count 104 RIVERPOS + \ calculate river char HCHAR \ draw bottom river FLY \ fly bird RIVER+ \ increment RIVER char THEN FALL+ \ increment FALL char ; \ draw a cloud : CLOUD ( col row --- ) OVER OVER \ copy col & row 1 128 HCHAR \ draw top left of cloud OVER 1+ OVER \ copy col; col + 1; copy row 1 130 HCHAR \ draw top right of cloud OVER OVER 1+ \ copy col & row; row + 1 1 129 HCHAR \ draw bottom left of cloud 1+ SWAP 1+ SWAP \ col + 1; row + 1 1 131 HCHAR \ draw bottom right of cloud ; \ draw 4 clouds : CLOUDS ( --- ) 4 0 CLOUD \ draw 1st cloud 8 1 CLOUD \ draw 2nd cloud 16 1 CLOUD \ draw 3rd cloud 24 0 CLOUD \ draw 4th cloud ; \ set waterfall scene in motion : WATERFALL ( --- ) VDPMDE @ \ save screen mode to stack GRAPHICS \ set Graphics mode SCR_OFF \ blank screen CHR1 CHR2 \ set up characters for scene GROUND \ draw ground CLOUDS \ draw clouds WATER \ draw rivers, waterfall and bird SCR_ON \ turn screen on BEGIN \ indefinite loop for animation 10 msec \ pause WATER \ next position of rivers, waterfall and bird ?TERMINAL \ break? UNTIL \ again? VMODE \ restore screen mode (value on stack) ; ...lee This is a great little program lee. I'll use this alongside learning the basics of forth . 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 11, 2017 Share Posted May 11, 2017 (edited) I have been working on creating additions to CAMEL99 Forth that make some training wheels for people who want to try Forth after TI BASIC The latest version of the EA5 file is here: https://github.com/bfox9900/CAMEL99 I used the DENILE program to beat up on my GRAPHICS words and it helped me find some bugs. I also thought it would funny/informative to write a Forth version that uses VARIABLES exactly like the BASICprogram. The hard thing for Forth is imitating BASIC strings, but fortunately I did that work in 1987for TI FORTH. Willsy liked the concepts so much he completely re-wrote them his own way for Turbo Forth and I re-wrote them againfor this job. So here is DENILE translated to Forth in a more literal way.So I guess this can be a ROSETTA stone to translate for BASIC PROGRAMERS. To use it start CAMEL99 in Classic99 and past it in.Then type RUN. BY THE WAY: Do not make Forth programs like this. Use Lee's example to see how it's really done. \ LITERAL TRANSLATION OF DENILE.BAS using variables \ This is not how Forth normally Forth is used \ but it was fun to see what would happen \ Integer variables in Forth are like BASIC in that \ they are global, meaning any part of the program \ can get at them. \ dialect: CAMEL99 Forth V 0.9 TRAINER \ with extensions to help TI-BASIC PROGRAMMERS \ un-rolled this loop HEX" 0102 0709 1F24 7F92" 65 CHARDEF \ 20 FOR L=65 TO 70 ) HEX" 8040 E090 F824 FE49" 66 CHARDEF \ 30 READ Q$ ) HEX" FF92 FF24 FF92 FF49" 67 CHARDEF \ 40 CALL CHAR(L,Q$) HEX" AA55 4489 2002 4801" 68 CHARDEF \ 50 NEXT L ) HEX" 0002 1735 7CFC 44AA" 69 CHARDEF \ Camel HEX" 0008 081C 2A08 1414" 70 CHARDEF \ little man HEX" 0083 C7AE FBEF BDF7" 104 CHARDEF \ 70 CALL CHAR(104,"0083C7AEFBEFBDF7") HEX" 0007 8F5D F7DF 7BEF" 105 CHARDEF \ 80 CALL CHAR(105,"00078F5DF7DF7BEF") HEX" 000E 1FBA EFBF F6DF" 106 CHARDEF \ 90 CALL CHAR(106,"000E1FBAEFBFF6DF") HEX" 001C 3E75 DF7F EDBF" 107 CHARDEF \ 100 CALL CHAR(107,"001C3E75DF7FEDBF") HEX" 0038 7CEA BFFE DB7F" 108 CHARDEF \ 110 CALL CHAR(108,"00387CEABFFEDB7F") HEX" 0070 F8D5 7FFD B7FE" 109 CHARDEF \ 120 CALL CHAR(109,"0070F8D57FFDB7FE") HEX" 00E0 F1AB FEFB 6FFD" 110 CHARDEF \ 130 CALL CHAR(110,"00E0F1ABFEFB6FFD") HEX" 00C1 E357 FDF7 DEFB" 111 CHARDEF \ 140 CALL CHAR(111,"00C1E357FDF7DEFB") \ ALL variables must be defined first VARIABLE X VARIABLE C VARIABLE T VARIABLE Y 32 STRING: A$ \ STRING: is not standard Forth. We made it to for you. 32 STRING: B$ \ *BTW Strings can have any name 32 STRING: C$ : TAB ( n -- ) 0 ?DO SPACE LOOP ; \ we don't have a TAB word so make one : PYRAMID A$ ="" B$ ="" C$ ="" 14 X ! \ 160 X=13 1 C ! \ 170 C=1 CR X @ 1+ TAB ." AB" \ 180 PRINT TAB(X+1);"AB" BEGIN \ " needs a space, '&' is RPN C$ " CC" & C$ $! \ 190 C$=C$&"CC" " A" C$ & " B" & B$ $! \ 200 B$="A"&C$&"B" CR X @ TAB B$ PRINT \ 210 PRINT TAB(X);B$ 1 C +! \ 220 C=C+1 -1 X +! \ 230 X=X-1 C @ 14 = \ 240 IF C=13 THEN 250 ELSE 190 UNTIL 0 23 68 32 HCHAR \ 250 CALL HCHAR(24,1,68,32) 0 22 69 1 HCHAR \ 260 CALL HCHAR(23,1,69) 1 22 70 1 HCHAR \ 270 CALL HCHAR(23,2,70) CR \ 280 PRINT CR \ 290 PRINT CR \ 295 PRINT 0 23 68 32 HCHAR \ 296 CALL HCHAR(24,1,68,32) ; : RIVER \ flow the river loop *EDIT* IF ELSE not needed for Forth 104 T ! \ 300 T=104 106 Y ! \ 310 Y=106 BEGIN 1 T +! \ 320 T=T+1 T @ 111 > \ 330 IF T>111 THEN 340 ELSE 350 IF 104 T ! THEN \ 340 T=104 2 Y +! \ 350 Y=Y+2 Y @ 111 > \ 360 IF Y>111 THEN 370 ELSE 380 IF 104 Y ! THEN \ 370 Y=104 0 21 T @ 32 HCHAR \ 380 CALL HCHAR(22,1,T,32) 0 22 Y @ 32 HCHAR \ 390 CALL HCHAR(23,1,Y,32) 100 MS KEY? UNTIL \ 400 GOTO 320 ; : RUN \ Forth doesn't have RUN so we make one CLEAR \ 10 CALL CLEAR 4 SCREEN \ BASIC does this, Forth only does what you say 13 6 5 COLOR \ 150 CALL COLOR[10,6,5] \ Forth has different sets, PYRAMID \ 500 GOSUB PYRAMID RIVER \ 600 GOSUB RIVERFLOW ; Edited May 11, 2017 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 11, 2017 Share Posted May 11, 2017 (edited) In fact I think that if that source wasn't documented it's byte-count would be less than the BASIC list I made. Comments are FREE in Forth. The compiler reads the file and throws comments away. Regarding code size I just measured CAMEL99 version at 554 bytes (all in mem. expansion) Of course there is 8K of run time block underneath it all but that is not so different than TI BASIC ROMS and GROMS. One the reasons This Forth version is smaller is because it loads the character patterns with the interpreter when the program loads. CHARDEF just loads the data into VDP ram in "IMMEDIATE MODE" as we say in BASIC and nothing is stored in the program. Kind of cool. In Extended BASIC the program uses: 976 bytes for program and 11 bytes of "stack memory" Edited May 11, 2017 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
sometimes99er Posted May 12, 2017 Share Posted May 12, 2017 Just a rough bit of code, I'm sat on the Chromebook at work, taking a slightly longer than expected break due to not much happenings ... Right, this one needs XB. Couple of issues with it, INVASION.txt Truly amazing. Actually had to check if CPU Overdrive was on. Very inspirational. Thanks. 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted May 12, 2017 Share Posted May 12, 2017 Just for fun RXB version: 10 CALL CLEAR 20 FOR N=104 TO 119 30 READ X$ 40 CALL CHAR(N,X$) 50 NEXT N 60 DATA FFC7BB7DFFFFFFFF,FF8F77FAFFFFFFFF,FF1FEEF5FFFFFFFF,FF3EDDEBFFFFFFFF,FF7CBBD7FFFFFFFF 70 DATA FFF877AFFFFFFFFF,FFF1EE5FFFFFFFFF,FFE3DDBEFFFFFFFF 80 DATA FDFDFBDBDBBFBFBF,BFFDFDFBDBDBBFBF,BFBFFDFDFBDBDBBF,BFBFBFFDFDFBDBDB,DBBFBFBFFDFDFBDB 90 DATA DBDBBFBFBFFDFDFB,FBDBDBBFBFBFFDFD,FDFBDBDBBFBFBFFD 100 CALL CHAR(120,"423865D085D24D38") 110 CALL CHAR(128,"000003070F0F3F7FFFFFFFFF7F0F00000000C0E0F0F0FCFEFFFFFFFFFEF00000000000C6281000000000285482000000") 150 CALL SCREEN(2) 160 FOR N=2 TO 12 170 CALL COLOR(N,2,2) 180 NEXT N 190 FOR N=6 TO 24 200 CALL HCHAR(N,16,120,16) 210 NEXT N 214 WA=104 215 WB=112 216 BA=132 218 Y=1 220 CALL HCHAR(5,16,WA,16,24,1,WA,15) 230 CALL VCHAR(5,15,WB,19) 250 CX=1 260 CY=5 270 GOSUB 1000 280 CX=2 290 CY=9 300 GOSUB 1000 310 CX=2 320 CY=17 330 GOSUB 1000 340 CX=1 350 CY=25 360 GOSUB 1000 370 CALL SCREEN(6) 380 CALL COLOR(10,5,16,11,5,16,12,7,10,13,16,1) 430 WA=WA+1 440 WB=WB+1 450 IF WA>111 THEN 451 ELSE 460 451 WA=104 452 CALL HCHAR(4,1,32,32) 453 BA=BA+1 454 IF BA>133 THEN 455 ELSE 456 455 BA=132 456 Y=Y+1 457 IF Y>32 THEN 458 ELSE 460 458 Y=1 460 IF WB>119 THEN 461 ELSE 470 461 WB=112 470 CALL HCHAR(5,16,WA,16,24,1,WA,15,4,Y,BA) 480 CALL VCHAR(5,15,WB,19) 500 GOTO 430 1000 CALL HCHAR(CX,CY,128,1,CX,CY+1,130,1,CX+1,CY,129,1,CX+1,CY+1,131) 1040 RETURN 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 12, 2017 Share Posted May 12, 2017 (edited) Just a rough bit of code, I'm sat on the Chromebook at work, taking a slightly longer than expected break due to not much happenings ... Right, this one needs XB. Couple of issues with it, <snip> INVASION.zip THE INVASION.txt This is very cool. Thank you. I am going to use this to debug my SPRITE CODE. BF Edited May 12, 2017 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 21, 2017 Share Posted May 21, 2017 (edited) Denile multi.mov I want to thank retrospect for this nice little scene. It gave me something to work on to beat up my graphics and muli-tasker. I might have gone a little overboard... But anyway, it works!! ... And isn't that all we care about. Here is the reworked code in Forth with 5 tasks running independently including the Console task. Check back in a few minutes for a movie of the "animation" (No sprites yet... this is not done yet.) \ DENILE #6 Multi-tasking demonstration \ dialect: MULTICAM , CAMEL99 Multi-tasking kernel \ with TI BASIC STYLE extensions \ ==================================================== \ save & restore character set \ we will use some low expansion RAM at address HEX 2000 HEX 2000 CONSTANT CHARBUFF \ it's just that easy \ PDT is the pattern descriptor table in VDP RAM \ 800 is how many bytes it contains (2K bytes) \ VREAD is VMBR in TI speak \ VWRITE is VMBW in TI speak : SAVE-CHARSET ( -- ) ( from) PDT ( to) CHARBUFF 800 ( bytes) VREAD ; \ *NEW* "COLORS" restores mulitple charsets wow! : RESTORE-CHARSET ( -- ) ( from) CHARBUFF ( to) PDT 800 ( bytes) VWRITE 0 16 2 1 COLORS ( change all color sets) 8 SCREEN ; \ give names to the pattern data \ Where BASIC uses strings, we will use HEX integers \ Each word drops 4 numbers onto the stack for CHARDEF \ to pickup HEX : RSLOPE ( -- n1 n2 n3 n4) 0102 0709 1F24 7F92 ; : LSLOPE ( -- n1 n2 n3 n4) 8040 E090 F824 FE49 ; : STONE ( -- n1 n2 n3 n4) FF92 FF24 FF92 FF49 ; : SAND ( -- n1 n2 n3 n4) AA55 4489 2002 4801 ; : CAMEL ( -- n1 n2 n3 n4) 0002 1735 7CFC 44AA ; \ head up : CAMEL2 ( -- n1 n2 n3 n4) 0000 1032 7FFD 44AA ; \ head down : MAN1 ( -- n1 n2 n3 n4) 0008 081C 2A08 1414 ; \ hands up : MAN2 ( -- n1 n2 n3 n4) 0008 2A1C 0808 1414 ; \ hands down : WAVE1 ( -- n1 n2 n3 n4) 0083 C7AE FBEF BDF7 ; : WAVE2 ( -- n1 n2 n3 n4) 0007 8F5D F7DF 7BEF ; : WAVE3 ( -- n1 n2 n3 n4) 000E 1FBA EFBF F6DF ; : WAVE4 ( -- n1 n2 n3 n4) 001C 3E75 DF7F EDBF ; : WAVE5 ( -- n1 n2 n3 n4) 0038 7CEA BFFE DB7F ; : WAVE6 ( -- n1 n2 n3 n4) 0070 F8D5 7FFD B7FE ; : WAVE7 ( -- n1 n2 n3 n4) 00E0 F1AB FEFB 6FFD ; : WAVE8 ( -- n1 n2 n3 n4) 00C1 E357 FDF7 DEFB ; 2 BASE ! \ we can use binary numbers to draw bits. : STAR ( -- n1 n2 n3 n4) 00000000 >< \ swap byte 00000000 + \ add the previous byte to make 16 bits 00000000 >< 00000000 + 00001000 >< \ LOL all this for 1 pixel 00000000 + 00000000 >< 00000000 + ; : MOONTOP 01000000 >< 00110000 + 00011000 >< 00011100 + 00001110 >< 00001110 + 00001111 >< 00001111 + ; : MOONBTM 00001111 >< 00001111 + 00001110 >< 00001110 + 00011100 >< 00011000 + 00110000 >< 01000000 + ; DECIMAL \ ==================================================== \ assign patterns to characters \ this is a big definItion but it is like a table of data \ so it is reads easily but it is CODE. \ SET# calculates the set# for a given character : CHANGE-CHARS ( -- ) SAVE-CHARSET \ pattern char set# fg bg color \ -------- ---- ---- ----------- RSLOPE 65 CHARDEF 65 SET# 11 1 COLOR LSLOPE 66 CHARDEF STONE 67 CHARDEF SAND 80 CHARDEF 80 SET# 2 12 COLOR CAMEL 88 CHARDEF 88 SET# 15 1 COLOR MAN1 89 CHARDEF STAR 96 CHARDEF 96 SET# 16 1 COLOR WAVE1 104 CHARDEF 104 SET# 5 6 COLOR WAVE2 105 CHARDEF WAVE3 106 CHARDEF WAVE4 107 CHARDEF WAVE5 108 CHARDEF WAVE6 109 CHARDEF WAVE7 110 CHARDEF WAVE8 111 CHARDEF MOONTOP 112 CHARDEF 112 SET# 15 1 COLOR MOONBTM 113 CHARDEF \ -------------------------------------------- ; : TABS ( n -- ) 0 ?DO SPACE LOOP ; \ DOT is the Forth word to print a number. \ These words begin with '.' to tell us they print something \ A common Forth style for naming words that print : .SAND ( col row -- ) 80 32 HCHAR ; : .CAMEL ( col row -- ) 88 1 HCHAR ; : .MAN ( col row -- ) 89 1 HCHAR ; : .LEFT ( -- ) [CHAR] A EMIT ; : .RIGHT ( -- ) [CHAR] B EMIT ; : .PEAK ( -- ) .LEFT .RIGHT ; : .BRICK ( -- ) [CHAR] C EMIT ; : .STAR ( col row -- ) 96 1 HCHAR ; \ we pass Y,X parameters to HCHAR : .STARS ( -- ) 1 1 .STAR 3 11 .STAR 6 3 .STAR 8 9 .STAR 13 2 .STAR 19 1 .STAR 22 4 .STAR 23 8 .STAR 28 3 .STAR 31 10 .STAR ; VARIABLE MCOL VARIABLE MROW : .MOON ( col row -- ) \ we pass Y,X parameters to HCHAR 2DUP MROW ! MCOL ! \ record the coordinates 2DUP 112 1 HCHAR 1+ 113 1 HCHAR ; : /MOON MCOL @ MROW @ \ CUT moon: erases the moon 2DUP BL 1 HCHAR 1+ BL 1 HCHAR ; : .1/2MOON ( col row) 112 1 HCHAR ; : .BRICKS ( n -- ) 0 DO .BRICK LOOP ; : .PYRAMID ( -- ) 15 6 AT-XY .PEAK 15 ( intitial tab value on stack) 13 1 DO CR DUP I - TABS ( subtact I from the tab value on stack .LEFT I 2* .BRICKS .RIGHT LOOP DROP ; ( drop the tab value) \ ==================================================== \ wave control variables VARIABLE T VARIABLE Y : WAVECLIP ( n -- n') DUP 111 > IF DROP 104 THEN ; \ clip n to valid wave char : NEXT-T ( -- n) T @ 1+ WAVECLIP DUP T ! ; \ inc T by 1 & clip : NEXT-Y ( -- n) Y @ 2+ WAVECLIP DUP Y ! ; \ inc Y by 2 & clip : INIT-WAVES ( -- ) 104 DUP T ! 2+ Y ! ; : .RIVER ( -- ) 0 20 NEXT-T 32 HCHAR 0 21 NEXT-Y 32 HCHAR ; \ ==================================================== \ PAINT the scene : .SCENE ( -- ) .PYRAMID 0 19 .SAND INIT-WAVES .RIVER 0 22 .SAND 1 18 .CAMEL 2 18 .MAN ; \ ==================================================== \ The follow loops will run as separate tasks : FLOW ( -- ) ( task that makes the river flow) INIT-WAVES BEGIN 10 MS .RIVER AGAIN ; : TWINKLE ( n -- ) ( task that makes the stars twinkle all colors) BEGIN 17 3 DO 96 SET# I 1 COLOR 5 MS LOOP AGAIN ; : MADCAMEL 4 0 DO CAMEL2 88 CHARDEF 20 MS CAMEL 88 CHARDEF 20 MS LOOP ; : MADMAN 6 0 DO MAN1 89 CHARDEF 10 MS MAN2 89 CHARDEF 10 MS LOOP MAN1 89 CHARDEF ; : CARTOON BEGIN 500 MS MADMAN 1 MS MADCAMEL AGAIN ; : MOONSET 200 MS /MOON 27 7 .MOON 200 MS /MOON 27 8 .MOON 200 MS /MOON 28 9 .MOON 200 MS /MOON 28 10 .MOON 200 MS /MOON 29 11 .MOON 200 MS /MOON 30 12 .MOON 200 MS /MOON 31 13 .MOON 200 MS /MOON MYSELF SLEEP PAUSE ; \ ========================================================= \ This loop will run in the console task (USER0) : WAITKEY ( -- ) \ waits for any key BEGIN 3 MS KEY? \ KSCAN takes too long so avoid UNTIL ; : ... 200 MS ; : INTRO 2 SCREEN 4 16 16 1 COLORS PAGE CR CR CR ." TI-99 MULTITASKING DEMONSTRATION" ... CR CR ." This demonstration runs 5 tasks" ... CR ." The console the is root task" ... CR ." #2 is the flowing river" ... CR ." #3 is the twinkling stars" ... CR ." #4 is the camel animation" ... CR ." #5 is the setting moon task" ... CR CR CR ." PRESS a key to start the demo" KEY DROP PAGE ; \ ======================================================== \ allocate memory for tasks CREATE TASK1 USIZE ALLOT CREATE TASK2 USIZE ALLOT CREATE TASK3 USIZE ALLOT CREATE TASK4 USIZE ALLOT : PREAMBLE SINGLE INIT-MULTI TASK1 FORK TASK2 FORK TASK3 FORK TASK4 FORK ['] FLOW TASK1 ASSIGN ['] TWINKLE TASK2 ASSIGN ['] CARTOON TASK3 ASSIGN ['] MOONSET TASK4 ASSIGN ; : RUN ( -- ) PREAMBLE SAVE-CHARSET INTRO CHANGE-CHARS .SCENE .STARS 26 6 .MOON .RIVER TASK1 WAKE TASK2 WAKE TASK3 WAKE TASK4 WAKE MULTI WAITKEY SINGLE HONK RESTORE-CHARSET CLEAR ; Edited May 21, 2017 by TheBF 5 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.