Code:
DECLARE FUNCTION Rel.FastKB% ()
DECLARE SUB Engine.LoadData ()
DECLARE SUB Rel.Rot128 (x%, y%, angle%, Scale%, Array() AS INTEGER, ArrayIndex%)
DECLARE SUB InitImageData (FileName$, ImageArray%())
DECLARE SUB MakeImageIndex (ImageArray%(), IndexArray%())
DECLARE SUB Rel.LoadPalPp256 (File$)
DECLARE SUB SetVideoSeg (Segment%)
DEFINT A-Z
REM $DYNAMIC
TYPE ShipType
x AS SINGLE
y AS SINGLE
dx AS SINGLE
dy AS SINGLE
angle AS INTEGER
speed AS SINGLE
accel AS SINGLE
END TYPE
TYPE ShotType
x AS SINGLE
y AS SINGLE
dx AS SINGLE
dy AS SINGLE
speed AS SINGLE
angle AS INTEGER
active AS INTEGER
END TYPE
CONST FIXFACTOR = 1024
CONST FALSE = 0, TRUE = NOT FALSE
'KeyBoard
CONST KEYRIGHT = 77, KEYLEFT = 75, KEYDOWN = 80, KEYUP = 72
CONST KEYESC = 1, KEYENTER = 28, KEYSPACE = 57, KEYTAB = &HF
CONST PI = 3.14151693#
CONST FRICTION = .1
REDIM SHARED Vpage(32009) AS INTEGER ' Clear offscreen buffer
DIM SHARED LutCOS(359) AS INTEGER
DIM SHARED LutSIN(359) AS INTEGER
DIM SHARED Ship(1 TO 1) AS INTEGER
DIM SHARED ShipIndex(1 TO 1) AS INTEGER
DIM SHARED x86 AS ShipType
Vpage(6) = 2560
Vpage(7) = 200
LAYER = VARSEG(Vpage(0)) + 1
FOR I = 0 TO 359
RA! = I * (3.141593 / 180)
LutCOS(I) = COS(RA!) * FIXFACTOR
LutSIN(I) = SIN(RA!) * FIXFACTOR
NEXT I
CLS
SCREEN 13
Engine.LoadData
x86.x = 160 - 20
x86.y = 100 - 20
x86.dx = .5
x86.dy = .5
x86.angle = 0
x86.accel = .2
x86.speed = 0
Finished = FALSE
DO
SELECT CASE Rel.FastKB
CASE KEYESC
Finished = TRUE
CASE KEYUP
x86.speed = x86.speed + x86.accel
CASE KEYDOWN
x86.speed = x86.speed - x86.accel
IF x86.speed < 0 THEN x86.speed = 0
CASE KEYLEFT
x86.angle = x86.angle - 5
IF x86.angle < 0 THEN x86.angle = 360 + x86.angle
CASE KEYRIGHT
x86.angle = x86.angle + 5
IF x86.angle > 359 THEN x86.angle = x86.angle - 360
CASE KEYSPACE
CASE ELSE
END SELECT
SetVideoSeg LAYER
LINE (0, 0)-(319, 199), 0, BF 'Clear Buffer
x86.speed = x86.speed - x86.speed * FRICTION
dx! = (LutCOS(x86.angle)) * x86.speed / FIXFACTOR
dy! = (LutSIN(x86.angle)) * x86.speed / FIXFACTOR
x86.x = x86.x + dx!
x86.y = x86.y + dy!
x = x86.x
y = x86.y
angle = x86.angle
Rel.Rot128 x, y, angle, 100, Ship(), ShipIndex(1) 'Dda Rotate
WAIT &H3DA, 8
SetVideoSeg &HA000
PUT (0, 0), Vpage(6), PSET
LOOP UNTIL Finished
C$ = INPUT$(1)
CLS
SCREEN 0
WIDTH 80
END
AsterData: 'ASTER.PUT image data.
DATA 884
DATA 328,43,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,29247,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,16128,-18762,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,-18881,-18760,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,-18830,184,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,-18318,3615,29211,182,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16128,-18250,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-18369,-18405,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16128,7094,27,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,29184,7963,184
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-18318,6926
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,29184,7096
DATA -18401,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-18830
DATA 3768,-18917,0,0,0,0,27,0,0,0,0,0,0,0,0,0,0,5376,0,-18830
DATA 7096,-18405,29366,0,0,0,3768,0,0,0,0,0,0,0,0,0,0,0,16149,-18250
DATA -18760,16242,16191,-18881,29366,16191,29247,29366,0,0,0,0,0,0,0,0,0,0,-18369,6975
DATA 7950,6943,6070,7957,3698,-18917,-18762,7096,-18930,0,0,0,0,0,0,0,0,0,0,16149
DATA 29298,29298,16242,16191,-18881,29366,16191,29247,29366,0,0,0,0,0,0,0,0,0,0,5376
DATA 0,-18881,7096,-18405,29366,0,0,0,3768,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,-18881,3768,-18917,0,0,0,0,27,0,0,0,0,0,0,0,0,0,0
DATA 0,0,29184,7096,-18401,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,-18318,6926,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,29184,7963,184,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,16128,7094,27,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,-18369,-18405,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,16128,-18250,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,-18318,3615,29211,182,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,-18830,184,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,-18881,-18760,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,16128,-18762,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,29247,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0
AsterPal: 'ASTER.PUT palette data.
DATA 0,2752512,10752,2763264,42,2752554,5418,2763306
DATA 1381653,4134165,1392405,4144917,1381695,4134207,1392447,4144959
DATA 0,328965,526344,723723,921102,1118481,1315860,1579032
DATA 1842204,2105376,2368548,2631720,2960685,3289650,3684408,4144959
DATA 0,4,8,12,16,21,25,29
DATA 33,37,42,46,50,54,58,63
DATA 0,262144,524288,786432,1048576,1376256,1638400,1900544
DATA 2162688,2424832,2752512,3014656,3276800,3538944,3801088,4128768
DATA 0,1024,2048,3072,4096,5376,6400,7424
DATA 8448,9472,10752,11776,12800,13824,14848,16128
DATA 0,262148,524296,786444,1048592,1376277,1638425,1900573
DATA 2162721,2424869,2752554,3014702,3276850,3538998,3801146,4128831
DATA 0,263168,526336,789504,1052672,1381632,1644800,1907968
DATA 2171136,2434304,2763264,3026432,3289600,3552768,3815936,4144896
DATA 0,1028,2056,3084,4112,5397,6425,7453
DATA 8481,9509,10794,11822,12850,13878,14906,16191
DATA 0,516,1032,1548,2064,2581,3097,3613
DATA 4385,4901,5418,5934,6450,6966,7482,8255
DATA 0,131076,262152,393228,524304,655381,786457,917533
DATA 1114145,1245221,1376298,1507374,1638450,1769526,1900602,2097215
DATA 0,262656,525312,787968,1050624,1378816,1641472,1904128
DATA 2167040,2429696,2757888,3020544,3283200,3545856,3808512,4136960
DATA 0,131844,263688,395532,527376,659477,791321,923165
DATA 1120545,1252389,1384490,1516334,1648178,1780022,1911866,2109503
DATA 0,131588,263176,394764,526352,657941,789529,921117
DATA 1118497,1250085,1381674,1513262,1644850,1776438,1908026,2105407
DATA 0,515,1030,1545,2060,2575,3090,3605
DATA 4376,4891,5406,5921,6436,6951,7466,8238
DATA 63,2103,4143,6183,8223,10008,12048,14088
DATA 16128,13833,11538,9243,6948,4653,2358,63
DATA 32,1058,2084,3110,4136,5418,6444,7470
DATA 8496,9522,10804,11830,12856,13882,14908,16191
REM $STATIC
SUB Engine.LoadData
RESTORE AsterPal 'Set up Pal
Rel.LoadPalPp256 ""
RESTORE AsterData 'Read PP256's documentation
InitImageData "", Ship()
MakeImageIndex Ship(), ShipIndex()
END SUB
SUB InitImageData (FileName$, ImageArray())
IF FileName$ <> "" THEN
'***** Read image data from file *****
'Establish size of integer array required.
FileNo = FREEFILE
OPEN FileName$ FOR BINARY AS #FileNo
Ints = (LOF(FileNo) - 7) \ 2
CLOSE #FileNo
REDIM ImageArray(1 TO Ints)
'Load image data directly into array memory.
DEF SEG = VARSEG(ImageArray(1))
BLOAD FileName$, 0
DEF SEG
ELSE
'***** Read image data from DATA statements *****
'Establish size of integer array required.
READ IntCount
REDIM ImageArray(1 TO IntCount)
'READ image DATA into array.
FOR n = 1 TO IntCount
READ x
ImageArray(n) = x
NEXT n
END IF
END SUB
SUB MakeImageIndex (ImageArray(), IndexArray())
'The index will initially be built in a temporary array, allowing
'for the maximum 1000 images per file.
DIM Temp(1 TO 1000)
ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray)
DO
Temp(IndexNo) = ptr&
IndexNo = IndexNo + 1
'Evaluate descriptor of currently referenced image to
'calculate the beginning of the next image.
x& = (ImageArray(ptr&) \ 8) * (ImageArray(ptr& + 1)) + 4
IF x& MOD 2 THEN x& = x& + 1
ptr& = ptr& + (x& \ 2)
LOOP WHILE ptr& < LastInt
LastImage = IndexNo - 1
'Copy the image index values into the actual index array.
REDIM IndexArray(1 TO LastImage)
FOR n = 1 TO LastImage
IndexArray(n) = Temp(n)
NEXT n
END SUB
FUNCTION Rel.FastKB STATIC
'Faster replacement for inkey$
'Break codes(Scancode+128) from 215 are ignored.
'returns the scancode for the pressed key
'the list of scancodes can be found at QB's help file.
IF NOT KeyReProg THEN
OUT &H60, &HF3 'Inform keyboard
FOR Delay& = 1 TO 1000: NEXT Delay& 'Just a precaution(Settle)
OUT &H60, 0 'send fast typematic rate
KeyReProg = -1
END IF
Code = INP(&H60)
IF Code > 215 THEN
Rel.FastKB = OldCode
ELSE
Rel.FastKB = Code
OldCode = Code
END IF
'Memory 40:1A/1C
'What this does is point the head to tail of the key buffer
DEF SEG = &H40 'Clears the pending key buffer
POKE &H1A, PEEK(&H1C) 'Set head pointer to buffer start...
'For the annoying beep :*)
END FUNCTION
SUB Rel.LoadPalPp256 (File$) STATIC
'Loads a pp256 palette
'Changes the VGA palette on the fly
'if File$="" the data statement is used
IF File$ = "" OR File$ = " " THEN
FOR n = 0 TO 255
READ C&
B = C& \ 65536: C& = C& - B * 65536
G = C& \ 256: C& = C& - G * 256
R = C&
OUT &H3C8, n
OUT &H3C9, R
OUT &H3C9, G
OUT &H3C9, B
NEXT
ELSE
FR = FREEFILE
IF INSTR(File$, ".") = 0 THEN File$ = LEFT$(File$, 8) + ".Pal"
OPEN File$ FOR BINARY AS #FR
FOR n = 0 TO 255
GET #FR, , C&
B = C& \ 65536: C& = C& - B * 65536
G = C& \ 256: C& = C& - G * 256
R = C&
OUT &H3C8, n
OUT &H3C9, R
OUT &H3C9, G
OUT &H3C9, B
NEXT
CLOSE #FR
END IF
END SUB
SUB Rel.Rot128 (x, y, angle, Scale, Array() AS INTEGER, ArrayIndex%)
'Description
'Rotates a given GET/PUT array directly to screen
'Parameters:
'X=Xcoord
'Y=YCoord
'Angle=Angle in Degrees to rotate(0 to 359)
'Scale=Zoom factor(100=Normal, <100=Small,>100=Big)
'Array=Get/put array
'Uses PSET so pixels are auto-clipped
DIM dx&, dy& 'Component Vectors
DIM XStart&, YStart& 'Next Line
DIM SrcX&, SrcY& 'Array coord
DIM MaxX AS INTEGER, MaxY AS INTEGER 'Wid and Hie of Array
DIM ArrayXmid AS INTEGER, ArrayYmid AS INTEGER 'Middle used to get start coord
DIM Pointer AS LONG 'VARPTR(Array(2))=First Pixel
'Scale Factor
Fixpoint = FIXFACTOR
MaxX = (Array(ArrayIndex%) \ 8)
MaxY = (Array(ArrayIndex% + 1))
'We have to rotate from center
ArrayXmid = ((MaxX) \ 2)
ArrayYmid = ((MaxY) \ 2)
IF Scale < 1 THEN Scale = 1
dx& = (LutCOS(angle)) * 100& \ Scale
dy& = -(LutSIN(angle)) * 100& \ Scale
'get Start coords from center darn it!!! this took me a while....
'Here we get the length of the vector(NO SQR since we know its half)
'Then rotate it using the normal rotation Cos+Sin,Sin+Cos to get
'the first pixel to rotate
XStart& = ((ArrayXmid * Fixpoint) - (ArrayXmid * dx&)) + (ArrayYmid * dy&)
YStart& = ((ArrayYmid * Fixpoint) - (ArrayYmid * dx&)) - (ArrayXmid * dy&)
DEF SEG = VARSEG(Array(ArrayIndex%))
Pointer = VARPTR(Array(ArrayIndex + 2))
FOR Ya = 0 TO MaxY - 1
SrcX& = XStart&
SrcY& = YStart&
FOR Xa = 0 TO MaxX - 1
XX = INT(SrcX&) \ Fixpoint
YY = INT(SrcY&) \ Fixpoint
IF (XX >= 0) AND (XX <= (MaxX - 1)) AND (YY >= 0) AND (YY <= (MaxY - 1)) THEN
C = PEEK(Pointer + (YY * (MaxX * 1&)) + XX)
PSET (Xa + x, Ya + y), C
END IF
SrcX& = SrcX& + dx&
SrcY& = SrcY& + dy&
NEXT Xa
XStart& = XStart& - dy&
YStart& = YStart& + dx&
NEXT Ya
DEF SEG
END SUB
SUB SetVideoSeg (Segment) STATIC
DEF SEG
IF VideoAddrOff& = 0 THEN ' First time the sub is called
' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
FOR Offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(Offset&) = &HA0 THEN ' in the default segment and
IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(Offset& + 3) = &HA0 THEN
VideoAddrOff& = Offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT
END IF
' Change b$SegC to the specified Segment
POKE VideoAddrOff&, Segment AND &HFF
POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100
END SUB