Jump to content
Sign in to follow this  
Retrospect

In DeNile

Recommended Posts

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

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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

  • Like 2

Share this post


Link to post
Share on other sites

 

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? :)

Share this post


Link to post
Share on other sites

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

  • Like 2

Share this post


Link to post
Share on other sites

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. :dunce: It obviously swallowed my ! words.

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

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.

  • Like 1

Share this post


Link to post
Share on other sites

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

  • Like 1

Share this post


Link to post
Share on other sites

 

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.

  • Like 2

Share this post


Link to post
Share on other sites

 

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

  • Like 1

Share this post


Link to post
Share on other sites

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.

  • Like 2

Share this post


Link to post
Share on other sites

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 by Retrospect
  • Like 1

Share this post


Link to post
Share on other sites

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 .

  • Like 1

Share this post


Link to post
Share on other sites
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 BASIC
program. The hard thing for Forth is imitating BASIC strings, but fortunately I did that work in 1987
for TI FORTH. Willsy liked the concepts so much he completely re-wrote them his own way for Turbo Forth and I re-wrote them again
for 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 by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

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 by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

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. :)

 

  • Like 1

Share this post


Link to post
Share on other sites

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

  • Like 1

Share this post


Link to post
Share on other sites

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>

 

attachicon.gifINVASION.zip

attachicon.gifTHE INVASION.txt

 

This is very cool. Thank you.

 

I am going to use this to debug my SPRITE CODE.

 

BF

Edited by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

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 by TheBF
  • Like 5

Share this post


Link to post
Share on other sites

Join the conversation

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

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

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

×   Your previous content has been restored.   Clear editor

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

Loading...
Sign in to follow this  

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...