In DeNile

[Retrospect]

little TI Basic program

 

10 CALL CLEAR

20 FOR L=65 TO 70

30 READ Q$

40 CALL CHAR(L,Q$)

50 NEXT L

60 DATA 010207091F247F92,8040E090F824FE49,FF92FF24FF92FF49,AA55448920024801,000217357CFC44AA,0008081C2A081414

70 CALL CHAR(104,"0083C7AEFBEFBDF7")

80 CALL CHAR(105,"00078F5DF7DF7BEF")

90 CALL CHAR(106,"000E1FBAEFBFF6DF")

100 CALL CHAR(107,"001C3E75DF7FEDBF")

110 CALL CHAR(108,"00387CEABFFEDB7F")

120 CALL CHAR(109,"0070F8D57FFDB7FE")

130 CALL CHAR(110,"00E0F1ABFEFB6FFD")

140 CALL CHAR(111,"00C1E357FDF7DEFB")

150 CALL COLOR(10,6,5)

160 X=13

170 C=1

180 PRINT TAB(X+1);"AB"

190 C$=C$&"CC"

200 B$="A"&C$&"B"

210 PRINT TAB(X);B$

220 C=C+1

230 X=X-1

240 IF C=13 THEN 250 ELSE 190

250 CALL HCHAR(24,1,68,32)

260 CALL HCHAR(23,1,69)

270 CALL HCHAR(23,2,70)

280 PRINT

290 PRINT

295 PRINT

296 CALL HCHAR(24,1,68,32)

300 T=104

310 Y=106

320 T=T+1

330 IF T>111 THEN 340 ELSE 350

340 T=104

350 Y=Y+2

360 IF Y>111 THEN 370 ELSE 380

370 Y=104

380 CALL HCHAR(22,1,T,32)

390 CALL HCHAR(23,1,Y,32)

400 GOTO 320

feel free to add your own creations or work out shorter routines for this

INDENILE.zip

[sometimes99er]

Very nice.

[Retrospect]

Very nice.

Thanks.

 

I'm thinking, "If only they had allowed multiple parenthesis on HCHAR commands in TI Basic!" it would have made this sort of thing that little bit smoother.

[Retrospect]

Interestingly, if you compile that code without making a single alteration, you get this ...

 

Where's the little chap with his camel gone? compiling caused the Great Flood!!

 

Edited May 4, 2017 by Retrospect

[+chue]

In the compiled version the water flows faster, therefore it overflows and washes away the guy.

[Retrospect]

Add these lines to the program for added effect

141 CALL CHAR(71,"000000187EFF3C42")

311 S=32

371 CALL HCHAR(3,1,32,32)

372 S=S-1

373 IF S<1 THEN 374 ELSE 380

374 S=32

EDIT: This is wrong. There's a DSK further down the posts.

Edited May 4, 2017 by Retrospect

[+Lee Stewart]

Here is your first program in fbForth 2.0:

 

 

HEX

\ chars 65 - 70

: CHR1 DATA[ 0102 0709 1F24 7F92

8040 E090 F824 FE49

FF92 FF24 FF92 FF49

AA55 4489 2002 4801

0002 1735 7CFC 44AA

0008 081C 2A08 1414

]DATA 41 DCHAR ;

\ chars 104 - 111

: CHR2 DATA[ 0083 C7AE FBEF BDF7

0007 8F5D F7DF 7BEF

000E 1FBA EFBF F6DF

001C 3E75 DF7F EDBF

0038 7CEA BFFE DB7F

0070 F8D5 7FFD B7FE

00E0 F1AB FEFB 6FFD

00C1 E357 FDF7 DEFB

]DATA 68 DCHAR ;

DECIMAL

\ set up line of 24 "C"s

0 VARIABLE CEE 22 ALLOT

CEE 24 67 FILL

\ draw pyramid

: PYRAMID

15 \ starting column

20 7 DO \ pyramid row

DUP I GOTOXY \ set screen pos

65 EMIT \ left brick

DUP CEE 15 ROT - 1 SLA TYPE \ middle bricks

66 EMIT \ right brick

1- \ inc column

LOOP

DROP ; \ drop leftover col

\ banks of Nile, camel and rider

: BANKS

