QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-08 07:55:14 +00:00
Code Releases Wiki Activity
qb64/programs/samples/thebob/kong/kong.bas

1224 lines
32 KiB
QBasic
Raw Blame History

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(LB, RB, MX, MY, Mouse)
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
View git blame Copy permalink