home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1987 October
/
64er_Magazin_87-10_1987_Markt__Technik_de.d64
/
fr.berge
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
2KB
|
83 lines
10 rem ****************************
20 rem * fraktale berge *
30 rem * 1987 by stefan vilsmeier *
40 rem ****************************
50 :
60 if a=0 then a=1:load "fractal.obj",8,1
70 dim h%(128,128)
80 open 1,8,15,"u9":close 1: rem diese zeeile kann bei problemen mit dem
90 rem floppyspeeder weggelassen werden!
100 poke53280,0:poke53281,0
110 input "[147]grad ";g
120 rem *********** variablen *****
130 w=128:d=.5:h=128:u=180:r=10:ge=2.25:n=0
200 rem ********* anfangswerte ****
210 rem (koennen variiert werden)
220 h%(0,0)=0
230 h%(128,0)=0
240 h%(0,128)=0
250 h%(64,0)=0
260 h%(0,64)=0
270 h%(64,64)=0
300 rem ********* grafik ein ******
310 sys50176,14,0:sys50179,1:sys50194
350 :
360 :
370 rem ****************************
380 rem * berge berechnen *
390 rem ****************************
400 :
410 for m=1 to g
420 :br=w*5:w2=w/2
430 :for t=0 to 127 step w
440 : for i=0 to 127-t step w
450 : b=(h%(i,t)+h%(i+w,t))/2
460 : h%(i+w2,t)=b+(rnd(1)-d)*br
470 : b=(h%(t,i)+h%(t,i+w))/2
480 : h%(t,i+w2)=b+(rnd(1)-d)*br
490 : b=(h%(128-t-i,i)+h%(128-t-i-w,i+w))/2
500 : h%(128-t-i-w2,i+w2)=b+(rnd(1)-d)*br
510 : next i
520 :next t
530 w=w/2
540 next m
650 :
660 :
670 rem ****************************
680 rem * berge zeichnen *
690 rem ****************************
700 :
710 for t=0 to 127 step w
720 :a=t/2:b=a+w:c=(t+w)/2:f=c+w
730 :ya=(t+w)+u-h
740 :yb=t+u-h
750 :for i=0 to 127-t step w
760 : ii=127-t-w
770 : h1=h%(i,t)/5:if h1<n then h1=n
780 : h2=h%(i,t+w)/5:if h2<n then h2=n
790 : h3=h%(i+w,t)/5:if h3<n then h3=n
800 : h4=h%(i+w,t+w)/5:if h4<n then h4=n
810 : x1=(i+a)*ge+r:y1=yb-h1
820 : x2=(i+c)*ge+r:y2=ya-h2
830 : x3=(i+b)*ge+r:y3=yb-h3
840 : x4=(i+f)*ge+r:y4=ya-h4
850 : sys 50185,x1,y1,x3,y3,1
860 : sys 50185,x2,y2,x1,y1,1
870 : sys 50185,x2,y2,x3,y3,1
880 : if i>ii goto 910
890 : sys 50185,x3,y3,x4,y4,1
900 : sys 50185,x4,y4,x2,y2,1
910 :next i
920 next t
1000 get a$:if a$="" goto 1000
1010 sys 50179,0:if a$<>"s" then goto 80:rem neustart
1040 :
1050 :
1060 rem ***************************
1070 rem * 'grafik speichern' *
1080 rem ***************************
1090 :
1100 input "grafik-name ";n$
1110 open 2,8,2,"pi."+n$+",p,w":sys 50191:close 2
1120 goto 80:rem neustart