0 20 32 68 HCHAR \ draw top bank

0 19 GOTOXY ." EF" \ draw camel and rider

0 23 32 68 HCHAR ; \ draw bottom bank

\ Flowing Nile

: RIVER

106 104 \ starting chars

BEGIN

3 1 DO \ adding 1 to 1st char and 2 to 2nd

I + DUP 111 > IF \ add loop index (1 or 2) to char

DROP 104 \ reset char

THEN

SWAP \ get other char

LOOP

OVER OVER >R >R \ dup chars and push to return stack

0 21 32 R> HCHAR \ pop char and draw 1st half of river

0 22 32 R> HCHAR \ pop char and draw 2nd half of river

?TERMINAL \ break?

UNTIL \ no; do it again

DROP DROP ; \ done; drop working chars

HEX

\ In DeNile...

: DENILE

VDPMDE @ \ save screen mode to stack

DCT 4 + @ \ save graphics mode colors to stack

1313 DCT 4 + ! \ Graphics mode: black on light green

GRAPHICS \ set Graphics mode

5 4 0D COLOR \ char set 13 colors: light blue on dark blue

CHR1 CHR2 \ change chars

PYRAMID \ draw pyramid

BANKS \ draw baks, camel and rider

RIVER \ draw and animate the river

DCT 4 + ! \ restore graphics colors

VMODE ; \ restore screen mode

DECIMAL

 

 

The river flows too fast without delays.

 

...lee

[+Lee Stewart]

Add these lines to the program for added effect

141 CALL CHAR(71,"000000187EFF3C42")

311 S=32

371 CALL HCHAR(3,1,32,32)

372 S=S-1

373 IF S<1 THEN 374 ELSE 380

374 S=32

 

Something is not right with this code, Joe.

 

...lee

[Retrospect]

Ok Lee, thanks, I've corrected it now.

NILE.zip

Edited May 5, 2017 by Retrospect

[Retrospect]

 

 

The river flows too fast without delays.

 

...lee

Hi Lee. I just pasted this into JS99er as I'm not near the main computer. Running FBforth, it pasted in but then produced an unexpected result, a kind of graphics glitch/crash.

[+Lee Stewart]

Hi Lee. I just pasted this into JS99er as I'm not near the main computer. Running FBforth, it pasted in but then produced an unexpected result, a kind of graphics glitch/crash.

 

I will need to take a look.

 

...lee

[+Lee Stewart]

Hi Lee. I just pasted this into JS99er as I'm not near the main computer. Running FBforth, it pasted in but then produced an unexpected result, a kind of graphics glitch/crash.

 

Are you using it with v2.0:9? When I selected "software", it brought up v2.0:5---that definitely will not work!

 

...lee

[Retrospect]

 

Are you using it with v2.0:9? When I selected "software", it brought up v2.0:5---that definitely will not work!

 

...lee

Yeah it's 2.05

[Retrospect]

Hey Lee, I got home and tried it out, using fbforth 2.09 in classic99 ... it's fast, isn't it!

 

I gotta say, forth has a lot of potential gaming wise as well as anything else. What would we do to introduce a delay?

[+Lee Stewart]

Hey Lee, I got home and tried it out, using fbforth 2.09 in classic99 ... it's fast, isn't it!

 

I gotta say, forth has a lot of potential gaming wise as well as anything else. What would we do to introduce a delay?

 

We could write a NOP loop and supply it a number for the number of times to go through the loop:

 

: DELAY ( n --- )

0 DO

NOP

LOOP ;

1000 DELAY would execute NOP 1000 times to give some delay. The more you give the loop to do, the longer each time through the loop will take. You could time certain operations to get a desired value for the loop to give DELAY a more specific delay like, perhaps msec or sec . DELAY as written here takes 0.14 ms per loop.

 

...lee

[+Lee Stewart]

Here it is with ~100 ms delay between rewrites of the river graphics. Note the definition of msec and its use in RIVER :

 

 

HEX

\ chars 65 - 70

: CHR1 DATA[ 0102 0709 1F24 7F92

8040 E090 F824 FE49

FF92 FF24 FF92 FF49

AA55 4489 2002 4801

0002 1735 7CFC 44AA

0008 081C 2A08 1414

]DATA 41 DCHAR ;

