## Magic Eight Ball

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Magic Eight Ball

Here's my version of a magic eight ball. Ask a yes-or-no question out loud. Then press the space bar for an answer.

Code: Select all

``````' FreeBasic Magic 8 Ball program

SCREENRES 800, 600, 32

CONST PI = 3.14159265359
CONST SPEED = 0.05

DIM SHARED AS INTEGER centerX, centerY
DIM SHARED AS DOUBLE angle, x, y
Dim As UByte cnt = 0, n = 0
Dim As String key, question
centerX = 400: x = 600
centerY = 300: y = 300

answers(4) = "Outlook not so good"
answers(8) = "Don't count on it"
answers(9) = "You may rely on it"
answers(11) = "Better not tell you now"
answers(12) = "My sources say no"
answers(13) = "As I see it, yes"
answers(16) = "Signs point to yes"
answers(18) = "It is decidedly so"

Randomize
Color rgb (0, 0, 0), rgb(255,255,255)
Cls

CIRCLE (400, 300), 230, RGB(0, 0, 0),,,,F
Locate 4,20:Print "Welcome to the Magic 8 Ball! Ask a yes or no question out loud."
Locate 6,20: Print "Then press the space bar. Its not necessary to type the question."

locate 33,38:Print "                           "
locate 34,38:Print "                           "
locate 35,38:Print "                           "

Do
key = Inkey

if key = chr(32) Then n = 1:locate 34,38:Print "                           "
if n = 1 Then cnt += 1

' pause before giving an answer
If cnt >= 100 Then
cnt = 0: n = 0
End If
ScreenLock
CIRCLE (x, y), 30, RGB(0, 0, 0),,,,F
angle = angle + SPEED

x = centerX + RADIUS * COS(angle)
y = centerY + RADIUS * SIN(angle)

CIRCLE (x, y), 30, RGB(0, 255, 0),,,,F
ScreenUnlock
SLEEP 10, 1
Loop Until (key = Chr(27)) Or (key = Chr(255) & "k")``````
Last edited by neil on Apr 19, 2024 23:16, edited 2 times in total.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Magic Eight Ball

Here's another idea I have for a shake version. This is not a complete working program; it's only an idea of how to make the ball shake and then give an answer.

Code: Select all

``````' magic eight ball shake idea

Screenres 800,600,32
Dim As Integer x, y, i, n
x = 400: y = 300
Color rgb(0, 0, 0),rgb(255,255,255)
Cls

for i = 1 to 500
ScreenLock
CIRCLE (x, y), 200, RGB(255, 255, 255),,,,F

if n = 0 Then x += 1:y -= 1
if x = 408 Then n = 1
if n = 1 Then x -= 1:y += 1
if x = 400 Then n = 0
CIRCLE (x, y), 200, RGB(0, 0, 0),,,,F
CIRCLE (x, y), 50, RGB(255, 255, 255),,,,F
ScreenUnlock
SLEEP 5, 1
next
locate 36,50:print "Yes"
sleep``````
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Magic Eight Ball

Here's another way to get the shaking effect using random

Code: Select all

``````' shaking ball demo

Dim As Integer i, x, y, distance
Screenres 800,600,32

Randomize

distance = 8  ' how far the ball moves

for i = 1 to 500
ScreenLock
Cls
x = Int(Rnd * distance) + 400
y = Int(Rnd * distance) + 300
Circle (x, y), 100, rgb(0, 255, 0),,,,F
ScreenUnlock
Sleep 5, 1
Next
locate 10,46: Print "demo ended"
Sleep``````
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Magic Eight Ball

Here's a working magic eight ball shaking version.

Code: Select all

``````' magic eight ball shaking version

ScreenRes 800, 600, 32

Dim As Integer mx, my, lb
Dim As Ulong i, j, r, x, y, Red, Green, Blue, distance
Dim As string key

function map(a as double,b as double,x as double,c as double,d as double) as double
return (d-c)*(x-a)/(b-a)+c
end function

Sub delay(ByVal amt As Single, ByVal thr As Ulong = 32)
Dim As Double t1 = Timer
Dim As Double t2 = t1 + amt / 1000
If amt > thr + 0.5 Then Sleep amt - thr, 1
Do
Loop Until Timer >= t2
End Sub

