home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1987 December
/
64er_Magazin_87-12_1987_Markt__Technik_de_Side_A.d64
/
demo6.fraktale
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
1KB
|
70 lines
5 print"[147]":init:obj 260,800
10 input"[147]wie oft teilen (1-4)";te: k=270:ifte<1orte>4then10
15 def fnr(x)=(rnd(1)-.5)*k/(t+1)/4
20 dim m(2^te,2^te),q(te)
30 sp=0
40 fori=0tote
50 :q(i)=2^i
60 next
65 print" ich erzeuge den berg."
80 gosub2000
95 print" ich setze die punkte."
99 p=0
100 s=sin(60*(NULL)/180)
110 fory=0to2^te
120 :forx=0toq(te)-y
130 : kx=(x+y/2)*k/q(te)-k/2
140 : ky=m(x,y)
145 :rem ifky<0thenky=0
150 : kz=y*k/q(te)*s-k/3
160 : pset p,kx,ky,kz
165 : p=p+1
170 :next
180 next
190 print" ich ziehe die linien."
195 p=0
196 gosub4000
200 forh=2^teto1step-1
210 :forx=1toh
220 : lset l,p+x-1,p+x
225 : l=l+1
230 :next
240 :p=p+h+1
250 next:\
260 t=2^te
270 forx=0tot-1
280 :fory=1tot-x
290 : lset l,y*(t+1-(y-1)/2)+x,(y-1)*(t+1-(y-2)/2)+x
295 : l=l+1
300 :next
310 next:\
400 forh=tto1step-1
410 :fory=hto1step-1
420 : p=y*(t+1-(y-1)/2)+h-y
430 : p1=(y-1)*(t+1-(y-2)/2)+h-y+1
440 : lset l,p,p1
445 : l=l+1
460 :next
470 next
1900 \:goto1900
1990 rem ***************
2000 fort=0tote-1
2010 v=q(te-t):h=q(te-t-1)
2020 forx=0toq(t)-1
2030 fory=0toq(t)-x-1
2040 m(x*v+h,y*v)=(m(x*v,y*v)+m((x+1)*v,y*v))/2+fnr(t)
2050 m(x*v,y*v+h)=(m(x*v,y*v)+m(x*v,(y+1)*v))/2+fnr(t)
2090 m(x*v+h,y*v+h)=(m((x+1)*v,y*v)+m(x*v,(y+1)*v))/2+fnr(t)
2100 nexty,x,t
2110 return
2600 rem ***********
4000 rem
4010 anfset 0,-100,0,0,0
4020 dwset 20,0
4030 delset 0,0,0
4040 video 1,0,0
4060 perspset-k*1,-k/2 :rem entfernung
4070 modset1,1,1 :rem persp
4090 dreh
4100 return