mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-08-31 12:20:15 +00:00
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.
1242 lines
31 KiB
QBasic
1242 lines
31 KiB
QBasic
CHDIR ".\programs\samples\thebob\kong"
|
|
|
|
'****************************************************************************'
|
|
'____________________________________________________________________________
|
|
'____________________________________________________________________________'
|
|
'_____²²___²²__²²²²²__²²___²²__²²²²²____________²²___²²___²²²²___²²__²²______'
|
|
'_____²²___²²_²²___²²_²²___²²_²²___²²___________²²___²²____²²____²²__²²______'
|
|
'_____²²__²²__²²___²²_²²²__²²_²²___²²___________²²²_²²²____²²____²²__²²______'
|
|
'_____²²_²²___²²___²²_²²²__²²_²²_______²_²_²_²__²²²_²²²____²²____²²__²²______'
|
|
'_____²²²²____²²___²²_²²²²_²²_²²_______²_²_²____²²²²²²²____²²____²²__²²______'
|
|
'_____°°°°____°°___°°_°°_°°°°_°°_______°_°___°__°°_°_°°____°°_____°°°°_______'
|
|
'_____°°_°°___°°___°°_°°__°°°_°°__°°°___°__°_°__°°_°_°°____°°______°°________'
|
|
'_____°°__°°__°°___°°_°°__°°°_°°___°°___________°°_°_°°_°°_°°______°°________'
|
|
'_____°°___°°_°°___°°_°°___°°_°°___°°___________°°___°°_°°_°°______°°________'
|
|
'_____°°___°°__°°°°°__°°___°°__°°°°°____________°°___°°__°°°______°°°°_______'
|
|
' '
|
|
'----------- Microsoft QBasic originally came bundled with four -------------'
|
|
'----------- example programs: a simple money management program ------------'
|
|
'----------- called, appropriately, "Money", a utility for removing ---------'
|
|
'----------- line numbers from BASIC programs called "RemLine", and ---------'
|
|
'----------- two game programs, "Nibbles" and "Gorilla". In the case --------'
|
|
'----------- of the second game, I loved the idea of two gorillas -----------'
|
|
'----------- throwing exploding bananas at each other from the roof- --------'
|
|
'----------- tops and had always wanted to do my own version. Here ----------'
|
|
'----------- then, is my homage to the QBasic classic, GORILLA.BAS... -------'
|
|
'
|
|
'-------------------- ...KING-KONG vs MIGHTY JOE YOUNG ----------------------'
|
|
'------- (Freeware)--Unique elements Copyright (C) 2005 by Bob Seguin -------'
|
|
'------------------------ email: BOBSEG@sympatico.ca ------------------------'
|
|
'
|
|
'************** NOTE: Mouse routines will not work with QB7.1 ***************'
|
|
|
|
DEFINT A-Z
|
|
|
|
DECLARE FUNCTION InitMOUSE ()
|
|
|
|
DECLARE SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ShowMOUSE ()
|
|
DECLARE SUB HideMOUSE ()
|
|
DECLARE SUB LocateMOUSE (x, y)
|
|
DECLARE SUB FieldMOUSE (x1, y1, x2, y2)
|
|
DECLARE SUB PauseMOUSE (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ClearMOUSE ()
|
|
DECLARE SUB MouseDRIVER (LB, RB, MX, MY)
|
|
|
|
DECLARE FUNCTION ControlPANEL ()
|
|
DECLARE FUNCTION Computer ()
|
|
DECLARE FUNCTION BananaTOSS ()
|
|
|
|
DECLARE SUB SetPALETTE ()
|
|
DECLARE SUB DrawSCREEN ()
|
|
DECLARE SUB StartUP ()
|
|
DECLARE SUB DoAPES ()
|
|
DECLARE SUB PlayGAME ()
|
|
DECLARE SUB TopMENU (InOUT)
|
|
DECLARE SUB Instructions ()
|
|
DECLARE SUB Sliders (Value, Slider)
|
|
DECLARE SUB EndGAME ()
|
|
DECLARE SUB Interval (Duration!)
|
|
DECLARE SUB Fade (InOUT)
|
|
DECLARE SUB SetWIND ()
|
|
DECLARE SUB Explode (What)
|
|
DECLARE SUB ApeCHUCKLE (Which)
|
|
DECLARE SUB PrintSCORE (Ape, Score)
|
|
|
|
CONST Degree! = 3.14159 / 180
|
|
CONST g# = 9.8
|
|
|
|
REDIM SHARED Box(1 TO 26000)
|
|
REDIM SHARED KongBOX(1 TO 5500)
|
|
REDIM SHARED YoungBOX(1 TO 5500)
|
|
DIM SHARED ExplosionBACK(1200)
|
|
DIM SHARED SliderBOX(1 TO 440)
|
|
DIM SHARED Banana(1 TO 900)
|
|
DIM SHARED FadeBOX(1 TO 48)
|
|
DIM SHARED LilBOX(1 TO 120)
|
|
DIM SHARED Buildings(1 TO 8, 1 TO 2)
|
|
DIM SHARED NumBOX(1 TO 300)
|
|
|
|
DEF SEG = VARSEG(NumBOX(1))
|
|
BLOAD "kongnums.bsv", VARPTR(NumBOX(1))
|
|
DEF SEG = VARSEG(LilBOX(1))
|
|
BLOAD "kongwind.bsv", VARPTR(LilBOX(1))
|
|
DEF SEG = VARSEG(Banana(1))
|
|
BLOAD "kongbnna.bsv", VARPTR(Banana(1))
|
|
DEF SEG = VARSEG(SliderBOX(1))
|
|
BLOAD "kongsldr.bsv", VARPTR(SliderBOX(1))
|
|
DEF SEG
|
|
|
|
FOR n = 1 TO 8
|
|
Buildings(n, 1) = n
|
|
NEXT n
|
|
|
|
DIM SHARED LB, RB, MouseX, MouseY
|
|
DIM SHARED x#, y#, Angle#, Speed#, Wind!, t#
|
|
DIM SHARED KongX, KongY, YoungX, YoungY, Ape
|
|
DIM SHARED KScore, YScore, Item, LBldg, RBldg
|
|
DIM SHARED NumPLAYERS, CompTOSS
|
|
|
|
DIM SHARED MouseDATA$
|
|
|
|
'Create and load MouseDATA$ for CALL ABSOLUTE routines
|
|
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B,5E,08,8B
|
|
DATA 0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53,8B,5E,0C,89,07,58
|
|
DATA 8B,5E,0A,89,07,8B,5E,08,89,0F,8B,5E,06,89,17,5D,CA,08,00
|
|
MouseDATA$ = SPACE$(57)
|
|
FOR i = 1 TO 57
|
|
READ h$
|
|
Hexxer$ = CHR$(VAL("&H" + h$))
|
|
MID$(MouseDATA$, i, 1) = Hexxer$
|
|
NEXT i
|
|
|
|
Moused = InitMOUSE
|
|
IF NOT Moused THEN
|
|
PRINT "Sorry, cat must have got the mouse."
|
|
SLEEP 2
|
|
SYSTEM
|
|
END IF
|
|
|
|
RESTORE PaletteDATA
|
|
FOR n = 1 TO 48
|
|
READ FadeBOX(n)
|
|
NEXT n
|
|
|
|
SCREEN 12
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
OUT &H3C9, 0
|
|
NEXT n
|
|
|
|
RANDOMIZE TIMER
|
|
|
|
DO
|
|
PlayGAME
|
|
LOOP
|
|
|
|
END
|
|
|
|
PaletteDATA:
|
|
DATA 0, 4, 16, 0, 10, 21, 0, 16, 32, 32, 10, 0
|
|
DATA 63, 0, 0, 63, 32, 0, 18, 18, 24, 30, 30, 37
|
|
DATA 42, 42, 50, 55, 55, 63, 0, 0, 0, 43, 27, 20
|
|
DATA 8, 8, 21, 0, 63, 21, 63, 55, 25, 63, 63, 63
|
|
|
|
SUB ApeCHUCKLE (Which)
|
|
|
|
SELECT CASE Which
|
|
CASE 1 'Kong chuckle
|
|
FOR Reps = 1 TO 10
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (KongX, KongY), KongBOX(1351), PSET
|
|
Interval .1
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (KongX, KongY), KongBOX(1801), PSET
|
|
Interval .1
|
|
NEXT Reps
|
|
|
|
CASE 2 'Young chuckle
|
|
FOR Reps = 1 TO 10
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (YoungX, YoungY), YoungBOX(1351), PSET
|
|
Interval .1
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (YoungX, YoungY), YoungBOX(1801), PSET
|
|
Interval .1
|
|
NEXT Reps
|
|
END SELECT
|
|
|
|
END SUB
|
|
|
|
FUNCTION BananaTOSS
|
|
|
|
t# = 0
|
|
IF Ape = 1 THEN
|
|
YTurn = 0: KTurn = 7
|
|
x# = KongX: y# = KongY - 24
|
|
ELSE
|
|
KTurn = 7: KTurn = 0
|
|
x# = YoungX: y# = YoungY - 24
|
|
END IF
|
|
|
|
IF Ape = 2 THEN Angle# = 180 - Angle#
|
|
Angle# = Angle# * Degree!
|
|
vx# = Speed# * COS(Angle#)
|
|
vy# = Speed# * SIN(Angle#)
|
|
InitialX = x#
|
|
InitialY = y#
|
|
|
|
'GET starting background location of banana ---------------------------
|
|
GET (x#, y#)-(x# + 12, y# + 12), Banana(801)
|
|
|
|
'Animate banana toss (frames 2 & 3) -----------------------------------
|
|
FOR Index = 451 TO 901 STEP 450
|
|
Interval .02
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
IF Ape = 1 THEN
|
|
PUT (KongX, KongY), KongBOX(Index), PSET
|
|
ELSE
|
|
PUT (YoungX, YoungY), YoungBOX(Index), PSET
|
|
END IF
|
|
NEXT Index
|
|
|
|
Index = 1 'Initialize banana index
|
|
|
|
DO 'banana toss loop
|
|
|
|
Interval .001
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
'PUT banana background at old x/y ---------------------------
|
|
IF x# >= 0 AND x# <= 627 THEN
|
|
IF y# >= 40 THEN
|
|
PUT (x#, y#), Banana(801), PSET
|
|
END IF
|
|
END IF
|
|
|
|
'Determine new position of banana --------------------------
|
|
'NOTE: The essential formula for determining the path of
|
|
'the thrown banana is taken from the original GORILLA.BAS
|
|
x# = InitialX + (vx# * t#) + (.5 * (Wind! / 5) * t# ^ 2)
|
|
y# = InitialY + -(vy# * t#) + (.5 * G# * t# ^ 2)
|
|
t# = t# + .1
|
|
|
|
'Whether or not to PUT the banana and background
|
|
IF x# >= 2 AND x# < 627 THEN
|
|
IF y# >= 40 AND y# <= 467 THEN
|
|
|
|
'JOE YOUNG hit
|
|
IF x# + 12 >= YoungX + 2 AND x# <= YoungX + 38 THEN
|
|
IF y# + 12 >= YoungY + 7 AND y# <= YoungY + 42 THEN
|
|
Explode 2
|
|
KScore = KScore + 1
|
|
PrintSCORE 1, KScore
|
|
ApeCHUCKLE 1
|
|
BananaTOSS = 1
|
|
EXIT FUNCTION
|
|
END IF
|
|
END IF
|
|
|
|
'KONG is hit
|
|
IF x# + 12 >= KongX + 2 AND x# <= KongX + 38 THEN
|
|
IF y# + 12 >= KongY + 7 AND y# <= KongY + 42 THEN
|
|
Explode 1
|
|
YScore = YScore + 1
|
|
PrintSCORE 2, YScore
|
|
ApeCHUCKLE 2
|
|
BananaTOSS = 2
|
|
EXIT FUNCTION
|
|
END IF
|
|
END IF
|
|
|
|
'Building hit
|
|
IF y# > 120 THEN
|
|
IF (POINT(x# + 2, y#) <> 12 AND POINT(x# + 2, y#) <> 0) THEN BLDG = 1
|
|
IF (POINT(x# + 10, y#) <> 12 AND POINT(x# + 10, y#) <> 0) THEN BLDG = 1
|
|
IF (POINT(x#, y# + 10) <> 12 AND POINT(x#, y# + 10) <> 0) THEN BLDG = 1
|
|
END IF
|
|
IF BLDG = 1 THEN
|
|
BLDG = 0
|
|
Explode 3
|
|
BananaTOSS = 3
|
|
EXIT FUNCTION
|
|
END IF
|
|
|
|
'GET background, PUT banana at new location
|
|
GET (x#, y#)-(x# + 12, y# + 12), Banana(801)
|
|
PUT (x#, y#), Banana(Index + 50), AND
|
|
PUT (x#, y#), Banana(Index)
|
|
|
|
END IF 'Legal banana-PUT END IF's
|
|
END IF
|
|
|
|
Index = Index + 100 'Index changes whether banana is PUT or not ---------
|
|
IF Index = 801 THEN Index = 1
|
|
|
|
'Ape reaction turns section -----------------------------------------------
|
|
|
|
IF t# > .5 AND t# < .6 THEN 'Finish toss (arm goes down)
|
|
IF Ape = 1 THEN
|
|
PUT (KongX, KongY), KongBOX(4501), PSET
|
|
ELSE
|
|
PUT (YoungX, YoungY), YoungBOX(2701), PSET
|
|
END IF
|
|
END IF
|
|
|
|
IF t# > 1.5 THEN 'Turn with passing banana (both apes)
|
|
IF YTurn < 2 THEN
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SELECT CASE YTurn
|
|
CASE 0: PUT (YoungX, YoungY), YoungBOX(3151), PSET: YTurn = 1
|
|
CASE 1: PUT (YoungX, YoungY), YoungBOX(2701), PSET: YTurn = 2
|
|
END SELECT
|
|
END IF
|
|
|
|
IF KTurn < 2 THEN
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SELECT CASE KTurn
|
|
CASE 0: PUT (KongX, KongY), KongBOX(4051), PSET: KTurn = 1
|
|
CASE 1: PUT (KongX, KongY), KongBOX(4501), PSET: KTurn = 2
|
|
END SELECT
|
|
END IF
|
|
|
|
IF x# > YoungX AND YTurn < 7 THEN
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SELECT CASE YTurn
|
|
CASE 2: PUT (YoungX, YoungY), YoungBOX(2701), PSET: YTurn = 3
|
|
CASE 3: PUT (YoungX, YoungY), YoungBOX(3151), PSET: YTurn = 4
|
|
CASE 4: PUT (YoungX, YoungY), YoungBOX(3601), PSET: YTurn = 5
|
|
CASE 5: PUT (YoungX, YoungY), YoungBOX(4051), PSET: YTurn = 6
|
|
CASE 6: PUT (YoungX, YoungY), YoungBOX(4501), PSET: YTurn = 7
|
|
END SELECT
|
|
END IF
|
|
|
|
IF x# < KongX + 40 AND KTurn < 7 THEN
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SELECT CASE KTurn
|
|
CASE 2: PUT (KongX, KongY), KongBOX(4501), PSET: KTurn = 3
|
|
CASE 3: PUT (KongX, KongY), KongBOX(4051), PSET: KTurn = 4
|
|
CASE 4: PUT (KongX, KongY), KongBOX(3601), PSET: KTurn = 5
|
|
CASE 5: PUT (KongX, KongY), KongBOX(3151), PSET: KTurn = 6
|
|
CASE 6: PUT (KongX, KongY), KongBOX(2701), PSET: KTurn = 7
|
|
END SELECT
|
|
END IF
|
|
END IF
|
|
|
|
LOOP UNTIL x# < 3 OR x# > 627
|
|
|
|
IF x# >= 0 AND x# <= 627 THEN 'erase banana to end toss sequence -------
|
|
IF y# >= 40 THEN
|
|
PUT (x#, y#), Banana(801), PSET
|
|
END IF
|
|
END IF
|
|
|
|
BananaTOSS = 3
|
|
|
|
END FUNCTION
|
|
|
|
SUB ClearMOUSE
|
|
|
|
WHILE LB OR RB
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
WEND
|
|
|
|
END SUB
|
|
|
|
FUNCTION Computer
|
|
STATIC CompSPEED, CompANGLE, XDiff, YDiff, FinalX
|
|
|
|
'The computer's gameplay is designed to imitate the play of a
|
|
'real person. The first shot is established as an educated guess
|
|
'with a touch of randomness. On subsequent shots, the formula
|
|
'modifies Speed# and Angle# based on the outcome of this first shot.
|
|
'Sometimes, just like a real person, the first shot will score a
|
|
'hit. Other times, it is a long and embarassing process.
|
|
|
|
'Computer-shot computation formulas
|
|
IF CompTOSS = 0 THEN
|
|
XDiff = YoungX - KongX
|
|
YDiff = KongY - YoungY
|
|
CompSPEED = XDiff / (FIX(RND * 2) + 6) + Wind!
|
|
CompANGLE = 35 - (YDiff / 5)
|
|
CompTOSS = 1
|
|
ELSE
|
|
IF KongX > FinalX THEN
|
|
CompSPEED = CompSPEED * .9
|
|
ELSE
|
|
CompSPEED = CompSPEED * 1.2
|
|
IF YoungX - FinalX < 100 THEN 'Oops! Tall building
|
|
CompANGLE = CompANGLE + 10
|
|
ELSE
|
|
CompANGLE = CompANGLE + 3
|
|
END IF
|
|
END IF
|
|
END IF
|
|
IF CompSPEED > 99 THEN CompSPEED = 99
|
|
IF CompSPEED < 0 THEN CompSPEED = 0
|
|
IF CompANGLE > 70 THEN CompANGLE = 70
|
|
IF CompANGLE < 0 THEN CompANGLE = 0
|
|
|
|
Speed# = CompSPEED
|
|
Angle# = CompANGLE
|
|
Sliders INT(Speed#), 1
|
|
Sliders INT(Angle#), 2
|
|
Interval 1
|
|
|
|
SELECT CASE BananaTOSS 'Call to BananaTOSS FUNCTION -----------
|
|
CASE 1 'Kong exploded Young
|
|
IF KScore = 3 THEN 'Kong wins
|
|
Computer = 2 'Game over
|
|
EXIT FUNCTION
|
|
END IF
|
|
Computer = 1 'Reset screen
|
|
EXIT FUNCTION
|
|
CASE 2 'Young exploded Kong
|
|
IF YScore = 3 THEN 'Young wins
|
|
Computer = 2 'Game over
|
|
EXIT FUNCTION
|
|
END IF
|
|
Computer = 1 'Reset screen
|
|
EXIT FUNCTION
|
|
CASE 3 'Building explosion or banana out-of-play
|
|
FinalX = x#
|
|
Computer = -1 'Change player
|
|
EXIT FUNCTION
|
|
END SELECT
|
|
|
|
Computer = 0 'No action required
|
|
|
|
END FUNCTION
|
|
|
|
FUNCTION ControlPANEL
|
|
SHARED Player1SPEED#, Player2SPEED#
|
|
SHARED Player1ANGLE#, Player2ANGLE#
|
|
|
|
SELECT CASE MouseX
|
|
CASE 147 TO 246
|
|
IF MouseY > 441 AND MouseY < 463 THEN
|
|
IF LB = -1 THEN
|
|
Speed# = MouseX - 147
|
|
IF Speed# < 0 THEN Speed# = 0
|
|
IF Speed# > 99 THEN Speed# = 99
|
|
SELECT CASE Ape
|
|
CASE 1
|
|
Player1SPEED# = Speed#
|
|
CASE 2
|
|
Player2SPEED# = Speed#
|
|
END SELECT
|
|
Sp = INT(Speed#)
|
|
Sliders Sp, 1
|
|
END IF
|
|
END IF
|
|
CASE 385 TO 499
|
|
IF MouseY > 423 AND MouseY < 463 THEN
|
|
IF LB = -1 THEN
|
|
Angle# = 494 - MouseX
|
|
IF Angle# < 0 THEN Angle# = 0
|
|
IF Angle# > 90 THEN Angle# = 90
|
|
SELECT CASE Ape
|
|
CASE 1
|
|
Player1ANGLE# = Angle#
|
|
CASE 2
|
|
Player2ANGLE# = Angle#
|
|
END SELECT
|
|
An = INT(Angle#)
|
|
Sliders An, 2
|
|
END IF
|
|
END IF
|
|
CASE 305 TO 335
|
|
IF MouseY > 423 AND MouseY < 452 THEN
|
|
IF LB = -1 THEN
|
|
HideMOUSE
|
|
GET (308, 427)-(331, 447), Box(25500)
|
|
GET (311, 430)-(328, 444), Box(25000)
|
|
PUT (310, 429), Box(25000), PSET
|
|
LINE (309, 428)-(330, 446), 1, B
|
|
LINE (308, 428)-(331, 448), 10, B
|
|
LINE (331, 429)-(331, 447), 8
|
|
LINE (308, 448)-(330, 448), 8
|
|
ShowMOUSE
|
|
Interval .2
|
|
HideMOUSE
|
|
PUT (308, 427), Box(25500), PSET
|
|
ShowMOUSE
|
|
SELECT CASE BananaTOSS 'Call to BananaTOSS FUNCTION -----------
|
|
CASE 1 'Kong exploded Young
|
|
IF KScore = 3 THEN 'Kong wins
|
|
ControlPANEL = 2 'Game over
|
|
EXIT FUNCTION
|
|
END IF
|
|
ControlPANEL = 1 'Reset screen
|
|
EXIT FUNCTION
|
|
CASE 2 'Young exploded Kong
|
|
IF YScore = 3 THEN 'Young wins
|
|
ControlPANEL = 2 'Game over
|
|
EXIT FUNCTION
|
|
END IF
|
|
ControlPANEL = 1 'Reset screen
|
|
EXIT FUNCTION
|
|
CASE 3 'Building explosion or banana out-of-play
|
|
ControlPANEL = -1 'Change player
|
|
EXIT FUNCTION
|
|
END SELECT
|
|
END IF
|
|
END IF
|
|
END SELECT
|
|
ControlPANEL = 0 'No action required
|
|
|
|
END FUNCTION
|
|
|
|
SUB DoAPES
|
|
|
|
KongX = LBldg * 80 - 59
|
|
KongY = Buildings(LBldg, 2) - 42
|
|
YoungX = RBldg * 80 - 59
|
|
YoungY = Buildings(RBldg, 2) - 42
|
|
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kongmjy.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
ApeINDEX = 1
|
|
GET (YoungX, YoungY)-(YoungX + 38, YoungY + 42), YoungBOX(5000)
|
|
FOR Index = 1 TO 9001 STEP 900
|
|
PUT (YoungX, YoungY), YoungBOX(5000), PSET
|
|
PUT (YoungX, YoungY), Box(Index + 450), AND
|
|
PUT (YoungX, YoungY), Box(Index)
|
|
GET (YoungX, YoungY)-(YoungX + 38, YoungY + 42), YoungBOX(ApeINDEX)
|
|
ApeINDEX = ApeINDEX + 450
|
|
NEXT Index
|
|
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kongkong.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
ApeINDEX = 1
|
|
GET (KongX, KongY)-(KongX + 38, KongY + 42), KongBOX(5000)
|
|
FOR Index = 1 TO 9001 STEP 900
|
|
PUT (KongX, KongY), KongBOX(5000), PSET
|
|
PUT (KongX, KongY), Box(Index + 450), AND
|
|
PUT (KongX, KongY), Box(Index)
|
|
GET (KongX, KongY)-(KongX + 38, KongY + 42), KongBOX(ApeINDEX)
|
|
ApeINDEX = ApeINDEX + 450
|
|
NEXT Index
|
|
|
|
PUT (KongX, KongY), KongBOX(2251), PSET
|
|
PUT (YoungX, YoungY), YoungBOX(2251), PSET
|
|
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kongexpl.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
|
|
END SUB
|
|
|
|
SUB DrawSCREEN
|
|
|
|
'Main screen background/title bar and control panel
|
|
CLS
|
|
DEF SEG = VARSEG(Box(1))
|
|
FileCOUNT = 0
|
|
FOR y = 0 TO 320 STEP 160
|
|
FileCOUNT = FileCOUNT + 1
|
|
FileNAME$ = "kongscr" + LTRIM$(STR$(FileCOUNT)) + ".bsv"
|
|
BLOAD FileNAME$, VARPTR(Box(1))
|
|
PUT (0, y), Box(), PSET
|
|
NEXT y
|
|
DEF SEG
|
|
|
|
'Shuffle buildings order
|
|
FOR n = 8 TO 2 STEP -1
|
|
Tower = INT(RND * n) + 1
|
|
SWAP Buildings(n, 1), Buildings(Tower, 1)
|
|
NEXT n
|
|
|
|
LBldg = FIX(RND * 3) + 1
|
|
RBldg = FIX(RND * 3) + 6
|
|
|
|
'Set buildings order/ save height information to array
|
|
x = 0
|
|
DEF SEG = VARSEG(Box(1))
|
|
FOR n = 1 TO 8
|
|
FileNAME$ = "kongbld" + LTRIM$(STR$(Buildings(n, 1))) + ".bsv"
|
|
BLOAD FileNAME$, VARPTR(Box(1))
|
|
Height = 165 + FIX(RND * 160)
|
|
IF n = LBldg AND Height > 264 THEN Height = 264
|
|
IF n = RBldg AND Height > 264 THEN Height = 264
|
|
Buildings(n, 2) = Height
|
|
Box(2001) = 405 - (Height + Box(1))
|
|
PUT (x, Height + Box(1)), Box(2000), PSET
|
|
PUT (x, Height + Box(1) - 45), Box(1000), AND
|
|
PUT (x, Height + Box(1) - 45), Box(2)
|
|
x = x + 80
|
|
NEXT n
|
|
|
|
'Street lights
|
|
FOR x = 19 TO 639 STEP 120
|
|
LINE (x, 360)-(x + 1, 400), 10, B
|
|
CIRCLE (x + 8, 364), 2, 15
|
|
PAINT STEP(0, 0), 15
|
|
CIRCLE STEP(0, 0), 5, 8
|
|
NEXT x
|
|
|
|
'Foreground building silhouettes
|
|
BLOAD "kongfbld.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
PUT (0, 362), Box(7000), AND
|
|
PUT (0, 362), Box()
|
|
|
|
SetWIND
|
|
Sliders 0, 1
|
|
Sliders 0, 2
|
|
PrintSCORE 1, KScore
|
|
PrintSCORE 2, YScore
|
|
|
|
END SUB
|
|
|
|
SUB Explode (What)
|
|
STATIC BlastCOUNT
|
|
|
|
SELECT CASE What
|
|
CASE 1
|
|
Ex = x# - 26: Ey = y# - 26
|
|
GOSUB FirstBLAST
|
|
Ex = KongX - 12: Ey = KongY - 12
|
|
Dx = KongX - 4: Dy = KongY + 20
|
|
CASE 2
|
|
Ex = x# - 26: Ey = y# - 26
|
|
GOSUB FirstBLAST
|
|
Ex = YoungX - 12: Ey = YoungY - 12
|
|
Dx = YoungX - 4: Dy = YoungY + 20
|
|
CASE 3
|
|
Ex = x# - 26: Ey = y# - 26
|
|
Dx = x# - 20: Dy = y# - 20
|
|
END SELECT
|
|
|
|
IF Ex + 62 > 639 THEN Ex = 639 - 62
|
|
IF Ex < 0 THEN Ex = 0
|
|
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
|
|
|
|
FOR Index = 1 TO 14421 STEP 2060
|
|
PUT (Ex, Ey), ExplosionBACK(), PSET
|
|
IF Index = 4121 THEN
|
|
IF What = 1 THEN
|
|
PUT (KongX, KongY), KongBOX(5000), PSET
|
|
ELSEIF What = 2 THEN
|
|
PUT (YoungX, YoungY), YoungBOX(5000), PSET
|
|
END IF
|
|
GOSUB Damage
|
|
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
|
|
END IF
|
|
PUT (Ex, Ey), Box(Index + 1030), AND
|
|
PUT (Ex, Ey), Box(Index), XOR
|
|
Interval .05
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
NEXT Index
|
|
|
|
PUT (Ex, Ey), ExplosionBACK(), PSET
|
|
|
|
EXIT SUB
|
|
|
|
Damage:
|
|
OPEN "kongcrtr.dat" FOR INPUT AS #2
|
|
INPUT #2, Wdth, Dpth
|
|
BlastCOUNT = BlastCOUNT + 1
|
|
SELECT CASE BlastCOUNT
|
|
CASE 1
|
|
FOR cx = Dx + Wdth TO Dx STEP -1
|
|
FOR cy = Dy + Dpth TO Dy STEP -1
|
|
GOSUB DrawCRATER
|
|
NEXT cy
|
|
NEXT cx
|
|
CASE 2
|
|
FOR cx = Dx TO Dx + Wdth
|
|
FOR cy = Dy TO Dy + Dpth
|
|
GOSUB DrawCRATER
|
|
NEXT cy
|
|
NEXT cx
|
|
BlastCOUNT = 0
|
|
END SELECT
|
|
CLOSE #2
|
|
RETURN
|
|
|
|
DrawCRATER:
|
|
INPUT #2, Colr
|
|
IF Colr <> 0 THEN
|
|
IF POINT(cx, cy) <> 0 AND POINT(cx, cy) <> 12 THEN
|
|
PSET (cx, cy), Colr
|
|
END IF
|
|
END IF
|
|
RETURN
|
|
|
|
FirstBLAST:
|
|
IF Ex < 0 THEN Ex = 0
|
|
IF Ex + 62 > 639 THEN Ex = 577
|
|
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
|
|
FOR Index = 1 TO 6181 STEP 2060
|
|
Interval 0
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (Ex, Ey), ExplosionBACK(), PSET
|
|
PUT (Ex, Ey), Box(Index + 1030), AND
|
|
PUT (Ex, Ey), Box(Index), XOR
|
|
NEXT Index
|
|
PUT (Ex, Ey), ExplosionBACK(), PSET
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB Fade (InOUT)
|
|
|
|
IF InOUT = 1 THEN 'Fade out
|
|
FullFADE! = 1
|
|
DO
|
|
Interval .1
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
FullFADE! = FullFADE! * 1.3
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
OUT &H3C9, INT(FadeBOX(n) / FullFADE!)
|
|
NEXT n
|
|
LOOP WHILE FullFADE! < 20
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
OUT &H3C9, 0
|
|
NEXT n
|
|
ELSE 'Fade in
|
|
FullFADE! = 20
|
|
DO
|
|
Interval .1
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
FullFADE! = FullFADE! * .825
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
OUT &H3C9, INT(FadeBOX(n) / FullFADE!)
|
|
NEXT n
|
|
LOOP WHILE FullFADE! > 1.2
|
|
SetPALETTE
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB FieldMOUSE (x1, y1, x2, y2)
|
|
|
|
MouseDRIVER 7, 0, x1, x2
|
|
MouseDRIVER 8, 0, y1, y2
|
|
|
|
END SUB
|
|
|
|
SUB HideMOUSE
|
|
|
|
LB = 2
|
|
MouseDRIVER LB, 0, 0, 0
|
|
|
|
END SUB
|
|
|
|
FUNCTION InitMOUSE
|
|
|
|
LB = 0
|
|
MouseDRIVER LB, 0, 0, 0
|
|
InitMOUSE = LB
|
|
|
|
END FUNCTION
|
|
|
|
SUB Instructions
|
|
|
|
HideMOUSE
|
|
GET (192, 140)-(447, 290), Box(12000)
|
|
ShowMOUSE
|
|
|
|
FOR n = 1 TO 3
|
|
DEF SEG = VARSEG(Box(1))
|
|
FileNAME$ = "kongins" + LTRIM$(STR$(n)) + ".bsv"
|
|
BLOAD FileNAME$, VARPTR(Box(1))
|
|
DEF SEG
|
|
HideMOUSE
|
|
PUT (192, 140), Box(), PSET
|
|
ShowMOUSE
|
|
GOSUB ClickARROW
|
|
NEXT n
|
|
|
|
HideMOUSE
|
|
PUT (192, 140), Box(12000), PSET
|
|
ShowMOUSE
|
|
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kongexpl.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
|
|
EXIT SUB
|
|
|
|
ClickARROW:
|
|
DO
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
SELECT CASE MouseX
|
|
CASE 400 TO 424
|
|
IF MouseY > 154 AND MouseY < 168 THEN
|
|
IF Arrow = 0 THEN
|
|
HideMOUSE
|
|
GET (400, 154)-(424, 167), Box(25000)
|
|
FOR x = 400 TO 424
|
|
FOR y = 154 TO 167
|
|
IF POINT(x, y) = 6 THEN PSET (x, y), 13
|
|
NEXT y
|
|
NEXT x
|
|
ShowMOUSE
|
|
Arrow = 1
|
|
END IF
|
|
ELSE
|
|
IF Arrow THEN
|
|
HideMOUSE
|
|
PUT (400, 154), Box(25000), PSET
|
|
ShowMOUSE
|
|
Arrow = 0
|
|
END IF
|
|
END IF
|
|
CASE ELSE
|
|
IF Arrow THEN
|
|
HideMOUSE
|
|
PUT (400, 154), Box(25000), PSET
|
|
ShowMOUSE
|
|
Arrow = 0
|
|
END IF
|
|
END SELECT
|
|
IF Arrow = 1 AND LB = -1 THEN
|
|
PUT (400, 154), Box(25000), PSET
|
|
ClearMOUSE
|
|
Arrow = 0
|
|
RETURN
|
|
END IF
|
|
LOOP
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
DEFSNG A-Z
|
|
SUB Interval (Length!)
|
|
|
|
OldTIMER# = TIMER
|
|
DO
|
|
IF TIMER < OldTIMER# THEN EXIT SUB
|
|
LOOP UNTIL TIMER > OldTIMER# + Length!
|
|
WAIT &H3DA, 8
|
|
|
|
END SUB
|
|
|
|
DEFINT A-Z
|
|
SUB LocateMOUSE (x, y)
|
|
|
|
LB = 4
|
|
MX = x
|
|
MY = y
|
|
MouseDRIVER LB, 0, MX, MY
|
|
|
|
END SUB
|
|
|
|
SUB MouseDRIVER (LB, RB, MX, MY)
|
|
|
|
DEF SEG = VARSEG(MouseDATA$)
|
|
Mouse = SADD(MouseDATA$)
|
|
CALL ABSOLUTE_MOUSE_EMU (LB, RB, MX, MY)
|
|
|
|
END SUB
|
|
|
|
SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
|
|
LB = 3
|
|
MouseDRIVER LB, RB, MX, MY
|
|
LB = ((RB AND 1) <> 0)
|
|
RB = ((RB AND 2) <> 0)
|
|
MouseX = MX
|
|
MouseY = MY
|
|
|
|
END SUB
|
|
|
|
SUB PauseMOUSE (OldLB, OldRB, OldMX, OldMY)
|
|
|
|
|
|
SHARED Key$
|
|
|
|
DO
|
|
Key$ = UCASE$(INKEY$)
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
LOOP UNTIL LB <> OldLB OR RB <> OldRB OR MouseX <> OldMX OR MouseY <> OldMY OR Key$ <> ""
|
|
|
|
END SUB
|
|
|
|
SUB PlayGAME
|
|
STATIC Started
|
|
SHARED Player1SPEED#, Player2SPEED#
|
|
SHARED Player1ANGLE#, Player2ANGLE#
|
|
|
|
DrawSCREEN
|
|
DoAPES
|
|
CompTOSS = 0
|
|
|
|
Fade 2
|
|
|
|
DO
|
|
IF Started = 0 THEN
|
|
KScore = 0: YScore = 0
|
|
PrintSCORE 1, KScore
|
|
PrintSCORE 2, YScore
|
|
StartUP
|
|
Started = 1
|
|
IF NumPLAYERS = 2 THEN
|
|
Ape = FIX(RND * 2) + 1
|
|
Player1SPEED# = 0: Player2SPEED# = 0
|
|
Player1ANGLE# = 0: Player2ANGLE# = 0
|
|
ELSE
|
|
Ape = 2
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
|
|
IF Ape = 1 THEN Ape = 2 ELSE Ape = 1
|
|
|
|
IF Ape = 1 THEN
|
|
YTurn = 0: KTurn = 7
|
|
LINE (73, 473)-(97, 474), 13, B 'LED's
|
|
LINE (540, 473)-(564, 474), 10, B
|
|
PUT (KongX, KongY), KongBOX(), PSET
|
|
Speed# = Player1SPEED#: Angle# = Player1ANGLE#
|
|
Sliders INT(Player1SPEED#), 1
|
|
Sliders INT(Player1ANGLE#), 0
|
|
ELSE
|
|
YTurn = 7: KTurn = 0
|
|
LINE (73, 473)-(97, 474), 10, B 'LED's
|
|
LINE (540, 473)-(564, 474), 13, B
|
|
PUT (YoungX, YoungY), YoungBOX(), PSET
|
|
Speed# = Player2SPEED#: Angle# = Player2ANGLE#
|
|
Sliders INT(Player2SPEED#), 1
|
|
Sliders INT(Player2ANGLE#), 0
|
|
END IF
|
|
IF NumPLAYERS = 1 AND Ape = 2 THEN LocateMOUSE 319, 440
|
|
ShowMOUSE
|
|
|
|
DO
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
SELECT CASE MouseY
|
|
CASE 18 TO 27
|
|
TopMENU 1
|
|
CASE 424 TO 462
|
|
IF NumPLAYERS = 1 AND Ape = 2 THEN
|
|
SELECT CASE Computer 'Call to Computer FUNCTION
|
|
CASE -1: EXIT DO 'Change player
|
|
CASE 1 'Reset screen
|
|
Fade 1
|
|
HideMOUSE
|
|
Player1SPEED# = 0: Player2SPEED# = 0
|
|
Player1ANGLE# = 0: Player2ANGLE# = 0
|
|
EXIT SUB
|
|
CASE 2: GOSUB EndGAME 'Game over
|
|
END SELECT
|
|
ELSE
|
|
SELECT CASE ControlPANEL 'Call to ControlPANEL FUNCTION
|
|
CASE -1: EXIT DO 'Change player
|
|
CASE 1 'Reset screen
|
|
Fade 1
|
|
HideMOUSE
|
|
Player1SPEED# = 0: Player2SPEED# = 0
|
|
Player1ANGLE# = 0: Player2ANGLE# = 0
|
|
EXIT SUB
|
|
CASE 2: GOSUB EndGAME 'Game over
|
|
END SELECT
|
|
END IF
|
|
CASE ELSE
|
|
IF Item THEN TopMENU 0
|
|
END SELECT
|
|
LOOP
|
|
|
|
LOOP
|
|
|
|
EXIT SUB
|
|
|
|
EndGAME:
|
|
DEF SEG = VARSEG(Box(1))
|
|
IF KScore = 3 THEN
|
|
BLOAD "kongwink.bsv", VARPTR(Box(1))
|
|
ELSE
|
|
BLOAD "kongwiny.bsv", VARPTR(Box(1))
|
|
END IF
|
|
DEF SEG
|
|
wx = (640 - Box(1)) / 2
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
PUT (wx, 160), Box(), PSET
|
|
a$ = INPUT$(1)
|
|
IF a$ = CHR$(13) THEN
|
|
Started = 0
|
|
Fade 1
|
|
Player1SPEED# = 0: Player2SPEED# = 0
|
|
Player1ANGLE# = 0: Player2ANGLE# = 0
|
|
HideMOUSE
|
|
EXIT SUB
|
|
END IF
|
|
SYSTEM
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB PrintSCORE (Ape, Score)
|
|
|
|
IF Ape = 1 THEN
|
|
PUT (19, 452), NumBOX(Score * 75 + 1), PSET
|
|
ELSE
|
|
PUT (604, 452), NumBOX(Score * 75 + 1), PSET
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB SetPALETTE
|
|
|
|
RESTORE PaletteDATA
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
READ Intensity
|
|
OUT &H3C9, Intensity
|
|
NEXT n
|
|
|
|
END SUB
|
|
|
|
SUB SetWIND
|
|
|
|
Wind! = FIX(RND * 17) - 8
|
|
LINE (291, 462)-(349, 476), 7, BF
|
|
IF Wind! = 0 THEN
|
|
PUT (298, 465), LilBOX(), PSET
|
|
ELSE
|
|
IF Wind! < 0 THEN
|
|
PSET (320 + ABS(Wind! * 2) + 3, 466), 13
|
|
DRAW "L10"
|
|
DRAW "L" + LTRIM$(STR$(ABS(Wind! * 3))) + "U3 G6 F6 U3 R10"
|
|
DRAW "R" + LTRIM$(STR$(ABS(Wind! * 3))) + "U6 bg3 p13,13"
|
|
ELSE
|
|
PSET (320 - Wind! * 2 - 3, 466), 13
|
|
DRAW "R10"
|
|
DRAW "R" + LTRIM$(STR$(ABS(Wind! * 3))) + "U3 F6 G6 U3 L10"
|
|
DRAW "L" + LTRIM$(STR$(ABS(Wind! * 3))) + "U6 bf3 p13,13"
|
|
END IF
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB ShowMOUSE
|
|
LB = 1
|
|
MouseDRIVER LB, 0, 0, 0
|
|
END SUB
|
|
|
|
SUB Sliders (Value, Slider)
|
|
STATIC LeftX, RightX
|
|
|
|
IF LeftX = 0 THEN LeftX = 141
|
|
IF RightX = 0 THEN RightX = 484
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
HideMOUSE
|
|
IF Slider = 1 THEN
|
|
PUT (LeftX, 443), SliderBOX(281), PSET
|
|
LeftX = 141 + Value
|
|
GET (LeftX, 443)-(LeftX + 10, 461), SliderBOX(281)
|
|
PUT (LeftX, 443), SliderBOX(201), PSET
|
|
ELSE
|
|
PUT (RightX, 443), SliderBOX(361), PSET
|
|
RightX = 489 - Value
|
|
GET (RightX, 443)-(RightX + 10, 461), SliderBOX(361)
|
|
PUT (RightX, 443), SliderBOX(201), PSET
|
|
END IF
|
|
ShowMOUSE
|
|
|
|
GOSUB SetNUMS
|
|
|
|
EXIT SUB
|
|
|
|
SetNUMS:
|
|
Num$ = LTRIM$(STR$(Value))
|
|
IF Value < 10 THEN
|
|
LNum = 0
|
|
RNum = VAL(Num$)
|
|
ELSE
|
|
LNum = VAL(MID$(Num$, 1, 1))
|
|
RNum = VAL(MID$(Num$, 2, 1))
|
|
END IF
|
|
HideMOUSE
|
|
IF Slider = 1 THEN
|
|
PUT (260, 447), SliderBOX(LNum * 20 + 1), PSET
|
|
PUT (266, 447), SliderBOX(RNum * 20 + 1), PSET
|
|
ELSE
|
|
PUT (369, 447), SliderBOX(LNum * 20 + 1), PSET
|
|
PUT (375, 447), SliderBOX(RNum * 20 + 1), PSET
|
|
END IF
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB StartUP
|
|
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kong1pl2.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
GET (209, 160)-(430, 237), Box(12000)
|
|
PUT (209, 160), Box(), PSET
|
|
LocateMOUSE 340, 190
|
|
ShowMOUSE
|
|
|
|
DO
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
SELECT CASE MouseX
|
|
CASE 244 TO 270
|
|
IF Item = 0 THEN
|
|
SELECT CASE MouseY
|
|
CASE 193 TO 205
|
|
IF LB THEN
|
|
ButtonX = 245: ButtonY = 194
|
|
GOSUB Clicker
|
|
NumPLAYERS = 2
|
|
FileNAME$ = "kongopen.bsv"
|
|
GOSUB LoadFILE
|
|
END IF
|
|
CASE 209 TO 221
|
|
IF LB THEN
|
|
ButtonX = 245: ButtonY = 210
|
|
GOSUB Clicker
|
|
NumPLAYERS = 1
|
|
FileNAME$ = "Kong1PLR.BSV"
|
|
GOSUB LoadFILE
|
|
END IF
|
|
END SELECT
|
|
END IF
|
|
CASE 340 TO 366
|
|
IF Item = 1 THEN
|
|
IF MouseY > 209 AND MouseY < 221 THEN
|
|
IF LB THEN
|
|
ButtonX = 340: ButtonY = 210
|
|
GOSUB Clicker
|
|
EXIT DO
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END SELECT
|
|
LOOP
|
|
|
|
HideMOUSE
|
|
PUT (209, 160), Box(12000), PSET
|
|
ShowMOUSE
|
|
Item = 0
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD "kongexpl.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
|
|
EXIT SUB
|
|
|
|
LoadFILE:
|
|
DEF SEG = VARSEG(Box(1))
|
|
BLOAD LCASE$(FileNAME$), VARPTR(Box(21500))
|
|
DEF SEG
|
|
HideMOUSE
|
|
PUT (209, 160), Box(21500), PSET
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
Clicker:
|
|
HideMOUSE
|
|
GET (ButtonX, ButtonY)-(ButtonX + 24, ButtonY + 10), Box(20000)
|
|
LINE (ButtonX, ButtonY)-(ButtonX + 24, ButtonY + 10), 8, B
|
|
ShowMOUSE
|
|
Interval .1
|
|
HideMOUSE
|
|
PUT (ButtonX, ButtonY), Box(20000), PSET
|
|
ShowMOUSE
|
|
Interval .01
|
|
Item = Item + 1
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB TopMENU (InOUT)
|
|
STATIC MX1
|
|
|
|
IF InOUT = 0 THEN GOSUB DeLIGHT: EXIT SUB
|
|
|
|
SELECT CASE MouseX
|
|
CASE 20 TO 72
|
|
IF Item <> 1 THEN
|
|
GOSUB DeLIGHT
|
|
MX1 = 20: MX2 = 72
|
|
GOSUB HiLIGHT
|
|
Item = 1
|
|
END IF
|
|
CASE 594 TO 616
|
|
IF Item <> 2 THEN
|
|
GOSUB DeLIGHT
|
|
MX1 = 594: MX2 = 616
|
|
GOSUB HiLIGHT
|
|
Item = 2
|
|
END IF
|
|
CASE ELSE
|
|
GOSUB DeLIGHT
|
|
END SELECT
|
|
|
|
IF LB = -1 AND Item THEN
|
|
SELECT CASE Item
|
|
CASE 1: GOSUB DeLIGHT: Instructions
|
|
CASE 2: GOSUB DeLIGHT: SYSTEM
|
|
END SELECT
|
|
END IF
|
|
|
|
EXIT SUB
|
|
|
|
HiLIGHT:
|
|
HideMOUSE
|
|
GET (MX1, 18)-(MX2, 27), Box(25000)
|
|
FOR x = MX1 TO MX2
|
|
FOR y = 18 TO 27
|
|
IF POINT(x, y) <> 1 AND POINT(x, y) <> 2 THEN
|
|
PSET (x, y), 13
|
|
END IF
|
|
NEXT y
|
|
NEXT x
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
DeLIGHT:
|
|
IF Item THEN
|
|
HideMOUSE
|
|
PUT (MX1, 18), Box(25000), PSET
|
|
ShowMOUSE
|
|
END IF
|
|
Item = 0
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB ABSOLUTE_MOUSE_EMU (AX%, BX%, CX%, DX%)
|
|
SELECT CASE AX%
|
|
CASE 0
|
|
AX% = -1
|
|
CASE 1
|
|
_MOUSESHOW
|
|
CASE 2
|
|
_MOUSEHIDE
|
|
CASE 3
|
|
WHILE _MOUSEINPUT
|
|
WEND
|
|
BX% = -_MOUSEBUTTON(1) - _MOUSEBUTTON(2) * 2 - _MOUSEBUTTON(3) * 4
|
|
CX% = _MOUSEX
|
|
DX% = _MOUSEY
|
|
CASE 4
|
|
_MOUSEMOVE CX%, DX% 'Not currently supported in QB64 GL
|
|
END SELECT
|
|
END SUB
|