Find the ball - classic shell game
#17
I like the new ball!  Good catch on the shadow edges showing.  On my old laptop screen they didn't stick out, until you pointed it out.  I thought the background and cup colors needed improving, to match the better ball and shadow, so I overhauled the look.  Removed the ball image, replaced the cup one.

- Dav


Code: (Select All)
_TITLE "Shell Game $5" 'b+ mod 2022-05-09
'mod by Dav 2022-05-11, colors & cup image

'============
'FINDBALL.BAS
'============
'Classic Cups & Ball game (shell game)
'Coded by Dav, MAY/2022

'Cups will shuffle.  Click the cup with the ball.
'If selected correctly, screen flashes green.  If not,
'screen will flash red.  This could be turned into a
'game easy, with score keeping and speed changes.
'For now it just loops over and over.

RANDOMIZE TIMER

SCREEN _NEWIMAGE(1000, 600, 32)
_SCREENMOVE 200, 60

cup& = BASIMAGE1& 'decode cup image to use

shadow& = _NEWIMAGE(100, 100, 32)
fcirc 49, 49, 49, &H25000000
_PUTIMAGE , 0, shadow&, (0, 0)-(99, 99)
'=========================================
ball& = _NEWIMAGE(100, 100, 32)
FOR r = 49 TO 0 STEP -1
    fcirc 49, 49, r, _RGB32(255 - 4 * r, 0, 50 - r)
NEXT

_PUTIMAGE , 0, ball&, (0, 0)-(99, 99)


'=== draw background

CLS , _RGB(0, 0, 0) 'black sky
'add a few stars
FOR s = 1 TO 75
    PSET (RND * _WIDTH, RND * 250), _RGB(192, 192, 192)
NEXT
'green gradient ground
c = 0
FOR y = 300 TO _HEIGHT
    LINE (0, y)-(_WIDTH, y), _RGB(0, c, c / 2), BF
    c = c + 1: IF c = 128 THEN c = 128
NEXT

'=== grab background image
back& = _COPYIMAGE(_DISPLAY)

speed = 75 'speed for _LIMIT
moves = 15 'how many shuffle moves to do

COLOR &HFFFFFFFF
_PRINTMODE _KEEPBACKGROUND
DIM winnings AS LONG
DO

    _PUTIMAGE , back&, 0
    LOCATE 2, 2: PRINT "Winnings: $"; winnings
    LOCATE 10, 39: INPUT "Enter to Pay $5 to Play Shell Game, any other quits "; yes$
    IF LEN(yes$) THEN END

    cupball = INT(RND * 3) + 1 'make random cupball number (1,2,or 3)

    GOSUB ShowBall 'show where ball is first

    'shuffle the cups
    FOR m = 1 TO moves
        SELECT CASE INT(RND * 6) + 1 'random move
            CASE 1: GOSUB move1to2
            CASE 2: GOSUB move1to3
            CASE 3: GOSUB move2to1
            CASE 4: GOSUB move2to3
            CASE 5: GOSUB move3to1
            CASE 6: GOSUB move3to2
        END SELECT
    NEXT

    GOSUB PlaceCups 'make sure they are placed right

    selected = 0 'not selected yet

    DO
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN
            mx = _MOUSEX: my = _MOUSEY
            'clicked cup 1
            IF mx > 114 AND mx < 316 AND my > 146 AND my < 439 THEN
                IF cupball = 1 THEN selected = 1
                EXIT DO
            END IF
            'clicked cup 2
            IF mx > 378 AND mx < 600 AND my > 146 AND my < 439 THEN
                IF cupball = 2 THEN selected = 1
                EXIT DO
            END IF
            'clicked cup 3
            IF mx > 694 AND mx < 911 AND my > 146 AND my < 439 THEN
                IF cupball = 3 THEN selected = 1
                EXIT DO
            END IF
        END IF
    LOOP

    'make sure mouse button up to continue
    DO UNTIL _MOUSEBUTTON(1) = 0: m = _MOUSEINPUT: LOOP

    'flash screen based on selection
    IF selected = 0 THEN
        'flash red - wrong one
        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(255, 0, 0, 64), BF
        winnings = winnings - 5
        _DISPLAY
        _DELAY 1
    ELSE
        'flash green - selected right
        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 255, 0, 64), BF
        winnings = winnings + 5
        _DISPLAY
        _DELAY 1
    END IF

    GOSUB ShowBall 'show where ball is
    IF winnings > 50 THEN speed = speed + 5
