Magic Eight Ball

[neil]

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 RADIUS = 200
CONST SPEED = 0.05

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

Dim shared As String answers(20)
answers(0) = "Yes"
answers(1) = "No"
answers(2) = "Maybe"
answers(3) = "Ask Again Later"
answers(4) = "Outlook not so good"
answers(5) = "Definitely"
answers(6) = "Cannot predict now"
answers(7) = "Most likely"
answers(8) = "Don't count on it"
answers(9) = "You may rely on it"
answers(10) = "Reply hazy, try again"
answers(11) = "Better not tell you now"
answers(12) = "My sources say no"
answers(13) = "As I see it, yes"
answers(14) = "Concentrate and ask again"
answers(15) = "Very doubtful"
answers(16) = "Signs point to yes"
answers(17) = "It is certain"    
answers(18) = "It is decidedly so"
answers(19) = "Without a doubt"

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
     randomAnswer = Int(Rnd * 20)
     locate 34,38: Print " "; answers(randomAnswer); " "
     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")

[neil]

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]

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]

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 Ubyte rndanswer 
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 = 4 Then Locate 37,46:Print "Ask Again":Locate 39,48:print "Later"
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

[neil]

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