02-19-2004, 11:02 AM
Code:
'Run this....
'Relsoft 2004
'Thanks to:
'Plasma for LIST2OP. Love the util my friend!!!
'Gradius for Multikey
'I remember Nek having a challenge of this type. :*)
DECLARE SUB AF.Cls (DestSeg%, c%)
DECLARE SUB AF.Mode7 (Layer%, x1%, y1%, x2%, y2%, Angle%, Scalex%, Scaley%, Scalez%, Horz%, camx!, camy!, Texture%(), TextureOffset%)
DECLARE FUNCTION MULTIKEY% (T%)
DECLARE SUB AF.Pcopy (DestSeg%, SRCSEG%)
DEFINT A-Z
REM $DYNAMIC
DEFINT A-Z
RANDOMIZE TIMER
TYPE KartType 'our camera
x AS SINGLE
y AS SINGLE
dx AS SINGLE
dy AS SINGLE
Angle AS INTEGER
speed AS SINGLE
accel AS SINGLE
END TYPE
CONST FALSE = 0, TRUE = NOT FALSE
CONST VIDEO = &HA000
'KEY CONSTANTS
CONST KEYESC = 1, KEYENTER = 28, KEYSPACE = 57, KEYTAB = &HF
CONST KEYUP = 72, KEYDOWN = 80, KEYLEFT = 75, KEYRIGHT = 77
'not needed but used for easy reference
CONST PI = 3.141593
CONST FRICTION = .016 'for pseudo physics
CONST TSIZE = 32 'tilesize try to change this...
CONST TSIZESQUARED = TSIZE * TSIZE
CONST MAPTILEXMAX = 128
CONST MAPMAXPIXELX = MAPTILEXMAX * TSIZE
CONST MAPTILEYMAX = 64
CONST MAPMAXPIXELY = MAPTILEYMAX * TSIZE
'$DYNAMIC
DIM SHARED Vpage%(0 TO 31999) 'our buffer
DIM SHARED Layer%
'$STATIC
DIM SHARED Lcos!(359) 'fast Lookups
DIM SHARED Lsin!(359)
DIM SHARED Texture%((((TSIZESQUARED%) + 4) \ 2)) 'calc array size for
'GET array
Layer% = VARSEG(Vpage%(0)) 'set layer address
'for reference
DIM SHARED Mario AS KartType 'needs a better name
Mario.x = MAPMAXPIXELX \ 2 'center our camera
Mario.y = MAPMAXPIXELY \ 2
Mario.dx = 0
Mario.dy = 0
Mario.Angle = 0
Mario.accel = .1 'acceleration
Mario.speed = 0
'calc lookup tables
FOR i% = 0 TO 359
RA! = i% * (3.141593 / 180)
Lcos!(i%) = COS(RA!)
Lsin!(i%) = SIN(RA!)
NEXT i%
CLS
SCREEN 0
PRINT "Vsynch?"
PRINT "[Y]es/[N]o"; ""
k$ = INPUT$(1)
IF UCASE$(k$) = "Y" THEN
WAITON = TRUE
ELSE
WAITON = FALSE
END IF
CLS
SCREEN 13
j! = 255 / 360 * 3
k! = 255 / 360 * 2
l! = 255 / 360 * 4
FOR i% = 0 TO 255
OUT &H3C8, i%
m% = INT(a!)
n% = INT(b!)
o% = INT(c!)
r% = 63 * ABS(SIN(m% * PI / 180))
g% = 63 * ABS(SIN(n% * PI / 180))
IF i < 128 THEN g% = 0
a! = a! + j!
b! = b! + k!
c! = c! + l!
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
NEXT
'do some nice texture
'Generate texture
FOR y% = -TSIZE% \ 2 TO TSIZE% \ 2 - 1
yy% = ABS(y%)
FOR x% = -TSIZE% \ 2 TO TSIZE% \ 2 - 1
xx% = ABS(x%)
c% = SIN(xx% / 12) * 132 + SIN(yy% / 12) * 256 + SIN((yy% + xx%) / 8) * 64
PSET (x% + TSIZE% \ 2, y% + TSIZE% \ 2), c%
NEXT x%
NEXT y%
c$ = INPUT$(1)
'duh!
GET (0, 0)-STEP(TSIZE - 1, TSIZE - 1), Texture%(0)
x1 = 0 'window dimensions for Mode7
y1 = 60
x2 = 319
y2 = 199
'mode 7 parameters
Angle = 0 'Look forward
Scalex = 256 '200 looks good
Scaley = 256
Scalez = 15 'height
Horz = 10 'eyeview
camx! = 0
camy! = 0
Finished = FALSE
Dummy = MULTIKEY(-1) 'Install MULTIKEY Keyboard handler
T# = TIMER
DO
F& = (F& + 1) AND &H7FFFFFFF
IF MULTIKEY(KEYLEFT) THEN 'rotate angle
Mario.Angle = (Mario.Angle - 1)
IF Mario.Angle < 0 THEN Mario.Angle = 360 + Mario.Angle
KoopaFrame% = 2
END IF
IF MULTIKEY(KEYRIGHT) THEN 'rotate angle
Mario.Angle = (Mario.Angle + 1)
IF Mario.Angle > 359 THEN Mario.Angle = 360 - Mario.Angle
KoopaFrame% = 3
END IF
IF MULTIKEY(KEYDOWN) THEN 'move backwards
Mario.speed = Mario.speed - Mario.accel
END IF
IF MULTIKEY(KEYUP) THEN 'move forvard
Mario.speed = Mario.speed + Mario.accel
END IF
IF MULTIKEY(&H1E) THEN 'A 'increase height
Scalez = Scalez + 1
END IF
IF MULTIKEY(&H2C) THEN 'z decrease height
Scalez = Scalez - 1
END IF
IF MULTIKEY(&H1F) THEN 's
Scalex = Scalex + 1
END IF
IF MULTIKEY(&H2D) THEN 'x
Scalex = Scalex - 1
END IF
IF MULTIKEY(&H20) THEN 'd
Scaley = Scaley + 1
END IF
IF MULTIKEY(&H2E) THEN 'c
Scaley = Scaley - 1
END IF
IF MULTIKEY(&H21) THEN 'F 'decrease eyeview
Horz = Horz + 1
y1 = y1 - 1
IF y1 < 0 THEN y1 = 0
END IF
IF MULTIKEY(&H2F) THEN 'v increase eyeview
Horz = Horz - 1
y1 = y1 + 1
IF y1 > 199 THEN y1 = 199
END IF
IF MULTIKEY(KEYENTER) THEN
Finished = TRUE
END IF
IF MULTIKEY(KEYESC) THEN
Finished = TRUE
END IF
'calc physics
Mario.speed = Mario.speed - Mario.speed * FRICTION
dx! = (Lcos!(Mario.Angle)) * Mario.speed
dy! = (Lsin!(Mario.Angle)) * Mario.speed
Mario.x = Mario.x + dx!
IF Mario.x < 0 THEN
Mario.x = 0
ELSEIF Mario.x >= MAPMAXPIXELX THEN
Mario.x = MAPMAXPIXELX
END IF
Mario.y = Mario.y + dy!
IF Mario.y < 0 THEN
Mario.y = 0
ELSEIF Mario.y >= MAPMAXPIXELY THEN
Mario.y = MAPMAXPIXELY
END IF
Angle% = Mario.Angle
px! = Mario.x
py! = Mario.y
AF.Cls Layer, 0
AF.Mode7 Layer%, x1, y1, x2, y2, Angle%, Scalex, Scaley, Scalez, Horz, px!, py!, Texture%(), 0
IF WAITON THEN WAIT &H3DA, 8
AF.Pcopy VIDEO, Layer
LOOP UNTIL Finished
Dummy = MULTIKEY(-2) 'Install MULTIKEY Keyboard handler
Fps% = F& / (TIMER - T#)
CLS
SCREEN 0
WIDTH 80
PRINT "FPS:"; Fps%
c$ = INPUT$(1)
END
SUB AF.Cls (DestSeg%, c%)
'Clears the Layer to a specified color
'Parameters:
'Destseg=Layer or page to clear(use VARSEG or VIDEO/&HA000)
STATIC Asm.Cls%(), InitDone%
IF InitDone% = 0 THEN
Asm$ = ""
Asm$ = Asm$ + "5589E58B46088CDA8EC031FF8A460688C489C166C1E01089C8B9803EF366AB8EDA5DCA0400"
CodeLen% = LEN(Asm$)
IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
Size% = CodeLen% \ 4
REDIM Asm.Cls%(Size%)
DEF SEG = VARSEG(Asm.Cls%(0))
FOR i% = 0 TO CodeLen% \ 2
Byte% = VAL("&H" + MID$(Asm$, (i% * 2) + 1, 2))
POKE VARPTR(Asm.Cls%(0)) + i%, Byte%
NEXT i%
DEF SEG
InitDone% = 1
END IF
DEF SEG = VARSEG(Asm.Cls%(0))
CALL ABSOLUTE(BYVAL DestSeg%, BYVAL c%, VARPTR(Asm.Cls%(0)))
DEF SEG
END SUB
SUB AF.Mode7 (Layer%, x1%, y1%, x2%, y2%, Angle%, Scalex%, Scaley%, Scalez%, Horz%, camx!, camy!, Texture%(), TextureOffset%)
'Just converted my mode7 render usin List2op by Plasma
'Relsoft
STATIC Asm.Mode7%(), InitDone%
IF InitDone% = 0 THEN
Asm$ = ""
Asm$ = "C834000006571E568B4E228B561E3BCA0F8F0302"
Asm$ = Asm$ + "81F9C7000F8FF30183F9000F8CF90183FA"
Asm$ = Asm$ + "000F8CE50181FAC7000F8FFD012BD1420F"
Asm$ = Asm$ + "84D60186E98BF9C1EF0203F98B46248B5E"
Asm$ = Asm$ + "203BC30F8FE7013D3F010F8FBA013D0000"
Asm$ = Asm$ + "0F8CDD0183FB000F8CAC0181FB3F010F8F"
Asm$ = Asm$ + "DE012BD84303F8B940012BCB894ED6895E"
Asm$ = Asm$ + "D4D1EB8BC36698668946CE8956D28B4614"
Asm$ = Asm$ + "6698668946FC8B46126698668946F86633"
Asm$ = Asm$ + "C08B46188B5E1A0FAFC366C1E008668946"
Asm$ = Asm$ + "E4C746E200008E46268E5E088B76068B04"
Asm$ = Asm$ + "C1E8038946DE488946DA8B44028946DC48"
Asm$ = Asm$ + "8946D88B46DE3D020075099090C646CC01"
Asm$ = Asm$ + "EB60903D040075099090C646CC02EB5290"
Asm$ = Asm$ + "3D080075099090C646CC03EB44903D1000"
Asm$ = Asm$ + "75099090C646CC04EB36903D2000750990"
Asm$ = Asm$ + "90C646CC05EB28903D400075099090C646"
Asm$ = Asm$ + "CC06EB1A903D800075099090C646CC07EB"
Asm$ = Asm$ + "0C903D00010F85D100C646CC088B46E203"
Asm$ = Asm$ + "46166698668BD8668B46E46633D266F7FB"
Asm$ = Asm$ + "668BD8668BC86633D28B461C6698669166"
Asm$ = Asm$ + "F7F9668BC8668BD166F7DA660FAF56F866"
Asm$ = Asm$ + "8956F4660FAF4EFC66894EF0668BC3660F"
Asm$ = Asm$ + "AF5EFC660FAF56CE662BDA66895EEC668B"
Asm$ = Asm$ + "560E660156EC660FAF46F8660FAF4ECE66"
Asm$ = Asm$ + "2BC1668946E8668B4E0A66014EE88A4ECC"
Asm$ = Asm$ + "8B5ED4895EE0668B46EC66C1F8102346DA"
Asm$ = Asm$ + "668B5EE866C1FB10235ED8D3E38BF303F0"
Asm$ = Asm$ + "0376068A4404268805668B56F4668B46F0"
Asm$ = Asm$ + "660156EC660146E847FF4EE075C5037ED6"
Asm$ = Asm$ + "8B46D28346E2013946E20F8C33FF5E1F5F"
Asm$ = Asm$ + "07C9CA220087CAE9F8FD8BC22BC103C883"
Asm$ = Asm$ + "F9007CE833C9E9F7FDE9F4FDBAC700E9FD"
Asm$ = Asm$ + "FD93E915FE8BCB2BC803C13D00007CCB33"
Asm$ = Asm$ + "C0E913FEBB3F01E91CFE"
CodeLen% = LEN(Asm$)
IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
Size% = CodeLen% \ 4
REDIM Asm.Mode7%(Size%)
DEF SEG = VARSEG(Asm.Mode7%(0))
FOR i% = 0 TO CodeLen% \ 2
Byte% = VAL("&H" + MID$(Asm$, (i% * 2) + 1, 2))
POKE VARPTR(Asm.Mode7%(0)) + i%, Byte%
NEXT i%
DEF SEG
InitDone% = 1
END IF
'This Draws ;*)
'xRelMode7 Proc Uses es di ds si,\
' Layer:word,scalex:word, scaley:word, scalez:word, horz:word,\
' cosa: word, sina: word, camx: word, camy: word, TextSeg: word, TextOff: word
a! = (Angle% * 3.141593) / 180
cosa% = COS(a!) * 256
sina% = SIN(a!) * 256
camx& = camx! * 65536
camy& = camy! * 65536
IF Horz% < 1 THEN Horz% = 1
DEF SEG = VARSEG(Asm.Mode7%(0))
CALL ABSOLUTE(BYVAL Layer%, BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Scalex%, BYVAL Scaley%, BYVAL Scalez%, BYVAL Horz%, BYVAL cosa%, BYVAL sina%, BYVAL camx&, BYVAL camy&, BYVAL VARSEG(Texture%(TextureOffset%)), BYVAL VARPTR(Texture%( _
TextureOffset%)), VARPTR(Asm.Mode7%(0)))
DEF SEG
END SUB
SUB AF.Pcopy (DestSeg%, SRCSEG%)
'copies the sourceseg to destseg
'this acheives double buffering to eliminate flicker
'same as QB's PCOPY command
'Parameters:
'Destseg=Layer or page to copy to(usually VIDEO)
'srcseg=the source layer to copy from
STATIC Asm.Pcopy%(), InitDone%
IF InitDone% = 0 THEN
Asm$ = ""
Asm$ = Asm$ + "5589E58CD88B4E088B56068EC18EDA31FF31F6B9803EF366A58ED85DCA0400"
CodeLen% = LEN(Asm$)
IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
Size% = CodeLen% \ 4
REDIM Asm.Pcopy%(Size%)
DEF SEG = VARSEG(Asm.Pcopy%(0))
FOR i% = 0 TO CodeLen% \ 2
Byte% = VAL("&H" + MID$(Asm$, (i% * 2) + 1, 2))
POKE VARPTR(Asm.Pcopy%(0)) + i%, Byte%
NEXT i%
DEF SEG
InitDone% = 1
END IF
DEF SEG = VARSEG(Asm.Pcopy%(0))
CALL ABSOLUTE(BYVAL DestSeg%, BYVAL SRCSEG%, VARPTR(Asm.Pcopy%(0)))
DEF SEG
END SUB
FUNCTION MULTIKEY (T)
'Milo Sedlacek's multikey
STATIC kbcontrol%(), kbmatrix%(), Firsttime, StatusFlag
IF Firsttime = 0 THEN 'Initalize
DIM kbcontrol%(128)
DIM kbmatrix%(128)
code$ = ""
code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
code$ = code$ + "5B589DCF"
DEF SEG = VARSEG(kbcontrol%(0))
FOR i% = 0 TO 155 ' Load ASM
d% = VAL("&h" + MID$(code$, (i% * 2) + 1, 2))
POKE VARPTR(kbcontrol%(0)) + i%, d%
NEXT i%
i& = 16 ' I think this stuff connects the interrupt with kbmatrix%()
n& = VARSEG(kbmatrix%(0)): l& = n& AND 255: h& = ((n& AND &HFF00) \ 256): POKE i&, l&: POKE i& + 1, h&: i& = i& + 2
n& = VARPTR(kbmatrix%(0)): l& = n& AND 255: h& = ((n& AND &HFF00) \ 256): POKE i&, l&: POKE i& + 1, h&: i& = i& + 2
DEF SEG
Firsttime = 1
END IF
SELECT CASE T
CASE -1
IF StatusFlag = 0 THEN
DEF SEG = VARSEG(kbcontrol%(0))
CALL ABSOLUTE(0) ' Run interrupt
DEF SEG
StatusFlag = 1
END IF
CASE -2
IF StatusFlag = 1 THEN
DEF SEG = VARSEG(kbcontrol%(0)) ' Turn off interrupt
CALL ABSOLUTE(3)
DEF SEG
StatusFlag = 0
END IF
CASE 1 TO 128
MULTIKEY = kbmatrix%(T) ' Return status
CASE ELSE
MULTIKEY = 0 ' User Supidity Error
END SELECT
END FUNCTION
very nice, a bit epileptic when moving fast