05-11-2022, 01:38 AM (This post was last modified: 07-15-2023, 02:21 AM by Dav.)
Hey @bplus, I had a little time to code today (very little) and added a 'shadow' when the cups raise off the table. Small addition but believe it adds a lot visually. First I thought to use the filled eclipse routine you posted on the old forum for a shadow, but realized RotoZoom3 can do it as image x & y can be scaled. Used a copy of the ball image since it is round, and used _SETALPHA. Worked out pretty well for a shadow I think.
- Dav
Code: (Select All)
_TITLE "Shell Game $5" 'b+ mod 2022-05-09
'Dav added shadow on 2022-05-10
'============
'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
ball& = BASIMAGE2& 'decode ball image to use
shadow& = _COPYIMAGE(ball&) 'use ball shape for shadow
_SETALPHA 35, 1 TO -1, shadow& 'set alpha for shadow&
speed = 75 'speed for _LIMIT
moves = 15 'how many shuffle moves to do
COLOR &HFF000000
_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, 100), BF
winnings = winnings - 5
_DISPLAY
_DELAY 1
ELSE
'flash green - selected right
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 255, 0, 100), 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, 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 '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, 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 '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, 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
_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, 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, 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, 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
@Dav luv the shadow! but after a couple of turns I noticed a pale square around the dark ellipise:
I have a fix for it, I left both sets of shadow& makers for you to compare, plus ever time a cup is raised, it is in sleep mode, so you can look at screen at different angles.
Code: (Select All)
_Title "Shell Game $5" 'b+ mod 2022-05-09
'Dav added shadow on 2022-05-10
'B+ 2022-05-10 added alternate shadow maker, to test also raised cups are put in sleep mode
'============
'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.
speed = 75 'speed for _LIMIT
moves = 15 'how many shuffle moves to do
Color &HFF000000
_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, 100), BF
winnings = winnings - 5
_Display
_Delay 1
Else
'flash green - selected right
Line (0, 0)-(_Width, _Height), _RGBA(0, 255, 0, 100), 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, 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, 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, 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, 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, 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, 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
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
05-11-2022, 05:01 AM (This post was last modified: 05-11-2022, 01:50 PM by bplus.)
Lots of choices! Here the drawn ball makes sense with shadow, I think.
Code: (Select All)
_Title "Shell Game $5" 'b+ mod 2022-05-09
'Dav added shadow on 2022-05-10
'============
'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.
speed = 75 'speed for _LIMIT
moves = 15 'how many shuffle moves to do
Color &HFF000000
_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, 100), BF
winnings = winnings - 5
_Display
_Delay 1
Else
'flash green - selected right
Line (0, 0)-(_Width, _Height), _RGBA(0, 255, 0, 100), 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
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
05-11-2022, 03:27 PM (This post was last modified: 07-15-2023, 02:20 AM by Dav.)
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.
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
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
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
Yeah. The first one was more realistic, but the image had white edges. Couldn’t remove it easily so I just drew a cup to match it with black edges. Not satisfied with it either. I’ll work on a better one, and try to come up with some sounds.
05-12-2022, 11:27 PM (This post was last modified: 07-15-2023, 02:19 AM by Dav.)
Hey @bplus! I had a cancelled gig today and found some time to improve this game. I went back to the original cup, removed its white outline (just inverted the image colors which turned the white edge to black, then colorized the image to blue again). I also added larger text using PPRINT. Also, the cups now drop down onto the board and lift away between turns. Also added some sound effects (cheap ones, but some sound at least).
- 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.
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
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
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"
_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
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