06-01-2024, 11:59 AM
Here's a little game @bplus helped me greatly to put together soon after this forum started. Classic find the ball under the cup/shell game. The cups shuffle around and you click where you think the ball is.
Thanks bplus!
- Dav
Thanks bplus!
- Dav
Code: (Select All)
_Title "Shell Game $5" 'b+ mod 2022-05-09
'mod by Dav 2022-05-12, back to old cup, cups drop & lift for new turns, added sounds.
'============
'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
Dim winnings As Long
Do
_PutImage , back&, 0
PPRINT 20, 10, 20, _RGB(255, 255, 255), 0, "Winnings: $" + LTrim$(Str$(winnings))
PPRINT 204, 124, 50, _RGB(32, 32, 32), 0, "Find the ball" 'shadow
PPRINT 200, 120, 50, _RGB(0, 128, 255), 0, "Find the ball"
PPRINT 260, 220, 16, _RGB(255, 255, 255), 0, "Press ENTER to Pay $5 and try!"
PPRINT 300, 245, 16, _RGB(255, 255, 255), 0, "(any other key quits)"
_KeyClear
Color 0, 0: Input "", yes$: If Len(yes$) Then End
GoSub DropCups
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
'shuffle sound
Play "mb l64 t255 o1 c,d o2 b,d+"
Next
GoSub PlaceCups 'make sure they are placed right
PPRINT 250, 30, 30, _RGB(255, 255, 0), 0, "Where's the ball?": _Display
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
'wrong - play failed sound
Play "mb l16 c,f f,b c,f f,b c,f"
_PutImage (0, 0), back&
GoSub PlaceCups
PPRINT 360, 30, 30, _RGB(255, 0, 0), 0, "WRONG CUP!": _Display
'flash red - wrong one
Line (0, 0)-(_Width, _Height), _RGBA(255, 0, 0, 64), BF
winnings = winnings - 5
_Display
_Delay 1
Else
'right! - play fanfare
Play "mb l8 o3e,g,o4c o3g,o4c,e c,e,g e,g,o5c"
_PutImage (0, 0), back&
GoSub PlaceCups
PPRINT 360, 30, 30, _RGB(0, 255, 0), 0, "CORRECT!": _Display
'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
GoSub LiftCups
_Delay .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
'=====
'===================================================================
DropCups: 'drops cups down at start of turn
'=======
'drop down sound....
Play "mb l64 o4 bagfedc o3 bagfedc"
_PutImage (0, 0), back&
For y = -200 To 300 Step 10
_PutImage (0, 0), back&
RotoZoom3 500, y, cup&, 1, 1, 0
RotoZoom3 800, y, cup&, 1, 1, 0
RotoZoom3 200, y, cup&, 1, 1, 0
_Display
_Limit 90
Next
'add thud at end for cups landing...
Play "mb l64 t255 o1 a,b c,d a,b c,d a,b"
Return
'===================================================================
LiftCups:
'=======
Play "mb l64 t200 o3 cdefgab o4 cdefgab"
_PutImage (0, 0), back&
For y = 300 To -200 Step -10
_PutImage (0, 0), back&
RotoZoom3 500, y, cup&, 1, 1, 0
RotoZoom3 800, y, cup&, 1, 1, 0
RotoZoom3 200, y, cup&, 1, 1, 0
_Display
_Limit 90
Next
Return
'===================================================================
ShowBall: 'Raises cup to show ball
'=======
'make sure showing all cups first
GoSub PlaceCups
_Display: _Delay 1
'play raising sound...
Play "mb l16 o1cdefg"
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.25 'pause to see ball
'lowering sound
Play "mb l32 o1 bagfedc"
'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$ + "haIkM6[[UTC40MR8NRPO0T8K5BTSFQ4a4RfT=Ko08VT=PO1T85nCh_PoV1JF"
A$ = A$ + "<C=NZb]MKk^:KO#j8N;\gkkNMGWGif^LeOjCOj3O2fBn?oW?=:lnk20ARklU"
A$ = A$ + "?>HnEo\nNmhg`ZC]iZ\lWLnMoLKnSoBKnnOmh8omFnI#kc<>=45Zek\l[JMT"
A$ = A$ + "OlKo9n[Og_8\Tn<JihiOoelikLK__N3aUJb5VWg;g1KecnWoi_I;XE_F;O]F"
A$ = A$ + "NJb;3i^YFNA]LQULakRWoGomOH;IFn\E>J]LaN7;1Sg9U^Y<7Ib;el`Ce1m`"
A$ = A$ + "W[aYU>LYL`N7g1]iVJi;ccCJiUN7OObDS;;c3;coVWgekhA`f=Ui;]LB]lUN"
A$ = A$ + "7O2?cQebkNA:_;cG>6nI]cU5WL?YVl^bi;CnFOlCLCh>ge:O;>[On9N9XQVk"
A$ = A$ + "VlflL]N7[_Z8MDimMZUkdkh1H=h>WUl\]kXbLXblW<_FH4Xi\YkYUL\?cA9o"
A$ = A$ + "9<CTnjOkgoeg;[g>Ad#K^^hX`KAN>fod_1OebCU>ZL^^NO=4>7Tnjoh?lUiG"
A$ = A$ + "mfAR0JiB9?:h5ic7njnGC[gTg^BDlDbU2A1I^edLQ?IG5?5R:BGm_lKaEo`o"
A$ = A$ + "K]NIN_#d#jZYi1OZgcJ:WjeH`eH1iDQX#nj;MAbE?aL[YLZGg;0iDQXA^[N5"
A$ = A$ + "WNb^jem0P[2A4iJ1WLeCM]PoX`E_6;`EQ8QFNeCMmUbMElE8BHiZWhj;9Me["
A$ = A$ + "eF2O5R2iNjEl9^jGkZL6J0_8_NPaE;kZ9OUeK2NCbkM4bhALe_dEUHUS5_56"
A$ = A$ + "9Jm92YO:1Gm;c[Ji\bkS5W5jUlHYlLXiaPhZjc1>O\:??;iJ[?6Ta6kaVlij"
A$ = A$ + "F:^3G]NG]FWMgR=[mkUfh#;S;W`hG;>:^Jo^ZelS_kIGQga<S86k]akaPA>V"
A$ = A$ + "Y]FA]4SQ[fW[Zi\gUc=jaQNkWkbHUfJifC\5^ZmNfdjHZUgFKNg84gnFONfQ"
A$ = A$ + "_ggUgLdaBhZSgE_cK_kiOJ]iU7I\]G^C4oNYUG\V[ISb?aEmaE7aeXkRC6A>"
A$ = A$ + "QCSFL_X47P[6CG]UldBONDiTg5d6G6mlDaEaECLeWM6Q?KE?7S>gD;ciODOF"
A$ = A$ + "^kkl<7_aEaE7ieiAAYlBJSMSnm]ElnJ0^jlME__6]2Nk>oi:BP[nClQ3aE7U"
A$ = A$ + "SLJOVR0J^j9fG8>EGMdaAhHcO<njWaEaEk962OmM6W_nILELeNRQ`EOWai[O"
A$ = A$ + "nDMEic6SdjdC<dcRS`CWoHle?WN>ILJm8HIOl>?^ck[?[8hWcOLmjOndNNaU"
A$ = A$ + "o\aPH:8ZT7KNJiFCgWZli2GZFL`GQ8QFNTCYok;cYZEWKhZ#=lFciGkmm:7c"
A$ = A$ + "9TKejIhXF]UjMl04CNkeDCkmi4b]JmlVBKN`h[P6_Y[:O]bhcCHoK^cE[iLK"
A$ = A$ + "P73iNd<R;T_Wi[[RLN`NkDc2iNZVnKE?eEaKQAaMaGicmkje\c?kTc[o1]aQ"
A$ = A$ + "WjZh]#?D[WVR?_N=WP[J]_Ze2cE6jUFRc`EkgEOJNH_SC0OM`NLDI<d9kZ]>"
A$ = A$ + "FgCO51GN]I4>I[n9^Z]O<kaKlhHcXmaJoklef3Y>AGMdGcN3W57>V>iMG[ke"
A$ = A$ + "AaEWgehgbEaYO?O\7W[geUlTLE]c1G4S5jmJlYijcL<?=^?RnOJ_Scboogij"
A$ = A$ + "<LV^jK6g41Wm]MhInI_F7LfSo]<>L2^Z7m\UI4GmF_^MVg:7iCmbJLeM]VPS"
A$ = A$ + "DoEbkhB_mT8`:^>mWR[^Bm^kE:nLEmZ8kT]hZkHmk_B^jKk`A5?W?PgG[?EG"
A$ = A$ + "m4jKQNkEcdE?=W\6GMGkmBbmFEN6KF][Ehck];fbe_[hhML?FCkGcYkZkX_k"
A$ = A$ + "mhQGSm9GMgfg6Y[:o>kmHo>1nhk>>OmckZ[^j[[40G8SMgam]I7F3H0^#cEg"
A$ = A$ + "Ye26G5f5fIGeZ?;Q[2[8i[_d>]_=\O=`>a>__=]f?808bT7oR[2#<1G5PePM"
A$ = A$ + "gEiiR<\;T7o^CWiLY[Bm`0[>ia`kV[VfKELEHeAcEgUJGj36k]:^:\RT73Wf"
A$ = A$ + "SELE0R5hZ0\6P[2`J0^:0[1k\[JEgnhZ`:RU[^jWe6>S=`>b>NFK`EQMTMgE"
A$ = A$ + "co>jmh=0?UlhhMbEY^mQMRM\nm]jOQhZ`:SV[^je4<Wa6H7I7?[=FmJDLEHU"
A$ = A$ + "AcEGmmHeZo5R[2[<F^j:_7[hZ`>b^iZbm[9o\[jmH=0mRfIHMEG;HZ32HWIW"
A$ = A$ + "Z72j;``>C^[^bka:^:\c\[^Jng=_7W1XGfYJG2G5fIf=GUJF2fEfYJGbbEmN"
A$ = A$ + "<6PAa>jZTC5fAbgSeEfEY>8PM6]jQ0G5Ph1^:0[1hZ0\6\K^:e\4\[XEC`[X"
A$ = A$ + "[BMk3k>Fe__g^G[iDYVUPMWMXfU`EQCPMaEYVUPCPE_fU\j9JN?^2`XIekAJ"
A$ = A$ + "FmI9_7G1Hd\jmM9LEhD0G5PePEfEYWX1W4[L?BSn\4LB\bmM9NNC1W4JkajZ"
A$ = A$ + "\_=dkFPCRE^G^He?8`EQMTlHlEcEe>;LhZ`>RV[^:e31^:LB\3^JnJ0S[2k8"
A$ = A$ + "iah[diH=iZohgR[2k?iahGamhZ04?f1GEkkQgS[0<JdRaG5GmShZ`1QU[^2e"
A$ = A$ + "4<m32hd`Zo#h];NglOaEQCSE\G^P[2W8hZ0\6P[2`J`ZjZLNhPCSElLaaiQ3"
A$ = A$ + ">AFac5WE_65G5fIdLeXG?4Fm4=LEHWabESlN\R[2W8hZ0\6\J^Z\GSbi<7>9"
A$ = A$ + "\>_iAMOK:eGPaEQM6[cKNdME]n2<^:\cXiZA^N8:E74hZ`>SF\NT[72Z32hT"
A$ = A$ + "IUZ72LEhT1G5PePEcEI_EQCUEZ>3Y7N3W<Fka:^:0a2LE0F3FAGUjP0>A\ZM"
A$ = A$ + "Y8jZFeGXgSQ0lFHEWQNkViiDY?;1W>Je^DdZc#LE0`E1HEHELEjOQ`Yc:Don"
A$ = A$ + "hZ0\>^:eG8Lj\2eI8mI90\Me8]_=F^ZgSM0lf4IG]DOFbka=0NK\Z7R8<?hB"
A$ = A$ + "mI9_7g0h]9bmM9F3H0n<AN]PaE1hc\2^:[1<0a^G^HiZN?V1PG4IGUm[1P?C"
A$ = A$ + "D[72[n1QgSG0h5A]o#He?8lNl20_8Zm7RDM#ToIdka;0lRL?8:e^4WKE0nB\"
A$ = A$ + ">7[N?oGLE0nBRhI>GjZdk21hW8g5`E18VP[2`J0^:0[1AgEco<jmh50NAdGK"
A$ = A$ + "9]?S0LR4EGUc370O9AlLaaiQ3P_V8N^hXo52`GSV[jMM6:MEF7H0n9bM1LE0"
A$ = A$ + "R9AgEco<jmh50NAdV3\\_0CNE0n<Ub[jaj;EZ_0S[2W<i^Pgm9HiN[R[2`Wa"
A$ = A$ + "bEmJOK:E74hZ`9SV;41GEKMU`EQC6=G`cjQPWiZ0HSeJ1S[2#\8Z^:co5P_4"
A$ = A$ + "[m]1G5PHATLE[W?bhZ0X__=NDkBllA6Pk92e31m320^W8dO8`E1hN`E1H=0G"
A$ = A$ + "5Pe0LE0F3RR[B?A3Pb4QJ26G5Pk92^:m^50^7[J2n=[72[NgRgS=04=\jU;h"
A$ = A$ + "Z04;ldEUm4=Z_#0:SE=1o6gcJYn\TgS;04=dZ9hgJmUhi=50eSWmM9LE0ZW8"
A$ = A$ + "hZ\O=0L?N^7[dWU0XNl\_;IiZN?V0#Da;GUm[1Pf`SNi2W_60J7?>_=hZ0d>"
A$ = A$ + "hZ0\6P[2`J0^:0[1NjZ\gZ0D?JkajKjZbOohZ0HC^[lF^JZn2aE1X>dLeIGW"
A$ = A$ + "QhZ0d>NiZl\Q3Pf#cEWMM6R[2#khQ[JeWU`E1`6;GMVe4<^:0]3^:0[1_][:"
A$ = A$ + "kOQhZ0D?ULeIL?[hZ0l<ldEc?WihZ0HC^[<kn4LYn2<^:0fXiZc\O6FZGSR["
A$ = A$ + "2P=J^b\ME[nG8^:0fXi:c\N8:mLL4G50K:iZcHOKhI^:0?WgbEI=P1X?N[e2"
A$ = A$ + "6G5Pnh]MEf_60N6FkKc<ME]O_N?>0#daJOK`E18FP[2`J`KkZDcn0lLdZQoI"
A$ = A$ + "hZdCd0X?dLeAGWQhZ0d?hZ0\6lF^:WaL0j3=GMde_?^:0mcKhZdkF0XO\LeA"
A$ = A$ + "FonD;`0d?UZ9hA=oGLE0jWIGonDcB0<6VM];AOF2PaPU[>Zm]Qn\40S1=gIT"
A$ = A$ + "[5<mI9063ULeA\nBdWU0HLlF^:iD1X?VeN\bne0`HIFkK3mI906;J^j8fg6f"
A$ = A$ + "KE06;cJ?FaE1H\<CG=M^E]nm00D?FkKC_e3AYcH>^:0]SV7=:GeJoJ`E1XM\"
A$ = A$ + "LeN[MY?DHoJ`E1XMdlXdnfP[2#LHf^Ze_3_oN3`ZQU7Q[2#\HF^j7aE1HXDb"
A$ = A$ + "EkYVPaE1H\<3Gm^JF2G5PfabSjYfU`E1HlP[2`J0^:0[1cbE;EgnhZ0d>FND"
A$ = A$ + "?e4lMm_#LE0JWB^jCgSekjOQhZ0d>giZ?IOK:eCd`E1hIHiBhZ04;l`Emnk<"
A$ = A$ + "0[:SdE_[o5R[2`cAcWNJo<l^WgDhZ0lL:]7[]^_=llV2Pib8fg6ZG90V?mFo"
A$ = A$ + "BbW96\n_0<?ZImP;i[geg2aG1XO^c]^K^`e<gGlE0jSJmZBc5FK^_ocolglO"
A$ = A$ + "1G5PaPU;UkJFkgZL?J^ngk_nMoRoo[]T[R_2#mDbSdl=]m`9_?0;OMhZ0<6J"
A$ = A$ + "eEe^_EimYVWC5G5Pa#]^Jbi^N=YkK=O=UdN=giZh[0L?gi#F>WL=VTmo1]LZ"
A$ = A$ + "hZ0d??aE_NMhZ0l^dS[VFOYdNelmoJKGmjoMlE0N6gi>F[]de[E^g=ik[ZV["
A$ = A$ + "B^E0N>hZ0\6ldeEB^_=]hZ\g=0l<JaC;iZJe[_lem_nko#EnZgS704EJaC]V"
A$ = A$ + "3\LMPCk_ZfkQdG9g:0eC[iDcMelm\9oleDbEiNG1hNJmND[aE]>gZi^J[n:>"
A$ = A$ + ";LRdjJnFcmZVGknJm2=lE0ZWAjYG_OFm:]BWOeW^f`h^`>C;am]j#UjG`Fm5"
A$ = A$ + "2lE0nJVUSJMOZFm5H]n]dKj[hdPGdBliCMdklUJNn>Vg73coLeC>fF7[`E1?"
A$ = A$ + "XVh_IT;=mk[fnHhXleNMflom`KQIB;aKc:GjekM;NjXmeAWW5W569]6K=SLY"
A$ = A$ + "mhYJnjeminSOkmOndfGWAj\mLM0GO?XVkE\eg_WnkM4[kJjI>eCmDY_:gkeJ"
A$ = A$ + "caFbICOn]>C\cjj7^jjC;GWWMLE_>jekoU?9g3eWjY]<WhFca:YdiHO6Ggl>"
A$ = A$ + "N3N>mhZ]43dSSn6ci]ei4gkmaFbK[Y?Dlfo=FH?ldWPEoBiY[Od8VcK;c9>U"
A$ = A$ + "SmJnf]h\eV_=i^c`Km>^3RY[:cEldl=FaKGNB:Gj8WcK]iHC>KjiON;>[dK7"
A$ = A$ + "alUaGGKFQLV]jY97=U7mbGVI^dkbanaKbcFcgaLW]Fg]T7Rc^6<ci<Im_cXL"
A$ = A$ + "C[HaTS:cS:?3Z_YWNWcJUWm^o6VUcFcj:C^eeSg8WYL^Hcd?_;?ZW>J]>K]["
A$ = A$ + "KL=>L=cAFb\mdAW78J<3oYfgoNnLU^n?SlWF>ZL=SRZSJi]bn^FJnaFNk\6G"
A$ = A$ + "Ojn1iENPgfamnk`8Megd=UnIJN^bN=HdmcFceZ=7i;N[ajMQMb?]L#]i;mfi"
A$ = A$ + ">CSeYk3M5cQfZc:mF[i9;c7fcmKdB\#?aCSn_OX53nTWm1cbO6igG]kIIfNX"
A$ = A$ + "5Jk_OnlKUni>iXUlfli9WLF[i9K5[<Rh]g:NMFaGJaiFiUlncKTXdOc;5;:["
A$ = A$ + "K1YK^[niCcgV?OI?V3WgaC`Hl_lLiB_D>_fC<oI?iKeFK:INg[clcKM_Hc8N"
A$ = A$ + "j^mVZElhgY7O76QWN5WL5oTWgd:g9nIK^KYl^icMNd>K?^hZi;AcC;]F2e^W"
A$ = A$ + "Lii<_;_9^iHMGYoVWkeJNc?IMAGQLZeTCbKGl9i?;iOFG3U^YE>CbKj_oNG^"
A$ = A$ + "GIng4]LO`c`KQjmCY3:9oJ<i<G3:Uk=iaBG>onPUg;L=[=QfNoiiJ]6]onRe"
A$ = A$ + "hCYJ;Cc=cm`T;:mAbI^7TOm;??\VoVW;njinNjo>mcYLcGdRS;oW7US?[i3D"
A$ = A$ + "b]ZiN6_6GB87;USWFg?YUGZMmdkH<`?7f2=g^DNJY?_beBTeWmdg=]iVJ=6I"
A$ = A$ + "UCl^LThTP5Ja:e>?K=O>oN[d8?V?U3:?On8h^gkJnlJiQe<oDLA`;JaYK1Il"
A$ = A$ + "o\XW?OhN`^A=iEF=lN<mThO3=4K5%%%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
Sub PPRINT (x, y, size, clr&, trans&, text$)
orig& = _Dest
bit = 32: If _PixelSize(0) = 1 Then bit = 256
For t = 0 To Len(text$) - 1
pprintimg& = _NewImage(16, 16, bit)
_Dest pprintimg&
Cls , trans&: Color clr&
Print Mid$(text$, t + 1, 1);
_ClearColor _RGB(0, 0, 0), pprintimg&
_Dest orig&
x1 = x + (t * size): x2 = x1 + size
y1 = y: y2 = y + size
_PutImage (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&
_FreeImage pprintimg&
Next
END SUB