10 screen 1,4,0: randomize -1: pena 7 20 dim d(128,64) 30 input "Number of levels <1-7> ";le: if le < 1 or le > 7 then 30 40 ds=2: for n=1 to le:ds=ds+2^(n-1):next n 50 mx=ds-1:my=mx/2:rh=pi*30/180:vt=rh*1.2 60 for n=1 to le:L=10000/1.8^n 70 ?: ? "Working on level ";n 80 ib=mx/2^n:sk=ib*2 90 gosub 150: ' *** Assign heights along X in array *** 100 gosub 220: ' *** Assign heights along Y in array *** 110 gosub 290: ' *** Assign heights along diag. in array *** 120 next n 130 goto 640: ' *** Draw *** 140 ' *** Heights along x *** 150 for ye = 0 to mx - 1 step sk 160 for xe = ib+ye to mx step sk 170 ax = xe-ib: ay = ye: gosub 370: d1=d: ax = xe+ib: gosub 370: d2 = d 180 d = (d1+d2)/2 + rnd(1) * L/2 - L/4: ax = xe: ay = ye: gosub 420 190 next xe 200 next ye: return 210 ' *** Heights along Y *** 220 for xe = mx to 1 step -sk 230 for ye = ib to xe step sk 240 ax = xe: ay = ye + ib: gosub 370: d1 = d: ay = ye - ib: gosub 370: d2 = d 250 d = (d1+d2)/2 + rnd(1) * L/2 - L/4: ax = xe: ay = ye: gosub 420 260 next ye 270 next xe: return 280 ' *** Heights along diag. *** 290 for xe = 0 to mx - 1 step sk 300 for ye = ib to mx - xe step sk 310 ax = xe + ye - ib: ay = ye - ib: gosub 370: d1 = d 320 ax = xe + ye + ib: ay = ye + ib: gosub 370: d2 = d 330 ax = xe + ye: ay = ye: d = (d1+d2)/2 + rnd(1) * L/2 - L/4: gosub 420 340 next ye 350 next xe: return 360 ' *** Return data from array *** 370 if ay > my then 390 380 by = ay: bx = ax: goto 400 390 by = mx+1-ay: bx = mx-ax 400 d = d(bx,by): return 410 ' *** Put data into array *** 420 if ay > my then 440 430 by = ay: bx = ax: goto 450 440 by = mx+1-ay: bx = mx-ax 450 d(bx,by) = d: return 460 ' *** Put in sea level here *** 470 if xo <> -999 then 500 480 if zz < 0 then gosub 1070: z2 = zz: zz = 0: goto 620 490 gosub 1090: goto 610 500 if z2 > 0 and zz > 0 then 610 510 if z2 < 0 and zz < 0 then z2 = zz: zz = 0: goto 620 520 w3 = zz/(zz-z2): x3 = (x2-xx) * w3 + xx: y3 = (y2-yy) * w3 + yy: z3 = 0 530 zt = zz: yt = yy: xt = xx 540 if zz > 0 then 590 550 ' *** Going into water *** 560 zz = z3: yy = y3: xx = x3: gosub 950 570 gosub 1070: zz = 0: yy = yt: xx = xt: z2 = zt: goto 620 580 ' *** Coming up out of water *** 590 zz = z3: yy= y3: xx= x3: gosub 950 600 gosub 1090: zz = zt: yy = yt: xx = xt 610 z2 = zz 620 x2 = xx: y2 = yy: return 630 ' **** Display here **** 640 gosub 1100: ' *** Set up plotting device or screen *** 650 xs = .04: ys = .04: zs = .04: ' *** scaling factors *** 660 for ax = 0 to mx: xo = -999: for ay = 0 to ax 670 gosub 370: zz = d: yy = ay/mx * 10000: xx = ax/mx * 10000 - yy/2 680 gosub 940: next ay: next ax 690 for ay = 0 to mx: xo = -999: for ax = ay to mx 700 gosub 370: zz = d: yy = ay/mx * 10000: xx = ax/mx * 10000 - yy/2 710 gosub 940: next ax: next ay 720 for ex = 0 to mx: xo = -999: for ey = 0 to mx-ex 730 ax = ex + ey: ay = ey: gosub 370: zz = d: yy = ay/mx *10000 740 xx = ax/mx * 10000 - yy/2: gosub 940: next ey: next ex 750 goto 1130: ' *** done plotting, goto end loop *** 760 ' *** Rotate *** 770 if xx <> 0 then 800 780 if yy <= 0 then ra = -pi/2: goto 820 790 ra = pi/2: goto 820 800 ra = atn(yy/xx) 810 if xx < 0 then ra = ra + pi 820 r1 = ra + rh: rd = sqr (xx*xx + yy*yy) 830 xx = rd * cos(r1): yy = rd * sin(r1) 840 return 850 ' *** Tilt down *** 860 rd = sqr(zz*zz + xx*xx) 870 if xx = 0 then ra = pi/2: goto 900 880 ra = atn (zz/xx) 890 if xx < 0 then ra = ra + pi 900 r1 = ra - vt 910 xx = rd * cos(r1) + xx: zz = rd * sin(r1) 920 return 930 ' *** Move or plot to (xp,yp) 940 gosub 470 950 xx = xx * xs: yy = yy * ys: zz = zz * zs 960 gosub 770: ' *** Rotate *** 970 gosub 860: ' *** Tilt up *** 980 if xo = -999 then pr$ = "M" 985 if xo <> -999 then pr$ = "D" 990 xp = int(yy) + cx: yp = int(zz) 1000 gosub 1030 1010 return 1020 ' *** plot line here *** 1030 xp = xp * 1.3: yp = 33.14 - .623 * yp 1040 if pr$ = "M" then x8 = xp: y8 = yp: xo = x 1045 if y8 > 199 or y8 < 0 or yp > 199 or yp < 0 then return 1050 draw (x8,y8 to xp,yp): x8 = xp: y8 = yp: return 1060 ' *** switch to sea color *** 1070 pena 11: return 1080 ' *** switch to land color *** 1090 pena 8: return 1100 ' * * * setup plotting device or screen * * * 1110 scnclr: pena 1: area (0,0 to 0,200 to 620,200 to 620,0 to 0,0): return 1120 ' *** End loop *** 1130 getkey a$ 1140 end 60000 ' This program come from "Creative Computing" July 1985 pp 78-82 60010 ' by Michiel van de Panne. He used the method of generating 60020 ' fractal landscapes from the September 1984 issue of "Scientific 60030 ' American". To modify the program you can change the color of 60040 ' pena in line 1070 and in line 1090. You can change the 60050 ' background color by changing pena to a different color in line 60060 ' 1110. The program can only handle 6 levels with a dimension of 60070 ' d(64,32) in line 20 -- if you want to wait for level 7 to be 60080 ' plotted, change line 20 to dimension d as dim d(128,64) for 60090 ' 16384 triangles to generated. 60100 ' The size of the landscape can be scaled in line 1030. 60110 ' Line 10 and lines 1030-1040 have the computer dependent code. 60120 ' To remove the seas from the landscape change line 470 to read 60130 ' 470 return