Boards
Sir Rowley Regis Attract Sequence
- "ATTRACT SEQUENCE" -
CLEAR 32767
DEFSNG a - z
DIM Lv (64, 64)
DIM cmap$ (31)
PRINT "AIR-RAID SIREN! AIR-RAID SIREN!"
PRINT "Sir Rowley Regis proudly presents"
PRINT "A ROUGH ALBUMS WORTH OF RAW ECCENTRIC ELECTRO !"
PRINT
RANDOMIZE
PRINT " http://www.myspace.com/sirrowleyregis "
PRINT " Please click link to proceed "
INPUT " (What do YOU think?) " ; 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 4 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, .25, .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-.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 - .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 - .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 =
ym = 1
xshift = .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
rxl = xm * a + xshift * b
ryl = ym * b + yp -Lv(a, b)
GOSUB getshade :
shadel = 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 + .5 : b = y + .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 shadel
AREAFILL
AREA (rx, ry)
AREA (rx2, ry2)
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
end 2 :
WINDOW CLOSE 3
SCREEN CLOSE 2
WINDOW OUTPUT 1
END
getshade :
c = x + 1 - (b - y)
d = y + (a - x)
xc = x + .5
yc = y + .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(risel *xrun2 - rise2 *xrun1)
yrunl = ABS(yrunl * xrun2 - xrunl *yrun2)
IF yrun = yrise THEN yrun = l : yrise = l
xrise = ABS (risel * yrun2 - rise2 * yrunl)
xrun = ABS (xrunl * yrun2 - yrunl * xrun2)
IF xrun = xrise THEN xrun = l : xrise = l
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