LOOP

END

'===================================================================
PlaceCups: 'shows all cups in place
'=========
'Place all cups first
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
_DISPLAY
RETURN
'=====

'===================================================================
ShowBall: 'Raises cup to show ball
'=======

'make sure showing all cups first
GOSUB PlaceCups

_DISPLAY: _DELAY 1

shadowgrow = 0

'raise a cup based on cupball number
SELECT CASE cupball
    CASE IS = 1 'raise cup 1
        _PUTIMAGE (0, 0), back&
        FOR y = 300 TO 175 STEP -7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 500, 300, cup&, 1, 1, 0
            RotoZoom3 800, 300, cup&, 1, 1, 0
            RotoZoom3 210, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 210, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 210, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 200, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow + .13
            _DISPLAY
            _LIMIT 50
        NEXT
        'Sleep
    CASE IS = 2 'raise cup 2
        _PUTIMAGE (0, 0), back&
        FOR y = 300 TO 175 STEP -7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 200, 300, cup&, 1, 1, 0
            RotoZoom3 800, 300, cup&, 1, 1, 0
            RotoZoom3 510, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 510, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 510, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 500, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow + .13
            _DISPLAY
            _LIMIT 50
        NEXT
        ' Sleep
    CASE IS = 3 'raise cup 3
        _PUTIMAGE (0, 0), back&
        FOR y = 300 TO 175 STEP -7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 200, 300, cup&, 1, 1, 0
            RotoZoom3 500, 300, cup&, 1, 1, 0
            RotoZoom3 810, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 810, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 810, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 800, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow + .13
            _DISPLAY
            _LIMIT 50
        NEXT
        'Sleep
END SELECT

_DELAY 1 'pause to see ball

'now lower the same a cup
SELECT CASE cupball
    CASE IS = 1 'lower cup 1
        _PUTIMAGE (0, 0), back&
        FOR y = 175 TO 300 STEP 7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 500, 300, cup&, 1, 1, 0
            RotoZoom3 800, 300, cup&, 1, 1, 0
            RotoZoom3 210, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 210, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 210, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 200, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow - .13
            _DISPLAY
            _LIMIT 50
        NEXT

    CASE IS = 2 'lower cup 2
        _PUTIMAGE (0, 0), back&
        FOR y = 175 TO 300 STEP 7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 200, 300, cup&, 1, 1, 0
            RotoZoom3 800, 300, cup&, 1, 1, 0
            RotoZoom3 510, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 510, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 510, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 500, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow - .13
            _DISPLAY
            _LIMIT 50
        NEXT
    CASE IS = 3 'lower cup 3
        _PUTIMAGE (0, 0), back&
        FOR y = 175 TO 300 STEP 7
            _PUTIMAGE (0, 0), back&
            RotoZoom3 200, 300, cup&, 1, 1, 0
            RotoZoom3 500, 300, cup&, 1, 1, 0
            RotoZoom3 810, 425, shadow&, 1 + shadowgrow, 1, 0
            RotoZoom3 810, 425, shadow&, 1, .58, 0 ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            RotoZoom3 810, 400, ball&, 1, 1, 0 'ball first
            RotoZoom3 800, y, cup&, 1, 1, 0 'cup over
            shadowgrow = shadowgrow - .13
            _DISPLAY
            _LIMIT 50
        NEXT
END SELECT

RETURN
'=====


'===================================================================
move1to2: 'moves cup 1 over to cup 2
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
    _PUTIMAGE (0, 0), back& 'redraw background
    'cup 3 stays in place
    RotoZoom3 800, 300, cup&, cup3z, cup3z, 0
    'cup 2 shrinks, going under cup 1, moving left
    RotoZoom3 500 - move, 300 - cup2z, cup&, cup2z, cup2z, 0
    IF move > 150 THEN cup2z = cup2z + .03 ELSE cup2z = cup2z - .03
    'cup 1 enlarges, going over cup 2, moving right
    RotoZoom3 200 + move, 300 * cup1z, cup&, cup1z, cup1z, 0
    IF move > 150 THEN cup1z = cup1z - .03 ELSE cup1z = cup1z + .03
    _DISPLAY
    _LIMIT speed
