Bricks (demo)

+retroclouds · April 17, 2015

Nice! This compiler opens up quite some possibilities

sometimes99er · April 17, 2015

After 2 1/2 years, here's a new version of my favorite "benchmark" program, this time in Java.

Execution speed is just slightly slower than C. You can compare it with my video above.

Code size: 870 bytes for the C version, 1222 bytes for the Java version.

Thanks. Absolutely awesome. :thumbsup:

+TheBF · April 11, 2021

On 7/23/2011 at 4:43 PM, JonnyBritish said:

Interesting stuff..

this is almost starting to read like GPL vs Turboforth trash talk ?

Question is could you write GPL in TurboForth!

Really old posts here but I like going back in time to see what happened before I converted to Atariage.

So the answer to this question is yes.

The way to do it would be to make a GPL assembler in Forth. It would be RPN like a Forth Assembler.

It could have labels or it could have structured branches and loops or both. And the Forth compiler gives you macros for free.

Could be done in a day by a smart coder. I would need a bit more time.

I also don't know the header details for a GPL file so that would be needed but definitely doable.

+TheBF · April 15, 2021

On 7/22/2011 at 8:21 AM, sometimes99er said:

@lucien2

Excellent video. And thanks for the how2 overview. Should go back and watch the video. The 6+ minutes scared me.

Street cred to both languages/implementations. Me too, I thought TF would be maybe at least twice as fast, but I guess GPL surprises a bit.

I had forgotten about this demo until this week. I am wondering how much benefit GPL gets from code running in 16 bit ROM. That's a sweet place to have code on the 99.

It is an interesting benchmark to try and optimize. Not trivial to make it faster in threaded Forth.

I thought I would take a run at it. I found a few things that I could do differently than Mark's version.

In the screen scan code I didn't use variables for row and col while search the screen. I record the coordinates once and then I computed the screen address with an assembly language word.

That way I only have 2 items on the stack to manage when I am searching an free-spot. Since this loop is so critical anything there makes a difference. I have a break key in the loop so it's not full speed but pretty close.


: FREE-SPOT ( -- )
       BEGIN
          30 RND 23 RND AT-XY  \ remember these coordinates
          VPOS DUP VC@ 40 <   ( -- Vaddr ?)
          SWAP 1+  VC@ 40 <   ( -- ? ?) AND
          ?TERMINAL ABORT" HALT!"
       UNTIL
;

Another other minor optimization uses the fact that I have code for integer fetch and store to VDP.

So I combined the two brick chars together and write them to the screen as as an integer.

: EMIT2    ( char -- ) DUP 1+ SWAP FUSE VPOS V! ; \ fuse chars to 16bit#, store

I also made liberal use of macros which allowed me to factor the code without a big speed penalty. That's important in Forth if you every want to understand your code again.

My PRNG routine is probably a touch faster because it does not use division. I "borrowed" it from GForth with credit of course. It uses 2 multiplications.

 83C0 CONSTANT SEED   \ TI incrementing number in main menu,
\ SEEDS stops spinning when Forth starts
: RNDW  ( -- n ) 6FE5 SEED @  *  1+ DUP SEED ! ;
: RND   ( n -- 0..n-1 ) RNDW UM* NIP ;

It seems to be running about the same speed as TurboForth or very close to it.

This version of Camel99 is not released yet. It uses a new VDP library that improved things quite a bit.

Spoiler


\ BRICKS IN CAMEL99 Forth
\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.VALUES

MARKER /BRICKS

\ brick pattern definitions
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,
\ fastest way to change patterns
DECIMAL
: BRICKS ( n -- )
    7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;

\ text macros are a little faster
: CLEANUP  ( -- )  S" 2DROP  R> DROP"  EVALUATE ; IMMEDIATE
: GCHAR    ( x y -- char) S" >VPOS VC@" EVALUATE ; IMMEDIATE

: Right    ( -- col row ) S" VCOL @ 2+ VROW @" EVALUATE ; IMMEDIATE
: Down     ( -- col row ) S" VROW 2@ 1+" EVALUATE ; IMMEDIATE
: Corner   ( -- col row ) S" VCOL @ 1+  VROW @ 1+" EVALUATE ; IMMEDIATE
: Diagonal ( -- col row ) S" VCOL @ 2+  VROW @ 1+" EVALUATE ; IMMEDIATE


: EMIT2    ( char -- ) DUP 1+ SWAP FUSE VPOS V! ; \ fuse chars to 16bit#, store
: .BRICK ( --) 7 RND 8* 40 +  EMIT2 ;

