D-Bug & Automation Forum | |
D-Bug & Automation Forum >> Coding >> STOTRO source code..
http://d-bug.mooo.com/dbugforums/cgi-bin/yabb2/YaBB.pl?num=1232833711 Message started by Christos on 24.01.09 at 21:48:30 |
Title: Re: STOTRO source code.. Post by Christos on 24.01.09 at 21:50:36
And here is the fantastic algorithm behind the DLA fractal :)
[code]DIM screen|(320,200) DIM precalc&(4000,1) th=90 ' Fill array screen with initial values FOR i=0 TO 179 STEP 0.5 x1=160+COSQ(th+i)*10 y1=100+SINQ(th+i)*10 x2=160-COSQ(th+i)*10 y2=y1 FOR j=x1 TO x2 screen|(j,y1)=1 NEXT j NEXT i counter=1 screen_address%=XBIOS(2) ' Load image DIM buffer|(32066-1) buf_address%=V:buffer|(0) BLOAD "stot8.pi1",buf_address% ~XBIOS(6,L:buf_address%+2) RC_COPY buf_address%+34,0,0,320,200 TO screen_address%,0,0 feed fractal saving PROCEDURE feed ' place a particle in a random position on the periphery of a circle ' of radius r fi=RAND(360) r=15+INT((counter/3.14)^0.63) x=INT(160+r*COSQ(fi)) y=INT(100+r*SINQ(fi)) IF screen|(x,y)=1 THEN GOSUB feed ENDIF IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN screen|(x,y)=1 GOSUB feed ENDIF RETURN PROCEDURE fractal ' This is the DLA algorithm. Particle follows brownian motion. In each step ' a check is being performed for the existance of a neigbouring particle. ' If such a particle exists then the particle sticks and a new one is being ' released DO REM theta=RAND(360) n%=RANDOM(3)-1 x=x+n% IF x<160-r THEN x=165-r ENDIF IF x>160+r THEN x=155+r ENDIF IF screen|(x,y)=1 THEN GOSUB fractal ENDIF IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN screen|(x,y)=1 PLOT x,y insert=1 IF insert=1 THEN counter=counter+1 precalc&(counter,0)=x precalc&(counter,1)=y GOSUB feed ENDIF ENDIF REM theta=RAND(360) m%=RANDOM(3)-1 y=y+m% IF y<100-r THEN y=105-r ENDIF IF y>100+r THEN y=95+r ENDIF IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN screen|(x,y)=1 PLOT x,y insert=1 IF insert=1 THEN counter=counter+1 precalc&(counter,0)=x precalc&(counter,1)=y ENDIF ENDIF ' PRINT AT(1,1);x,y,counter,r COLOR y/10 IF counter>3500 GOSUB saving ENDIF LOOP RETURN PROCEDURE saving BSAVE "precalc.chr",V:precalc&(0,0),4000*2*2 END RETURN [/code] |
D-Bug & Automation Forum » Powered by YaBB 2.6.0! YaBB Forum Software © 2000-2024. All Rights Reserved. |