\ chars 104 - 111

: CHR2 DATA[ 0083 C7AE FBEF BDF7

0007 8F5D F7DF 7BEF

000E 1FBA EFBF F6DF

001C 3E75 DF7F EDBF

0038 7CEA BFFE DB7F

0070 F8D5 7FFD B7FE

00E0 F1AB FEFB 6FFD

00C1 E357 FDF7 DEFB

]DATA 68 DCHAR ;

DECIMAL

\ set up line of 24 "C"s

0 VARIABLE CEE 22 ALLOT

CEE 24 67 FILL

\ draw pyramid

: PYRAMID

15 \ starting column

20 7 DO \ pyramid row

DUP I GOTOXY \ set screen pos

65 EMIT \ left brick

DUP CEE 15 ROT - 1 SLA TYPE \ middle bricks

66 EMIT \ right brick

1- \ inc column

LOOP

DROP ; \ drop leftover col

\ banks of Nile, camel and rider

: BANKS

0 20 32 68 HCHAR \ draw top bank

0 19 GOTOXY ." EF" \ draw camel and rider

0 23 32 68 HCHAR ; \ draw bottom bank

\ ~1 msec delay

: msec ( n --- )

0 DO

11 0 DO

LOOP

LOOP ;

\ Flowing Nile

: RIVER

106 104 \ starting chars

BEGIN

3 1 DO \ adding 1 to 1st char and 2 to 2nd

I + DUP 111 > IF \ add loop index (1 or 2) to char

DROP 104 \ reset char

THEN

SWAP \ get other char

LOOP

OVER OVER >R >R \ dup chars and push to return stack

100 msec \ 100 ms delay

0 22 32 R> HCHAR \ pop char and draw lower half of river

0 21 32 R> HCHAR \ pop char and draw upper half of river

?TERMINAL \ break?

UNTIL \ no; do it again

DROP DROP ; \ done; drop working chars

HEX

\ In DeNile...

: DENILE

VDPMDE @ \ save screen mode to stack

DCT 4 + @ \ save graphics mode colors to stack

1313 DCT 4 + ! \ Graphics mode: black on light green

GRAPHICS \ set Graphics mode

5 4 0D COLOR \ char set 13 colors: light blue on dark blue

CHR1 CHR2 \ change chars

PYRAMID \ draw pyramid

BANKS \ draw baks, camel and rider

RIVER \ draw and animate the river

DCT 4 + ! \ restore graphics colors

VMODE ; \ restore screen mode

DECIMAL

 

 

...lee

[+Lee Stewart]

And, here is UFO with the same ~100 ms delay. Sorry about the increased stack-ro-batics in RIVER | :

 

 

HEX

\ chars 65 - 71

: CHR1 DATA[ 0102 0709 1F24 7F92

8040 E090 F824 FE49

FF92 FF24 FF92 FF49

AA55 4489 2002 4801

0002 1735 7CFC 44AA

0008 081C 2A08 1414

0000 0018 7EFF 3C42

]DATA 41 DCHAR ;

\ chars 104 - 111

: CHR2 DATA[ 0083 C7AE FBEF BDF7

0007 8F5D F7DF 7BEF

000E 1FBA EFBF F6DF

001C 3E75 DF7F EDBF

0038 7CEA BFFE DB7F

0070 F8D5 7FFD B7FE

00E0 F1AB FEFB 6FFD

00C1 E357 FDF7 DEFB

]DATA 68 DCHAR ;

DECIMAL

\ set up line of 24 "C"s

0 VARIABLE CEE 22 ALLOT

CEE 24 67 FILL

\ draw pyramid

: PYRAMID

15 \ starting column

20 7 DO \ pyramid row

DUP I GOTOXY \ set screen pos

65 EMIT \ left brick

DUP CEE 15 ROT - 1 SLA TYPE \ middle bricks

66 EMIT \ right brick

1- \ inc column

LOOP

DROP ; \ drop leftover col

\ banks of Nile, camel and rider

: BANKS

0 20 32 68 HCHAR \ draw top bank

0 19 GOTOXY ." EF" \ draw camel and rider

0 23 32 68 HCHAR ; \ draw bottom bank

\ ~1 msec delay

: msec ( n --- )