NEXT
'swap ball placement
SELECT CASE cupball
    CASE 1: cupball = 2
    CASE 2: cupball = 1
END SELECT

RETURN
'=====


'===================================================================
move1to3: 'move cup 1 over to cup 3
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 8
    _PUTIMAGE (0, 0), back&
    'cup 3 shrinks, moves left two places
    RotoZoom3 800 - (move * 2), 300 - cup3z, cup&, cup3z, cup3z, 0
    IF move > 150 THEN cup3z = cup3z + .02 ELSE cup3z = cup3z - .02
    'cup 2 stays in place
    RotoZoom3 500, 300, cup&, cup2z, cup2z, 0
    'cup 1 enlarges, moving right two places
    RotoZoom3 200 + (move * 2), 300 * cup1z, cup&, cup1z, cup1z, 0
    IF move > 150 THEN cup1z = cup1z - .02 ELSE cup1z = cup1z + .02
    _DISPLAY
    _LIMIT speed * 1.7
NEXT
SELECT CASE cupball
    CASE 1: cupball = 3
    CASE 3: cupball = 1
END SELECT

RETURN
'=====

'===================================================================
move2to1: 'move cup 2 over to cup 1
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
    _PUTIMAGE (0, 0), back&
    '3rd cup stays in place
    RotoZoom3 800, 300, cup&, cup3z, cup3z, 0
    'cup 1 shrinks, moving right
    RotoZoom3 200 + move, 300 - cup1z, cup&, cup1z, cup1z, 0
    IF move > 150 THEN cup1z = cup1z + .03 ELSE cup1z = cup1z - .03
    'cup 2 enlarges, moving left
    RotoZoom3 500 - move, 300 * cup2z, cup&, cup2z, cup2z, 0
    IF move > 150 THEN cup2z = cup2z - .03 ELSE cup2z = cup2z + .03
    _DISPLAY
    _LIMIT speed
NEXT
SELECT CASE cupball
    CASE 1: cupball = 2
    CASE 2: cupball = 1
END SELECT

RETURN
'=====

'===================================================================
move2to3: 'move cup 2 over to cup 3
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
    _PUTIMAGE (0, 0), back&
    'cup 1 stays in place
    RotoZoom3 200, 300, cup&, cup1z, cup1z, 0
    'cup 3 shrinks under, moves left 1 cup,
    RotoZoom3 800 - move, 300 - cup3z, cup&, cup3z, cup3z, 0
    IF move > 150 THEN cup3z = cup3z + .03 ELSE cup3z = cup3z - .03
    'cup 2 enlarges over, moves right 1 cup
    RotoZoom3 500 + move, 300 * cup2z, cup&, cup2z, cup2z, 0
    IF move > 150 THEN cup2z = cup2z - .03 ELSE cup2z = cup2z + .03
    _DISPLAY
    _LIMIT speed
NEXT
SELECT CASE cupball
    CASE 2: cupball = 3
    CASE 3: cupball = 2
END SELECT

RETURN

'===================================================================
move3to1: 'move cup 3 over to cup 1
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 8
    _PUTIMAGE (0, 0), back&
    'cup 1 shrinks under, moving right two cup places,
    RotoZoom3 200 + (move * 2), 300 - cup1z, cup&, cup1z, cup1z, 0
    IF move > 150 THEN cup1z = cup1z + .02 ELSE cup1z = cup1z - .02
    'cup2 stays in place
    RotoZoom3 500, 300, cup&, cup2z, cup2z, 0
    'cup 3 enlarges over, moving left two cup places,
    RotoZoom3 800 - (move * 2), 300 * cup3z, cup&, cup3z, cup3z, 0
    IF move > 150 THEN cup3z = cup3z - .02 ELSE cup3z = cup3z + .02
    _DISPLAY
    _LIMIT speed * 1.7
NEXT
SELECT CASE cupball
    CASE 3: cupball = 1
    CASE 1: cupball = 3
END SELECT

