You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


Air Hockey 2
09-06-2017, 01:46 AM
Post: #1
 (Print Post)
Air Hockey 2
Code Snippet: [Select]
'Air hockey 2.bas for QB64 fork (B+=MGA) 2017-09-05  (started)
' the first version was a direct translation from SmallBASIC
' now add some more graphic image handling, try new things

RANDOMIZE TIMER

CONST xmax = 1200
CONST ymax = 700

SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Air Hockey by bplus"
_SCREENMOVE 100, 20

CONST pr = 16 'puck radius
CONST pr2 = 2 * pr 'puck diameter = bumper width = radius of strikers
CONST tl = xmax 'table length
CONST tw = tl / 2 'table width
CONST tw13 = .3333 * tw \ 1 'goal end point
CONST tw23 = .6667 * tw \ 1 'goal end point
CONST speed = 30 'puck speed also see _limit in main loop
CONST midC = 316 '(tl - 2 * pr2) \ 4 + pr2   'mid line of computer's sin field
CONST rangeC = 252 ' 316 - 252 = 64 (bumper + pr2)  316 + 252 = 568 (mid screen - pr2)

COMMON SHARED computer, player, px, py, pa, psx, psy, c1, csx, csy, strkr&

f& = _LOADFONT("C:\Windows\Fonts\arial.ttf", 25) 'normal style
_FONT f&

table& = _NEWIMAGE(xmax, tw, 32)
_DEST table&
drawTable
strkr& = _NEWIMAGE(2 * pr2, 2 * pr2, 32)
_DEST strkr&
striker pr2, pr2
_DEST 0
cp 7, "Air Hockey, first to score 21 goals wins!"
cp 9, "Player you will be defending the goal on the right (a black slot)."
cp 10, "Your goal is on the left, defended by the computer."
cp 12, "Press any when ready..."
SLEEP
_DELAY 1
computer = 0 'score
player = 0 'score
initball
WHILE player < 21 AND computer < 21
    CLS
    updateScore
    _PUTIMAGE (0, 0), table&, 0
    drawComputerStriker
    DO WHILE _MOUSEINPUT
        psx = _MOUSEX
        psy = _MOUSEY
    LOOP
    drawPlayerStriker
    drawPuck
    _DISPLAY
    _LIMIT 20 'slow down, speeed up as needed for good game
WEND

IF computer > player THEN
    s$ = "Game Won by Computer."
    tx = 450
ELSE
    s$ = "Game Won by Player!"
    tx = 470
END IF
COLOR _RGB(200, 240, 140)
_PRINTSTRING (tx, tw + 30), s$
_DISPLAY
_DELAY 3

SUB initball
    px = tl / 2: py = tw / 2: pa = _PI(1) + RND * _PI(.1)
    rnddir = (RND * 2) \ 1: IF rnddir THEN pa = _PI(1) - pa
END SUB

SUB updateScore
    COLOR _RGB(40, 255, 255)
    s$ = "Computer: " + STR$(computer) + SPACE$(67) + "Player: " + STR$(player)
    _PRINTSTRING (200, tw + 30), s$
END SUB

SUB drawTable
    FOR i = 0 TO pr2 STEP 4
        shade = 64 + i / pr2 * 100
        COLOR _RGB(shade, shade, shade)
        LINE (i, i)-(tl - i, tw - i), , BF
    NEXT
    LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(190, 230, 255), BF 'field
    LINE (pr, tw13)-(pr2, tw23), _RGB(60, 60, 60), BF
    LINE (tl - pr2, tw13)-(tl - pr, tw23), _RGB(60, 60, 60), BF
    LINE (tl \ 2 - 1, pr2)-(tl \ 2 + 1, tw - pr2), _RGB(128, 128, 128), BF
END SUB

SUB drawPlayerStriker
    IF psx - pr2 < tl / 2 THEN psx = tl / 2 + pr2
    IF psx + pr2 > tl - pr2 THEN psx = tl - 2 * pr2
    IF psy - pr2 < pr2 THEN psy = 2 * pr2
    IF psy + pr2 > tw - pr2 THEN psy = tw - 2 * pr2
    _PUTIMAGE (psx - pr2, psy - pr2), strkr&, 0
END SUB

SUB drawComputerStriker
    c1 = c1 + _PI(1 / 80)
    csx = midC + rangeC * SIN(c1)
    IF px > csx THEN csy = py + pr2 * 1.5 * SIN(c1)
    IF csy - pr2 < pr2 THEN csy = 2 * pr2
    IF csy + pr2 > tw - pr2 THEN csy = tw - 2 * pr2
    _PUTIMAGE (csx - pr2, csy - pr2), strkr&, 0
END SUB