0 DO

11 0 DO

LOOP

LOOP ;

\ Flowing Nile and moving ufo

: RIVER

106 104 \ starting chars

31 \ starting ufo column

BEGIN

1- -DUP IF \ if ufo col <> 0, leave alone

ELSE \ if ufo col = 0, put at highest col

31

THEN

>R \ ufo col to return stack

3 1 DO \ adding 1 to 1st char and 2 to 2nd

I + DUP 111 > IF \ add loop index (1 or 2) to char

DROP 104 \ reset char

THEN

SWAP \ get other char

LOOP

OVER OVER >R >R \ dup chars and push to return stack

100 msec \ 100 ms delay

0 22 32 R> HCHAR \ pop char and draw lower half of river

0 21 32 R> HCHAR \ pop char and draw upper half of river

0 2 32 32 HCHAR \ erase ufo row

R 2 1 71 HCHAR \ move ufo

R> \ copy of current ufo column

?TERMINAL \ break?

UNTIL \ no; do it again

DROP DROP DROP ; \ done; drop working chars

HEX

\ In DeNile with a UFO...

: UFO

VDPMDE @ \ save screen mode to stack

DCT 4 + @ \ save graphics mode colors to stack

1313 DCT 4 + ! \ Graphics mode: black on light green

GRAPHICS \ set Graphics mode

5 4 0D COLOR \ char set 13 colors: light blue on dark blue

CHR1 CHR2 \ change chars

PYRAMID \ draw pyramid

BANKS \ draw banks, camel and rider

RIVER \ draw and animate the river and ufo

DCT 4 + ! \ restore graphics colors

VMODE ; \ restore screen mode

DECIMAL

 

 

...lee

[+TheBF]

I am always fascinated by the difference in programs written in BASIC and converted to Forth.

The authors of BASIC really created a very consise language. The programs are pretty small

compared to the Forth version.

But it's a closed box unless you want to re-write the language.

 

I am working on creating a layer that adds a little more TI BASIC functionality by adding some words

to Forth. That might close the gap on line count a little.

 

But Forth was designed to be primitive and expandable as your DENILE routine demonstrates Lee.

Very nice.

 

It's late. I need to crash.

 

BF

[+TheBF]

Put this in the "for what it's worth" jar.

 

ANS Standard Forth has a word called 'MS' which gives you a delay in milliseconds, just like Lee's 'msec' word.

 

In real time systems this is connected to some kind of timer so it can be very accurate.

In multi-tasking systems it also puts the task to sleep so the computer can do other things while

the delay is going on.

 

It's a pretty cool word even though it looks simple.

 

BF

[Retrospect]

And, here is UFO with the same ~100 ms delay. Sorry about the increased stack-ro-batics in RIVER | :

 

 

...lee

Nice execution! ... I've just spent five or so minutes looking at that code. All very well documented, but alas, no idea how to comprehend it ,

 

In fact I think that if that source wasn't documented it's byte-count would be less than the BASIC list I made.

[+Lee Stewart]

Nice execution! ... I've just spent five or so minutes looking at that code. All very well documented, but alas, no idea how to comprehend it ,

 

In fact I think that if that source wasn't documented it's byte-count would be less than the BASIC list I made.

 

It can be a little rough---especially when one is not used to a stack-oriented language.

 

When I get home, I will add stack-tracking to the comments. That may make it clearer.

 

...lee

[+TheBF]

Nice execution! ... I've just spent five or so minutes looking at that code. All very well documented, but alas, no idea how to comprehend it ,

 

In fact I think that if that source wasn't documented it's byte-count would be less than the BASIC list I made.

 

According MS Word

125 words in BASIC

193 words in the 1st version in FB-Forth (comments removed)

 

Not bad for a "low level" language.

 

But if I group the HEX numbers together as done in BASIC the Forth version goes to 151 words.

So Lee would have to revise his DATA[ ]DATA words.

 

You could save 2 words by replacing DROP DROP with 2DROP and OVER OVER with 2DUP.

But I don't see too many other places to consolidate code. Lee's pretty good at this.

 

BF

[Retrospect]

 

According MS Word

125 words in BASIC

193 words in the 1st version in FB-Forth (comments removed)

 