RETURN
'=====

'===================================================================
move3to2: 'move cup 3 over to cup2
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
    _PUTIMAGE (0, 0), back&
    'cup1 stays in place
    RotoZoom3 200, 300, cup&, cup1z, cup1z, 0
    'cup 2 shrinks under, moves right 1 cup
    RotoZoom3 500 + move, 300 - cup2z, cup&, cup2z, cup2z, 0
    IF move > 150 THEN cup2z = cup2z + .03 ELSE cup2z = cup2z - .03
    'cup 3 enlarges over, moves left 1 cup,
    RotoZoom3 800 - move, 300 * cup3z, cup&, cup3z, cup3z, 0
    IF move > 150 THEN cup3z = cup3z - .03 ELSE cup3z = cup3z + .03
    _DISPLAY
    _LIMIT speed
NEXT
SELECT CASE cupball
    CASE 3: cupball = 2
    CASE 2: cupball = 3
END SELECT

RETURN


SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
    ' This assumes you have set your drawing location with _DEST or default to screen.
    ' X, Y - is where you want to put the middle of the image
    ' Image - is the handle assigned with _LOADIMAGE
    ' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
    ' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
    ' radianRotation is the Angle in Radian units to rotate the image
    ' note: Radian units for rotation because it matches angle units of other Basic Trig functions
    '       and saves a little time converting from degree.
    '       Use the _D2R() function if you prefer to work in degree units for angles.

    DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
    DIM W&, H&, sinr!, cosr!, i&, x2&, y2& '   variables for image manipulation
    W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
    px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
    px(2) = W& / 2: py(2) = H& / 2 '  right bottom
    px(3) = W& / 2: py(3) = -H& / 2 ' right top
    sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
    FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
        x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
        px(i&) = x2&: py(i&) = y2&
    NEXT
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB

FUNCTION BASIMAGE1& 'cup.png
    v& = _NEWIMAGE(235, 336, 32)
    DIM m AS _MEM: m = _MEMIMAGE(v&)
    A$ = ""
    A$ = A$ + "haIkM_SLMLS506nj#7XMPRDi<WbBK0_8V87<k8_<d6aK3_5DX3i8DDH8^Pha"
    A$ = A$ + "1_a1hOZj[V9H45Igm?AOknd]NmeGOl:004k?NiUG=nc_neGo_oj_^E\O_mKO"
    A$ = A$ + "nc_^j]C0mPmHJSJkRojaS]C[=^aZggPka_oU_8^3GMK]Cb]]bLN4f][?NHfD"
    A$ = A$ + "_nmeH_9]5GmanW89]\IocZ?61kGC^jSMAn>V6n\T[;GmaQX_=<m[NHKc#G;e"
    A$ = A$ + "EO\5VOoBk^?X=A:d^kAOBKRBAg>7QFoLekkQN5ZKGmahJFX[;dZg7ScCXigH"
    A$ = A$ + "e7k[5VIIc]AGmnBL?LKFVYbdL?GgE_O3g;>ghhH]D\KLGSMema^`dY^GgXE_"
    A$ = A$ + "?2`bLlhoiGn5jeObdYV]7dYHgHKEcaXgnWOelk[NiCOReDaFbfZVSA_meF=o"
    A$ = A$ + "n:cf1FG5k6g>ehfWK2K[j^f:=;F=kaQfS=ii[mmc1fb^n:m:F5o>UeDohjZd"
    A$ = A$ + "\He\7ciN^_dZ__^ZIkRE\NUV5STkaIn77B[nFWjgPf]Ef]GfoglLePNcoHZD"
    A$ = A$ + "7gMcG3Hg>mKo`OocoKg]SQFWU^5]8EOjOnLnoi^aNeM>U\MjolC^=K^]WQjF"
    A$ = A$ + "JGh:da7i>NbnWmK?NnHaKlLQ=olJ_7=V]5V6mk>lKFg]iYf>CkRD]I^OO_KS"
    A$ = A$ + "JGo`NL8]jc]jonhiNe^]ZT^EBkBoN6R]_=GKVZ?M?7?;Je?mog6ifZFn[cjn"
    A$ = A$ + "kh2e]BKgDm;=lN:en;om]afg7JOLXnlk?nhaNdZYKE9M[oj]aJG9mK^6VFN="
    A$ = A$ + "]H\V\TcWbm_[LmYoaMn]j]MmU\coPdF]T^=EkFb_7^fFVN^l><F;Fki9igVU"
    A$ = A$ + "dWaJEcG;cOgVSMGMoXUF=GgV[MSMlC]7WDK?[]6_UO^b]=CjfH9KcTdVU\^0"
    A$ = A$ + "]JOJEY]KXnEJ3gSO__D]d3SF]o<e[cK9FCVjJ2EJKB[>_F=EkVZOC]6L9[]d"
    A$ = A$ + "jabef3c#[OOfbiDhgTijbNM\4]jlJE9mK^6^TF^UcELe]h8Gg?gf\#]XdVLT"
    A$ = A$ + "7g#[^fFEJoFJ;GB??R?ChXEk?CYj#Y]hXKBJEmdZ]fbUdcSZc7YLmF?j`EeS"
    A$ = A$ + "dZWE[f[NNDMn8EC_YQ>TFmNKeEeicfZgFA[>GfgK;dZHWA[VNfm1f5dZdZ#7"
    A$ = A$ + "LKEcaZgN[JnmEf[Q1m:f9dZ_gZVk_^mc\jf[d\H7#[nN[j^fZkeIRV5[TkmB"
    A$ = A$ + "c\6RM>E^aW9>geEMWM=oeHYIa<iOo^MOnX]c4m=m\VKngI0gomK<f\\5[IYK"
    A$ = A$ + "A?5JVD2mnikfN?1kfYiV5FoVU^5mB\n<eke[K[EMOW0k?;\YVMM9MkZgoSmG"
    A$ = A$ + "9mI\W5ZKhc[JnmAQ^7=^KgT\mRcA6B5K^[;Y?3MnOWlJ[VcmelkSlWY#o]Se"
    A$ = A$ + "\=<fk50JgkD\W9RBG3=daGfo\Wlon>6K=e#KSMKfJf^BkNGTdV]LLToGCkGS"
    A$ = A$ + "ClLQM_NBiVW#9W_B9WcRdfUnE7RM>]YJcB?N9fW[:dmKel_e;[^_jmJZe<k_"
    A$ = A$ + "]NM0J]MYQgWV\W]I;G_BoiHjdFK]eid_7[e6kj4DckL;JhifTn?kmefVU\6J"
    A$ = A$ + "Z_OmWi`CJ]eNn<eTJ]fN\o;ek[4oSOTl>BHe]`>fQaja#_?<ZiM3K9WCEYk["
    A$ = A$ + "2eZWde4fnLUgSF=Eg>Zf]V6^Ugi9[^aZ]mbeQedTU\O[V?_C=K3>iFennJYg"
    A$ = A$ + "]J\SQbMMj[iH09=L9_[njMO?JUlmN\]1mhm_lZ_>RQJeCjc\>jF]ff]7mK^>"
    A$ = A$ + "^TN^enNDTlmZk?OifFd[]a[hJl7ZE?YWA^IgZed^aFk]eS_:YWkAOgCel>#M"
    A$ = A$ + "DKWbM=0WeWSPFM^bM>NQ>VMT7KfcnN4Vm?Ki^V0[lchC[^NBn<JaFkIE7[_c"
    A$ = A$ + "TL>3B>_oMkJ_A[^_TL]FjmiA^;mM][3;ilfULMdFmnNJEMeZedaUfcmZ_k]J"
    A$ = A$ + "o\bULm\Gmn#Je`]ZMooYdZmXWkEO?2]N?TFmfnAgZVSW?aFenn:dN<`Y^_L5"
    A$ = A$ + "mmX]j]7k4K[J>>fLl\ihjC[E]OnWoVmo#i<7oJKEcaeWB[JV[IY??L0JPoWI"
    A$ = A$ + "eLlm9<onl_56hd4jj;M2c4<]:>=WJ[NcG3HLV2M]P?QigW[1<>=Wje2V[1<>"
    A$ = A$ + "AWfe2V[1<>EWfe2V[[4>EWfeGRF5W:JE0MPF5#7>]FMD_o21F]#]ZV_7[Wjc"
    A$ = A$ + "]:`YmL\B[RC5]:P>#[2X3dZ0j0]:P>#[2X3dZ0j`YfZlLVSCcYm^7UWcLLZ>"
    A$ = A$ + "]WgLN>ca9kDNNcii<7W^Cii=WWa6Lj>UWe6JELj>UFenl`ae06WZCiM?:G3H"
    A$ = A$ + "Lj>U[5\O[BWRCTke2FS]:G3HL;dne2V[[4^5Joj;A[RK1]:P>#[2X3J_EiM="
    A$ = A$ + ":^5JoM?:?gZhFXmWSEJEL;XE1d1JE0MPF5#7XE1dQCYEiiQ3W>]o>BSW7>L;"
    A$ = A$ + "dnc57??LhVXeW;^OlONemmG8[YRCWM]EggWQV>He]H><;`hfXeI2VF5g6JE0"
    A$ = A$ + "M#[]:?S=hfXeWe6^O=hfXekK3g_6LSdfm]QkG3^EQ^_=[^7CQ[[4^EQn<[kl"
    A$ = A$ + "kNDJEL[dfe2VF5g:JE0MPF5#7dF[bcH>^EJkI>WF5g:JE0MPF5#7XE1d1]fZ"
    A$ = A$ + "<gnhfh?onJXEI^ma]B;c__oLkC[RKSK[^c_gU<cY<OFELcdbl##[RK7]:P>#"
    A$ = A$ + "[2X3JYEI^ma]C;]:c11^MJIN8XEa]CK]:c\4^EJIfU2mN1NeKk0V==lN2VIF"
    A$ = A$ + "28l\;]jfd5g_6PghoIF=]j>m^7UF5h=knk9HJEPg#[2X3kN[b<;1lVMOfUH>"
    A$ = A$ + "80Nc^??4dZ0_QF5#7XE1d1]dZoe?oNTF5g:gFM7W9HV5HPg]cc4<c2<`kfeI"
    A$ = A$ + "2ViP0hIkjl##[2l<JE0MPF5#7feFUI16hIkj<1cL#0l\MMN8XE1Nf^gZ<cB0"
    A$ = A$ + "_IGWMY#c\4]:^In_kAgUIGj?Ni5VI90?nc^TYCFIWJ^>dfi;Tco5hMkfkc#^"
    A$ = A$ + "gZ0Q]KgSEJEP`XE1d1JE0MHgJEV32P`f]iQPF58<JE0MHGKEV_#PW]KcIXIF"
    A$ = A$ + "<Hn21nX#cIh:WM9V_#PhfUi<l7o7V_#P42=WQV^If]:gKEPdfUka:]:#JdZ0"
    A$ = A$ + "j0]:P>\;]ZiJJA[24GXFM5G;HVI9PdfUIGRF58=JE0MPF5#7XE1dQM[EiI\1"
    A$ = A$ + "8\MiI]QWa6PdfUWe6N6K0bKe?[=<cB0b\jIGRF5#6JE0MPF5#7XE1dQEgZl<"
    A$ = A$ + "f08cZOFKXE1TQF5#7Fml#`<;18g:W72VI90iFekNDN_03DVEM]Pine0D6JE0"
    A$ = A$ + "MPF5#7XE1dQEM?FiN[2D6JE0MPF5#7XE1dQEfZ<OQ0b]ZI2f_EYC1bcMVPWE"
    A$ = A$ + "[JW_#cOW\V:P<feF]c_oXO?1cmF5X>cNN8XE1Z3]:P>#[2X3c^EiN[2DWIO?"
    A$ = A$ + "FYE1Z3]:P>#[2X3dZ0j`\Wc#V5HPj=ci<TI16XNcL>3IFP1Zg\^7[<740]QF"
    A$ = A$ + "5#7XE1d1JE0MHFgSE^gZ0]QF5#7XE1d1JE0MPF5#7VM[b\03D7oigOT]:c2<"
    A$ = A$ + "#KValkKnJb\03d6oig_g]:c11#O<jIGRF5X?XE1d1JE0MHd]:gKEPnHdgSEJ"
    A$ = A$ + "EPnPF5#7XE1dQIeZ<OQ0]IdcI8cG8#o<bi<dMn2YE1JSK[fci<Tk]:#O=Zka"
    A$ = A$ + ":]:#OA[2X3dZ0j`XJE^gZ0meX^7[dZ0m5]:P>#[2X3dZ0jPK[fci<dMFPYE1"
    A$ = A$ + "j3gI2^GcIXo\0o?K`?W0Jg8Vc#V5HPn;dWImaS7Eg[Vo\lIE1j?JE0MPF5#7"
    A$ = A$ + "XE1dQ#]j_oU_DM[JncB[2dOmNN8H>8063JE0MPF5#7XE1dQN?C`<;`0SQok9"
    A$ = A$ + "hFW9h#c2<]:#OdcI2VI16HLjel#`L#0<FdZ0j0]:P>#[2X3mJVPIFP16[N=?"
    A$ = A$ + "4<740S5]:P>#[2X3mJ>3In216[N=WQ<OQ0SG?Vc#V_#Pa[eka:gKEPi`OMEJ"
    A$ = A$ + "EPmSoWGUF5Ho4[Coc_neRJE^O=0SagO4^C=G7gJ^W=LoJ0j;o6eN?EMkdJKE"
    A$ = A$ + "km[iK?NnNf#c2D6KSV[C[YE=Wc\mLPmkEFS5#6Y[UFK[J_^B6V_NfN=dJ\[N"
    A$ = A$ + "K1`>b]AMWQ#C;I_6B^\MVUdW;>gF=Dcbi43lAOoa7KD9[UjfXFB_F`QJe#=["
    A$ = A$ + "oi4CcRKC\nDBSj^FZmlFMoo_Tc5fNMURMndaFSUV5gRLmI^?CJ\>eo?KZc5f"
    A$ = A$ + "fY^[7;ig94[IYKaY8gihjniA[]AmojH>GhLMJ]oMKKFjFL2TN>^YJTBkD9W;"
    A$ = A$ + "\YQSmebmk7YWk=M;d89mIZ[Y[OGDJSjgMn[]j>CQBFK>FgjOncBkFJG\:n77"
    A$ = A$ + ":Y?;I=dJJdD[]6jlOUleYGM;];VUH]I[mI?KDoFeM]e#cm#;=[k?GnW7POgB"
    A$ = A$ + "kRABJKFKOFcW5]dnb>?CofWolCgCfFojFKgBkRNXUf<eeT9dW3MT=JXFEjWE"
    A$ = A$ + "]gMK_KGjgkD=]I=[M6jLL7ISjgZVc3ND]JYMK[]K\nU6FoR]OeOo_dfDjWmL"
    A$ = A$ + "V[OVZK\[[jo<e<[onkAk6ZO;YSGmaP8OCj_Od]9SeUedVYFkLf=Zk?3^?3jc"
    A$ = A$ + "HMEYMK=]KZ__3eaBG;VFN>]H^e8CeSQ>>Zfe=GeJWinIbnm[kmF]f[3l>d^a"
    A$ = A$ + "nMQYF7FbJaiJIjJiKObeSiJbHkOkaJVkDSjnc[oke5koN`]3]JY]K^n=E77k"
    A$ = A$ + "_cH]LX>^VVN7KmFnn>gfUBjaDkcUfSYn\VkHCV[C][YjoNPH7keLk73e_Bkh"
    A$ = A$ + "FoM\U\nlXKmAfK]fOBf7>RVDCmYof7k?Sn?[=fc3NEO^eAd_YjH9[5WKOO?>"
    A$ = A$ + ">XW]N=Z]g:MO#Yo>eKX9C]]doLOmiO>m[nkiAgaa>^YTF^V^NW?nZV_gSeJY"
    A$ = A$ + "fV:IkIYG7RC#ZcmeUmc]JGKmDgN8mHBY7;EkaPm\ekQBon]d[aJ]oL^jSEVi"
    A$ = A$ + "aS^KGcm>GboLQ_U]Eedb]LLn8JmM1mghkDo[cd]g[U^]NV[Y=kfRe17ka>ed"
    A$ = A$ + "Yd[[Koe:]j]1g6oO?M]MJXNemgo^jO>1dZH=ZYeZ]C3e[Wfe86HV2eXfk;C9"
    A$ = A$ + "ok2G:^GOHjEPb<S6eUi[Yke8Vc968=o[KXkik>R6=eJ\nG3aE_]1HeRmiAKm"
    A$ = A$ + "J7ekc9VV5gX#gk=o6MDW_K=WC<=;^=iF3en>GIE=ZdVU^5WXL[QJkCckK`Eg"
    A$ = A$ + "ViJf#gS7jFXIB?7gM^?SaliImKFjFX9BjC=\6ZDVO62]FK\^Uf5[B\icnTkc"
    A$ = A$ + "JjFJG<KBKcKY?ce]nGC:JG<:UdVgNOBkRI:dcBTTf<fk<5dofUnmn4kil;EK"
    A$ = A$ + "J_f]cN>R>Min\^aV53jhcA^m[ijBJce`\m>gj^Ufa[nHAT_9UdSnWC;]inYV"
    A$ = A$ + "nEjJadbc[7ULMOX;?G]daUnn8JeM`^fO]dRdSXf6^GMm^ej]lmM=m7=9jUNf"
    A$ = A$ + "bcZegQN;5kfCJA\:fS1WAG_KhNCRKRmHmLgGZAgK\N70#knO[;ga%%%0"
    btemp$ = ""
    FOR i& = 1 TO LEN(A$) STEP 4: B$ = MID$(A$, i&, 4)
        IF INSTR(1, B$, "%") THEN
            FOR C% = 1 TO LEN(B$): F$ = MID$(B$, C%, 1)
                IF F$ <> "%" THEN C$ = C$ + F$
            NEXT: B$ = C$: END IF: FOR j = 1 TO LEN(B$)
            IF MID$(B$, j, 1) = "#" THEN
        MID$(B$, j) = "@": END IF: NEXT
        FOR t% = LEN(B$) TO 1 STEP -1
            B& = B& * 64 + ASC(MID$(B$, t%)) - 48
            NEXT: X$ = "": FOR t% = 1 TO LEN(B$) - 1
            X$ = X$ + CHR$(B& AND 255): B& = B& \ 256
    NEXT: btemp$ = btemp$ + X$: NEXT
    btemp$ = _INFLATE$(btemp$,m.SIZE)
    _MEMPUT m, m.OFFSET, btemp$: _MEMFREE m
    BASIMAGE1& = _COPYIMAGE(v&): _FREEIMAGE v&
