Optical Illusion tutorial with the Commodore 64 and DurexForth

Hello again. Start here if you don't know what DurexForth is, or perhaps even what a Commodore 64 is.

Let's expand on my previous post with something a bit more fun than yet-another-fizzbuzz.

In this post, we'll implement the "stepping feet" illusion. Here's an example:

Let's think about how to implement this. We'll need the black and white vertical bars, and a way to quickly switch them off to show a plain gray background (thus revealing the illusion). Commodore 64 character graphics seem just about ideal for this.

The coloured "feet" can be hardware sprites moving across this background. Two big rectangles must be just about the simplest sprites we could imagine!

But first, the alternating bars. I want to implement the colours in colour memory, and then just fill the screen with "reversed" spaces to display the coloured bars. That way I can turn off the bars by simply filling the screen with "non-reversed" spaces (which are invisible), leaving the alternating colours intact in the colour memory but allowing the background "screen colour" to show through. I'll make this gray just like in the example.

Let's begin by starting up the DurexForth 'v' editor, and entering some useful constants.

$0400 constant SCREENMEM
$d800 constant COLORMEM
53281 constant SCREENCOLOR
32 constant SPACE-CHAR
160 constant REVERSE-CHAR
12 constant GRAY2

Notice how easily numbers can be entered in either hexadecimal or decimal. You can also enter numbers as binary by prefixing with '%', e.g. %10000011.

Now I'll make a helper word (i.e. a function) to fill the screen with a given character. Although DurexForth is much faster than Basic, using a loop to fill in the screen memory is still noticeably slower than if you were to do it in assembly. Fortunately, there is a better way. Let's take a look at the fill word from the DurexForth manual:

fill ( addr len char — )
Fill range [addr, len + addr) with char.

Note the stack comment, ( addr len char — ). This indicates what values the word will expect to take off the stack (before the dash), and what values it may leave on the stack (after the dash). So, the fill word will consume three parameters from the stack and add nothing back onto the stack. It's good practice to leave comments like this on your own words too, as it helps you to prevent stack overflow or underflow, which will crash your program.

So, using this word to fill the first 100 characters of screen memory with the 'A' character would look like this:

$0400 100 1 fill

where $0400 is the start address of the fill operation, 100 is the number of bytes to fill, and 1 is the byte you want to fill that memory area with (i.e. the character code for the letter 'A').

We want to fill screen memory, so the first two parameters will always be $0400 and 1000. Here's how the helper word looks:

: fillscreen ( char -- )
 SCREENMEM 1000 rot fill ;

first, take a look at the stack comment. This word expects the character code to already be on the stack. Then the word itself will push the SCREENMEM constant onto the stack ($0400), followed by size in bytes of screen memory (1000).

The stack will now contain char addr len. Referring back to the documentation for fill we see that it requires those values in this order: addr len char.

Now let's take a look at the documentation for the built-in stack-manipulation word, rot:

rot ( a b c — b c a )
Rotate the third item to the top.

Substitute a b c for char addr len, and you can see this will give us just what we need. There are many such stack-manipulation words for getting parameters into the required order.

Now we have our fillscreen helper word which we can use to fill the screen with any character we give it. For example, using our predefined character constants:

REVERSE-CHAR fillscreen  \ show the black and white bars
SPACE-CHAR fillscreen    \ hide them again

Next, we'll implement the colours. We can put this into a setup word, as once we've defined these colours, we don't need to touch them again. Also, as this is a one-off setup routine, I don't mind using a slightly slow loop construct.

: coloursetup
GRAY2 SCREENCOLOR c!
1000 0 do
 i 1 and COLORMEM i + c!
loop ;

The snippet i 1 and will give us a zero for even-numbered iterations, and a one for odd-numbered iterations. Fortuitously, these are the colour codes for black and white respectively. c! simply stores a byte at an address. It's POKE with a less silly name.

Let's add a couple of words to test what we have so far:

: mainloop
 REVERSE-CHAR fillscreen
 key drop
 SPACE-CHAR fillscreen
 key drop
recurse ;

: main
 screen-setup
 mainloop ;

The key word gets one character from input and leaves it on the stack. We don't want to use that character for anything, we only want to check if a key has been pressed, so we can discard that value from the stack with the drop word.

Let's try it out. If you're in the 'v' editor, hit F7 to compile and return to the immediate prompt, and then run the main word. Tapping a key will toggle the black and white bars on or off. Hit RESTORE to exit the program ("Page up" on my Vice key mapping... YMMV).

Now let's move on to the sprites. First, let's add some more useful constants to the top of the program:

53280 constant VIC
14 constant SPRITEPTR
4 constant BLUE
7 constant YELLOW

Note that it is common in BASIC to store a base address for the VIC-II registers as V=53280, and then reference the various registers by their offset, e.g. POKE V+21, 3. While I am going to do the same in my program, I'm using the name VIC, so as not to collide with the command to open the 'v' text editor. Despite my convention of using ALL CAPS for constant names, these names are case insensitive so naming this constant 'V' would be a problem.

Here's the wall of POKEs required to initialise the two sprites:

: init-sprites
 SPRITEPTR 2040 c! \ sprite 0
 SPRITEPTR 2041 c! \ sprite 1
 SPRITEPTR 64 * 64 $ff fill \ data
 YELLOW VIC 39 + c!
 BLUE VIC 40 + c!
 \ sprite x expand
 3 VIC 29 + c!
 \ sprite initial position
 50 VIC c!       \ sprite 0 xpos
 100 VIC 1 + c!  \ sprite 0 ypos
 50 VIC 2 + c!   \ sprite 1 xpos
 180 VIC 3 + c!  \ sprite 1 ypos
;

: show-sprites
 3 VIC 21 + c! ;

: hide-sprites
 0 VIC 21 + c! ;

This is straightforward sprite boilerplate. As I mentioned, I'm just poking values into various VIC registers to initialise the sprites, their size, their colour and their positions. I use the fill word again to initialise the sprite data because we just want to turn on every pixel... i.e. a plain rectangle of pixels. There a many resources online which explain the various registers and how to set up your sprites. Here's a pretty good example.

At this point I want to add a value to track whether the black and white bars are currently hidden. This can go near the top of the program with the constants:

0 value hidebars

The syntax for using a value is nice and simple. hidebars will push the current value of hidebars to the stack, and val to hidebars will set hidebars with a new value. In our case we want to toggle the value between true and false, so we'll use hidebars invert to hidebars.

Now all that is left is to modify our main and mainloop words to incorporate the sprites.

: mainloop
 begin
 [ VIC inc, VIC 2 + inc, ]
 100 0 do
  key? if
   key drop
   hidebars invert to hidebars
   hidebars if
    SPACE-CHAR fillscreen
   else
    RVS-CHAR fillscreen
   then
  then
 loop
 again ;

: main
 screen-setup
 init-sprites
 RVS-CHAR fillscreen
 show-sprites
 mainloop ;

Notice that I've used some inline assembly to increment the x-position of the two sprites. This is a rare case where I feel assembly code provides nicer syntax.

The alternative in forth would be:

VIC dup c@ 1+ swap c!
VIC 2 + dup c@ 1+ swap c!

Another change is that I'm now using key? to check whether there is a character available for key. This prevents the program from waiting for input when there is none, which would pause the animation.

Let's take a look at the end result:

Here's the full program:

$0400 constant SCREENMEM
$d800 constant COLORMEM
53281 constant SCREENCOLOR
32 constant SPACE-CHAR
160 constant RVS-CHAR
12 constant GRAY2
53248 constant VIC
14 constant SPRITEPTR
6 constant BLUE
7 constant YELLOW
0 value hidebars

: screen-setup  ( -- )
 GRAY2 SCREENCOLOR c!
 1000 0 do
  i 1 and COLORMEM i + c!
 loop ;

: fillscreen ( char -- )
SCREENMEM 1000 rot fill ;

: init-sprites
 SPRITEPTR 2040 c! \ sprite 0
 SPRITEPTR 2041 c! \ sprite 1
 SPRITEPTR 64 * 64 $ff fill \ data
 YELLOW VIC 39 + c!
 BLUE VIC 40 + c!
 \ sprite x expand
 3 VIC 29 + c!
 \ sprite initial position
 50 VIC c!       \ sprite 0 xpos
 100 VIC 1 + c!  \ sprite 0 ypos
 50 VIC 2 + c!   \ sprite 1 xpos
 180 VIC 3 + c!  \ sprite 1 ypos
;

: show-sprites
 3 VIC 21 + c! ;

: hide-sprites
 0 VIC 21 + c! ;

: mainloop
 begin
 [ VIC inc, VIC 2 + inc, ]
 100 0 do
  key? if
   key drop
   hidebars invert to hidebars
   hidebars if
    SPACE-CHAR fillscreen
   else
    RVS-CHAR fillscreen
   then
  then
 loop
 again ;

: main
 screen-setup
 init-sprites
 RVS-CHAR fillscreen
 show-sprites
 mainloop ;