Not bad for a "low level" language.

 

But if I group the HEX numbers together as done in BASIC the Forth version goes to 151 words.

So Lee would have to revise his DATA[ ]DATA words.

 

You could save 2 words by replacing DROP DROP with 2DROP and OVER OVER with 2DUP.

But I don't see too many other places to consolidate code. Lee's pretty good at this.

 

BF

Yeah , he sure is ... Forth really boggles my head. It's a little bit like talking to my missus ... I'm looking at it, I'm trying to understand it, but it's just getting muddier and muddier.

[Asmusr]

What's the color of the pyramids, are they red, are they blue, or are we all in DeNile?

 

 

 

[+Lee Stewart]

OK...Here is the promised stack-tracking (in comments) version. It also has a little more detail in the comments:

 

 

\ Stack tracking---

\ * Parameter (data) stack = "S:"

\ * Return stack = "R:"

\ Top of each stack is on the right with the bottom adjacent to the ':'

HEX \ change radix (base) to hexadecimal

\ Define CHR1 to populate chars 65 - 71 with new patterns

: CHR1 ( --- )

DATA[ \ start compiling cells (16 bits each)

0102 0709 1F24 7F92

8040 E090 F824 FE49

FF92 FF24 FF92 FF49

AA55 4489 2002 4801

0002 1735 7CFC 44AA

0008 081C 2A08 1414

0000 0018 7EFF 3C42

]DATA \ end cell compilation S:addr #cells

41 \ 1st chr# = 65 S:addr #cells chr#

DCHAR ; \ write patterns for 7 chrs from 65 - 71 S:

\ Define CHR2 to populate chars 104 - 111 with new patterns

: CHR2 ( --- )

DATA[ \ start compiling cells (16 bits each)

0083 C7AE FBEF BDF7

0007 8F5D F7DF 7BEF

000E 1FBA EFBF F6DF

001C 3E75 DF7F EDBF

0038 7CEA BFFE DB7F

0070 F8D5 7FFD B7FE

00E0 F1AB FEFB 6FFD

00C1 E357 FDF7 DEFB

]DATA \ end cell compilation S:addr #cells

68 \ 1st chr# = 104 S:addr #cells chr#

DCHAR ; \ write patterns for 8 chrs from 104 - 111 S:

DECIMAL \ change radix (base) to decimal

\ set up line of 24 "C"s in an array called CEE

0 VARIABLE CEE \ define variable CEE (2 bytes) initially with 0

22 ALLOT \ allot 22 more bytes = 24-byte total for CEE

CEE 24 67 \ S:CEE-addr #bytes chr

FILL \ fill CEE array with 'C's S:

\ draw pyramid

: PYRAMID ( --- )

15 \ starting column S:col

20 7 DO \ pyramid row S:col R:loopMAX loopIndex

DUP \ dup col S:col col

I \ get loopIndex = row S:col col row

GOTOXY \ set screen pos S:col

65 EMIT \ left brick

\ process middle bricks

DUP CEE \ dup col and get CEE addr S:col col addr

15 \ mid_col for 'C's S:col col addr 15

\ calculate # of 'C's

ROT \ get col to top of stack S:col addr 15 col

- \ mid_col - col S:col addr 15-col

1 SLA \ *2 by shifting 1 left S:col addr (15-col)*2

TYPE \ type middle bricks S:col

66 EMIT \ right brick

1- \ dec column (col=col-1) S:col

LOOP S:col R:loopMAX loopIndex

DROP ; \ drop leftover col S: R:

\ banks of Nile, camel and rider

: BANKS ( --- )

0 20 32 68 HCHAR \ draw top bank

0 19 GOTOXY \ cursor to (col,row)=(0,19)

." EF" \ draw camel and rider

0 23 32 68 HCHAR ; \ draw bottom bank

\ ~1 msec delay

: msec ( n --- )

0 DO \ loop 0 to n-1 R:loop1MAX loop1Index

11 0 DO \ loop 0 to 11-1 R:loop1MAX loop1Index loop2MAX loop2Index

LOOP

LOOP R:loop1MAX loop1Index

; R:

\ Flowing Nile and moving ufo

: RIVER ( --- )

106 104 \ starting chars (rvr1, rvr2) S:rvr1 rvr2