SUB drawPuck
    'update ball x, y and see if hit anything
    px = px + speed * COS(pa)
    py = py + speed * SIN(pa)

    IF px - pr < pr2 THEN
        IF tw13 < py - pr AND py + pr < tw23 THEN
            player = player + 1
            CLS
            updateScore
            drawTable
            striker csx, csy
            striker psx, psy
            puck pr, py
            FOR i = 0 TO pr STEP 4
                shade = 64 + i / pr2 * 100
                COLOR _RGB(shade, shade, shade)
                LINE (i, t13)-(pr, tw23), , BF
            NEXT
            snd 1200, 200
            snd 2200, 300
            _DISPLAY
            initball
            _DELAY .5
            EXIT SUB
        ELSE
            snd 2600, 8
            pa = _PI(1) - pa
            px = pr2 + pr
        END IF
    END IF

    IF px + pr > tl - pr2 THEN
        IF tw13 < py - pr AND py + pr < tw23 THEN
            computer = computer + 1
            CLS
            updateScore
            drawTable
            striker csx, csy
            striker psx, psy
            puck tl - pr, py
            FOR i = 0 TO pr STEP 4
                shade = 64 + i / pr2 * 100
                COLOR _RGB(shade, shade, shade)
                LINE (tl - pr, t13)-(tl - i, tw23), , BF
            NEXT
            snd 2200, 300
            snd 1200, 200
            _DISPLAY
            initball
            _DELAY .5
            EXIT SUB
        ELSE
            snd 2600, 5
            pa = _PI(1) - pa
            px = tl - pr2 - pr
        END IF
    END IF

    IF py - pr < pr2 THEN
        snd 2600, 8
        pa = -pa
        py = pr2 + pr
    END IF

    IF py + pr > tw - pr2 THEN
        snd 2600, 8
        pa = -pa
        py = tw - pr2 - pr
    END IF

    IF SQR((px - psx) ^ 2 + (py - psy) ^ 2) < (pr + pr2) THEN
        pa = _ATAN2(py - psy, px - psx)
        'boost puck away
        px = px + .5 * speed * COS(pa)
        py = py + .5 * speed * SIN(pa)
        snd 2200, 4
    END IF
    IF SQR((px - csx) ^ 2 + (py - csy) ^ 2) < (pr + pr2) THEN
        pa = _ATAN2(py - csy, px - csx)
        'boost puck away
        px = px + .5 * speed * COS(pa)
        py = py + .5 * speed * SIN(pa)
        snd 2200, 4
    END IF
    puck px, py
END SUB

SUB puck (x, y)
    COLOR _RGB(90, 90, 90)
    fillcirc x, y, pr
    COLOR _RGB(190, 100, 0)
    fillcirc x, y, pr - 4
END SUB

SUB striker (x, y)
    FOR i = pr2 TO pr STEP -1
        shade = 164 - 90 * SIN(i * _PI(2) / pr)
        COLOR _RGB(shade, shade, shade)
        fillcirc x, y, i
    NEXT
    FOR i = pr TO 0 STEP -1
        shade = 185 + 70 * (pr - i) / pr
        COLOR _RGB(shade, shade, shade)
        fillcirc x, y, i
    NEXT
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fillcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

SUB snd (frq, dur)
    SOUND frq / 2.2, dur * .01
END SUB

SUB cp (lineNum, s$)
    '1200 pixels / 85 characters = 14.11 pixels/char wide
    '700 pixels / 28 lines = 18.42 pixels / char high
    x = (xmax - 11 * LEN(s$)) \ 2
    y = lineNum * 25
    _PRINTSTRING (x, y), s$
END SUB

Works better in QB64!

B += _
Find all posts by this user
Like Post
09-06-2017, 02:38 AM
Post: #2
 (Print Post)
RE: Air Hockey 2
Very cool version... PC plays like one possessed!!!

J

May your journey be free of incident.

Live long and prosper.
Find all posts by this user
Like Post
09-06-2017, 07:57 PM
Post: #3
 (Print Post)
RE: Air Hockey 2
nice graphics and fun to play. i keep knocking the puck in my goal but that's normal for me even on a real table. love this game.
Find all posts by this user
Like Post
09-06-2017, 09:40 PM
Post: #4
 (Print Post)
RE: Air Hockey 2
;-)) yes, and computer plays just the same!

I really like the AI for this, it plays well but then has really stupid moves too.

It's funny, you play for couple of minutes for hard earned point and then blow it with a stupid bounce, backwards into the computer's goal. Big Grin

B += _
Find all posts by this user
Like Post
09-07-2017, 06:13 AM
Post: #5
 (Print Post)
RE: Air Hockey 2
Nice game!I like it a lot! Big Grin


Attached File(s) Image(s)
   
Find all posts by this user
Like Post
09-07-2017, 11:47 AM
Post: #6
 (Print Post)
RE: Air Hockey 2
Hi Ashish, 

I'm glad you are enjoying the game but what happened to my title in your screen shot?

B += _
Find all posts by this user
Like Post
09-08-2017, 07:53 AM
Post: #7
 (Print Post)
RE: Air Hockey 2
@bplus
I don't know. I've just pasted your code into the QB64 IDE & run it.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Basic Dithering
QB64 Member Project - Dreamy Clock
QB64 Member Project - Amazon
QB64 Member Project - Touche
QB64 Member Project - Color Triangles
QB64 Member Project - ARB Checkers
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Kings Court
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Exit
QB64 Member Project - Line Thickness
QB64 Member Project - Blokus
QB64 Member Project - Connect Four
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Qubic
QB64 Member Project - Quarto
QB64 Member Project - Rotating Background
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Swirl
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Sabotage
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Foursight
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Color Rotating Text
QB64 Member Project - Pivet version one
QB64 Member Project - Dakapo
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Algeria Weather
QB64 Member Project - Inside Moves
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Bowditch curve
QB64 Member Project - Othello
QB64 Member Project - Rubix's Magic
QB64 Member Project - Overboard
QB64 Member Project - Pivot version two
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Splatter
QB64 Member Project - Input
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Spiro Roses
QB64 Member Project - 9 Board
QB64 Member Project - Isolation
QB64 Member Project - Domain
QB64 Member Project - Point Blank
QB64 Member Project - Score 4
QB64 Member Project - MAPTRIANGLE