: FREE-SPOT ( -- )
       BEGIN
          30 RND 23 RND AT-XY  \ remember these coordinates
          VPOS DUP VC@ 40 <   ( -- Vaddr ?)
          SWAP 1+  VC@ 40 <   ( -- ? ?) AND
          ?TERMINAL ABORT" HALT!"
       UNTIL
;

: .SHADOWS
       Right 2DUP GCHAR DUP>R 39 <
       IF >VPOS  R> 4 OR SWAP VC!
       ELSE CLEANUP THEN

       Down 2DUP GCHAR DUP>R 39 <
       IF >VPOS  R> 2 OR SWAP VC!
       ELSE CLEANUP THEN

       Corner 2DUP GCHAR DUP>R 39 <
       IF >VPOS  R> 3 OR SWAP VC!
       ELSE CLEANUP THEN

       Diagonal 2DUP GCHAR DUP>R 39 <
       IF >VPOS  R> 1 OR SWAP VC!
       ELSE CLEANUP THEN
;

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     BEGIN
        FREE-SPOT
        .BRICK
        .SHADOWS
     AGAIN
;

+TheBF · April 15, 2021

After looking at Lucien's Pascal program I changed to this version. It seems to run a touch faster probably by removing some calling overhead.

Using AND instead of a 2nd IF in the main loop is faster in Forth.

Spoiler


\ BRICKS IN CAMEL99 Forth
\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.VALUES

MARKER /BRICKS

\ brick pattern definitions
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,
\ fastest way to change patterns
DECIMAL
: BRICKS ( n -- )
    7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;

\ text macros are a little faster
: CLEANUP  ( -- )  S" 2DROP  R> DROP"  EVALUATE ; IMMEDIATE
: GCHAR    ( x y -- char) S" >VPOS VC@" EVALUATE ; IMMEDIATE
: Right    ( -- col row ) S" VCOL @ 2+ VROW @" EVALUATE ; IMMEDIATE
: Down     ( -- col row ) S" VROW 2@ 1+" EVALUATE ; IMMEDIATE
: Corner   ( -- col row ) S" VCOL @ 1+  VROW @ 1+" EVALUATE ; IMMEDIATE
: Diagonal ( -- col row ) S" VCOL @ 2+  VROW @ 1+" EVALUATE ; IMMEDIATE
: EMIT2    ( char -- ) S" DUP 1+ SWAP FUSE VPOS V!" EVALUATE ; IMMEDIATE

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     BEGIN
         30 RND 23 RND AT-XY
         VPOS DUP VC@ 40 <   ( -- Vaddr ?)
         SWAP 1+  VC@ 40 <   ( -- ? ?) AND
         IF
               7 RND 8* 40 +  EMIT2

               Right 2DUP GCHAR DUP>R 39 <
               IF >VPOS  R> 4 OR SWAP VC!
               ELSE CLEANUP THEN

               Down 2DUP GCHAR DUP>R 39 <
               IF >VPOS  R> 2 OR SWAP VC!
               ELSE CLEANUP THEN

               Corner 2DUP GCHAR DUP>R 39 <
               IF >VPOS  R> 3 OR SWAP VC!
               ELSE CLEANUP THEN

               Diagonal 2DUP GCHAR DUP>R 39 <
               IF >VPOS  R> 1 OR SWAP VC!
               ELSE CLEANUP THEN
         THEN
         ?TERMINAL ABORT" HALT!"
     AGAIN
;

+TheBF · April 15, 2021

This is about as good as I can get it without resorting to Assembly language.

I invoked my inline[] compiler that creates "super-instructions" in Low RAM by copying code from the kernel so they run inline without the interpreter.

It isn't smart enough to inline everything at it's current stage of development but it made a difference. I inlined the PRNG too. What the heck.

Spoiler


\ BRICKS IN CAMEL99 Forth
\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.INLINE

MARKER /BRICKS

 83C0 CONSTANT SEED   \ TI incrementing number in main menu,
\ SEEDS stops spinning when Forth starts

: RNDW  ( -- n ) INLINE[ 6FE5 SEED @  *  1+ DUP SEED ! ] ;
: RND   ( n -- 0..n-1 ) RNDW INLINE[ UM* NIP ] ;

\ brick pattern definitions
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,
\ fastest way to change patterns
DECIMAL
: BRICKS ( n -- )
    7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;

\ text macros are a little faster
: VPOS   ( -- vaddr) INLINE[ VROW 2@ >VPOS ] ;

: CLEANUP  ( -- )  S" 2DROP  R> DROP"  EVALUATE ; IMMEDIATE
: GCHAR    ( x y -- char) S" >VPOS VC@" EVALUATE ; IMMEDIATE

