uxn

Varvara Ordinator, written in ANSI C(SDL2)
git clone https://git.eamoncaddigan.net/uxn.git
Log | Files | Refs | README | LICENSE

mandelbrot.tal (6297B)


      1 ( mandelbrot.tal )
      2 ( )
      3 ( by alderwick and d_m )
      4 ( )
      5 ( uses 4.12 fixed point arithmetic. )
      6 
      7 ( SCALE  LOGICAL   SCREENSIZE )
      8 ( #0001    21x16        42x32 )
      9 ( #0002    42x32        84x64 )
     10 ( #0004    84x64      168x128 )
     11 ( #0008  168x128      336x256 )
     12 ( #0010  336x256      672x512 )
     13 ( #0020  672x512    1344x1024 )
     14 
     15 %SCALE  { #0009 } (    32 )
     16 %WIDTH  { #0015 } (    21 )
     17 %HEIGHT { #0010 } (    16 )
     18 %XMIN   { #de69 } ( -8601 => -8601/4096 => -2.100 )
     19 %XMAX   { #0b33 } (  2867 =>  2867/4096 =>  0.700 )
     20 %YMIN   { #ecc7 } ( -4915 => -4915/4096 => -1.200 )
     21 %YMAX   { #1333 } (  4915 =>  4915/4096 =>  1.200 )
     22 
     23 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
     24 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
     25 
     26 |0100 ( -> )
     27 
     28 	( set colors )
     29 	#00ff .System/r DEO2
     30 	#0ff0 .System/g DEO2
     31 	#0f0f .System/b DEO2
     32 
     33 	( set window size )
     34 	width #10 SFT2 .Screen/width  DEO2
     35 	height #10 SFT2 .Screen/height DEO2
     36 
     37 	( run )
     38 	draw-mandel BRK
     39 
     40 ( logical width )
     41 @width ( -> w* )
     42     WIDTH SCALE MUL2 JMP2r
     43 
     44 ( logical height )
     45 @height ( -> h* )
     46     HEIGHT SCALE MUL2 JMP2r
     47 
     48 ( draw the mandelbrot set using 4.12 fixed point numbers )
     49 @draw-mandel ( -> )
     50 	XMAX XMIN SUB2 width DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width )
     51 	YMAX YMIN SUB2 height DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height )
     52 	[ LIT2 01 -Screen/auto ] DEO         ( ; auto<-1 )
     53 	LIT2r 8000                           ( [8000] )
     54 	YMAX YMIN                            ( ymax* ymin* [8000] )
     55 	&yloop                               ( ymax* y* [8000] )
     56 		XMAX XMIN                        ( ymax* y* xmax* xmin* [8000] )
     57 		&xloop                           ( ymax* y* xmax* x* [8000] )
     58 			ROT2k evaluate               ( ymax* y* xmax* x* xmax* count^ [8000] )
     59 			draw-px POP2                 ( ymax* y* xmax* x* [8000] )
     60 			[ LIT2 &dx $2 ] ADD2         ( ymax* y* xmax* x+dx* [8000] )
     61 			OVR2 STH2kr ADD2             ( ymax* y* xmax* x+dx* 8000+xmax* [8000] )
     62 			OVR2 STH2kr ADD2             ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] )
     63 			GTH2 ?&xloop                 ( ymax* y* xmax* x+dx* [8000] )
     64 		POP2 POP2                        ( ymax* y* [8000] )
     65 		#0000 .Screen/x DEO2             ( ymax* y* [8000] ; sc/x<-0 )
     66 		.Screen/y ;inc2 adjust           ( ymax* y* [8000] ; sc/y<-sy+1 )
     67 		[ LIT2 &dy $2 ] ADD2             ( ymax* y+dy* [8000] )
     68 		OVR2 STH2kr ADD2                 ( ymax* y+dy* 8000+ymax* [8000] )
     69 		OVR2 STH2kr ADD2                 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] )
     70 		GTH2 ?&yloop                     ( ymax* y+dy* [8000] )
     71 	POP2 POP2 POP2r JMP2r                ( )
     72 
     73 ( dithering pattern for 2x2 pixels: )
     74 ( )
     75 ( |o o|  ->  |x o|  ->  |x o|  ->  |x x|  ->  |x x| )
     76 ( |o o|  ->  |o o|  ->  |o x|  ->  |o x|  ->  |x x| )
     77 ( )
     78 ( |[p+3]/4 [px+1]/4| )
     79 ( |[p+0]/4 [px+2]/4| )
     80 @draw-px ( px^ -> )
     81 	INCk INCk INC               ( p+0 p+1 p+3 )
     82 	draw-quad draw-quad         ( p+0 ; draw NW, NE )
     83 	.Screen/y ;inc1 adjust      ( ; y<-y+1 )
     84 	.Screen/x ;sub2 adjust      ( ; x<-x-2 )
     85 	INCk INC SWP                ( p+2 p+0 )
     86 	draw-quad draw-quad         ( ; draw SW, SE )
     87 	.Screen/y ;sub1 !adjust     ( ; y<-y-1 )
     88 
     89 ( draw one quadrant of a 2x2 area )
     90 @draw-quad ( p^ -> )
     91 	#02 SFT .Screen/pixel DEO JMP2r ( ; pixel<-p/4 )
     92 
     93 ( evaluate the mandelbrot function at one point )
     94 @evaluate ( x* y* -> count^ )
     95 	#0000 DUP2 ,&x1 STR2         ( x* y* ; x1<-0 )
     96 		  DUP2 ,&y1 STR2         ( x* y* ; y1<-0 )
     97 		  DUP2 ,&x2 STR2         ( x* y* ; x2<-0 )
     98 			   ,&y2 STR2         ( x* y* ; y2<-0 )
     99 	LIT2r 2000                   ( x* y* [20 00] )
    100 	&loop                        ( x* y* [20 n^] )
    101 		[ LIT2 &x1 $2 ]          ( x* y* x1* [20 n^] )
    102 		[ LIT2 &y1 $2 ]          ( x* y* x1* y1* [20 n^] )
    103 		smul2 DUP2 ADD2          ( x* y* 2x1y1* [20 n^] )
    104 		OVR2 ADD2 ,&y1 STR2      ( x* y* [20 n^] ; y1<-2x1y1+y* )
    105 		SWP2 [ LIT2 &x2 $2 ]     ( y* x* x2* [20 n^] )
    106 		[ LIT2 &y2 $2 ] SUB2     ( y* x* x2-y2* [20 n^] )
    107 		OVR2 ADD2 ,&x1 STR2 SWP2 ( x* y* [20 n^] ; x1<-x2-y2+x* )
    108 		,&x1 LDR2 square         ( x* y* x1^2* [20 n^] )
    109 		DUP2 ,&x2 STR2           ( x* y* x1^2* [20 n^] ; x2<-x1^2* )
    110 		,&y1 LDR2 square         ( x* y* x1^2* y1^2* [20 n^] )
    111 		DUP2 ,&y2 STR2           ( x* y* x1^2* y1^2* [20 n^] ; y2<-y1^2* )
    112 		ADD2 #4000 GTH2 ?&end    ( x* y* [20 n^] )
    113 		INCr GTHkr STHr ?&loop   ( x* y* [20 n+1*] )
    114 	&end                         ( x* y* [20 count^] )
    115 	POP2 POP2 NIPr STHr JMP2r    ( count^ )
    116 
    117 ( is x a non-negative signed value? )
    118 @non-negative ( x* -> x* x>=0^ )
    119 	DUP2 #8000 LTH2 JMP2r
    120 
    121 ( multiply two signed 4.12 fixed point numbers )
    122 @smul2 ( a* b* -> ab* )
    123 	LIT2r 0001 non-negative ?{ negate SWPr } ( a* |b|* [sign*] )
    124 	SWP2 non-negative ?{ negate SWPr }       ( |b|* |a|* [sign*] )
    125 	smul2-pos STHr ?{ negate } POPr JMP2r    ( ab* )
    126 
    127 ( multiply two non-negative fixed point numbers )
    128 ( )
    129 ( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} )
    130 (       = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 )
    131 (       = x + y + z + 0 ; the last term is too small to represent, i.e. zero )
    132 ( )
    133 ( x = a0b0 << 4 )
    134 ( y = a1b0 >> 4 )
    135 ( z = a0b1 >> 4 )
    136 @smul2-pos ( a* b* -> ab* )
    137 	aerate ROT2 aerate           ( b0* b1* a0* a1* )
    138 	STH2 ROT2k STH2 MUL2r        ( b0* b1* a0* b1* a0* [a1b0*] )
    139 	MUL2 STH2 ADD2r              ( b0* b1* a0* [a1b0+a0b1*] )
    140 	NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] )
    141 	STH2r #04 SFT2 ADD2          ( x* [y+z*] )
    142 	#7fff !min                   ( ab* )
    143 
    144 ( equivalent to DUP2 smul2 but faster )
    145 @square ( a* -> aa* )
    146 	non-negative ?{ negate }     ( |a|* )
    147 	aerate                       ( 00 ahi^ 00 alo^ )
    148 	OVR2 MUL2 #03 SFT2 SWP2      ( yz* ahi* )
    149 	DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* )
    150 	ADD2 #7fff !min              ( aa* )
    151 
    152 ( update a device d^ given a function f: x* -> f[x]* )
    153 @adjust ( d^ f* -> )
    154 	STH2 DEI2k STH2r JSR2 ROT DEO2 JMP2r
    155 
    156 ( return the minimum of two non-negative numbers. )
    157 @min ( x* y* )
    158 	GTH2k [ JMP SWP2 ] NIP2 JMP2r
    159 
    160 ( convert each byte of a a short into a short )
    161 @aerate ( x* -> 00 xhi^ 00 xlo^ )
    162 	SWP #0000 ROT SWP2 SWP JMP2r
    163 
    164 ( negate a fixed point number. doesn't work for #8000 )
    165 @negate ( x* -> -x* )
    166 	DUP2k EOR2 SWP2 SUB2 JMP2r
    167 
    168 ( useful arithmetic operations )
    169 @inc2 ( n* -> n+2* ) INC2
    170 @inc1 ( n* -> n+1* ) INC2 JMP2r
    171 @sub1 ( n* -> n-1* ) #0001 SUB2 JMP2r
    172 @sub2 ( n* -> n-2* ) #0002 SUB2 JMP2r