Author Topic: Air Hockey (Read 5493 times)

bplus · « **on:** March 11, 2020, 06:24:13 pm »

Beats Pong, you can control where you hit the puck if you are fast and accurate enough.

Code: QB64: [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
 
 

Feel free to adjust the _LIMIT amount to your skill level.

bplus · « **Reply #1 on:** March 12, 2020, 12:28:50 am »

Improved for 2020:

Quote

' 2020-03-11 v2-1 (QB64 v1.4 now) cleanup some code:
' Fix _MOUSEINPUT block too newbie ;)
' Fix flat spots on strikers how long have they been there?
' Increase frames per sec and slow puck speed for less double images.
' Oh that sped up the AI player! Nice.
' Do start shots to the side instead of directly at goal. MUCH BETTER!
' Update opening screen with this info. Now pause the puck at start.
' Ran OPTION _EXPLICIT and found a type-O that has been 0 all this time!

Code: QB64: [Select]

OPTION _EXPLICIT
'Air Hockey v2-1.bas for QB64
' Started in QB64 Walter fork version (B+=MGA) 2017-09-05
' The first version was a direct translation from SmallBASIC,
' Now v2.0 add some more graphic image handling, try new things.
' 2020-03-11 v2-1 (QB64 v1.4 now) cleanup some code:
' Fix _MOUSEINPUT block too newbie ;)
' Fix flat spots on strikers how long have they been there?
' Increase frames per sec and slow puck speed for less double images.
' Oh that sped up the AI player! Nice.
' Do start shots to the side instead of directly at goal. MUCH BETTER!
' Update opening screen with this info. Now pause the puck at start.
' Ran OPTION _EXPLICIT and found a type-O that has been 0 all this time!
 
RANDOMIZE TIMER
CONST xmax = 1200, ymax = 700 'screen dimensions
SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Air Hockey v2-1 by bplus"
_DELAY .25
_SCREENMOVE _MIDDLE
 
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 = 15 '           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 f&, table&, computer, player, s$, tx, px, py, pa, psx, psy, c1, csx, csy, strkr&
 
f& = _LOADFONT("C:\Windows\Fonts\arial.ttf", 25) ' arial normal style  if you have windows
_FONT f& '                                         arial is pretty common if you don't have Windows
 
table& = _NEWIMAGE(xmax, tw, 32)
_DEST table&
drawTable
 
strkr& = _NEWIMAGE(2 * pr2 + 1, 2 * pr2 + 1, 32) ' more space to avoid right and bottom flat edges
_DEST strkr&
striker pr2, pr2
 
_DEST 0 '                                                    Opening screen
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, "The puck will be started going up and down in the middle of"
cp 13, "the screen at slight angle towards a randomly selected goal."
cp 16, "Press any when ready..."
SLEEP
_DELAY 1
CLS
updateScore
_PUTIMAGE (0, 0), table&, 0
drawComputerStriker
WHILE _MOUSEINPUT: WEND
psx = _MOUSEX: psy = _MOUSEY
drawPlayerStriker
initball
WHILE player < 21 AND computer < 21 '        play until someone scores 21
    CLS
    updateScore
    _PUTIMAGE (0, 0), table&, 0
    drawComputerStriker
    WHILE _MOUSEINPUT: WEND
    psx = _MOUSEX: psy = _MOUSEY
    drawPlayerStriker
    drawPuck
    _DISPLAY
    _LIMIT 60 '<<<<<<<<<<<<<  slow down, speeed up as needed for good game
WEND
IF computer > player THEN '                                    last report
    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 'toss puck out to side slightly angled to one goal or the other
    DIM pao
    px = tl / 2: py = tw / 2: pao = _PI(1 / 10) * RND
    puck px, py
    _DISPLAY
    _DELAY .3
    IF RND < .5 THEN pa = _PI(.5) ELSE pa = _PI(1.5)
    IF RND < .5 THEN pa = pa + pao ELSE pa = pa - pao
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
    DIM i, shade
    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
    DIM i, shade
    px = px + speed * COS(pa)
    py = py + speed * SIN(pa)
 
    IF px - pr < pr2 THEN
        IF tw13 < py - pr AND py + pr < tw23 THEN 'through computer slot, player scores
            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, tw13)-(pr, tw23), , BF ' wow tw13 has been 0
            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, tw13)-(tl - i, tw23), , BF 't13 again!
            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 ' hit top boundry
        snd 2600, 8
        pa = -pa
        py = pr2 + pr
    END IF
 
    IF py + pr > tw - pr2 THEN ' hit bottom boundry
        snd 2600, 8
        pa = -pa
        py = tw - pr2 - pr
    END IF
 
    IF SQR((px - psx) ^ 2 + (py - psy) ^ 2) < (pr + pr2) THEN 'contact player striker
        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 'contact computer striker
        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 ' here it is!
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)
    DIM i, shade
    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$)
    DIM x, y
    '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
 
 