: Right    ( -- col row ) INLINE[ VCOL @ 2+ VROW @ ] ;
: Down     ( -- col row ) INLINE[ VROW 2@ 1+ ] ;
: Corner   ( -- col row ) INLINE[ VCOL @ 1+  VROW @ 1+ ] ;
: Diagonal ( -- col row ) INLINE[ VCOL @ 2+  VROW @ 1+ ] ;
: EMIT2    ( char -- ) INLINE[ DUP 1+ SWAP FUSE ] VPOS V!  ;

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     BEGIN
         30 RND 23 RND AT-XY
         VPOS
         INLINE[ DUP VC@ 40 ] <
         INLINE[ SWAP 1+  VC@ 40 ] <  AND
         IF
               7 RND 8* 40 +  EMIT2

               Right 2DUP GCHAR DUP>R 39 <
               IF INLINE[ >VPOS   R> 4 OR SWAP VC! ]
               ELSE CLEANUP THEN

               Down 2DUP GCHAR DUP>R 39 <
               IF INLINE[ >VPOS   R> 2 OR SWAP VC! ]
               ELSE CLEANUP THEN

               Corner 2DUP GCHAR DUP>R 39 <
               IF INLINE[ >VPOS   R> 3 OR SWAP VC! ]
               ELSE CLEANUP THEN

               Diagonal 2DUP GCHAR DUP>R 39 <
               IF INLINE[ >VPOS   R> 1 OR SWAP VC! ]
               ELSE CLEANUP THEN
         THEN
         ?TERMINAL ABORT" HALT!"
     AGAIN
;

+TheBF · April 16, 2021

I took another look at this thing tonight and suddenly realized it was not right.

There is no need to manipulate col,row coordinates more than once, to read/write the shadow characters.

All you need is the VDP address. Great example of where thinking more like Assembler gives you a better perspective on Forth.

So each of the macros that computes the coordinates for the shadow characters now return a VDP address.

This means I don't need GCHAR, I just need VSBR and VSBW. (VC@ and VC! in Forth)

Now the un-optimized code runs in about 10 seconds depending on the random numbers that are generated and it is more idiomatic.

Ok now I will shutup.

Spoiler


\ BRICKS Demo CAMEL99 Forth saved as EA5 program   Apr 2021  Fox

HERE  ( for measuring size of this code)

INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM

CR .( Compiling BRICKS...)
MARKER /BRICKS

\ brick pattern definitions as integers
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,

\ fastest way to change patterns uses integers
DECIMAL
: BRICKS ( n -- )
     7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;

\ Shadow calculators return a VDP address
: Right    ( -- vaddr ) S" VCOL @ 2+  VROW @    >VPOS " EVALUATE ; IMMEDIATE
: Down     ( -- vaddr ) S" VROW 2@ 1+           >VPOS " EVALUATE ; IMMEDIATE
: Corner   ( -- vaddr ) S" VCOL @ 1+  VROW @ 1+ >VPOS " EVALUATE ; IMMEDIATE
: Diagonal ( -- vaddr ) S" VCOL @ 2+  VROW @ 1+ >VPOS " EVALUATE ; IMMEDIATE

\ emit char & char+1 with one write
: EMIT2    ( char -- )  S" DUP 1+ SWAP FUSE VPOS V!" EVALUATE ; IMMEDIATE

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     BEGIN
         30 RND 23 RND AT-XY
         VPOS DUP VC@ 40 <   ( -- Vaddr ?)
         SWAP 1+  VC@ 40 <   ( -- ? ?) AND
         IF
               7 RND 8* 40 +  EMIT2

               Right DUP VC@ DUP 39 <
               IF  4 OR SWAP VC!
               ELSE 2DROP THEN

               Down DUP VC@ DUP 39 <
               IF   2 OR SWAP VC!
               ELSE 2DROP THEN

               Corner DUP VC@ DUP 39 <
               IF  3 OR SWAP VC!
               ELSE 2DROP THEN

               Diagonal DUP VC@ DUP 39 <
               IF  1 OR SWAP VC!
               ELSE 2DROP THEN
         THEN
         ?TERMINAL
     UNTIL
;
CR
CR .( **Program compiled successfully**)
HERE SWAP -
CR DECIMAL . .( bytes added to system)

 CR .( Creating cold start code)

 : COLD  WARM  GO  BYE  ;
 CR .( Locking dictionary )
 LOCK

 INCLUDE DSK1.SAVESYS
 CR
 ' COLD  SAVESYS DSK3.BRICKS

HOME AUTOMATION · April 16, 2021

1 hour ago, TheBF said:

Almost perfect...

...just needs, random frequency beeping, when each brick is placed!?