END FUNCTION

SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    DIM Radius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    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


Attached Files Image(s)
   

Find my programs here in Dav's QB64 Corner
Reply


Messages In This Thread
Find the ball - classic shell game - by Dav - 05-09-2022, 01:00 PM
RE: Find the ball - classic shell game - by bplus - 05-09-2022, 01:38 PM
RE: Find the ball - classic shell game - by Dav - 05-09-2022, 01:52 PM
RE: Find the ball - classic shell game - by Dav - 05-09-2022, 04:53 PM
RE: Find the ball - classic shell game - by bplus - 05-09-2022, 05:48 PM
RE: Find the ball - classic shell game - by bplus - 05-10-2022, 01:12 AM
RE: Find the ball - classic shell game - by Dav - 05-10-2022, 02:20 AM
RE: Find the ball - classic shell game - by bplus - 05-10-2022, 03:03 PM
RE: Find the ball - classic shell game - by Dav - 05-11-2022, 01:38 AM
RE: Find the ball - classic shell game - by bplus - 05-11-2022, 04:08 AM
RE: Find the ball - classic shell game - by bplus - 05-11-2022, 04:35 AM
RE: Find the ball - classic shell game - by bplus - 05-11-2022, 05:01 AM
RE: Find the ball - classic shell game - by Dav - 05-11-2022, 03:27 PM
RE: Find the ball - classic shell game - by bplus - 05-11-2022, 03:42 PM
RE: Find the ball - classic shell game - by Dav - 05-11-2022, 03:52 PM
RE: Find the ball - classic shell game - by Dav - 05-12-2022, 11:27 PM
RE: Find the ball - classic shell game - by bplus - 05-13-2022, 12:58 AM



Users browsing this thread: 10 Guest(s)