31 \ starting ufo column S:rvr1 rvr2 ufo

BEGIN \ indefinite loop

1- \ ufo = ufo-1 S:rvr1 rvr2 ufo

-DUP \ dup if non-zero S:rvr1 rvr2 ufo [ufo]

IF \ if ufo col <> 0, leave alone

\ do nothing S:rvr1 rvr2 ufo

ELSE \ if ufo col = 0, put at last col

31 \ ufo = 31 S:rvr1 rvr2 ufo

THEN

>R \ ufo col to return stack (RS) S:rvr1 rvr2 R:ufo

3 1 DO \ adding 1 to chr1 & 2 to chr2 S:rvr1 rvr2 R:ufo loopMAX loopIndex

I + \ current rvr char + loopIndex S:rvr1 rvr2 R:ufo loopMAX loopIndex

DUP \ dup current rvr char S:rvr1 rvr2 rvr2 R:ufo loopMAX loopIndex

111 > \ cur rvr char > 111? S:rvr1 rvr2 flag R:ufo loopMAX loopIndex

IF \ add loop index (1 or 2) to char S:rvr1 rvr2 R:ufo loopMAX loopIndex

DROP \ drop cur rvr char S:rvr1 R:ufo loopMAX loopIndex

104 \ reset cur rvr char S:rvr1 rvr2 R:ufo loopMAX loopIndex

THEN

SWAP \ get other rvr char S:rvr2 rvr1 R:ufo loopMAX loopIndex

LOOP S:rvr2 rvr1 R:ufo loopMAX loopIndex

\ now back to original rvr char order S:rvr1 rvr2 R:ufo

OVER OVER \ dup rvr chars S:rvr1 rvr2 rvr1 rvr2 R:ufo

>R >R \ push to RS S:rvr1 rvr2 R:ufo rvr2 rvr1

100 msec \ 100 ms delay

0 22 32 \ col row cnt for low river S:rvr1 rvr2 0 22 32 R:ufo rvr2 rvr1

R> \ pop char from RS S:rvr1 rvr2 0 22 32 rvr1 R:ufo rvr2

HCHAR \ draw lower half of river S:rvr1 rvr2 R:ufo rvr2

0 21 32 \ col row cnt for high river S:rvr1 rvr2 0 21 32 R:ufo rvr2

R> \ pop char from RS S:rvr1 rvr2 0 21 32 rvr2 R:ufo

HCHAR \ draw upper half of river S:rvr1 rvr2 R:ufo

0 2 32 32 HCHAR \ erase ufo row with spaces

R \ copy ufo col from RS S:rvr1 rvr2 ufo R:ufo

2 1 71 \ row count (1) ufo_char S:rvr1 rvr2 ufo 2 1 71 R:ufo

HCHAR \ move ufo S:rvr1 rvr2 R:ufo

R> \ pop cur ufo col from RS S:rvr1 rvr2 ufo R:

?TERMINAL \ break? S:rvr1 rvr2 ufo flag R:

UNTIL \ no; do it again S:rvr1 rvr2 ufo R:

DROP DROP DROP ; \ done; drop rvr1, rvr2, ufo S: R:

HEX

\ In DeNile with a ufo...

: UFO ( --- )

VDPMDE @ \ save screen mode to stack S:mode

DCT \ get default color table addr S:mode dct

4 + \ +4 for Graphics mode color bytes S:mode dct+4

@ \ get colors to stack S:mode color1

1313 \ new FG & BG colors: black on lt green S:mode color1 1313

DCT 4 + \ get def Graphics colors addr again S:mode color1 1313 dct+4

! \ save new def Graphics mode colors S:mode color1

GRAPHICS \ set Graphics mode

5 4 \ FG & BG colors for... S:mode color1 5 4

0D \ ...char set 13 (0Dh) S:mode color1 5 4 0D

COLOR \ char set 13: lt blue on dk blue S:mode color1

CHR1 CHR2 \ set up new chars

PYRAMID \ draw pyramid

BANKS \ draw banks, camel and rider

RIVER \ draw and animate the river

DCT 4 + ! \ restore graphics colors S:mode

VMODE ; \ restore screen mode S:

DECIMAL \ change radix to decimal

 

 

...lee