' Challenge of the month August 2012 Free throw basketball by NaochanON MMQ961-1
' Throwed ball traced
' Click ball , move(slide) ball and release ball within blue circle
'
GUI()
GraphicsWindow.MouseDown=Onmousedown
GraphicsWindow.MouseMove=Onmousemove
GraphicsWindow.Mouseup=Onmouseup
While "true"
If move="true" Then
Shoot() ' ball is throwed
Goalcheck() ' if ball goals in or not
Goalin() ' ball goes down throgh goal net
EndIf
Program.Delay(20)
endwhile
sub Goalin
If goal="true" Then
Vx=0
newx=RX+(RW-BD)/2 ' ball falling position
Vy=Vy/3 ' ball falling speed
Gravity=Gravity*0.8
If (PY+BD/2)
For i=1 To 11
Shapes.Rotate(line[i],10) ' goal net swings
EndFor
Program.Delay(50)
EndIf
'
If (PY+BD)
staynet() ' Net return initial state
Gravity=7
EndIf
endif
EndSub
Sub staynet
For i=1 To 11
Shapes.Rotate(line[i],0) ' goal net stay
EndFor
EndSub
Sub goalcheck
If goal="false" and RX
Shapes.SetText(smsg," Goal !!!!! ")
Shapes.Animate(smsg,1000,150,1500)
goal="true"
MM=MM+1 ' count up goals
resultshow()
EndIf
endsub
Sub resultshow
result=" Click , move(slide) and release ball within blue circle. " +Text.GetCharacter(10)+ " Throwing = "+NN +" times Goal= "+MM+" times"
Shapes.SetText(sresult,result)
EndSub
Sub Shoot
dn=dn+1
Shapes.ShowShape(gball[dn]) ' trace ball
Shapes.Move(gball[dn],newx,newy)
t3=clock.ElapsedMilliseconds
newx=newx-vx*PM
newy=newy-vy +(t3-t2)*(t3-t2)*Gravity/2/1000000
Shapes.Move(BBall,newx,newy)
GraphicsWindow.Title="Now Ball X= "+math.Floor(newx)+ " Y= "+math.Floor(newy)+" Vx = "+math.Floor(Vx) + " Vy = "+math.Floor(Vy)
If (RX-PW
PM=-1
EndIf
If GH-BD-20
move="false"
newx=0
newy=0
Shapes.Animate(BBall,x0,y0,4000) ' ball backs initial position
Program.Delay(4000)
Shapes.Move(smsg,-100,-50) ' hide goal message
GraphicsWindow.Title="Now Ball is "+X0+ " : "+Y0
For i=1 To dn
Shapes.HideShape(gball[i])
EndFor
dn=0
EndIf
EndSub
Sub onmousedown
gx= GraphicsWindow.MouseX
gy= GraphicsWindow.MouseY
If math.Abs(gx-x0)<50 And math.Abs(gy-y0)<50 Then
NN=NN+1
PM=1
catch="true"
goal="false"
Gravity=9.8
t1=clock.ElapsedMilliseconds ' ball caught time
resultshow() ' result
staynet() ' Net return initial state
EndIf
endsub
Sub onmousemove
If catch="true" Then
gx1= GraphicsWindow.MouseX
gy1= GraphicsWindow.MouseY
Shapes.Move(BBall,gx1,gy1)
r=Math.SquareRoot((gx1-x0)*(gx1-x0)+ (gy1-y0)*(gy1-y0)) ' distance from initial position
If r>410 Then
onmouseup() ' forced throwing
endif
EndIf
endsub
Sub onmouseup
If catch="true" Then
gx2= GraphicsWindow.MouseX
gy2= GraphicsWindow.MouseY
t2=clock.ElapsedMilliseconds ' Ball release time
catch="false"
Vx=(gx-gx2)/(t2-t1)*10 ' Ball speed X
Vy=(gy-gy2)/(t2-t1)*10 ' Ball speed Y
newx=shapes.GetLeft(BBall)
newy=shapes.Gettop(BBall)
Move="true"
EndIf
endsub
Sub GUI
GraphicsWindow.Show()
GraphicsWindow.Hide()
GraphicsWindow.Top=20
GraphicsWindow.Left=20
'---------------- initial value ----------------------
GW=1200
GH=650
GraphicsWindow.BackgroundColor="Darkgreen"
GraphicsWindow.Width=GW
GraphicsWindow.Height=GH
GraphicsWindow.BrushColor="Lightcyan"
GraphicsWindow.PenColor="Navy"
GraphicsWindow.PenWidth=3
circle= Shapes.AddEllipse(800,800) ' throwing circle
Shapes.Move(circle,GW-400,GH-400)
'---------------- basketball ----------------------
BD=50
GraphicsWindow.BrushColor="lightgray"
GraphicsWindow.penColor="gray"
For i=1 To 300
gball[i]=Shapes.AddEllipse(BD,BD) ' trace ball
Shapes.Move(gball[i],1200,900)
Shapes.HideShape(gball[i])
endfor
GraphicsWindow.BrushColor="Brown"
GraphicsWindow.PenColor="Coral"
X0=GW-BD
Y0=GH-BD
BBall= Shapes.AddEllipse(BD,BD)
Shapes.Move(BBall,X0,Y0)
'---------------- Message ----------------------
GraphicsWindow.BrushColor="Yellow"
GraphicsWindow.FontSize=25
GraphicsWindow.FontItalic="True"
smsg=shapes.AddText(" ")
Shapes.Move(smsg,-100,-50)
result=" Click , move(slide) and release ball within blue circle. " +Text.GetCharacter(10)+ " Throwing = "+NN +" times Goal= "+MM+" times"
sresult=shapes.AddText(result)
Shapes.Move(sresult,200,10)
'---------------- Goal Net ----------------------
GraphicsWindow.BrushColor="Yellow"
PW=20 ' Panel Width
PH=200 ' Panel Height
PY=200 ' Panel position Y
RX=90 ' Ring position X
RW=110 ' Ring width
panel=shapes.AddRectangle(PW,PH)
GraphicsWindow.BrushColor="Darkgreen"
Ring=shapes.AddRectangle(RW,10)
GraphicsWindow.PenColor="lightcyan"
For i=1 To 11
line[i]=Shapes.AddLine(0+10*i,0,30+5*i,100) ' Net
EndFor
setgoal()
GraphicsWindow.Show()
'--------------------------------------
catch="false"
NN=0
MM=0
EndSub
Sub setgoal
Shapes.Move(panel,RX-PW,PY-PH/2)
Shapes.Move(ring,RX,PY)
For i=1 To 11
Shapes.Move(line[i],RX,PY)
EndFor
endsub
Program Listing: MMQ961-1