QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-08 09:05:17 +00:00
Code Releases Wiki Activity
qb64/programs/samples/pete/optimus/deedsaks.bas

3007 lines
57 KiB
QBasic
Raw Blame History

DECLARE SUB copper ()
DECLARE SUB fadefromcolor (a%, c%, t%, r%, g%, B%)
DECLARE SUB fadetocolor (a%, c%, t%, r%, g%, B%)
DECLARE SUB getpal ()
DECLARE SUB setpal (c1%, c2%, r1%, g1%, b1%, r2%, g2%, b2%)
DECLARE SUB keyaction ()
DECLARE SUB crosfade (r1%(), r2%(), g1%(), g2%(), b1%(), b2%())
DECLARE SUB setcrosfadepal (r1%(), r2%(), g1%(), g2%(), b1%(), b2%())
DECLARE SUB initcrosfadepics (a%, B%)
DECLARE SUB clearscreen (c%)
DECLARE SUB spheremaplasma ()
DECLARE SUB zoomdistort ()
DECLARE SUB loadqbinside ()
DECLARE SUB rgblights ()
DECLARE SUB cycleblobs ()
DECLARE SUB plasmablobs ()
DECLARE SUB actions3d ()
DECLARE SUB loadobject (a$)
DECLARE SUB createobject (a%)
DECLARE SUB animatewavelet (k%)
DECLARE SUB mov3dpos (xp, yp, zp)
DECLARE SUB rotate3d (xr, yr, zr)
DECLARE SUB translate3d ()
DECLARE SUB output3d ()
DECLARE SUB load3drecord ()
DECLARE SUB loadrecord ()
DECLARE SUB precalculations ()
DECLARE SUB getmap (a$)
DECLARE SUB Intersections ()
DECLARE SUB Actions ()
DECLARE SUB saverecord ()
DECLARE SUB Output0 ()
DECLARE SUB deedlinesax (c%)
DECLARE SUB prehistoricode ()
DECLARE SUB sucking ()
DECLARE SUB delay (t%)
DECLARE SUB ffix
'ffix
RANDOMIZE TIMER
IF COMMAND$ = "-COPPER" THEN copper: END
SCREEN 13
deedlinesax 15
delay 140
deedlinesax 0
CLS
prehistoricode
sucking
delay 140
xit% = 0
'$DYNAMIC
DIM SHARED r%(0 TO 255), g%(0 TO 255), B%(0 TO 255)
DIM SHARED r1%(0 TO 255), g1%(0 TO 255), b1%(0 TO 255)
DIM SHARED fpos%(0 TO 255)
fp% = 256 * 86: DIM SHARED fonts%(0 TO fp%)
'$STATIC
'DIM SHARED fsin1%(-48 TO 826), fsin2%(-640 TO 602), fsin3%(-640 TO 715)
DIM SHARED fsin4%(-319 TO 602)
DIM SHARED fsin1%(-48 TO 1083)
DIM SHARED fsin2%(-640 TO 957)
DIM SHARED fsin3%(-640 TO 871)
DIM SHARED mod256128%(-168 TO 168)
DIM SHARED sp%(16384)
DIM SHARED dt%(-192 TO 180)
DIM SHARED dt100%(-180 TO 180)
DIM SHARED cd%(0 TO 1792)
DIM SHARED dsx%(10), dsy%(10), psx%(10), psy%(10), xp1%(10), yp1%(10), yy%(10)
DIM SHARED epi6%(0 TO 5), epi36%(0 TO 5)
DIM SHARED cy%(-100 TO 300)
DIM SHARED dis%(320), sla%(320), slb%(320), slc%(320), sc%(320)
DIM SHARED div2%(255), div4%(320), mul32%(32), mul128%(128)
DIM SHARED fs%(0 TO 199)
'DIM SHARED map%(1024)
DIM SHARED kon%(127)
DIM SHARED ka%(4)
setcrosfadepal r%(), r1%(), g%(), g1%(), B%(), b1%()
getpal
fadetocolor 0, 255, 1, 0, 0, 0
a$ = "fonts16.fnt"
c$ = " "
open ".\programs\samples\pete\optimus\"+a$ FOR BINARY AS #1
FOR i% = 0 TO 255
GET #1, , c$: fpos%(i%) = ASC(c$)
NEXT i%
FOR i% = 0 TO 85
FOR y% = 0 TO 15
FOR x% = 0 TO 15
GET #1, , c$
fonts%(i% * 256 + y% * 16 + x%) = ASC(c$)
NEXT x%
NEXT y%
NEXT i%
CLOSE #1
'$DYNAMIC
DIM SHARED text$(3, 11)
'$STATIC
text$(0, 0) = " Ok! Let's get "
text$(0, 1) = " serious now :) "
text$(0, 2) = " "
text$(0, 3) = " Hopefully you will "
text$(0, 4) = "see a nice demo from"
text$(0, 5) = "my side and not old "
text$(0, 6) = " prehistoric line "
text$(0, 7) = " drawing and lame "
text$(0, 8) = "oldstyle qbasic code"
text$(0, 9) = " "
text$(0, 10) = " But let's crosfade "
text$(0, 11) = " some more text now!"
text$(1, 0) = " Optimus presents "
text$(1, 1) = " a demo done in a "
text$(1, 2) = " hurry by connecting"
text$(1, 3) = " various older or "
text$(1, 4) = " newer sources into "
text$(1, 5) = " the main programm. "
text$(1, 6) = " "
text$(1, 7) = " All coded in pure "
text$(1, 8) = " Quickbasic 4.5 "
text$(1, 9) = " Use ffix.com for "
text$(1, 10) = " maximum pleasure "
text$(1, 11) = " "
text$(2, 0) = " Featuring effects "
text$(2, 1) = "like Sphere mapping "
text$(2, 2) = "circle blobs,rgb8bpp"
text$(2, 3) = "lights, zoom distort"
text$(2, 4) = "plasma inside blob, "
text$(2, 5) = "hardware raster fx "
text$(2, 6) = "3d dots and a simple"
text$(2, 7) = "raycaster engine. "
text$(2, 8) = " Some are not so "
text$(2, 9) = "optimized as I could"
text$(2, 10) = "and few have several"
text$(2, 11) = "bugs too.. "
text$(3, 0) = "They still run at "
text$(3, 1) = "full frame rate in "
text$(3, 2) = "my AMDK6-2/500Mhz, "
text$(3, 3) = "though I had thought"
text$(3, 4) = "ways to optimize "
text$(3, 5) = "them even more. "
text$(3, 6) = " Anyways.."
text$(3, 7) = "lean back and enjoy!"
text$(3, 8) = " "
text$(3, 9) = " Optimus/Dirty Minds"
text$(3, 10) = " Thessaloniki/Greece"
text$(3, 11) = " Saturday 25/05/2002"
CLS
dl% = 840
initcrosfadepics 0, 1
fadefromcolor 0, 255, 256, 0, 0, 0
delay dl%
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
crosfade r%(), r1%(), g%(), g1%(), B%(), b1%()
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
initcrosfadepics 1, 1
setcrosfadepal r%(), r1%(), g%(), g1%(), B%(), b1%()
initcrosfadepics 1, 2
delay dl%
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
crosfade r%(), r1%(), g%(), g1%(), B%(), b1%()
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
delay dl%
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
initcrosfadepics 2, 2
setcrosfadepal r%(), r1%(), g%(), g1%(), B%(), b1%()
initcrosfadepics 2, 3
crosfade r%(), r1%(), g%(), g1%(), B%(), b1%()
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
delay dl%
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
getpal
fadetocolor 0, 255, 256, 63, 63, 63
IF xit% = 1 THEN xit% = 2: getpal: fadetocolor 0, 255, 64, 0, 0, 0: GOTO endfadetext
endfadetext:
xit% = 0
LINE (0, 0)-(320, 200), 255, BF
spheremaplasma
xit% = 0
zoomdistort
xit% = 0
getpal
fadetocolor 0, 255, 31, 0, 0, 0
CLS
' ------------- RGB Lights ---------------
rgblights
xit% = 0
' ------------- 3D Dots ---------------
'$DYNAMIC
DIM SHARED x(4096), y(4096), z(4096)
DIM SHARED xo%(4096), yo%(4096), zo%(4096)
DIM SHARED xs%(4096, 1), ys%(4096, 1)
'DIM SHARED pl%(8192, 2), ln%(8192, 1)
DIM SHARED ypk&(-100 TO 99)
DIM SHARED zpo%(8)
'$STATIC
CLS
' ------ Precalculations for Wavelet -----
FOR i% = 0 TO 826
fsin1%(i%) = SIN(i% / 50) * 48
NEXT i%
' ------ Precalculations for Poke ------
FOR i& = -100 TO 99
ypk&(i&) = (i& + 100) * 320
NEXT i&
' ---------------------------------------
actions3d
xit% = 0
' -------- Cycleblobs ------------
ERASE fsin2%, fsin3%
cycleblobs
xit% = 0
CLS
plasmablobs
xit% = 0
LINE (0, 0)-(320, 200), 255, BF
'dm% = 16384
'DIM SHARED mapout%(dm%)
setpal 0, 255, 0, 0, 0, 63, 63, 63
getmap "wolfmap0.wad"
precalculations
k$ = " "
a$ = "3rdrec.rec"
gi$ = " ": gg$ = " "
g% = 0: gi% = 0
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #2
GET #2, , gi$: gi% = ASC(gi$): GET #2, , gg$: gg% = ASC(gg$)
WHILE INKEY$ <> "": WEND
' ----------------- Some important data -----------------
ph% = 32: px% = 64 + 32: py% = 64 + 32: pa% = 90: ps% = 3
fv% = 60: ra = fv% / 320: dpp% = 160 / TAN((fv% \ 2) / 57.3)
map% = 0
k% = 0
fps% = 0
filei% = 0
DO WHILE INKEY$ = ""
fps% = fps% + 1
IF fps% = 558 THEN map% = 1
IF fps% = 2148 THEN map% = 0
IF fps% = 3500 THEN map% = 1
IF fps% = 4760 THEN map% = 0
keyaction
loadrecord
Actions
sp%(mul128%(py% \ 16) + px% \ 16) = 64
Intersections
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
Output0
IF filei% = 194 THEN GOTO telos
LOOP
telos:
CLOSE #2
xit% = 0
getpal
fadetocolor 0, 255, 255, 0, 0, 0
SUB Actions
SHARED kb%, px%, py%, pa%, ps%, map%
WHILE kon%(75) = 1
pa% = pa% + 1
IF pa% > 360 THEN pa% = 0 + (pa% - 360)
GOTO 101
WEND
101
WHILE kon%(77) = 1
pa% = pa% - 1
IF pa% < 0 THEN pa% = 360 + pa%
GOTO 102
WEND
102
WHILE kon%(72) = 1
pxd% = COS(pa% / 57.3) * ps%
pyd% = SIN(pa% / 57.3) * ps%
px% = px% + pxd%
IF cd%(mul32%(py% \ 64) + px% \ 64) = 1 THEN px% = px% - pxd%
py% = py% - pyd%
IF cd%(mul32%(py% \ 64) + px% \ 64) = 1 THEN py% = py% + pyd%
GOTO 103
WEND
103
WHILE kon%(80) = 1
pxd% = COS(pa% / 57.3) * ps%
pyd% = SIN(pa% / 57.3) * ps%
px% = px% - pxd%
IF cd%(mul32%(py% \ 64) + px% \ 64) = 1 THEN px% = px% + pxd%
py% = py% + pyd%
IF cd%(mul32%(py% \ 64) + px% \ 64) = 1 THEN py% = py% - pyd%
GOTO 104
WEND
104
WHILE kon%(15) = 1
IF map% = 0 THEN map% = 1 ELSE map% = 0
GOTO 105
WEND
105
WHILE kon%(1) = 1
END
WEND
WHILE INKEY$ <> "": WEND
END SUB
SUB actions3d
SHARED xit%
SHARED ndts%, ndtso%
SHARED xc, yc, zc, rxc, ryc, rzc
SHARED xp, yp, zp
SHARED gi$, gg$
SHARED k%, obj%
SHARED ftype%, filei%
SHARED mtr
CONST pi = 3.1415926#
mtr = pi / 180
k% = 0
gi$ = " "
gg$ = " "
xp = 0: yp = 0: zp = 800
'kyvos 100
'sphere 200
'torus 600
'wavelet 800
'teapot,cow 300
zpo%(1) = 100
zpo%(2) = 200
zpo%(3) = 600
zpo%(4) = 800
zpo%(5) = 300
zpo%(6) = 300
SCREEN 13
COLOR 255
DEF SEG = &HA000
xc = 0: yc = 0: zc = 0
rxc = 0: ryc = 0: rzc = 0
f$ = "3drec.001"
OPEN ".\samples\pete\optimus\"+f$ FOR BINARY AS #2
k% = 0
DO
B$ = INKEY$: IF B$ = "x" THEN END
load3drecord
IF ASC(gg$) = 0 THEN a$ = "" ELSE a$ = gg$
WHILE a$ = "s" OR a$ = "S"
setpal 0, 255, 0, 0, 0, 63, 63, 63
obj% = 1
'zp = zpo%(obj%)
createobject obj%
ndtso% = 64: ndts% = ndtso%
a$ = ""
WEND
WHILE a$ = "d" OR a$ = "D"
setpal 0, 255, 0, 0, 0, 63, 47, 15
obj% = 2
'zp = zpo%(obj%)
createobject obj%
ndtso% = 256: ndts% = ndtso%
a$ = ""
WEND
WHILE a$ = "f" OR a$ = "F"
setpal 0, 255, 0, 0, 0, 31, 63, 47
obj% = 3
'zp = zpo%(obj%)
createobject obj%
ndtso% = 512: ndts% = ndtso%
a$ = ""
WEND
WHILE a$ = "g" OR a$ = "G"
setpal 0, 255, 0, 0, 0, 15, 31, 63
obj% = 4
'zp = zpo%(obj%)
createobject obj%
ndtso% = 64: ndts% = 0
a$ = ""
WEND
WHILE a$ = "h" OR a$ = "H"
setpal 0, 255, 0, 0, 0, 0, 63, 63
obj% = 5
'zp = zpo%(obj%)
loadobject "hiteapot.3do"
ndtso% = 0
a$ = ""
WEND
WHILE a$ = "j" OR a$ = "J"
setpal 0, 255, 0, 0, 0, 63, 31, 47
obj% = 6
'zp = zpo%(obj%)
loadobject "cow.3do"
ndtso% = 0
a$ = ""
WEND
WHILE a$ = "," OR a$ = "<"
clearscreen 0
IF ndts% - ndtso% > 0 THEN ndts% = ndts% - ndtso%
a$ = ""
WEND
WHILE a$ = "." OR a$ = ">"
'clearscreen 0
IF ndts% + ndtso% < 4096 THEN ndts% = ndts% + ndtso%
a$ = ""
WEND
WHILE a$ = "k" OR a$ = "K"
'clearscreen 0
xp = -zpo%(obj%) * 1.5: yp = 0: zp = zpo%(obj%)
xc = 0: yc = 0: zc = 0
a$ = ""
WEND
WHILE a$ = "l" OR a$ = "L"
'clearscreen 0
xp = zpo%(obj%) * 1.5: yp = 0: zp = zpo%(obj%)
xc = 0: yc = 0: zc = 0
a$ = ""
WEND
WHILE a$ = "u" OR a$ = "U"
'clearscreen 0
xp = 0: yp = zpo%(obj%) * 1.5: zp = zpo%(obj%)
xc = 0: yc = 0: zc = 0
a$ = ""
WEND
WHILE a$ = "y" OR a$ = "Y"
'clearscreen 0
xp = 0: yp = -zpo%(obj%) * 1.5: zp = zpo%(obj%)
xc = 0: yc = 0: zc = 0
a$ = ""
WEND
WHILE a$ = "m" OR a$ = "M"
'clearscreen 0
xp = 0: yp = 0: zp = -zpo%(obj%) \ 2
xc = 0: yc = 0: zc = 0
a$ = ""
WEND
WHILE a$ = "a" OR a$ = "A"
yc = yc + .1
a$ = ""
WEND
WHILE a$ = "Q" OR a$ = "q"
yc = yc - .1
a$ = ""
WEND
WHILE a$ = "o" OR a$ = "O"
xc = xc - .1
a$ = ""
WEND
WHILE a$ = "p" OR a$ = "P"
xc = xc + .1
a$ = ""
WEND
WHILE a$ = "-"
zc = zc + .25
a$ = ""
WEND
WHILE a$ = "=" OR a$ = "+"
zc = zc - .25
a$ = ""
WEND
WHILE a$ = "z" OR a$ = "Z"
xr = 0: yr = 0: zr = 0
rxc = 0: ryc = 0: rzc = 0
a$ = ""
WEND
WHILE a$ = "x" OR a$ = "X"
END
WEND
WHILE a$ = "4"
ryc = ryc - .005
a$ = ""
WEND
WHILE a$ = "6"
ryc = ryc + .005
a$ = ""
WEND
WHILE a$ = "8"
rxc = rxc - .005
a$ = ""
WEND
WHILE a$ = "2"
rxc = rxc + .005
a$ = ""
WEND
WHILE a$ = "7"
rzc = rzc - .005
a$ = ""
WEND
WHILE a$ = "9"
rzc = rzc + .005
a$ = ""
WEND
WHILE a$ = "w" OR a$ = "W"
clearscreen 1
ftype% = 0
a$ = ""
WEND
WHILE a$ = "e" OR a$ = "E"
ftype% = 1
a$ = ""
WEND
WHILE a$ = "r" OR a$ = "R"
ftype% = 2
a$ = ""
WEND
xp = xp + xc: yp = yp + yc: zp = zp + zc
xr = xr + rxc: yr = yr + ryc: zr = zr + rzc
IF obj% = 4 THEN animatewavelet k%: k% = k% + 1: IF k% = 314 THEN k% = 0
rotate3d xr, yr, zr
mov3dpos xp, yp, zp
translate3d
output3d
IF filei% = 4446 THEN GOTO telos2
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO telos2
LOOP
telos2:
filei% = 0
CLOSE #2
END SUB
SUB animatewavelet (k%)
l% = 0
FOR z% = 0 TO 511 STEP 8
FOR x% = 0 TO 511 STEP 8
xo%(l%) = x% - 256: zo%(l%) = z% - 256
yo%(l%) = fsin1%(x% + k%) + fsin1%(z% + k%)
l% = l% + 1
NEXT x%
NEXT z%
END SUB
SUB clearscreen (c%)
FOR y% = 0 TO 199
DEF SEG = &HA000 + y% * 20
FOR x% = 0 TO 319
POKE x%, c%
NEXT x%
NEXT y%
DEF SEG = &HA000
END SUB
SUB copper
CLS
'WHILE INKEY$ <> "": WEND
'SCREEN 0
LOCATE 2, 32: PRINT "Congratulations!"
LOCATE 4, 2: PRINT "You have just found the secret part of the demo, even if I guess it was quite"
LOCATE 5, 2: PRINT "easy, since I use to give away the source of every quickbasic demo of mine ;)"
PRINT
PRINT " These are supposed to be hardware fx inspired by Amiga, C64, CPC or any other"
PRINT "raster display computer that happens to exist. Quite unstable if you are running"
PRINT "them under windows, so I suggest to boot up in pure DOS and retry there.."
PRINT
PRINT " What you are just watching are called raster or copper bars. Originally 1st"
PRINT "seen in Amiga demos, giving to the machine the opportunity to display more than"
PRINT "the theoritical maximum number of colors (This is text mode!) in the screen (But"
PRINT "mostly used as horizontal colorfull lines and not per pixel. Do you remember"
PRINT "Shadow of the Beast or Agony, which used to have extra colors upon a colorfull"
PRINT "sky in the background?)"
PRINT " They are so simple fx, just changing the RGB values of just one color several"
PRINT "times in a frame, synced with the raster beam of the CRT (You can use the &HDA "
PRINT "port address you know from Vsync to use for horizontal syncing too, by checking"
PRINT " the 1st bit, in the similar way you did that for the 4th bit for Vsync!)"
PRINT
PRINT "It seems that I have 2 go, unfortunatelly haven't explained you about the next"
PRINT "effects you are gonna see if you press any key.."
PRINT " Optimus"
DIM c%(1 TO 32)
DIM xb%(0 TO 319)
DIM ds%(1 TO 32), ps%(1 TO 32)
DIM xp%(32)
DIM rgb%(15, 15)
'DIM b01%(-1024 TO 1024)
'DIM b02%(-1024 TO 1024)
DIM b01%(-640 TO 640)
DIM b02%(-640 TO 640)
DIM y2%(0 TO 399)
DIM lc%(0 TO 399)
DIM l%(3)
DIM br%(-200 TO 500)
k% = 0
FOR i% = 168 TO 200
IF k% > 63 THEN k% = 63
br%(i%) = k%
k% = k% + 2
NEXT i%
FOR i% = 201 TO 232
k% = k% - 2
IF k% < 0 THEN k% = 0
br%(i%) = k%
NEXT i%
k% = 0
DO WHILE INKEY$ = ""
k% = k% + 1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
l%(1) = SIN(k% / 25) * 120
l%(2) = SIN(k% / 45) * 110
l%(3) = SIN(k% / 35) * 100
FOR i% = 0 TO 380
WAIT &H3DA, 1, 1: WAIT &H3DA, 1
OUT &H3C8, 0
OUT &H3C9, br%(i% + l%(1))
OUT &H3C9, br%(i% + l%(2))
OUT &H3C9, br%(i% + l%(3))
NEXT i%
LOOP
SCREEN 13
OUT &H3D4, &H13
OUT &H3D5, 0
FOR i% = 1 TO 16
OUT &H3C8, i%
OUT &H3C9, (i% - 1) * 4
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
FOR i% = 17 TO 32
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, (i% - 17) * 4
OUT &H3C9, 0
NEXT i%
FOR i% = 33 TO 48
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, (i% - 33) * 4
NEXT i%
FOR i% = 49 TO 64
OUT &H3C8, i%
OUT &H3C9, (i% - 49) * 4
OUT &H3C9, (i% - 49) * 4
OUT &H3C9, 0
NEXT i%
FOR i% = 65 TO 80
OUT &H3C8, i%
OUT &H3C9, (i% - 65) * 4
OUT &H3C9, 0
OUT &H3C9, (i% - 65) * 4
NEXT i%
FOR i% = 81 TO 96
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, (i% - 81) * 4
OUT &H3C9, (i% - 81) * 4
NEXT i%
FOR i% = 97 TO 112
OUT &H3C8, i%
OUT &H3C9, (i% - 97) * 4
OUT &H3C9, (i% - 97) * 2
OUT &H3C9, 0
NEXT i%
FOR i% = 113 TO 128
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, (i% - 113) * 2
OUT &H3C9, (i% - 113) * 4
NEXT i%
FOR i% = 1 TO 16: c%(i%) = i%: NEXT i%
FOR i% = 17 TO 32: c%(i%) = 33 - i%: NEXT i%
FOR i% = 1 TO 32
ds%(i%) = INT(RND * 63 + 32)
ps%(i%) = INT(RND * 127)
NEXT i%
DEF SEG = &HA000
k% = 0
DO WHILE INKEY$ = ""
k% = k% + 1
FOR i% = 1 TO 8
xp%(i%) = SIN(k% / ds%(i%)) * ps%(i%) + ps%(i%) + (280 - 2 * ps%(i%)) \ 2
NEXT i%
FOR ii% = 1 TO 8
FOR i% = 1 TO 32
xb%(i% + xp%(ii%)) = c%(i%) + 16 * (ii% - 1)
NEXT i%
NEXT ii%
WAIT &H3DA, 8
FOR i% = 0 TO 319
POKE i%, xb%(i%)
POKE i% + 80, xb%(i%)
NEXT i%
WAIT &H3DA, 8, 8
l%(1) = SIN(k% / 25) * 120
l%(2) = SIN(k% / 45) * 110
l%(3) = SIN(k% / 35) * 100
FOR i% = 0 TO 380
WAIT &H3DA, 1, 1: WAIT &H3DA, 1
OUT &H3C8, 0
OUT &H3C9, br%(i% + l%(1))
OUT &H3C9, br%(i% + l%(2))
OUT &H3C9, br%(i% + l%(3))
NEXT i%
FOR i% = 0 TO 319: xb%(i%) = 0: NEXT i%
LOOP
' --------- Translucent copper bars -----------
c% = 0
OUT &H3C8, 0
FOR a% = 0 TO 15
FOR B% = 0 TO 15
OUT &H3C9, a% * 2 + 33
OUT &H3C9, 0
OUT &H3C9, B% * 2 + 33
rgb%(a%, B%) = c%
c% = c% + 1
NEXT B%
NEXT a%
OUT &H3D4, &H13
OUT &H3D5, 0
'DIM fsin1%(0 TO 1083)
'DIM fsin2%(0 TO 957)
'DIM fsin3%(-471 TO 871)
FOR i% = 0 TO 1083: fsin1%(i%) = SIN(i% / 45) * 63 + 92: NEXT i%
FOR i% = 0 TO 957: fsin2%(i%) = SIN(i% / 25) * 31 + 31: NEXT i%
FOR i% = -471 TO 871: fsin3%(i%) = SIN(i% / 75) * 91 + 127: NEXT i%
DIM p16%(0 TO 15)
FOR i% = 0 TO 15
p16%(i%) = i% * 16
NEXT i%
DIM c1%(0 TO 7), c2%(0 TO 7), c3%(0 TO 7)
FOR i% = 0 TO 5: c1%(i%) = i% + 1: c2%(i%) = i% + 7: c3%(i%) = i% + 13: NEXT i%
FOR i% = 0 TO 399: y2%(i%) = i% * 2: NEXT i%
FOR i% = 0 TO 399: lc%(i%) = i% / 6.4: NEXT i%
y1% = 0
fps% = 0
DO WHILE INKEY$ = ""
k% = k% + 3: IF k% >= 283 THEN k% = 0
l% = l% + 2: IF l% >= 157 THEN l% = 0
m% = m% + 1: IF m% >= 471 THEN m% = 0
fps% = fps% + 1
IF fps% < 400 AND y1% < 395 THEN y1% = y1% + 1
IF fps% > 1200 AND y1% <> 0 THEN y1% = y1% - 1
IF y1% = 0 THEN GOTO out1
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
'GOTO 17
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
17
DEF SEG = &HA000
FOR y% = 0 TO y1%
WAIT &H3DA, 1, 1: WAIT &H3DA, 1
f1% = fsin2%(y2%(y%) + l%) + fsin3%(y% - m%)
f2% = fsin2%(y% + l%) + fsin1%(y2%(y%) + k%)
FOR i% = 1 TO 15
b01%(f1% + i%) = i%
b02%(f2% + i%) = p16%(i%)
POKE f1% + i%, i% OR b02%(f1% + i%)
POKE f2% + i%, p16%(i%) OR b01%(f2% + i%)
NEXT i%
OUT &H3C8, 0
OUT &H3C9, (63 - lc%(y%))
OUT &H3C9, (63 - lc%(y%)) / 2
OUT &H3C9, lc%(y%)
NEXT y%
FOR i% = 0 TO 319: POKE i%, 0: NEXT i%
FOR i% = 0 TO 319: b01%(i%) = 0: b02%(i%) = 0: NEXT i%
LOOP
out1:
' --------- RGB copper bars -----------
CLS
FOR i% = 0 TO 7
OUT &H3C8, i%
OUT &H3C9, i% * 5 + 28
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
FOR i% = 8 TO 15
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, (i% - 8) * 5 + 28
OUT &H3C9, 0
NEXT i%
FOR i% = 16 TO 23
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, (i% - 16) * 5 + 28
NEXT i%
OUT &H3D4, &H13
OUT &H3D5, 0
FOR i% = 0 TO 7: c1%(i%) = i%: c2%(i%) = i% + 8: c3%(i%) = i% + 16: NEXT i%: c1%(0) = 1
k% = 0
l% = 0
m% = 0
fps% = 0
y1% = 0
DO WHILE INKEY$ = ""
k% = k% + 3: IF k% >= 283 THEN k% = 0
l% = l% + 2: IF l% >= 157 THEN l% = 0
m% = m% + 1: IF m% >= 471 THEN m% = 0
fps% = fps% + 1
IF fps% < 400 AND y1% < 395 THEN y1% = y1% + 1
IF fps% > 1200 AND y1% <> 0 THEN y1% = y1% - 1
IF y1% = 0 THEN GOTO out2
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
DEF SEG = &HA000
FOR y% = 0 TO y1%
WAIT &H3DA, 1
FOR i% = 0 TO 7
POKE fsin2%(y2%(y%) + l%) + fsin3%(y% - m%) + i%, c1%(i%)
POKE fsin2%(y% + l%) + fsin1%(y2%(y%) + k%) + i%, c2%(i%)
POKE fsin1%(y% + k%) + fsin2%(y% + l%) + fsin3%(y% + m%) + i% - 99, c3%(i%)
NEXT i%
OUT &H3C8, 0
OUT &H3C9, lc%(y%)
OUT &H3C9, 63 - lc%(y%)
OUT &H3C9, 63 - lc%(y%)
WAIT &H3DA, 1, 1
NEXT y%
FOR i% = 0 TO 319: POKE i%, 0: NEXT i%
LOOP
out2:
OUT &H3D4, &H28
OUT &H3D5, &H13
SCREEN 13
SCREEN 1
OUT &H3D4, &H28
OUT &H3D5, &H13
END SUB
SUB createobject (a%)
CONST pi = 3.1415926#
rtm = 180 / pi
clearscreen 0
SELECT CASE a%
CASE 1
' ========== Creating object 1 - Cube ==========
FOR i% = 0 TO 4
xo%(i%) = 2 * i% - 5: yo%(i%) = 5: zo%(i%) = 5
xo%(i% + 5) = 2 * i% - 5: yo%(i% + 5) = 5: zo%(i% + 5) = -5
xo%(i% + 10) = 2 * i% - 5: yo%(i% + 10) = -5: zo%(i% + 10) = 5
xo%(i% + 15) = 2 * i% - 5: yo%(i% + 15) = -5: zo%(i% + 15) = -5
xo%(i% + 20) = -5: yo%(i% + 20) = 5: zo%(i% + 20) = 2 * i% - 5
xo%(i% + 25) = 5: yo%(i% + 25) = 5: zo%(i% + 25) = 2 * i% - 5
xo%(i% + 30) = -5: yo%(i% + 30) = -5: zo%(i% + 30) = 2 * i% - 5
xo%(i% + 35) = 5: yo%(i% + 35) = -5: zo%(i% + 35) = 2 * i% - 5
xo%(i% + 40) = 5: yo%(i% + 40) = 2 * i% - 5: zo%(i% + 40) = 5
xo%(i% + 45) = 5: yo%(i% + 45) = 2 * i% - 5: zo%(i% + 45) = -5
xo%(i% + 50) = -5: yo%(i% + 50) = 2 * i% - 5: zo%(i% + 50) = 5
xo%(i% + 55) = -5: yo%(i% + 55) = 2 * i% - 5: zo%(i% + 55) = -5
NEXT i%
xo%(60) = 5: yo%(60) = 5: zo%(60) = 5
xo%(61) = 5: yo%(61) = 5: zo%(61) = 5
xo%(62) = 5: yo%(62) = 5: zo%(62) = 5
xo%(63) = 5: yo%(63) = 5: zo%(63) = 5
' ========== Random copier for object 1 ==========
FOR j% = 1 TO 63
metx% = INT(RND * 64 - 32)
mety% = INT(RND * 64 - 32)
metz% = INT(RND * 64 - 32)
FOR i% = 0 TO 63
xo%(i% + j% * 64) = xo%(i%) + metx%
yo%(i% + j% * 64) = yo%(i%) + mety%
zo%(i% + j% * 64) = zo%(i%) + metz%
NEXT i%
NEXT j%
' =================================
CASE 2
' ========== Creating object 2 - Sphere ==========
j% = 0
FOR i% = 90 TO 270 STEP 11.25
c = i% / rtm
xo%(j%) = COS(c) * 63: yo%(j%) = SIN(c) * 63: zo%(j%) = 0
j% = j% + 1
NEXT i%
yr = 0
FOR i% = 1 TO 15
yr = yr + 22.5
c = yr / rtm
cosyr = COS(c)
sinyr = SIN(c)
FOR j% = 0 TO 15
xo%(j% + i% * 16) = cosyr * xo%(j%) - sinyr * zo%(j%)
zo%(j% + i% * 16) = sinyr * xo%(j%) + cosyr * zo%(j%)
yo%(j% + i% * 16) = yo%(j%)
NEXT j%
NEXT i%
' ========== Random copier for object 2 ==========
FOR j% = 1 TO 15
metx% = INT(RND * 512 - 256)
mety% = INT(RND * 512 - 256)
metz% = INT(RND * 512 - 256)
FOR i% = 0 TO 255
xo%(i% + j% * 256) = xo%(i%) + metx%
yo%(i% + j% * 256) = yo%(i%) + mety%
zo%(i% + j% * 256) = zo%(i%) + metz%
NEXT i%
NEXT j%
CASE 3
' ========== Creating object 3 - Torus ==========
j% = 0
FOR i% = 0 TO 359 STEP 22.5
c = i% / rtm
xo%(j%) = COS(c) * 64: yo%(j%) = SIN(c) * 64: zo%(j%) = 0
j% = j% + 1
NEXT i%
i% = 90
c = i% / rtm
cosyr = COS(c)
sinyr = SIN(c)
FOR i% = 0 TO 15
xp = xo%(i%)
xo%(i%) = cosyr * xp - sinyr * zo%(i%)
zo%(i%) = sinyr * xp + cosyr * zo%(i%)
yo%(i%) = yo%(i%) - 192
NEXT i%
zr = 0
FOR j% = 1 TO 31
zr = zr + 11.25
c = zr / rtm
coszr = COS(c)
sinzr = SIN(c)
FOR i% = 0 TO 15
xo%(i% + j% * 16) = coszr * xo%(i%) - sinzr * yo%(i%)
yo%(i% + j% * 16) = sinzr * xo%(i%) + coszr * yo%(i%)
zo%(i% + j% * 16) = zo%(i%)
NEXT i%
NEXT j%
' ========== Random copier for object 3 ==========
FOR j% = 1 TO 7
xr = (INT(RND * 180) - 90) / rtm
yr = (INT(RND * 180) - 90) / rtm
zr = (INT(RND * 180) - 90) / rtm
cosxr = COS(xr)
cosyr = COS(yr)
coszr = COS(zr)
sinxr = SIN(xr)
sinyr = SIN(yr)
sinzr = SIN(zr)
metx% = INT(RND * 1024 - 512)
mety% = INT(RND * 1024 - 512)
metz% = INT(RND * 1024 - 512)
FOR i% = 0 TO 511
x(i%) = cosyr * xo%(i%) - sinyr * zo%(i%)
z(i%) = sinyr * xo%(i%) + cosyr * zo%(i%)
y(i%) = cosxr * yo%(i%) - sinxr * z(i%)
z(i%) = sinxr * yo%(i%) + cosxr * z(i%)
nx = x(i%)
x(i%) = coszr * nx - sinzr * y(i%)
y(i%) = sinzr * nx + coszr * y(i%)
xo%(i% + j% * 512) = x(i%) + metx%
yo%(i% + j% * 512) = y(i%) + mety%
zo%(i% + j% * 512) = z(i%) + metz%
NEXT i%
NEXT j%
CASE ELSE
END SELECT
END SUB
SUB crosfade (r1%(), r2%(), g1%(), g2%(), b1%(), b2%())
SHARED xit%
FOR k% = 0 TO 63
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO endcrosfade
OUT &H3C8, 0
FOR c% = 0 TO 255
IF r1%(c%) < r2%(c%) THEN r1%(c%) = r1%(c%) + 1 ELSE IF r1%(c%) > r2%(c%) THEN r1%(c%) = r1%(c%) - 1
IF g1%(c%) < g2%(c%) THEN g1%(c%) = g1%(c%) + 1 ELSE IF g1%(c%) > g2%(c%) THEN g1%(c%) = g1%(c%) - 1
IF b1%(c%) < b2%(c%) THEN b1%(c%) = b1%(c%) + 1 ELSE IF b1%(c%) > b2%(c%) THEN b1%(c%) = b1%(c%) - 1
OUT &H3C9, r1%(c%)
OUT &H3C9, g1%(c%)
OUT &H3C9, b1%(c%)
NEXT c%
NEXT k%
endcrosfade:
END SUB
SUB cycleblobs
SHARED xit%
n% = 7
FOR i% = 0 TO 127
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
FOR y% = 0 TO 99
FOR x% = 0 TO 159
sp%(p%) = 16384 \ SQR((160 - x%) ^ 2 + (100 - y%) ^ 2) ^ 1.5
IF sp%(p%) > 255 THEN sp%(p%) = 255
p% = p% + 1
NEXT x%
NEXT y%
FOR i% = 0 TO 319
IF i% < 160 THEN fsin2%(i%) = i% ELSE fsin2%(i%) = 319 - i%
NEXT i%
FOR i% = 0 TO 199
IF i% > 99 THEN fsin3%(i%) = (199 - i%) * 160 ELSE fsin3%(i%) = i% * 160
NEXT i%
FOR i% = 0 TO 1792
IF i% > 255 THEN cd%(i%) = 255 ELSE cd%(i%) = i%
NEXT i%
FOR i% = 1 TO n%
dsx%(i%) = INT(RND * 35 + 25)
dsy%(i%) = INT(RND * 35 + 25)
psx%(i%) = INT(RND * 64 + 64)
psy%(i%) = INT(RND * 50 + 50)
NEXT i%
m% = 0: q% = 32: r%(1) = 1: g%(1) = 1: B%(1) = 1
fps% = 0
DO
fps% = fps% + 1
k% = k% + 1
m% = m% + 1
IF fps% < 1600 AND m% = q% THEN m% = 0: q% = INT(RND * 255 + 5): r%(1) = r%(2): g%(1) = g%(2): B%(1) = B%(2): r%(2) = INT(RND * 63) + 1: g%(2) = INT(RND * 63) + 1: B%(2) = INT(RND * 63) + 1
IF fps% > 1600 AND fps% < 1855 AND m% = q% THEN sq% = 1: m% = 0: q% = 255: r%(1) = r%(2): g%(1) = g%(2): B%(1) = B%(2): r%(2) = 0: g%(2) = 0: B%(2) = 0
IF fps% > 1856 AND sq% = 1 AND m% >= q% THEN GOTO gout4
IF fps% > 2100 THEN GOTO gout4
r% = r%(1) + (r%(2) - r%(1)) / q% * m%
g% = g%(1) + (g%(2) - g%(1)) / q% * m%
B% = B%(1) + (B%(2) - B%(1)) / q% * m%
IF r% = 0 THEN r% = 1
IF g% = 0 THEN g% = 1
IF B% = 0 THEN B% = 1
FOR c% = 128 TO 255
OUT &H3C8, c%
IF c% < 192 THEN OUT &H3C9, (c% - 128) / (63 / r%): OUT &H3C9, (c% - 128) / (63 / g%): OUT &H3C9, (c% - 128) / (63 / B%) ELSE OUT &H3C9, (255 - c%) / (63 / r%): OUT &H3C9, (255 - c%) / (63 / g%): OUT &H3C9, (255 - c%) / (63 / B%)
NEXT c%
FOR i% = 1 TO n%
xp1%(i%) = SIN(k% / dsx%(i%)) * psx%(i%)
yp1%(i%) = SIN(k% / dsy%(i%)) * psy%(i%)
NEXT i%
yp% = 0
FOR y% = 0 TO 199
DEF SEG = &HA000 + yp%
yp% = yp% + 20
yy%(1) = fsin3%(y% - yp1%(1))
yy%(2) = fsin3%(y% - yp1%(2))
yy%(3) = fsin3%(y% - yp1%(3))
yy%(4) = fsin3%(y% - yp1%(4))
yy%(5) = fsin3%(y% - yp1%(5))
yy%(6) = fsin3%(y% - yp1%(6))
yy%(7) = fsin3%(y% - yp1%(7))
FOR x% = 24 TO 295
dn% = sp%(yy%(1) + fsin2%(x% - xp1%(1))) + sp%(yy%(2) + fsin2%(x% - xp1%(2))) + sp%(yy%(3) + fsin2%(x% - xp1%(3))) + sp%(yy%(4) + fsin2%(x% - xp1%(4))) + sp%(yy%(5) + fsin2%(x% - xp1%(5))) + sp%(yy%(6) + fsin2%(x% - xp1%(6))) + sp%(yy%(7) + fsin2%( _
x% - xp1%(7)))
POKE x%, cd%(dn%)
NEXT x%
NEXT y%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout4
LOOP
gout4:
END SUB
SUB deedlinesax (c%)
SHARED xit%
LINE (20, 20)-(25, 80), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (25, 80)-(60, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (60, 70)-(55, 30), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (55, 30)-(20, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (25, 25)-(30, 60), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (30, 60)-(50, 65), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (50, 65)-(25, 25), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (23, 23), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (65, 20)-(100, 24), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (100, 24)-(70, 34), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (70, 34)-(85, 44), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (85, 44)-(75, 54), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (75, 54)-(75, 64), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (75, 64)-(85, 64), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (85, 64)-(70, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (70, 70)-(65, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (66, 21), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (110, 30)-(130, 30), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (130, 30)-(110, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (110, 40)-(110, 50), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (110, 50)-(125, 50), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (125, 50)-(125, 55), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (125, 55)-(110, 55), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (110, 55)-(110, 65), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (110, 65)-(120, 65), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (120, 65)-(120, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (120, 70)-(100, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (100, 70)-(110, 30), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (111, 31), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (150, 40)-(130, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (130, 20)-(140, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (140, 70)-(150, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (135, 30)-(140, 60), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (140, 60)-(145, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (145, 40)-(135, 30), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (133, 25), f%, c%: delay 10
LINE (160, 30)-(165, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (165, 70)-(190, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (190, 70)-(175, 65), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (175, 65)-(160, 30), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (164, 40), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (180, 20)-(190, 60), c%, BF: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (195, 20)-(195, 70), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (195, 70)-(200, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (200, 40)-(220, 65), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (220, 65)-(220, 35), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (220, 35)-(215, 55), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (215, 55)-(195, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (196, 30), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (245, 20)-(225, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (225, 20)-(225, 60), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (225, 60)-(250, 60), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (250, 60)-(250, 50), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (250, 50)-(230, 50), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (230, 50)-(230, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (230, 40)-(240, 40), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (240, 40)-(240, 35), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (240, 35)-(228, 35), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (228, 35)-(230, 25), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (230, 25)-(245, 20), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (227, 24), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (300, 5)-(260, 8), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (260, 8)-(290, 58), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (290, 58)-(250, 68), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (250, 68)-(305, 64), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (305, 64)-(270, 18), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
LINE (270, 18)-(300, 5), c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
IF c% = 15 THEN f% = INT(RND * 255) ELSE f% = 0
PAINT (265, 10), f%, c%: delay 10: IF xit% = 1 THEN GOTO enddeedlinesax
COLOR c% \ 15
LOCATE 1, 1: PRINT "SAX!"
delay 70: IF xit% = 1 THEN GOTO enddeedlinesax
FOR y% = 0 TO 63
FOR x% = 0 TO 255
a% = POINT(x% \ 8, y% \ 8) * (SIN(y% / 45) * c% + COS(x% / 45) * c% + 2 * c%)
PSET (x% + 40, y% + 100), a%
NEXT x%
NEXT y%
delay 140: IF xit% = 1 THEN GOTO enddeedlinesax
COLOR c%
LOCATE 22, 10: PRINT "Not so serious side :)": PRINT "Just for fun or boredom to draw anything"
enddeedlinesax:
END SUB
SUB delay (t%)
SHARED xit%
FOR i% = 1 TO t%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
keyaction
IF xit% = 1 THEN GOTO endelay
NEXT i%
endelay:
END SUB
SUB fadefromcolor (a%, c%, t%, r%, g%, B%)
SHARED xit%
FOR s% = 1 TO t%
OUT &H3C8, a%
FOR k% = a% TO c%
OUT &H3C9, r% + s% * ((r%(k%) - r%) / t%)
OUT &H3C9, g% + s% * ((g%(k%) - g%) / t%)
OUT &H3C9, B% + s% * ((B%(k%) - B%) / t%)
NEXT k%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO endfadefromcolor
NEXT s%
endfadefromcolor:
END SUB
SUB fadetocolor (a%, c%, t%, r%, g%, B%)
SHARED xit%
FOR s% = 1 TO t%
OUT &H3C8, a%
FOR k% = a% TO c%
OUT &H3C9, r%(k%) + s% * ((r% - r%(k%)) / t%)
OUT &H3C9, g%(k%) + s% * ((g% - g%(k%)) / t%)
OUT &H3C9, B%(k%) + s% * ((B% - B%(k%)) / t%)
NEXT k%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO endfadetocolor
NEXT s%
endfadetocolor:
END SUB
SUB getmap (a$)
' ------------------ Get Map --------------------
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #1
GET #1, 1, a$
xg% = ASC(a$)
GET #1, 2, a$
yg% = ASC(a$)
k% = 2
FOR y% = 0 TO yg% - 1
FOR x% = 0 TO xg% - 1
k% = k% + 1
GET #1, k%, a$
cd%(y% * 32 + x%) = ASC(a$)
NEXT x%
NEXT y%
CLOSE
END SUB
SUB getpal
OUT &H3C7, 0
FOR k% = 0 TO 255
r%(k%) = INP(&H3C9)
g%(k%) = INP(&H3C9)
B%(k%) = INP(&H3C9)
NEXT k%
END SUB
SUB initcrosfadepics (a%, B%)
FOR l% = 0 TO 11
FOR g% = 0 TO 19
c$ = MID$(text$(a%, l%), g% + 1, 1)
d$ = MID$(text$(B%, l%), g% + 1, 1)
yp% = 0
FOR y% = 0 TO 15
DEF SEG = &HA000 + yp% + l% * 320
yp% = yp% + 20
FOR x% = 0 TO 15
POKE x% + g% * 16, fonts%(fpos%(ASC(c$)) * 256 + y% * 16 + x%) OR (fonts%(fpos%(ASC(d$)) * 256 + y% * 16 + x%)) * 16
NEXT x%
NEXT y%
NEXT g%
NEXT l%
END SUB
SUB Intersections
SHARED px%, py%, pa%, ps%
SHARED va%, ra, dpp%
va = pa% + 32.2
IF va > 360 THEN va = 32.2 - (360 - pa%)
FOR sl% = 0 TO 319
va = va - ra
IF va < 0 THEN va = 358.8
va% = va
IF va% = 0 OR va% = 180 OR va% = 360 THEN GOTO 112
' ---------- Horizontal intersection ----------------
IF va% > 0 AND va% < 180 THEN ay% = (py% \ 64) * 64 - 1 ELSE IF va% > 180 AND va% < 360 THEN ay% = (py% \ 64) * 64 + 64
ax% = px% + (py% - ay%) / TAN(va / 57.3)
bx% = ax% \ 64
by% = ay% \ 64
IF bx% < 0 THEN bx% = 0
IF bx% > 31 THEN bx% = 31
IF by% < 0 THEN by% = 0
IF by% > 31 THEN by% = 31
IF cd%(mul32%(by%) + bx%) = 1 THEN cx% = ax%: cy% = ay%: GOTO 112
IF va% > 0 AND va% < 180 THEN yd% = -64 ELSE IF va% > 180 AND va% < 360 THEN yd% = 64
xd% = (-yd%) / TAN(va / 57.3)
IF xd% > 2048 THEN xd% = 2048
IF xd% < -2048 THEN xd% = -2048
cx% = ax%: cy% = ay%
DO
cx% = cx% + xd%: IF cx% > 2048 OR cx% < -2048 THEN GOTO 112
cy% = cy% + yd%: IF cy% > 2048 OR cy% < -2048 THEN GOTO 112
bx% = cx% \ 64: by% = cy% \ 64
IF bx% < 0 THEN bx% = 0
IF bx% > 31 THEN bx% = 31
IF by% < 0 THEN by% = 0
IF by% > 31 THEN by% = 31
LOOP UNTIL cd%(mul32%(by%) + bx%) = 1 OR bx% = 31 OR by% = 31
112
cxa% = cx%: cya% = cy%
IF va% = 90 OR va% = 270 THEN GOTO 113
' ---------- Vertical intersection ----------------
IF va% > 270 OR va% < 90 THEN ax% = (px% \ 64) * 64 + 64 ELSE IF va% > 90 OR va% < 270 THEN ax% = (px% \ 64) * 64 - 1
ay% = py% - (ax% - px%) * TAN(va / 57.3)
bx% = ax% \ 64
by% = ay% \ 64
IF bx% < 0 THEN bx% = 0
IF bx% > 31 THEN bx% = 31
IF by% < 0 THEN by% = 0
IF by% > 31 THEN by% = 31
IF cd%(mul32%(by%) + bx%) = 1 THEN cx% = ax%: cy% = ay%: GOTO 113
IF va% > 270 OR va% < 90 THEN xd% = 64 ELSE IF va% > 90 OR va% < 270 THEN xd% = -64
yd% = (-xd%) * TAN(va / 57.3)
cx% = ax%: cy% = ay%
DO
cx% = cx% + xd%: cy% = cy% + yd%
bx% = cx% \ 64: by% = cy% \ 64
IF bx% < 0 OR bx% > 31 THEN bx% = 31
IF by% < 0 OR by% > 31 THEN by% = 31
LOOP UNTIL cd%(mul32%(by%) + bx%) = 1 OR bx% = 31 OR by% = 31
113
cxb% = cx%: cyb% = cy%
wdisa% = SQR((px% - cxa%) ^ 2 + (py% - cya%) ^ 2)
wdisb% = SQR((px% - cxb%) ^ 2 + (py% - cyb%) ^ 2)
IF wdisa% < wdisb% THEN wdis% = wdisa% ELSE wdis% = wdisb%
dis%(sl%) = wdis% * COS((pa% - va) / 57.3)
slc%(sl%) = 64 * (dpp% / dis%(sl%))
IF slc%(sl%) > 200 THEN slc%(sl%) = 200
sc%(sl%) = 254 - dis%(sl%) \ 2: IF sc%(sl%) < 0 THEN sc%(sl%) = 0
sla%(sl%) = (200 - slc%(sl%)) \ 2: slb%(sl%) = sla%(sl%) + slc%(sl%)
NEXT sl%
117
END SUB
SUB keyaction
SHARED xit%
kb% = INP(&H60)
IF kb% = 1 THEN xit% = 1
END SUB
SUB load3drecord
SHARED gi$, gg$, ggi%, gi%, filei%, gg%
IF ggi% < gi% THEN ggi% = ggi% + 1 ELSE GET #2, , gi$: gi% = ASC(gi$): GET #2, , gg$: gg% = ASC(gg$): ggi% = 1: filei% = filei% + 2
END SUB
SUB loadobject (a$)
SHARED ndts%, nlns%, npls%
clearscreen 0
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #1
GET #1, , ndts%
GET #1, , nlns%
GET #1, , npls%
a$ = " "
FOR i% = 0 TO ndts% - 1
GET #1, , a$: xo%(i%) = ASC(a$) - 128
GET #1, , a$: yo%(i%) = ASC(a$) - 128
GET #1, , a$: zo%(i%) = ASC(a$) - 128
NEXT i%
FOR i% = 0 TO nlns% - 1
'GET #1, , ln%(i%, 0)
'GET #1, , ln%(i%, 1)
NEXT i%
FOR i% = 0 TO npls% - 1
'GET #1, , pl%(i%, 0)
'GET #1, , pl%(i%, 1)
'GET #1, , pl%(i%, 2)
NEXT i%
CLOSE #1
END SUB
SUB loadqbinside
' ------------ Load Quickbasic inside Big --------------
a$ = "qbrules.spr"
c$ = " "
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #1
OUT &H3C8, 128
FOR i% = 0 TO 383
GET #1, , c$: OUT &H3C9, ASC(c$)
NEXT i%
xg% = 100
yg% = 100
i% = 0
FOR y% = 1 TO yg%
FOR x% = 1 TO xg%
GET #1, , c$: sp%(i%) = ASC(c$)
i% = i% + 1
NEXT x%
NEXT y%
CLOSE #1
END SUB
SUB loadrecord
SHARED k$, gi$, gg$, ggi%, gi%, filei%, gg%
IF ggi% < gi% THEN ggi% = ggi% + 1 ELSE GET #2, , gi$: gi% = ASC(gi$): GET #2, , gg$: gg% = ASC(gg$): ggi% = 1: filei% = filei% + 2
pushgg% = gg%
FOR i% = 4 TO 1 STEP -1
IF gg% - 2 ^ (i% - 1) >= 0 THEN gg% = gg% - 2 ^ (i% - 1): ka%(i%) = 1 ELSE ka%(i%) = 0
NEXT i%
gg% = pushgg%
kon%(75) = ka%(1)
kon%(77) = ka%(2)
kon%(72) = ka%(3)
kon%(80) = ka%(4)
END SUB
SUB mov3dpos (xp, yp, zp)
SHARED ndts%
FOR i% = 0 TO ndts% - 1
x(i%) = x(i%) + xp
y(i%) = y(i%) + yp
z(i%) = z(i%) + zp
NEXT i%
END SUB
SUB Output0
SHARED map%, px%, py%
' -------------- Output ------------------
cx% = px% \ 64
cy% = py% \ 64
SELECT CASE map%
CASE 0
yp% = 0
FOR y% = 0 TO 199
DEF SEG = &HA000 + yp%
yp% = yp% + 20
FOR x% = 0 TO 319
IF y% > sla%(x%) AND y% < slb%(x%) THEN POKE x%, sc%(x%) ELSE POKE x%, fs%(y%)
NEXT x%
NEXT y%
sp%(mul128%(py% \ 16) + px% \ 16) = 24
CASE 1
yp% = 0
FOR y% = 0 TO 199
DEF SEG = &HA000 + yp%
yp% = yp% + 20
FOR x% = 0 TO 319
IF y% > sla%(x%) AND y% < slb%(x%) THEN c% = sc%(x%) ELSE c% = fs%(y%)
IF x% > 127 OR y% > 127 THEN POKE x%, c% ELSE POKE x%, div2%(c%) + sp%(mul128%(y%) + x%)
NEXT x%
NEXT y%
sp%(mul128%(py% \ 16) + px% \ 16) = 24
CASE ELSE
END SELECT
END SUB
SUB output3d
SHARED ftype%, ndts%, nlns%, obj%
SHARED filei%
zp% = zpo%(obj%)
SELECT CASE ftype%
CASE IS = 0
FOR i% = 0 TO ndts% - 1
xak% = xs%(i%, 1) + 160
IF xak% > -1 AND xak% < 320 AND ys%(i%, 1) > -101 AND ys%(i%, 1) < 100 THEN POKE ypk&(ys%(i%, 1)) + xak%, 0
xsk% = xs%(i%, 0) + 160
c% = 256 - z(i%) * (80 / zp%): IF c% < 80 THEN c% = 80
IF xsk% > -1 AND xsk% < 320 AND ys%(i%, 0) > -101 AND ys%(i%, 0) < 100 THEN POKE ypk&(ys%(i%, 0)) + xsk%, c%
NEXT i%
SELECT CASE filei%
CASE 0 TO 10, 780 TO 936, 1320 TO 1440, 2162 TO 2400, 3520 TO 3640, 4180 TO 4230
CASE ELSE
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
END SELECT
CASE ELSE
'FOR i% = 0 TO nlns% - 1
'LINE (xs%(ln%(i%, 0), 1) + 160, ys%(ln%(i%, 0), 1) + 100)-(xs%(ln%(i%, 1), 1) + 160, ys%(ln%(i%, 1), 1) + 100), 1
'NEXT i%
clearscreen 1
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
OUT &H3C8, 0
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
FOR i% = 0 TO nlns% - 1
'LINE (xs%(ln%(i%, 0), 0) + 160, ys%(ln%(i%, 0), 0) + 100)-(xs%(ln%(i%, 1), 0) + 160, ys%(ln%(i%, 1), 0) + 100), 15
NEXT i%
END SELECT
END SUB
SUB plasmablobs
SHARED xit%
meg = 1.3
n% = 3
OUT &H3C8, 0
FOR i% = 0 TO 127
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
FOR i% = 128 TO 159
OUT &H3C9, 0
OUT &H3C9, (i% - 128) * 2
OUT &H3C9, 0
NEXT i%
FOR i% = 160 TO 191
OUT &H3C9, 0
OUT &H3C9, (191 - i%) * 2
OUT &H3C9, 0
NEXT i%
FOR i% = 192 TO 255
OUT &H3C9, i% - 192
OUT &H3C9, i% - 192
OUT &H3C9, i% - 192
NEXT i%
getpal
OUT &H3C8, 0
FOR i% = 0 TO 255
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
FOR i% = -157 TO 518
IF i% > -1 AND i% < 519 THEN fsin1%(i%) = SIN(i% / 45) * 63: fsin2%(i%) = SIN(i% / 35) * 127
IF i% > -158 AND i% < 476 THEN fsin3%(i%) = SIN(i% / 25) * 31
NEXT i%
rc% = -1
FOR i% = -1 TO -156 STEP -1
dt100%(i%) = 63 - (i% - ((i% - 63) \ 64) * 64)
IF rc% = 1 THEN dt100%(i%) = 63 - dt100%(i%)
IF dt100%(i%) = 0 AND rc% = 1 THEN rc% = -1
IF dt100%(i%) = 63 AND rc% = -1 THEN rc% = 1
NEXT i%
rc% = 1
FOR i% = 0 TO 156
dt100%(i%) = i% - ((i%) \ 64) * 64
IF rc% = -1 THEN dt100%(i%) = 63 - dt100%(i%)
IF dt100%(i%) = 63 AND rc% = 1 THEN rc% = -1
IF dt100%(i%) = 0 AND rc% = -1 THEN rc% = 1
NEXT i%
DIM cf%(0 TO 4095)
l% = 0
FOR i% = 0 TO 63
FOR k% = 0 TO 63
cf%(l%) = i% * (k% / 63)
l% = l% + 1
NEXT k%
NEXT i%
i% = 0
FOR y% = 0 TO 99
FOR x% = 0 TO 159
IF x% = 159 AND y% = 99 THEN sp%(i%) = 255 ELSE sp%(i%) = 16384 \ SQR((159 - x%) ^ 2 + (99 - y%) ^ 2) ^ meg
IF sp%(i%) > 255 THEN sp%(i%) = 255
i% = i% + 1
NEXT x%
NEXT y%
FOR i% = -160 TO 479
IF i% < 0 OR i% > 319 THEN fsin4%(i%) = 0 ELSE IF i% < 160 THEN fsin4%(i%) = i% ELSE fsin4%(i%) = 319 - i%
NEXT i%
FOR i% = -100 TO 300
IF i% < 0 OR i% > 199 THEN cy%(i%) = 0 ELSE IF i% > 99 THEN cy%(i%) = 199 - i% ELSE cy%(i%) = i%
cy%(i%) = cy%(i%) * 160
NEXT i%
FOR i% = 0 TO 767
IF i% > 255 THEN cd%(i%) = 255 ELSE cd%(i%) = i%
NEXT i%
FOR i% = -192 TO 63
dt%(i%) = i% * 64
NEXT i%
FOR i% = 1 TO n%
dsx%(i%) = INT(RND * 45 + 45)
dsy%(i%) = INT(RND * 30 + 30)
psx%(i%) = INT(RND * 80 + 80)
psy%(i%) = INT(RND * 50 + 50)
NEXT i%
k% = 0
l% = 0
ax = TIMER
s% = 0: t% = 256
s1% = 0: t1% = 256
k0% = 128: k1% = 191
l0% = 128: l1% = 191
r1% = 0: g1% = 0: b1% = 0
fps% = 0
DO
fps% = fps% + 1
k% = k% + 2
IF k% > 156 THEN k% = 0
l% = l% + 1
FOR i% = 1 TO n%
xp1%(i%) = SIN(l% / dsx%(i%)) * psx%(i%)
yp1%(i%) = SIN(l% / dsy%(i%)) * psy%(i%)
NEXT i%
IF fps% = 512 THEN k0% = 192: k1% = 255: s% = 0
IF fps% = 1512 THEN fadeout% = 1
IF fps% = 2500 THEN getpal: s1% = 0: l0% = 0: l1% = 255: r1% = 63: g1% = 63: b1% = 63
IF fps% = 2800 THEN GOTO gout7
IF s% < t% THEN s% = s% + 1 ELSE GOTO endfadepal1
FOR kk% = k0% TO k1%
OUT &H3C8, kk%
OUT &H3C9, 0 + s% * ((r%(kk%) - 0) / t%)
OUT &H3C9, 0 + s% * ((g%(kk%) - 0) / t%)
OUT &H3C9, 0 + s% * ((B%(kk%) - 0) / t%)
NEXT kk%
endfadepal1:
IF fadeout% = 0 THEN GOTO nofadeout1
IF s1% < t1% THEN s1% = s1% + 1
FOR kk% = l0% TO l1%
OUT &H3C8, kk%
OUT &H3C9, r%(kk%) + s1% * ((r1% - r%(kk%)) / t1%)
OUT &H3C9, g%(kk%) + s1% * ((g1% - g%(kk%)) / t1%)
OUT &H3C9, B%(kk%) + s1% * ((b1% - B%(kk%)) / t1%)
NEXT kk%
nofadeout1:
yp% = 0
FOR y% = 0 TO 199
DEF SEG = &HA000 + yp%
yp% = yp% + 20
yy%(1) = cy%(y% - yp1%(1))
yy%(2) = cy%(y% - yp1%(2))
yy%(3) = cy%(y% - yp1%(3))
FOR x% = 0 TO 319
dyn% = cd%(sp%(yy%(1) + fsin4%(x% - xp1%(1))) + sp%(yy%(2) + fsin4%(x% - xp1%(2))) + sp%(yy%(3) + fsin4%(x% - xp1%(3))))
IF dyn% < 192 THEN POKE x%, dyn% ELSE pls% = dt100%(fsin3%(x% + k%) + fsin3%(y%) + fsin1%(x% + y%) + fsin3%(fsin3%(y% - k%) + fsin2%(x%) + k%)): POKE x%, cf%(dt%(dyn% - 192) + pls%) + 192
NEXT x%
NEXT y%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout7
LOOP
gout7:
END SUB
SUB precalculations
REM --------- Div2 -----------
FOR i% = 0 TO 255
div2%(i%) = i% \ 2
NEXT i%
REM --------- Div4 -----------
FOR i% = 0 TO 320
div4%(i%) = i% \ 4
NEXT i%
REM ----------- Mul32 -------------
FOR i% = 0 TO 32
mul32%(i%) = i% * 32
NEXT i%
REM ----------- Nul128 ------------
FOR i% = 0 TO 127
mul128%(i%) = i% * 128
NEXT i%
REM --------- Map Output buffer precalc ---------
i% = 0
FOR y% = 0 TO 127
FOR x% = 0 TO 127
sp%(i%) = cd%((y% \ 4) * 32 + x% \ 4) * 128
i% = i% + 1
NEXT x%
NEXT y%
REM ----------- Floor&Ceiling Shades -------------
ast = 32 / 100
ang = 0
FOR i% = 0 TO 99
IF ang = 0 THEN ang = .01
dist = 24 / SIN(ang / 57.3)
fs = (255 - dist)
IF fs < 0 THEN fs%(99 - i%) = 0 ELSE fs%(99 - i%) = fs
fs%(i% + 100) = fs%(99 - i%)
ang = ang + ast
NEXT i%
END SUB
SUB prehistoricode
SHARED xit%
l% = 15
SCREEN 12
1
keyaction
IF xit% = 1 THEN GOTO prehistoricodend
COLOR 15: LOCATE 15, 18: PRINT "Press the" + CHR$(34) + "any key" + CHR$(34) + " button to continue.. ;-)"
c% = INT(RND * 63 + 1)
FOR i% = 1 TO 640 STEP 15
LINE (i%, 480)-(640, 480 - i%), i% / c%
NEXT i%
cc% = cc% + 1
CIRCLE (cx%, cy%), cc%, l%
IF cc% = 30 THEN cc% = 0: l% = 0: k% = 1: GOTO 1
IF k% = 1 AND cc% = 29 THEN cc% = 0: l% = 15: cx% = INT(RND * 640): cy% = INT(RND * 480): k% = 0
a$ = INKEY$
WHILE a$ = ""
GOTO 1
a$ = "z"
WEND
FOR z% = 1 TO 480
keyaction
IF xit% = 1 THEN GOTO prehistoricodend
t% = 31 - z% / 16
CIRCLE (320, 240), z%, t%
FOR i& = 0 TO 16383: NEXT i&
NEXT z%
FOR z% = 1 TO 640
keyaction
IF xit% = 1 THEN GOTO prehistoricodend
CIRCLE (320, 240), z%, 0
FOR i& = 0 TO 16383: NEXT i&
NEXT z%
prehistoricodend:
END SUB
SUB rgblights
SHARED xit%
meg = 2.2
n% = 3
FOR i% = 0 TO 127
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
i% = 0
OUT &H3C8, 0
FOR a% = 0 TO 5
FOR B% = 0 TO 5
FOR c% = 0 TO 5
OUT &H3C9, a% * 12.6
OUT &H3C9, B% * 12.6
OUT &H3C9, c% * 12.6
r1%(i%) = i%
i% = i% + 1
NEXT c%
NEXT B%
NEXT a%
FOR i% = 0 TO 5
epi6%(i%) = i% * 6
epi36%(i%) = i% * 36
NEXT i%
i% = 0
FOR y% = 0 TO 99
FOR x% = 0 TO 159
IF x% = 159 AND y% = 99 THEN sp%(i%) = 255 ELSE sp%(i%) = 16384 \ SQR((159 - x%) ^ 2 + (99 - y%) ^ 2) ^ meg
IF sp%(i%) > 255 THEN sp%(i%) = 255
i% = i% + 1
NEXT x%
NEXT y%
FOR i% = -320 TO 639
IF i% < 0 OR i% > 319 THEN fsin3%(i%) = 0 ELSE IF i% < 160 THEN fsin3%(i%) = i% ELSE fsin3%(i%) = 319 - i%
NEXT i%
FOR i% = -300 TO 500
IF i% < 0 OR i% > 199 THEN fsin4%(i%) = 0 ELSE IF i% > 99 THEN fsin4%(i%) = 199 - i% ELSE fsin4%(i%) = i%
fsin4%(i%) = fsin4%(i%) * 160
NEXT i%
FOR i% = 0 TO 1792
IF i% > 5 THEN cd%(i%) = 5 ELSE cd%(i%) = i%
NEXT i%
FOR i% = 1 TO n%
dsx%(i%) = INT(RND * 35 + 15)
dsy%(i%) = INT(RND * 35 + 15)
psx%(i%) = INT(RND * 80 + 80)
psy%(i%) = INT(RND * 50 + 50)
NEXT i%
k% = 40
plx = 8: ply = 8
ax = TIMER
DO
k% = k% + 1
IF plx > 1 AND k% < 1024 THEN plx = plx - .025
IF ply > 1 AND k% < 1024 THEN ply = ply - .025
IF k% > 1024 THEN plx = plx + .01: ply = ply + .01
IF k% = 1220 THEN GOTO gout3
FOR i% = 1 TO n%
psx% = psx%(i%) * plx
psy% = psy%(i%) * ply
IF psx% > 320 THEN psx% = 320
IF psy% > 300 THEN psy% = 300
xp1%(i%) = SIN(k% / dsx%(i%)) * psx%
yp1%(i%) = SIN(k% / dsy%(i%)) * psy%
NEXT i%
yp% = 0
FOR y% = 0 TO 199
DEF SEG = &HA000 + yp%
yp% = yp% + 20
yy%(1) = fsin4%(y% - yp1%(1))
yy%(2) = fsin4%(y% - yp1%(2))
yy%(3) = fsin4%(y% - yp1%(3))
FOR x% = 0 TO 319
ca% = cd%(sp%(yy%(1) + fsin3%(x% - xp1%(1))))
cb% = cd%(sp%(yy%(2) + fsin3%(x% - xp1%(2))))
cc% = cd%(sp%(yy%(3) + fsin3%(x% - xp1%(3))))
POKE x%, r1%(ca% + epi6%(cb%) + epi36%(cc%))
NEXT x%
NEXT y%
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout3
LOOP
gout3:
END SUB
SUB rotate3d (xr, yr, zr)
SHARED ndts%
cosxr = COS(xr)
cosyr = COS(yr)
coszr = COS(zr)
sinxr = SIN(xr)
sinyr = SIN(yr)
sinzr = SIN(zr)
FOR i% = 0 TO ndts% - 1
x(i%) = cosyr * xo%(i%) - sinyr * zo%(i%)
z(i%) = sinyr * xo%(i%) + cosyr * zo%(i%)
y(i%) = cosxr * yo%(i%) - sinxr * z(i%)
z(i%) = sinxr * yo%(i%) + cosxr * z(i%)
nx = x(i%)
x(i%) = coszr * nx - sinzr * y(i%)
y(i%) = sinzr * nx + coszr * y(i%)
NEXT i%
END SUB
SUB saverecord
SHARED k$
k$ = CHR$(kon%(75)): PUT #2, , k$
k$ = CHR$(kon%(77)): PUT #2, , k$
k$ = CHR$(kon%(72)): PUT #2, , k$
k$ = CHR$(kon%(80)): PUT #2, , k$
END SUB
SUB setcrosfadepal (r1%(), r2%(), g1%(), g2%(), b1%(), b2%())
OUT &H3C8, 0
FOR j% = 0 TO 15
FOR i% = 0 TO 15
OUT &H3C9, i% * 4: r1%(j% * 16 + i%) = i% * 4
OUT &H3C9, i% * 4: g1%(j% * 16 + i%) = i% * 4
OUT &H3C9, i% * 4: b1%(j% * 16 + i%) = i% * 4
NEXT i%
NEXT j%
FOR i% = 0 TO 255
r2%(i%) = (i% \ 16) * 4
g2%(i%) = (i% \ 16) * 4
b2%(i%) = (i% \ 16) * 4
NEXT i%
END SUB
SUB setpal (c1%, c2%, r1%, g1%, b1%, r2%, g2%, b2%)
dc% = c2% - c1%
r = r1%: g = g1%: B = b1%
OUT &H3C8, c1%
FOR i% = c1% TO c2%
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, B
r = r + (r2% - r1%) / dc%
g = g + (g2% - g1%) / dc%
B = B + (b2% - b1%) / dc%
NEXT i%
END SUB
SUB spheremaplasma
SHARED xit%
' ------------- Sphere mapped plasma ------------
setpal 0, 31, 0, 0, 0, 63, 0, 0
setpal 32, 63, 63, 0, 0, 63, 0, 63
setpal 64, 95, 63, 0, 63, 0, 63, 63
setpal 96, 127, 0, 63, 63, 0, 0, 0
setpal 128, 159, 0, 0, 31, 31, 0, 31
setpal 160, 191, 31, 0, 31, 31, 0, 63
setpal 192, 223, 31, 0, 63, 0, 47, 63
setpal 224, 254, 0, 47, 63, 0, 0, 31
getpal
r%(255) = 0: g%(255) = 0: B%(255) = 31
setpal 0, 255, 63, 63, 63, 63, 63, 63
delay 210
a$ = "sphrprec.dat"
fp& = -1
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #1
FOR i% = 0 TO 16383
fp& = fp& + 2
GET #1, fp&, a$
xp% = ASC(a$)
GET #1, fp& + 1, a$
yp% = ASC(a$)
sp%(i%) = yp% * 128 + xp%
IF i% = 64 * 128 + 64 THEN sp%(i%) = sp%(i%) + 1
NEXT i%
CLOSE
dg% = 99
FOR i% = -180 TO -1
dt%(i%) = i% - ((i% - dg% + 1) \ dg%) * dg%
dt100%(i%) = (i% - ((i% - dg% + 1) \ dg%) * dg%) * 100
NEXT i%
FOR i% = 0 TO 180
dt%(i%) = i% - ((i% - 1) \ dg%) * dg%
dt100%(i%) = (i% - ((i% - 1) \ dg%) * dg%) * 100
NEXT i%
FOR i% = -640 TO 518
fsin2%(i%) = SIN(i% / 16) * 31
NEXT i%
FOR i% = -640 TO 715
fsin3%(i%) = SIN(i% / 63) * 75
NEXT i%
FOR i% = -168 TO 168
mod256128%(i%) = ((i% + 512) MOD 256) \ 2
NEXT i%
xs = 91: vxs = 1: ys = -96: vys = 0: fs = 0
yys% = 134
WHILE INKEY$ <> "": WEND
s% = 0: t% = 256
s1% = 0: t1% = 256
fps% = 0
k% = 0: l% = 0
DO
fps% = fps% + 1
k% = k% + 1: l% = l% + 1
IF k% = 101 THEN k% = 0
IF l% = 396 THEN l% = 0
m% = -1
IF fps% = 256 THEN fs = .02
IF fps% = 256 + 768 THEN yys% = 654
IF fps% = 256 + 1024 THEN fadeout% = 1
IF s% < t% THEN s% = s% + 1 ELSE GOTO endfadepal
OUT &H3C8, 0
FOR n% = 0 TO 255
OUT &H3C9, 63 + s% * ((r%(n%) - 63) / t%)
OUT &H3C9, 63 + s% * ((g%(n%) - 63) / t%)
OUT &H3C9, 63 + s% * ((B%(n%) - 63) / t%)
NEXT n%
endfadepal:
IF fadeout% = 0 THEN GOTO nofadeout
IF s1% < t1% THEN s1% = s1% + 1 ELSE GOTO gout
OUT &H3C8, 0
FOR n% = 0 TO 255
OUT &H3C9, r%(n%) + s1% * ((0 - r%(n%)) / t1%)
OUT &H3C9, g%(n%) + s1% * ((0 - g%(n%)) / t1%)
OUT &H3C9, B%(n%) + s1% * ((0 - B%(n%)) / t1%)
NEXT n%
nofadeout:
xs = xs + vxs: IF xs > 254 OR xs < 65 THEN vxs = -vxs
vys = vys + fs
ys = ys + vys
IF ys > yys% THEN ys = ys - vys: vys = -vys * .8
xs% = xs: ys% = ys
sy% = ys% - 63
sx% = xs% - 63
IF sy% < 0 AND sy% > -128 THEN m% = sy% * (-128) - 1
yw1% = -1 + sy%: yw2% = 128 + sy%
xw1% = -1 + sx%: xw2% = 128 + sx%
FOR y% = 0 TO 199
DEF SEG = &HA000 + y% * 20
IF y% > yw1% AND y% < yw2% THEN GOTO 111
FOR x% = 0 TO 319
c% = fsin2%(x%) + fsin3%(y% + l%) + fsin2%(x% + y%) + fsin2%(fsin3%(x% + l%) - fsin2%(x% - y% - k%))
POKE x%, mod256128%(c%)
NEXT x%
GOTO 1121
111
FOR x% = 0 TO 319
IF x% > xw1% AND x% < xw2% THEN m% = m% + 1: yn% = sp%(m%) \ 128: xn% = sp%(m%) - yn% * 128 + sx%: yn% = yn% + sy%: spp% = 128 ELSE xn% = x%: yn% = y%
IF xn% = x% AND yn% = y% THEN spp% = 0
c% = fsin2%(xn%) + fsin3%(yn% + l%) + fsin2%(xn% + yn%) + fsin2%(fsin3%(xn% + l%) - fsin2%(xn% - yn% - k%))
POKE x%, mod256128%(c%) + spp%
NEXT x%
1121
NEXT y%
'OUT &H3C8, 0
'OUT &H3C9, 0
'OUT &H3C9, 0
'OUT &H3C9, 0
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout
'OUT &H3C8, 0
'OUT &H3C9, 63
'OUT &H3C9, 0
'OUT &H3C9, 0
LOOP
gout:
END SUB
SUB sucking
SHARED xit%
SCREEN 13
COLOR 15
LOCATE 1, 1: PRINT "Still Sucking?"
FOR y% = 7 TO 0 STEP -1
FOR x% = 14 * 8 - 1 TO 0 STEP -1
c% = POINT(x%, y%) * (y% + 1) * SIN((x% + y%) / 45)
LINE (x% * 2.8, y% * 16 + 32)-((x% + 1) * 2.8, (y% + 1) * 16 + 32), c%, BF
NEXT x%
NEXT y%
END SUB
SUB translate3d
SHARED ndts%, obj%
IF obj% = 1 THEN zpr% = 1
IF obj% = 2 OR obj% = 3 THEN zpr% = 4
IF obj% = 4 THEN zpr% = 16
IF obj% > 4 THEN zpr% = 8
FOR i% = 0 TO ndts% - 1
xs%(i%, 1) = xs%(i%, 0)
ys%(i%, 1) = ys%(i%, 0)
IF z(i%) <= zpr% THEN GOTO 10
xs%(i%, 0) = (x(i%) * 256) / z(i%)
ys%(i%, 0) = (y(i%) * 256) / z(i%)
10
NEXT i%
END SUB
SUB zoomdistort
SHARED xit%
WHILE INKEY$ <> "": WEND
CLS
FOR i% = -640 TO 518
fsin2%(i%) = SIN(i% / 16) * 31
NEXT i%
FOR i% = -640 TO 715
fsin3%(i%) = SIN(i% / 63) * 75
NEXT i%
FOR i% = -48 TO 539
fsin1%(i%) = SIN(i% / 35) * 24
NEXT i%
FOR i% = -319 TO 602
fsin4%(i%) = SIN(i% / 45) * 24
NEXT i%
'$DYNAMIC
DIM dr%(-160 TO 160, -48 TO 48)
'$STATIC
FOR ii% = -48 TO 48
FOR i% = -160 TO 160
dva = ii% / 64 + 2
IF dva <> 0 THEN dr%(i%, ii%) = i% / dva ELSE dr%(i%, ii%) = i%
NEXT i%
NEXT ii%
' ------------ Load Quickbasic inside --------------
a$ = "qbinside.spr"
c$ = " "
open ".\samples\pete\optimus\"+a$ FOR BINARY AS #1
OUT &H3C8, 128
FOR i% = 0 TO 383
GET #1, , c$: OUT &H3C9, ASC(c$)
NEXT i%
xg% = 100
yg% = 100
i% = 0
FOR y% = 1 TO yg%
FOR x% = 1 TO xg%
GET #1, , c$: sp%(i%) = ASC(c$)
i% = i% + 1
NEXT x%
NEXT y%
CLOSE #1
setpal 0, 31, 0, 0, 0, 0, 31, 63
setpal 32, 63, 0, 31, 63, 31, 0, 63
setpal 64, 95, 31, 0, 63, 0, 63, 0
setpal 96, 127, 0, 63, 0, 0, 0, 0
FOR l% = 15 TO 305
LINE (14, 6)-(l%, 7), 27, B
LINE (13, 5)-(l% + 1, 8), 31, B
LINE (12, 4)-(l% + 2, 9), 27, B
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout2
NEXT l%
FOR n% = 7 TO 193
IF n% > 7 AND n% < 194 THEN LINE (15, n% - 1)-(304, n% - 1), 0, B
LINE (14, 6)-(305, n%), 27, B
LINE (13, 5)-(306, n% + 1), 31, B
LINE (12, 4)-(307, n% + 2), 27, B
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout2
NEXT n%
' ----------- Quickbasic Inside ------------
k0% = k%
l0% = l%
k% = 0
l% = 0
kxy0% = 0
fps% = 0
DO
fps% = fps% + 1
IF fps% > 1400 AND kxy0% > -100 THEN kxy0% = kxy0% - 100 ELSE IF fps% <= 1000 AND kxy0% < 10000 THEN kxy0% = kxy0% + 100
IF kxy0% = -100 THEN GOTO gout2
k% = k% + 1: IF k% = 220 THEN k% = 0
l% = l% + 1: IF l% = 283 THEN l% = 0
k0% = k0% + 1: IF k0% = 101 THEN k0% = 0
l0% = l0% + 1: IF l0% = 396 THEN l0% = 0
xp% = SIN(k% / 35) * 48
yp% = SIN(l% / 45) * 64
ypp% = 160
FOR y% = 8 TO 191
DEF SEG = &HA000 + ypp%
ypp% = ypp% + 20
sx% = fsin4%(y% + l%) + fsin1%(fsin1%(y%) + fsin4%(y% + l%))
FOR x% = 16 TO 303
sy% = fsin1%(x% + k%) + fsin4%(y% - x%)
kxy% = dt100%(dr%(y% - 100, sy%) + yp%) + dt%(dr%(x% - 160, sx%) + xp%)
IF kxy% > kxy0% THEN c% = 0 ELSE IF sp%(kxy%) = 129 THEN c% = mod256128%(fsin3%(x%) + fsin2%(x% + k0%) + fsin2%(y%)) ELSE c% = sp%(kxy%)
POKE x%, c%
NEXT x%
NEXT y%
'OUT &H3C8, 0
'OUT &H3C9, 0
'OUT &H3C9, 0
'OUT &H3C9, 0
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF xit% = 0 THEN keyaction
IF xit% = 1 THEN GOTO gout2
'OUT &H3C8, 0
'OUT &H3C9, 63
'OUT &H3C9, 0
'OUT &H3C9, 0
LOOP
gout2:
END SUB
View git blame Copy permalink