Dim As Any Ptr DrawBall = ImageCreate( 417, 417, RGB(40, 180, 200))
Dim As Any Ptr EraseBall = ImageCreate( 417, 417, RGB(40, 180, 200))

x = 208: y = 208: r = 208

FOR i  = 1 TO r
red=map(1,r,i,255,25)
green=map(1,r,i,255,25)
blue=map(1,r,i,255,25)
CIRCLE DrawBall, (x, y),i, RGB(Red, Green, Blue)
CIRCLE DrawBall, (x, y + 1),i, RGB(Red, Green, Blue)
next

' choose the circle or rectangle box for the answer
CIRCLE DrawBall, (207, 212),60, RGB(255, 255, 255),,,,F
' line DrawBall, (151,190) - (263,234), rgb(255,255,255), BF

color  rgb(255, 255, 255), rgb(40, 180, 200)
Cls

Locate 2,20:Print "Welcome to the Magic 8 Ball! Ask a yes-or-no question out loud."
Locate 4,20: Print "Then press the space bar or the mouse left-click shake button."
Locate 6, 20: Print "Press the Esc key or mouse left-click X to quit."
Randomize

' how far the ball moves when shaking
distance = 12

Do

' how long the ball shakes
for i = 1 to 100
ScreenLock
put(x, y), EraseBall, Pset

x = Int(Rnd * distance) + 188
y = Int(Rnd * distance) + 88

put(x, y),DrawBall, Pset
ScreenUnlock

Delay 30

next

' reset ball position so text stays aligned
put(x, y), EraseBall, Pset
x = 188: y = 88
put(x, y),DrawBall, Pset

rndanswer = int(rnd * 20) + 1

' text color
color rgb(0, 0, 0), rgb(255,255,255)

' pause before giving an answer
sleep 1000, 1

if rndanswer = 1 Then Locate 37,49:Print "Yes"
if rndanswer = 2 Then Locate 37,49:Print "No"
if rndanswer = 3 Then Locate 37,48:Print "Maybe"
if rndanswer = 5 Then Locate 37,45:Print "Outlook not":Locate 39,47: Print "so good"
if rndanswer = 6 Then Locate 37,46:Print "Definitely"
if rndanswer = 7 Then Locate 37,48:Print "Cannot":Locate 39,45:Print "predict now"
if rndanswer = 8 Then Locate 37,45:Print "Most likely"
if rndanswer = 9 Then Locate 37,45:Print "Don't count":Locate 39,48:Print "on it"
if rndanswer = 10 Then Locate 37,47:Print "You may":Locate 39,45:Print "rely on it"
if rndanswer = 11 Then Locate 37,45:Print "Reply hazy,":Locate 39,45:Print "try again"
if rndanswer = 12 Then Locate 37,45:Print "Better not":Locate 39,44: Print "tell you now"
if rndanswer = 13 Then Locate 37,45:Print "My sources":Locate 39,47:Print "say no"
if rndanswer = 14 Then Locate 37,45:Print "As I see it,":Locate 39,48:Print "yes"
if rndanswer = 15 Then Locate 37,45:Print "Concentrate":Locate 39,44:Print "and ask again"
if rndanswer = 16 Then Locate 37,44:Print "Very doubtful"
if rndanswer = 17 Then Locate 37,45:Print "Signs point":Locate 39,47: print "to yes"
if rndanswer = 18 Then Locate 37,44:Print "It is certain"
if rndanswer = 19 Then Locate 37,47:Print "It is":Locate 39,44:Print "decidedly so"
if rndanswer = 20 Then Locate 37,47:Print "Without":Locate 39,47:Print"a doubt"
line (750,524) - (663,570), rgb(255, 255, 0), BF

color rgb(0, 0, 0), rgb(255 ,255, 0)
Locate 69, 87: Print "Shake"

Do
key = inkey
sleep 1,1
GetMouse mx,my,,lb

if key = chr(32) or lb = 1 and mx >= 665 and mx <= 750 and my >= 526 and my <= 570 Then
line (750,524) - (663,570), rgb(40, 180, 200), BF
Exit Do
End If

If (key = Chr(27)) Or (key = Chr(255) & "k") Then
Imagedestroy DrawBall
ImageDestroy EraseBall
End
End If

Loop

Loop``````
Last edited by neil on Apr 20, 2024 4:54, edited 1 time in total.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Magic Eight Ball

I updated the magic eight-ball shaking version. Now you can use the mouse; it has a shake button.