Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Discussion Board for the Collection of Graphic Programs by TheBOB.
#2
(04-19-2022, 05:53 PM)Pete Wrote: KONG2.BAS

[Image: Screenshot-552.png]

Code: (Select All)
'****************************************************************************'
'____________________________________________________________________________
'____________________________________________________________________________'
'_____²²___²²__²²²²²__²²___²²__²²²²²____________²²___²²___²²²²___²²__²²______'
'_____²²___²²_²²___²²_²²___²²_²²___²²___________²²___²²____²²____²²__²²______'
'_____²²__²²__²²___²²_²²²__²²_²²___²²___________²²²_²²²____²²____²²__²²______'
'_____²²_²²___²²___²²_²²²__²²_²²_______²_²_²_²__²²²_²²²____²²____²²__²²______'
'_____²²²²____²²___²²_²²²²_²²_²²_______²_²_²____²²²²²²²____²²____²²__²²______'
'_____°°°°____°°___°°_°°_°°°°_°°_______°_°___°__°°_°_°°____°°_____°°°°_______'
'_____°°_°°___°°___°°_°°__°°°_°°__°°°___°__°_°__°°_°_°°____°°______°°________'
'_____°°__°°__°°___°°_°°__°°°_°°___°°___________°°_°_°°_°°_°°______°°________'
'_____°°___°°_°°___°°_°°___°°_°°___°°___________°°___°°_°°_°°______°°________'
'_____°°___°°__°°°°°__°°___°°__°°°°°____________°°___°°__°°°______°°°°_______'
'                                                                            '
'----------- 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 -------'

DEFINT A-Z

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

RESTORE PaletteDATA
FOR n = 1 TO 48
    READ FadeBOX(n)
NEXT n

SCREEN 12
_FULLSCREEN
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)

    IF Which = 1 THEN
        LaffX! = (KongX / 320) - 1
    ELSE
        LaffX! = (YoungX / 320) - 1
    END IF
    IF LaffX! < -1 THEN LaffX! = -1
    IF LaffX! > 1 THEN LaffX! = 1

    Laff& = _SNDOPEN("KONGlaff.ogg", "SYNC,VOL")
    REM _SNDBAL Laff&, LaffX!
    _SNDPLAY Laff&


    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 'tosses banana
    SHARED BananaHIT

    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
    _SNDPLAYFILE "KONGbnna.ogg", 1
    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
    Explode 4

    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.12
            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

    BlastX! = (x# / 320) - 1
    IF BlastX! < -1 THEN BlastX! = -1
    IF BlastX! > 1 THEN BlastX! = 1

    b1& = _SNDOPEN("KONGExp1.ogg", "SYNC,VOL")
    b2& = _SNDOPEN("KONGExp2.ogg", "SYNC,VOL")
    b3& = _SNDOPEN("KONGExp3.ogg", "SYNC,VOL")

    SELECT CASE What
        CASE 1 'Kong hit
            REM _SNDBAL b2&, BlastX!
            _SNDPLAY b2&
            Ex = x# - 26: Ey = y# - 26
            GOSUB FirstBLAST
            Ex = KongX - 12: Ey = KongY - 12
            Dx = KongX - 4: Dy = KongY + 20
        CASE 2 'Young hit
            REM _SNDBAL b2&, BlastX!
            _SNDPLAY b2&
            Ex = x# - 26: Ey = y# - 26
            GOSUB FirstBLAST
            Ex = YoungX - 12: Ey = YoungY - 12
            Dx = YoungX - 4: Dy = YoungY + 20
        CASE 3 'Building hit
            REM _SNDBAL b3&, BlastX!
            _SNDPLAY b3&
            Ex = x# - 26: Ey = y# - 26
            Dx = x# - 20: Dy = y# - 20
        CASE 4 'Off-screen explosion
            REM _SNDBAL b1&, BlastX!
            _SNDPLAY b1&
            EXIT SUB
    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()
    _SNDPLAYFILE "Explosion.ogg"
    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 HideMOUSE

    _MOUSEHIDE: MouseDRIVER

END SUB

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
            _SNDPLAYFILE "KONGtick.ogg", 1
            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 MouseDRIVER

    WHILE _MOUSEINPUT: WEND

END SUB

SUB MouseSTATUS (LB, RB, MouseX, MouseY)

    MouseDRIVER
    LB = _MOUSEBUTTON(1)
    RB = _MOUSEBUTTON(2)
    MouseX = _MOUSEX
    MouseY = _MOUSEY

END SUB

SUB PauseMOUSE (OldLB, OldRB, OldMX, OldMY)


    SHARED Key$

    DO
        _LIMIT 60
        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, Counnt
    SHARED Player1SPEED#, Player2SPEED#
    SHARED Player1ANGLE#, Player2ANGLE#

    DrawSCREEN
    DoAPES
    CompTOSS = 0
    IF Started = 0 THEN
        Street& = _SNDOPEN("Kongstam.ogg", "SYNC")
        _SNDPLAYFILE "Kong theme.ogg", 1
        _SNDLOOP Street&
    END IF
    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
        ShowMOUSE

        DO
            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
                MouseSTATUS LB, RB, MouseX, MouseY
                SELECT CASE MouseY
                    CASE 18 TO 27
                        TopMENU 1
                    CASE 424 TO 462
                        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
                    CASE ELSE
                        IF Item THEN TopMENU 0
                END SELECT
            END IF
            Counnt = Counnt + 1
            IF Counnt = 32000 THEN Counnt = 0
            IF INT(RND * 10000) = 0 THEN
                IF INT(RND * 600) = 0 THEN
                    SELECT CASE Counnt MOD 3
                        CASE 0: _SNDPLAYFILE "KONGhrn1.ogg", 1
                        CASE 1: _SNDPLAYFILE "KONGhrn2.ogg", 1
                        CASE 2: _SNDPLAYFILE "KONGcar.ogg", 1
                    END SELECT
                END IF
            END IF
        LOOP
    LOOP

    EXIT SUB

    EndGAME:
    _SNDPLAYFILE "KONGvict.ogg", 1
    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
    _SNDSTOP Street&
    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

    _MOUSESHOW: MouseDRIVER

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
    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 FileNAME$, VARPTR(Box(21500))
    DEF SEG
    HideMOUSE
    PUT (209, 160), Box(21500), PSET
    ShowMOUSE
    RETURN

    Clicker:
    _SNDPLAYFILE "KONGtick.ogg", 1
    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
        _SNDPLAYFILE "KONGtick.ogg", 1
        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

Required sound and graphics libraries. Incudes .bas file. Make your own folder like KONG2, unzip and compile the KONG2.bas with QB64.

Linux is extremely fussy when it comes to filenames... lol... Finally got those sorted out... This is a very good version of the old gorillas game. Nicely done!  A couple of audio files seem to be missing... "Explosion.ogg" and "Kong theme.ogg"

One thing I found annoying...  My lack of skill...  The computer seems to be quite accurate...  I am not sure which is worse... The original gorilla waving arms or the new sinister 'laugh' when it wins... lol

Do you have any plans in recreating any more "old" games?
May your journey be free of incident. Live long and prosper.
Reply


Messages In This Thread
RE: Preview of Coming Attractions - by johnno56 - 04-20-2022, 12:01 PM



Users browsing this thread: 2 Guest(s)