home *** CD-ROM | disk | FTP | other *** search
AmigaBASIC Source Code | 1986-11-20 | 4.4 KB | 198 lines |
- CLEAR 32767
- DEFSNG a-z
- DIM Lv(64,64)
- DIM cmap$(31)
- PRINT" Copyright 1987"
- PRINT"Compute Publications, Inc."
- PRINT" All Rights Reserved.":PRINT
- RANDOMIZE
- PRINT"Enter maximum variation (0-2) (1 is nice) ";:INPUT max
- PRINT"Enter a filename to save picture under."
- INPUT "(Saving at end is optional.) ";fiL$
- FOR a = 1 TO 10
- PRINT RND
- NEXT
- SCREEN 2,320,200,5,1
- WINDOW 3,"Mountain",(0,0) - (311,186),28,2
- FOR a = 0 TO 15
- PALETTE a,a/15,a/25,a/50
- PALETTE a+16,a/15,a/15,a/15
- a$ = CHR$(a*17)
- cmap$(a) = a$+CHR$(a*10.2)+CHR$(a*5.1)
- cmap$(a+16) = a$+a$+a$
- NEXT
- PALETTE 16,0,0.25,0.5
- cmap$(16) = CHR$(0)+CHR$(64)+CHR$(128)
- COLOR 15
- maxLv = 0
- MakeMount:
- FOR iter = 6 TO 1 STEP -1
- sk = 2 ^ iter
- hL = sk/2
- PRINT"Doing Iteration";iter
- Dotops:
- PRINT"Tops & Bottoms ";
- FOR y = 0 TO 64 STEP sk
- FOR x = hL TO 64 STEP sk
- ran = (RND-0.5)*max*sk
- oLd = (Lv(x-hL,y) + Lv(x+hL,y))/2
- Lv(x,y) = oLd + ran
- NEXT x
- NEXT y
- Dobottoms:
- PRINT "Sides ";
- FOR x = 0 TO 64 STEP sk
- FOR y = hL TO 64 STEP sk
- ran = (RND-0.5)*max*sk
- oLd = (Lv(x,y-hL) + Lv(x,y+hL))/2
- Lv(x,y) = oLd + ran
- NEXT y
- NEXT x
- Docentres:
- PRINT "Centers "
- FOR x = hL TO 64 STEP sk
- FOR y = hL TO 64 STEP sk
- ran = (RND-0.5)*max*sk
- oLd1 = (Lv(x+hL,y-hL) + Lv(x-hL,y+hL))/2
- oLd2 = (Lv(x-hL,y-hL) + Lv(x+hL,y+hL))/2
- oLd = (oLd1 + oLd2)/2
- Lv(x,y) = oLd + ran
- IF Lv(x,y) > maxLv THEN maxLv = Lv(x,y)
- NEXT y
- NEXT x
- NEXT iter
- snowLine = maxLv - maxLv/4
- drawmount:
- CLS
- xm = 4
- ym = 1
- xshift = 0.5
- yp = 70
- FOR x = 0 TO 64
- IF Lv(x,0) < 0 THEN Lv(x,0) = 0
- NEXT x
- FOR y = 0 TO 63
- IF Lv(0,y) < 0 THEN Lv(0,y) = 0
- FOR x = 0 TO 63
- IF Lv(x+1,y+1) < 0 THEN Lv(x+1,y+1) = 0
- Lv = Lv(x,y) + Lv(x+1,y) + Lv(x,y+1)
- Lv = (Lv + Lv(x+1,y+1))/4
- a=x:b=y
- rx1 = xm * a + xshift * b
- ry1 = ym * b + yp - Lv(a,b)
- GOSUB getshade:
- shade1 = shade
- a = x + 1
- rx2 = xm * a + xshift * b
- ry2 = ym * b + yp - Lv(a,b)
- GOSUB getshade:
- shade2 = shade
- a = x:b = y + 1
- rx3 = xm * a + xshift * b
- ry3 = ym * b +yp - Lv(a,b)
- GOSUB getshade:
- shade3 = shade
- a = x + 1
- rx4 = xm * a + xshift * b
- ry4 = ym * b + yp - Lv(a,b)
- GOSUB getshade:
- shade4 = shade
- a = x + 0.5:b = y + 0.5
- rx = xm * a + xshift * b
- ry = ym * b + yp
- a=x:b=y
- ry = ry - Lv
- AREA (rx,ry)
- AREA (rx1,ry1)
- AREA (rx2,ry2)
- COLOR shade1
- AREAFILL
- AREA (rx,ry)
- AREA (rx4,ry4)
- COLOR shade2
- AREAFILL
- AREA (rx,ry)
- AREA (rx1,ry1)
- AREA (rx3,ry3)
- COLOR shade3
- AREAFILL
- AREA (rx,ry)
- AREA (rx3,ry3)
- AREA (rx4,ry4)
- COLOR shade4
- AREAFILL
- NEXT x
- NEXT y
- ender:
- a$ = INKEY$
- IF a$ = "s" THEN GOTO savepic
- IF a$ <> " " THEN GOTO ender
- end2:
- WINDOW CLOSE 3
- SCREEN CLOSE 2
- WINDOW OUTPUT 1
- END
- getshade:
- c = x + 1 - (b-y)
- d = y + (a-x)
- xc = x + 0.5
- yc = y + 0.5
- xrun1 = xc - a
- xrun2 = xc - c
- yrun1 = yc - b
- yrun2 = yc - d
- rise1 = Lv - Lv(a,b)
- rise2 = Lv - Lv(c,d)
- yrise = ABS(rise1*xrun2 - rise2*xrun1)
- yrun = ABS(yrun1*xrun2 - xrun1*yrun2)
- IF yrun = yrise THEN yrun = 1:yrise = 1
- xrise = ABS(rise1*yrun2 - rise2*yrun1)
- xrun = ABS(xrun1*yrun2 - yrun1*xrun2)
- IF xrun = xrise THEN xrun = 1:xrise = 1
- xrise = xrise / 2
- yrise = yrise / 2
- xshade = 1-ABS(xrise / (xrun + xrise))
- yshade = 1-ABS(yrise / (yrun + yrise))
- shade = 14*xshade*yshade+1
- IF Lv > snowLine THEN shade = shade + 16
- IF Lv <= 0 THEN shade = 16
- RETURN
- savepic:
- rastport& = WINDOW(8)
- bitmap& = PEEKL(rastport&+4)
- topLine = 60 - INT(maxLv)
- IF topLine < 0 THEN topLine = 0
- topadd = topLine * 40
- FOR a = 0 TO 4
- pLane&(a) = PEEKL(bitmap& + 8 + a*4)+topadd
- NEXT
- bottomLine = 144
- Lines = bottomLine - topLine
- OPEN fiL$ FOR OUTPUT AS 1
- a$ = MKL$(Lines * 40 * 5 + 144)
- PRINT#1,"FORM";a$;"ILBMBMHD";MKL$(20);
- PRINT#1,MKI$(320);MKI$(Lines);MKL$(0);
- PRINT#1,CHR$(5);MKI$(0);CHR$(0);
- PRINT#1,MKI$(0);CHR$(10);CHR$(11);
- PRINT#1,MKI$(320);MKI$(200);
- PRINT#1,"CMAP";MKL$(96);
- FOR a = 0 TO 31
- PRINT#1,cmap$(a);
- NEXT
- PRINT#1,"BODY";MKL$(Lines * 40 * 5);
- FOR a = 1 TO Lines
- FOR p = 0 TO 4
- FOR b = 0 TO 39 STEP 4
- PRINT#1,MKL$(PEEKL(pLane&(p) + b));
- NEXT b
- POKEL pLane&(p), -1
- pLane&(p) = pLane&(p) + 40
- NEXT p
- NEXT a
- CLOSE
- GOTO end2
-
-
-
-
-