[ColorForth] Mandelbrot Set

[Charles Shattuck <charleys@xxxxxxx>]

I'd like to share a colorForth program for looking at the Mandelbrot
set. I'd welcome any comments or criticism. I'd also welcome other
people posting their colorForth programs for comparison. This one takes
3 blocks. I don't have color here, so I'll use : for red words and
enclose yellow words in [ and ]. I'll put var before magenta words.
Assume the rest of the words are green. I made most references to
variables yellow, but I don't think this is necessary so I won't do it
here. I will use \ and ( ) for white comments. Assume that a word
outside a colon definition is yellow, like empty for example on the
first line. Hex numbers have a $ preceding them.

\ Block 64
( Mandelbrot set) empty var p var q var sum var limit var go var sh 1 go
! 16 limit !
: one 10000000 ;
: square dup one */ ;
: newx square negate swap square + p @ + ;
: newy [ one 2/ ] */ q @ + ;
: size over square over square + ;
: once over over newy push newx pop size ;
: in? [ one dup + dup + ] less drop drop ;
: few? sum @ limit @ less drop drop ;
: look once in? if few? if 1 sum +! look ; then then drop drop sum @ ;
: depth 0 sum ! q ! p ! 0 0 look ;
: s1 1 ? drop if white ; then black ;
: lshift for 2* next ;
: s2 limit @ less drop if 15 and 15 or 2* 2* 2* negate $ff + dup 8
lshift dup 8 lshift + + color ; then drop black ;
: shade sh @ 1 ? drop if s1 ; then s2 ; 66 load 68 load ok h

\ Block 66
( Mandelbrot) var size var xc var yc 50000 size ! 0 xc ! 0 yc !
: go? go @ 2 and drop ;
: warn? go @ 1 and drop ;
: scale size @ * ;
: xo 512 size @ * negate xc @ + ;
: yo 320 size @ * negate yc @ + ;
: real scale xo + ;
: imag scale yo + ;
: dot at 0 1 line ;
: plot over real over imag depth shade dot ;
: draw 1022 for i 639 for dup i plot next drop next ;
: upper 0 0 at green 1024 641 box ;
: ?draw go? if upper draw 0 go ! then ;
: lower 0 641 at black 1024 768 box text ;
: details 0 680 at xc @ . yc @ . size @ . limit @ . ;
: ok show ?draw lower details warn? if 2 go ! ; then keyboard ;

\ Block 68
( changes)
: g 1 go ! ;
: s 1 sh +! g ;
: more 16 limit +! ;
: less limit @ -16 + 16 max limit ! ;
: in size @ 2/ 1 max size ! ;
: out size @ 2* size ! ;
: +yc size @ * yc +! ;
: up -160 +yc ;
: down 160 +yc ;
: +xc size @ * xc +! ;
: right 256 +xc ;
: left -256 +xc ;
: reset 64 load ;
: nul ;
: h pad nul nul accept nul g s nul reset left up down right out less
more in nul nul nul nul nul nul nul nul nul nul nul nul $2500 , $100050d
, $110160c , $72b2303 , 0 , 0 , 0 ,

\ That's it.

The keypad is for the right hand only:

ga r
ludr
o-+i
.

Where g means go, make a new picture. a means change to alternate color
scheme and make new picture. r means reset, start fresh. ludr move your
attention left, up, down, or right by a quarter screen. o moves you out,
less magification. i moves in, more magnification. - sets the iteration
limit lower by 16, and + sets it higher by 16.

Problems:

1. I made one bigger to start with, but the machine kept rebooting. I
believe it was the divide by zero interrupt. The problem went away with
a smaller one, but this is really irritating. If the result of */
overflows 32 bits the machine reboots.

2. In the word s1 where I check to see if the depth is less than the
limit, it doesn't seem to matter whether I use if or -if, the behavior
is the same. Does anyone have an explanation?

Charley Shattuck


------------------------

To Unsubscribe from this list, send mail to Mdaemon@xxxxxxxxxxxxxxxxxx with:
unsubscribe ColorForth
as the first and only line within the message body
Problems   -   List-Admin@xxxxxxxxxxxxxxxxxx
Main ColorForth site   -   http://www.colorforth.com