johnno56 · « **Reply #2 on:** March 12, 2020, 08:19:20 am »

This... looks familiar... Nice conversion!

bplus · « **Reply #3 on:** March 12, 2020, 12:03:30 pm »

Thanks Johnno, were you able to get Arial Font going on Linux?

I can give you the Arial font I use but any font will do that can be 25 pixels high and about 11 wide. I tried QB64's Cyberbit.ttf, a little too curly but worse, the bottoms of g, y, p, q letters with tails are getting cut off.

johnno56 · « **Reply #4 on:** March 12, 2020, 04:30:32 pm »

Yes I did. I noticed your file reference and edited accordingly... Ran like a dream... I quit the game once the computer scored more than I did... lol

bplus · « **Reply #5 on:** March 12, 2020, 07:02:48 pm »

Thanks I had some pretty good battles myself last night. It wins because it never tires or gets distracted.

Angle bank shots to goal are best bet. Just getting puck past it is good too, it will often knock it in for you.

Dimster · « **Reply #6 on:** March 13, 2020, 10:39:16 am »

Being an x-road hockey player, I love this game. Improved my slap shot and wrist shot all with the same motion. I could have been a contender if I could have mastered that shot in real life. Stick handling still sucked. I need some kind of magnet on the puck if I want to deke.

bplus · « **Reply #7 on:** March 13, 2020, 10:55:03 am »

Hi Dimster,

Well I just learned a "deke" is a fake out while maintaining control of puck.

How about dribbling the puck along your side boundary to near the boundary line between opponents and then a bank shot to the goal.

DANILIN · « **Reply #8 on:** March 22, 2020, 06:22:28 pm »

I think we need a dark theme
for playing on a dark background that is pleasing for our eyes
choice: black or dark green or dark purple

bplus · « **Reply #9 on:** March 23, 2020, 12:08:47 pm »

Quote from: DANILIN on March 22, 2020, 06:22:28 pm

I think we need a dark theme
for playing on a dark background that is pleasing for our eyes
choice: black or dark green or dark purple

Code: QB64: [Select]

LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(190, 230, 255), BF 'field
 

This lovely shade of sky blue is virus free! Oh look this was from my early days with QB64, no _RGB32(), should be &HFFBBBBFF

Of course this being source code make the shade whatever pleases the eye. All hockey games on physical boards, I've seen were white, air hockey... don't remember shade

Here's what Google show's
https://www.google.com/search?q=70%27s+air+hockey+games&client=opera&hs=qbn&sxsrf=ALeKk02LbeoakD1bXPSQGXFru0vQ2sxf8g:1584979630804&source=lnms&tbm=isch&sa=X&ved=2ahUKEwjoz_qe_bDoAhXXXc0KHfKWDxUQ_AUoAnoECAsQBA&biw=1297&bih=667

Yeah, pretty much white! ;-))

DANILIN · « **Reply #10 on:** March 23, 2020, 03:05:27 pm »