GDMike · April 16, 2021

? nice job

+TheBF · April 16, 2021

9 hours ago, HOME AUTOMATION said:

Almost perfect...

...just needs, random frequency beeping, when each brick is placed!?

ok.

Since this not about speed in this case, I removed all the macros so the code reads a little easier.

included the sound library and added some envelope control make the sound interesting.

The video shows how you build the program and then run it.

(During testing you would just type GO at the Forth command line and to remove the program but leave the libraries installed type /BRICKS )

Spoiler


\ BRICKS Demo CAMEL99 Forth saved as EA5 program   Apr 2021  Fox

HERE  ( for measuring size of this code)

INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.SOUND

CR .( Compiling BRICKS...)
MARKER /BRICKS

\ brick pattern definitions as integers
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,

\ fastest way to change patterns uses integers
DECIMAL
: BRICKS ( n -- )
     7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;
\ envelope control
: ATT     ( n -- )  ATT @ OR SND! ;  \ fast attenuator (volume control)
: WAIT    ( n -- )  0 ?DO LOOP ;     \ ~100us delay per unit
: DECAY   ( speed -- ) 16 0 DO   I ATT  DUP WAIT  LOOP DROP ;

: TINK    ( freq --) HZ  0 DB  4 WAIT  100 DECAY MUTE ;
: CLINK   ( -- )   GEN2   1400 200 RND +   TINK ;

\ Shadow calculators return a VDP address
: Right    ( -- vaddr ) VCOL @ 2+  VROW @    >VPOS ;
: Down     ( -- vaddr ) VROW 2@ 1+           >VPOS ;
: Corner   ( -- vaddr ) VCOL @ 1+  VROW @ 1+ >VPOS ;
: Diagonal ( -- vaddr ) VCOL @ 2+  VROW @ 1+ >VPOS ;

\ emit char & char+1 with one write
: EMIT2    ( char -- ) DUP 1+ SWAP FUSE VPOS V! ;

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     BEGIN
         30 RND 23 RND AT-XY
         VPOS DUP VC@ 40 <   ( -- Vaddr ?)
         SWAP 1+  VC@ 40 <   ( -- ? ?) AND
         IF
               7 RND 8* 40 +  EMIT2

               Right DUP VC@ DUP 39 <
               IF  4 OR SWAP VC!
               ELSE 2DROP THEN

               Down DUP VC@ DUP 39 <
               IF   2 OR SWAP VC!
               ELSE 2DROP THEN

               Corner DUP VC@ DUP 39 <
               IF  3 OR SWAP VC!
               ELSE 2DROP THEN

               Diagonal DUP VC@ DUP 39 <
               IF  1 OR SWAP VC!
               ELSE 2DROP THEN
               
               CLINK
               100 RND MS
         THEN
         ?TERMINAL
     UNTIL
;
CR
CR .( **Program compiled successfully**)
HERE SWAP -
CR DECIMAL . .( bytes added to system)

 CR .( Creating cold start code)

 : COLD  WARM  GO  BYE  ;
 CR .( Locking dictionary )
 LOCK

 INCLUDE DSK1.SAVESYS
 CR
 ' COLD  SAVESYS DSK3.BRICKS

HOME AUTOMATION · April 17, 2021

Gracias Senior, Yay!

...Speed counts, I theeink! |:)

+TheBF · April 17, 2021

Well if you would like to hear a sound for each brick, it has to be on for a period of time... so you can't have it both ways.

I chose to give each sound a decay to so it sounds interesting. That takes time. Only milliseconds, but they all add up.

And then I put a random 100 mS delay on each brick to add a little more variation.

Give me the spec. and I will write it.

Edit

I could just hit the sound and change it with every brick. Not hard to do but might sound weird.

HOME AUTOMATION · April 17, 2021

This one, starts out weird, but than gets better:

;-)

+TheBF · April 17, 2021

Ok. Those are nice sounds.

Let me see what I can do.

+TheBF · April 17, 2021

This is un-optimized Forth. It starts with 3500 DO LOOP delay which is about 300 mS I think.

and by the end with a 300 DO LOOP delay the sound is turning off before it really gets started.

Something that might be interesting to BASIC programmers is the way I make sounds.

In BASIC you have:

SOUND (duration,frequency,volume, .... )

For flexibility I have DB HZ MUTE and GEN1 GEN2 GEN3 and NOISE.

This way I can change the frequency without touching the volume or change the volume without changing the frequency.

I can also start a sound, run some other code and the turn it off as I am doing here.

This is Chuck Moore's thinking on keeping every function really simple and doing only one thing. You can always combine them later.

