mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-08-31 03:00:14 +00:00
3006 lines
57 KiB
QBasic
3006 lines
57 KiB
QBasic
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
|
|
|