replace line of listing 109
it's real include dark theme many variants of colors

'LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(190, 230, 255), BF 'field
'LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(0, 0, 0), BF 'field
'LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(0, 50, 50), BF 'field
'LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(50, 50, 0), BF 'field

LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(50, 0, 50), BF 'field

bplus · « **Reply #11 on:** March 23, 2020, 03:17:15 pm »

Can you still see puck with darker fields?

Oh maybe a puck that light's up! and glows!!!

The goals could have a line of blinking lights and blow up into fireworks when someone wins a game!

bplus · « **Reply #12 on:** March 23, 2020, 03:59:24 pm »

Nice color DANILIN, thanks for tip! updated circle fill with color and lightened edge around puck.

It helps contrast the edges of puck, Strikers and the field.

Code: QB64: [Select]

OPTION _EXPLICIT
'Air Hockey v2-1.bas for QB64
' Started in QB64 Walter fork version (B+=MGA) 2017-09-05
' The first version was a direct translation from SmallBASIC,
' Now v2.0 add some more graphic image handling, try new things.
' 2020-03-11 v2-1 (QB64 v1.4 now) cleanup some code:
' Fix _MOUSEINPUT block too newbie ;)
' Fix flat spots on strikers how long have they been there?
' Increase frames per sec and slow puck speed for less double images.
' Oh that sped up the AI player! Nice.
' Do start shots to the side instead of directly at goal. MUCH BETTER!
' Update opening screen with this info. Now pause the puck at start.
' Ran OPTION _EXPLICIT and found a type-O that has been 0 all this time!
 
' v2020-03-23 Dark Theme as suggested by Danlin also fix fill circle with color
' also lighten color around the puck, oh fix the rest of the _rgb to rgb32.
 
RANDOMIZE TIMER
CONST xmax = 1200, ymax = 700 'screen dimensions
SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Air Hockey v2020-03-23 Dark Theme"
_DELAY .25
_SCREENMOVE _MIDDLE
 
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 = 15 '           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 f&, table&, computer, player, s$, tx, px, py, pa, psx, psy, c1, csx, csy, strkr&
 
f& = _LOADFONT("C:\Windows\Fonts\arial.ttf", 25) ' arial normal style  if you have windows
_FONT f& '                                         arial is pretty common if you don't have Windows
 
table& = _NEWIMAGE(xmax, tw, 32)
_DEST table&
drawTable
 
strkr& = _NEWIMAGE(2 * pr2 + 1, 2 * pr2 + 1, 32) ' more space to avoid right and bottom flat edges
_DEST strkr&
striker pr2, pr2
 
_DEST 0 '                                                    Opening screen
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, "The puck will be started going up and down in the middle of"
cp 13, "the screen at slight angle towards a randomly selected goal."
cp 16, "Press any when ready..."
SLEEP
_DELAY 1
_MOUSEHIDE
CLS
updateScore
_PUTIMAGE (0, 0), table&, 0
drawComputerStriker
WHILE _MOUSEINPUT: WEND
psx = _MOUSEX: psy = _MOUSEY
drawPlayerStriker
initball
WHILE player < 21 AND computer < 21 '        play until someone scores 21
    CLS
    updateScore
    _PUTIMAGE (0, 0), table&, 0
    drawComputerStriker
    WHILE _MOUSEINPUT: WEND
    psx = _MOUSEX: psy = _MOUSEY
    drawPlayerStriker
    drawPuck
    _DISPLAY
    _LIMIT 60 '<<<<<<<<<<<<<  slow down, speeed up as needed for good game
WEND
IF computer > player THEN '                                    last report
    s$ = "Game Won by Computer."
    tx = 450
ELSE
    s$ = "Game Won by Player!"
    tx = 470
END IF
COLOR _RGB32(200, 240, 140)
_PRINTSTRING (tx, tw + 30), s$
_DISPLAY
_DELAY 3
 
