d6
/
uxn
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

(mandelbrot) Improvements from d6

This commit is contained in:
Devine Lu Linvega 2024-04-05 09:14:03 -07:00
parent 11d32db150
commit 41567558bc
1 changed files with 85 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
projects/examples/demos/mandelbrot.tal
View File

@ -1,36 +1,54 @@
( mandelbrot.tal ) ( mandelbrot.tal )
( ) ( )
( by alderwick and d_m ) ( by alderwick and d_m )
( )
( uses 4.12 fixed point arithmetic. )
%WIDTH { #02a0 } ( SCALE LOGICAL SCREENSIZE )
%HEIGHT { #0200 } ( #0001 21x16 42x32 )
%XMIN { #de69 } ( -8601 ) ( #0002 42x32 84x64 )
%XMAX { #0b33 } ( 2867 ) ( #0004 84x64 168x128 )
%YMIN { #ecc7 } ( -4915 ) ( #0008 168x128 336x256 )
%YMAX { #1333 } ( 4915 ) ( #0010 336x256 672x512 )
( #0020 672x512 1344x1024 )
%SCALE { #0009 } ( 32 )
%WIDTH { #0015 } ( 21 )
%HEIGHT { #0010 } ( 16 )
%XMIN { #de69 } ( -8601 => -8601/4096 => -2.100 )
%XMAX { #0b33 } ( 2867 => 2867/4096 => 0.700 )
%YMIN { #ecc7 } ( -4915 => -4915/4096 => -1.200 )
%YMAX { #1333 } ( 4915 => 4915/4096 => 1.200 )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0100 ( -> ) |0100 ( -> )
( theme ) ( set colors )
#0f0f .System/r DEO2 #00ff .System/r DEO2
#0ff0 .System/g DEO2 #0ff0 .System/g DEO2
#00ff .System/b DEO2 #0f0f .System/b DEO2
( size ) ( set window size )
WIDTH .Screen/width DEO2 width #10 SFT2 .Screen/width DEO2
HEIGHT .Screen/height DEO2 height #10 SFT2 .Screen/height DEO2
( run ) ( run )
draw-mandel draw-mandel BRK
BRK
( logical width )
@width ( -> w* )
WIDTH SCALE MUL2 JMP2r
( logical height )
@height ( -> h* )
HEIGHT SCALE MUL2 JMP2r
( draw the mandelbrot set using 4.12 fixed point numbers ) ( draw the mandelbrot set using 4.12 fixed point numbers )
@draw-mandel ( -> ) @draw-mandel ( -> )
XMAX XMIN SUB2 WIDTH DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width ) XMAX XMIN SUB2 width DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width )
YMAX YMIN SUB2 HEIGHT DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height ) YMAX YMIN SUB2 height DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height )
[ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 ) [ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 )
LIT2r 8000 ( [8000] ) LIT2r 8000 ( [8000] )
YMAX YMIN ( ymax* ymin* [8000] ) YMAX YMIN ( ymax* ymin* [8000] )
@ -38,21 +56,41 @@
XMAX XMIN ( ymax* y* xmax* xmin* [8000] ) XMAX XMIN ( ymax* y* xmax* xmin* [8000] )
&xloop ( ymax* y* xmax* x* [8000] ) &xloop ( ymax* y* xmax* x* [8000] )
ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] ) ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] )
.Screen/pixel DEO POP2 ( ymax* y* xmax* x* [8000] ) draw-px POP2 ( ymax* y* xmax* x* [8000] )
[ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] ) [ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] )
OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] ) OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] )
OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] ) OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] )
GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] ) GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] )
POP2 POP2 ( ymax* y* [8000] ) POP2 POP2 ( ymax* y* [8000] )
#0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 ) #0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 )
.Screen/y DEI2k ( ymax* y* d^ sy* [8000] ) .Screen/y ;inc2 adjust ( ymax* y* [8000] ; sc/y<-sy+1 )
INC2 ROT DEO2 ( ymax* y* [8000] ; sc/y<-sy+1 )
[ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] ) [ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] )
OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] ) OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] )
OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] ) OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] )
GTH2 ?&yloop ( ymax* y+dy* [8000] ) GTH2 ?&yloop ( ymax* y+dy* [8000] )
POP2 POP2 POP2r JMP2r ( ) POP2 POP2 POP2r JMP2r ( )
( dithering pattern for 2x2 pixels: )
( )
( |o o| -> |x o| -> |x o| -> |x x| -> |x x| )
( |o o| -> |o o| -> |o x| -> |o x| -> |x x| )
( )
( |[p+3]/4 [px+1]/4| )
( |[p+0]/4 [px+2]/4| )
@draw-px ( px^ -> )
INCk INCk INC ( p+0 p+1 p+3 )
draw-quad draw-quad ( p+0 ; draw NW, NE )
.Screen/y ;inc1 adjust ( ; y<-y+1 )
.Screen/x ;sub2 adjust ( ; x<-x-2 )
INCk INC SWP ( p+2 p+0 )
draw-quad draw-quad ( ; draw SW, SE )
.Screen/y ;sub1 !adjust ( ; y<-y-1 )
( draw one quadrant of a 2x2 area )
@draw-quad ( p^ -> )
#02 SFT .Screen/pixel DEO JMP2r ( ; pixel<-p/4 )
( evaluate the mandelbrot function at one point )
@evaluate ( x* y* -> count^ ) @evaluate ( x* y* -> count^ )
#0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 ) #0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 )
DUP2 ,&y1 STR2 ( x* y* ; y1<-0 ) DUP2 ,&y1 STR2 ( x* y* ; y1<-0 )
@ -76,12 +114,15 @@
&end ( x* y* [20 count^] ) &end ( x* y* [20 count^] )
POP2 POP2 NIPr STHr JMP2r ( count^ ) POP2 POP2 NIPr STHr JMP2r ( count^ )
( is x a non-negative signed value? )
@non-negative ( x* -> x* x>=0^ )
DUP2 #8000 LTH2 JMP2r
( multiply two signed 4.12 fixed point numbers ) ( multiply two signed 4.12 fixed point numbers )
@smul2 ( a* b* -> ab* ) @smul2 ( a* b* -> ab* )
LIT2r 0001 DUP2 #8000 LTH2 ?&bpos negate SWPr ( a* |b|* [sign*] ) LIT2r 0001 non-negative ?{ negate SWPr } ( a* |b|* [sign*] )
&bpos SWP2 DUP2 #8000 LTH2 ?&apos negate SWPr ( |b|* |a|* [sign*] ) SWP2 non-negative ?{ negate SWPr } ( |b|* |a|* [sign*] )
&apos smul2-pos STHr ?&abpos negate ( ab* [scrap^] ) smul2-pos STHr ?{ negate } POPr JMP2r ( ab* )
&abpos POPr JMP2r ( ab* )
( multiply two non-negative fixed point numbers ) ( multiply two non-negative fixed point numbers )
( ) ( )
@ -94,8 +135,7 @@
( z = a0b1 >> 4 ) ( z = a0b1 >> 4 )
@smul2-pos ( a* b* -> ab* ) @smul2-pos ( a* b* -> ab* )
aerate ROT2 aerate ( b0* b1* a0* a1* ) aerate ROT2 aerate ( b0* b1* a0* a1* )
STH2 ROT2k ( b0* b1* a0* b1* a0* b0* [a1*] ) STH2 ROT2k STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] )
STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] )
MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] ) MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] )
NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] ) NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] )
STH2r #04 SFT2 ADD2 ( x* [y+z*] ) STH2r #04 SFT2 ADD2 ( x* [y+z*] )
@ -103,22 +143,30 @@
( equivalent to DUP2 smul2 but faster ) ( equivalent to DUP2 smul2 but faster )
@square ( a* -> aa* ) @square ( a* -> aa* )
DUP2 #8000 LTH2 ?&pos negate &pos non-negative ?{ negate } ( |a|* )
( >> )
( equivalent to DUP2 smul2-pos but faster )
@square-pos ( a* -> aa* )
aerate ( 00 ahi^ 00 alo^ ) aerate ( 00 ahi^ 00 alo^ )
OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* ) OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* )
DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* ) DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* )
ADD2 #7fff !min ( aa* ) ADD2 #7fff !min ( aa* )
( convert each byte of a a short into a short ) ( update a device d^ given a function f: x* -> f[x]* )
@aerate ( x* -> 00 xhi^ 00 xlo^ ) SWP #0000 ROT SWP2 SWP JMP2r @adjust ( d^ f* -> )
STH2 DEI2k STH2r JSR2 ROT DEO2 JMP2r
( negate a fixed point number. doesn't work for #8000 )
@negate ( x* -> -x* ) DUP2k EOR2 SWP2 SUB2 JMP2r
( return the minimum of two non-negative numbers. ) ( return the minimum of two non-negative numbers. )
@min ( x* y* ) GTH2k [ JMP SWP2 ] NIP2 JMP2r @min ( x* y* )
GTH2k [ JMP SWP2 ] NIP2 JMP2r
( convert each byte of a a short into a short )
@aerate ( x* -> 00 xhi^ 00 xlo^ )
SWP #0000 ROT SWP2 SWP JMP2r
( negate a fixed point number. doesn't work for #8000 )
@negate ( x* -> -x* )
DUP2k EOR2 SWP2 SUB2 JMP2r
( useful arithmetic operations )
@inc2 ( n* -> n+2* ) INC2
@inc1 ( n* -> n+1* ) INC2 JMP2r
@sub1 ( n* -> n-1* ) #0001 SUB2 JMP2r
@sub2 ( n* -> n-2* ) #0002 SUB2 JMP2r