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),S%(319,1),F%(7,7)
80 OPEN 1,8,15,"U9":CLOSE 1: REM DIESE ZEEILE KANN BEI PROBLEMEN MIT DEM
90 REM FLOPPYSPEEDER WEGGELASSEN WERDEN!
100 POKE53280,15:POKE53281,15
110 INPUT "[147][151]GRAD ";G
120 INPUT "MEERESHOEHE ";N
130 INPUT "LICHTQUELLE ";L1,L2,L3
140 L=SQR(L1*L1+L2*L2+L3*L3)
150 L1=L1/L:L2=L2/L:L3=L3/L
160 REM *********** VARIABLEN *****
170 W=128:D=.5:H=128:U=180:R=10:GE=2.25:SQ=.866
180 GOSUB 3500
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,11,15:SYS50179,1:SYS50194
350 :
360 :
370 REM ****************************
380 REM *     BERGE BERECHNEN      *
390 REM ****************************
400 :
410 FOR M=1 TO G
420 :BR=W*10: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 :SS=GE*W:HH=SQ*SS:V3=SS*HH
740 :YA=(T+W)+U-H:YB=T+U-H
750 :FOR I=0 TO 127-T STEP W
760 : II=127-T-W
770 : H1=H%(I,T)/10:IF H1<N THEN H1=N
780 : H2=H%(I,T+W)/10:IF H2<N THEN H2=N
790 : H3=H%(I+W,T)/10:IF H3<N THEN H3=N
800 : H4=H%(I+W,T+W)/10: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 : GOSUB 3200:GOSUB 3300:IFH1=0ANDH2=0ANDH3=0THENFA=0
860 : X=X1:XX=X3:Y=Y1:YY=Y3:GOSUB 2000
870 : X=X2:XX=X1:Y=Y2:YY=Y1:GOSUB 2000
880 : X=X2:XX=X3:Y=Y2:YY=Y3:GOSUB 2000
890 : IF I>II GOTO 1010
900 : GOSUB 3200:GOSUB 3320:IFH2=0ANDH3=0ANDH4=0THENFA=0
910 : X=X3:XX=X4:Y=Y3:YY=Y4:GOSUB 2000
920 : X=X4:XX=X2:Y=Y4:YY=Y2:GOSUB 2000
930 : X=X2:XX=X3:Y=Y2:YY=Y3:GOSUB 2000
1010 :NEXT I
1020 NEXT T
1500 GET A$:IF A$="" GOTO 1500
1510 SYS 50179,0:IF A$<>"S" THEN GOTO 80:REM NEUSTART
1540 :
1550 :
1560 REM ***************************
1570 REM *   'GRAFIK SPEICHERN'    *
1580 REM ***************************
1590 :
1600 INPUT "GRAFIK-NAME ";N$
1610 OPEN 2,8,2,"PI."+N$+",P,W":SYS 50191:CLOSE 2
1620 GOTO 80:REM NEUSTART
1950 :
1960 :
1970 REM ***************************
1980 REM *      SCHATTIEREN        *
1990 REM ***************************
2000 :
2010 WE=ABS(X-XX)/(X-XX)
2020 SG=(Y-YY)/(X-XX):YS=YY
2030 FOR XS=XX TO X STEP WE
2040 :YS=YS+SG*WE
2050 :IFS%(XS,0)=0ANDS%(XS,1)=0THENS%(XS,0)=YS:S%(XS,1)=YS:GOTO2080
2060 :IFYS>S%(XS,1)THENS%(XS,1)=YS:GOSUB3000:GOTO2080
2070 :IFYS<S%(XS,0)THENS%(XS,0)=YS:GOSUB3000
2080 NEXT
2090 RETURN
3000 IF S%(XS,0)=0 OR S%(XS,1)=0 THEN RETURN
3010 BX=7 AND XS
3020 FOR V=S%(XS,0) TO S%(XS,1)
3030 :ZM=0:IF FA<F%(BX,VAND7)THEN ZM=1
3040 :IF BX<0 OR BX>319 OR V<0 OR V>199 GOTO 3060
3050 :SYS 50182,XS,V,ZM
3060 NEXT V
3070 RETURN
3200 FOR P=0 TO 319:S%(P,0)=0:S%(P,1)=0:NEXT:RETURN
3250 :
3260 :
3270 REM ***************************
3280 REM * WINKEL ZUM LICHT BER.   *
3290 REM ***************************
3300 :
3310 V1=-HH*(H3-H1):V3=SS*((H1+H3)/2-H2):GOTO 3330
3320 V1=-HH*(H2-H0):V3=SS*((H0+H2)/2-H1)
3330 L=SQR(V1*V1+V2*V2+V3*V3):IF L=0 THEN L=.000000001
3340 CO=ABS((L1*V1+L2*V2+L3*V3)/L)
3350 IF CO>1 THEN CO=1
3360 FA=CO*50
3370 RETURN
3450 :
3460 :
3470 REM ***************************
3480 REM *    RASTER EINLESEN      *
3490 REM ***************************
3500 :
3510 FOR I=0 TO 7
3520 :FOR T=0 TO 7
3530 : READ F%(T,I)
3540 :NEXT T
3550 NEXT I
3560 RETURN
3600 DATA  0, 8,53,61, 2,10,55,63
3610 DATA 16,24,37,45,18,26,39,47
3620 DATA 49,57, 4,12,51,59, 6,14
3630 DATA 33,41,20,28,35,43,22,30
3640 DATA  3,11,54,62, 1, 9,52,60
3650 DATA 19,27,38,46,17,25,36,44
3660 DATA 50,58, 7,15,48,56, 5,13
3670 DATA 34,42,23,31,32,40,21,29