SUB initball 'toss puck out to side slightly angled to one goal or the other
    DIM pao
    px = tl / 2: py = tw / 2: pao = _PI(1 / 10) * RND
    puck px, py
    _DISPLAY
    _DELAY .3
    IF RND < .5 THEN pa = _PI(.5) ELSE pa = _PI(1.5)
    IF RND < .5 THEN pa = pa + pao ELSE pa = pa - pao
END SUB
 
SUB updateScore
    COLOR _RGB32(40, 255, 255)
    s$ = "Computer: " + STR$(computer) + SPACE$(67) + "Player: " + STR$(player)
    _PRINTSTRING (200, tw + 30), s$
END SUB
 
SUB drawTable
    DIM i, shade
    FOR i = 0 TO pr2 STEP 4
        shade = 64 + i / pr2 * 100
        COLOR _RGB32(shade, shade, shade)
        LINE (i, i)-(tl - i, tw - i), , BF
    NEXT
    LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB32(190, 230, 255), BF 'field
    LINE (pr2, pr2)-(tl - pr2, tw - pr2), _RGB32(50, 0, 50), BF 'field
    LINE (pr, tw13)-(pr2, tw23), _RGB32(60, 60, 60), BF
    LINE (tl - pr2, tw13)-(tl - pr, tw23), _RGB32(60, 60, 60), BF
    LINE (tl \ 2 - 1, pr2)-(tl \ 2 + 1, tw - pr2), _RGB32(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
    DIM i, shade
    px = px + speed * COS(pa)
    py = py + speed * SIN(pa)
 
    IF px - pr < pr2 THEN
        IF tw13 < py - pr AND py + pr < tw23 THEN 'through computer slot, player scores
            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 _RGB32(shade, shade, shade)
                LINE (i, tw13)-(pr, tw23), , BF ' wow tw13 has been 0
            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 _RGB32(shade, shade, shade)
                LINE (tl - pr, tw13)-(tl - i, tw23), , BF 't13 again!
            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 ' hit top boundry
        snd 2600, 8
        pa = -pa
        py = pr2 + pr
    END IF
 
    IF py + pr > tw - pr2 THEN ' hit bottom boundry
        snd 2600, 8
        pa = -pa
        py = tw - pr2 - pr
    END IF
 
    IF SQR((px - psx) ^ 2 + (py - psy) ^ 2) < (pr + pr2) THEN 'contact player striker
        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 'contact computer striker
        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 ' here it is!
END SUB
 
SUB puck (x, y)
    fillcirc x, y, pr, _RGB32(160, 160, 160)
    fillcirc x, y, pr - 4, _RGB32(190, 100, 0)
END SUB
 
SUB striker (x, y)
    DIM i, shade
    FOR i = pr2 TO pr STEP -1
        shade = 164 - 90 * SIN(i * _PI(2) / pr)
        fillcirc x, y, i, _RGB32(shade, shade, shade)
    NEXT
    FOR i = pr TO 0 STEP -1
        shade = 185 + 70 * (pr - i) / pr
        fillcirc x, y, i, _RGB32(shade, shade, shade)
    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, C AS _UNSIGNED 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), C: 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), C, 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), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB snd (frq, dur)
    SOUND frq / 2.2, dur * .01
END SUB
 
SUB cp (lineNum, s$)
    DIM x, y
    '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
 
 

EDIT: fix the rest of the _RGB's

News:

Author Topic: Air Hockey (Read 5493 times)

bplus

Air Hockey

bplus

Re: Air Hockey

johnno56

Re: Air Hockey

bplus

Re: Air Hockey

johnno56

Re: Air Hockey

bplus

Re: Air Hockey

Dimster

Re: Air Hockey

bplus

Re: Air Hockey

DANILIN

Re: Air Hockey

bplus

Re: Air Hockey

DANILIN

Re: Air Hockey

bplus

Re: Air Hockey

bplus

Re: Air Hockey