mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-28 07:37:47 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
3006 lines
54 KiB
QBasic
3006 lines
54 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
|
|
|