For example to make SOUND for one voice I would do:

: SOUND1  ( duration freq volume -- )   GEN1   DB  HZ   MS   MUTE ;

Spoiler


\ BRICKS Demo CAMEL99 Forth saved as EA5 program   Apr 2021  Fox

HERE  ( for measuring size of this code)
INCLUDE DSK1.SUPERTOOLS
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.SOUND

CR .( Compiling BRICKS...)
MARKER /BRICKS
HEX
83C0 CONSTANT SEED   \ TI incrementing number in main menu,
\ SEEDS stops spinning when Forth starts
: RNDW  ( -- n )  6FE5 SEED @  *  1+ DUP SEED !  ;
: RND   ( n -- 0..n-1 ) RNDW  UM* NIP  ;

\ brick pattern definitions as integers
HEX
CREATE BRICK1  0000 , 0000 , 0000 , 3F7F ,
CREATE BRICK2  0103 , 0303 , 0303 , FFFF ,

\ fastest way to change patterns uses integers
DECIMAL
: BRICKS ( n -- )
     7 0 DO
        BRICK1 I 8* 40 + CHARDEF
        BRICK2 I 8* 41 + CHARDEF
     LOOP
;

\ More familiar way to change patterns ;)
DECIMAL
: SHADOWS
  S" 0000000000000000" 32 CALLCHAR
  S" 8000000000000000" 33 CALLCHAR
  S" 3F00000000000000" 34 CALLCHAR
  S" FF00000000000000" 35 CALLCHAR
  S" 0000808080808080" 36 CALLCHAR
  S" 8000808080808080" 37 CALLCHAR
  S" 3F00808080808080" 38 CALLCHAR
  S" FF00808080808080" 39 CALLCHAR
;

DECIMAL
: SET-COLORS
     5  3  4 COLOR
     6  5  6 COLOR
     7  7  9 COLOR
     8  9 10 COLOR
     9 11 12 COLOR
    10 13  3 COLOR
    11 15 16 COLOR
;

\ Shadow calculators return a VDP address
: Right    ( -- vaddr ) VCOL @ 2+  VROW @     >VPOS ;
: Down     ( -- vaddr ) VROW 2@ 1+            >VPOS ;
: Corner   ( -- vaddr ) VCOL @ 1+  VROW @ 1+  >VPOS ;
: Diagonal ( -- vaddr ) VCOL @ 2+  VROW @ 1+  >VPOS ;

\ emit char & char+1 with one write
: BRICK ( char -- )  DUP 1+ SWAP FUSE  VROW 2@ >VPOS  V!  ;

VARIABLE DLY
: WAIT    DLY @  0 ?DO LOOP ;
: DELAY  ( n -- ) DLY @ SWAP +  300 MAX DLY ! ;

DECIMAL
: GO
     GRAPHICS
     PAGE 14 SCREEN
     SHADOWS
     BRICKS
     SET-COLORS
     3500 DLY !
     GEN1  \ Use sound generator 1
     BEGIN
         BEGIN
           ?TERMINAL ABORT" HALT"
           30 RND 23 RND AT-XY
           VPOS  DUP VC@ 40  <
           SWAP 1+  VC@ 40 < AND
         UNTIL

         7 RND  8* 40 +  BRICK    \ random brick
         2000 RND 120 + HZ   0 DB  \ random freq at 0 DB attenuation

         Right  DUP VC@ DUP  39 <
         IF  4 OR SWAP VC!
         ELSE 2DROP THEN

         Down  DUP VC@ DUP  39 <
         IF   2 OR SWAP VC!
         ELSE 2DROP THEN

         Corner  DUP VC@ DUP 39 <
         IF  3 OR SWAP VC!
         ELSE 2DROP THEN

         Diagonal  DUP VC@ DUP 39 <
         IF   1 OR SWAP VC!
         ELSE 2DROP THEN

        -20 DELAY
         WAIT
         MUTE
    AGAIN
;
CR
CR .( **Program compiled successfully**)
HERE SWAP -
CR DECIMAL . .( bytes added to system)
.FREE

HOME AUTOMATION · April 17, 2021

hmmgclodglv.gif.7a4ed985519dada707a168fe518f3e0a.gif

...Like the part around 19 sec. in, best!

I considered trying to run this, but might not have access to what you're using?

+TheBF · April 17, 2021

6 hours ago, HOME AUTOMATION said:

I considered trying to run this, but might not have access to what you're using?

I am cleaning up things for a release of V2.67, what this was built on.

I can give you that with this source code in the demo files and you could play with the random time delay values and see what happens.

Peek at the Camel99 topic later next week and I will have something posted.

Bricks (demo)

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members