'Duck Shoot - local Version 1.0 August 2013 http://smallbasic.com/program/?XCC705-1
'This version is Modified to run with ide closed or open.
'****************************BUG , fixed************************************
'exe BUG, spear speed which runs in a Timer thread runs reliably only when the SB ide is open
'but when i run the exe the spear animation slows right down.
spearSpeed = 1.8'8 '1.8 is good when ide is open. If this is too high collision test doesn't work
'optimise the thread by delay / 2
delay = 2'1 '0.5 is like critical limit . 2 for ide
'NB i put a speed test in Fire() It tests a condition if the ide is running
''***********************************************************************
mainTrack = "http://www.televisiontunes.com/download.php?f=Benny_Hill_Show"
quack = "http://soundbible.com/grab.php?id=197&type=mp3"
tree = ImageList.LoadImage("http://www.krishadlock.com/clients/informit/dwc/transparent_png/img/tree1.png")
Shapes.SetText(openningMessage, "Press Enter to Start")
While start <> "Yes"
EndWhile
Shapes.Remove(openningMessage)
'--------------------------------------------------Main Program Data---------------------------------------------------------------
Sub PlayMusic 'thread issue
Timer.Pause()
Timer.Tick = OnTick 'animate spear & check collision
While "True"
Sound.PlayAndWait(mainTrack)
EndWhile
EndSub
'-----------------------------------------------Event Response---------------------------------------
Sub OnButtonClicked
If Controls.GetButtonCaption(Controls.LastClickedButton) = "Play Again" Then
flagClick = "Play Again"
EndIf
EndSub
Sub OnMouseMove
UpdateScopePosition()
MoveScope()
EndSub
Sub OnKeyDown
If GraphicsWindow.LastKey = "Space" And flagFire = 1 Then
Timer.Resume()
flagFire = 0
ElseIf Text.ConvertToUpperCase(GraphicsWindow.LastKey) = "P" Then
pause = -pause
If pause > 0 Then 'continue from New startTime
startTime = Clock.ElapsedMilliseconds
EndIf
ElseIf GraphicsWindow.LastKey = "Return" Then
start = "Yes"
EndIf
EndSub
Sub OnTick
Timer.Pause()
Fire()
flagFire = 1
EndSub
'============================Main Program=======================
Mouse.HideCursor()
DrawGraphics()
CreateSpear()
CreateDuckMessages()
AddDuck()
zOrderTree() 'could've been an issue with the way wings are Animated
GraphicsWindow.Show()
GetMouseCentre() 'get after GW.show
CreateScopeShapes()
OnMouseMove()
ShowScope()
startTime = Clock.ElapsedMilliseconds
'=======================Main Loop / Event Loop ANIMATE DUCK======================
While "True"
If flag = "Game Over" Then
IndexHighScores()
GraphicsWindow.BrushColor = "black"
playAgainButton = Controls.AddButton("Play Again", gw/2-25, gh/2) 'WIP
Mouse.ShowCursor()
While flag = "Game Over"
If flagClick = "Play Again" Then
flagClick = 0
flag = "Break Loop"
ResetTimeAndScore()
SetAltitude()
FlightSpeed()
ResetDuck()
EndIf
EndWhile
Else
UpdateTime()
EndIf
While pause < 0 'negative = Pause On
EndWhile
If TY[3]+dTY > 28 Or TY[3]+dTY < -10 Then
flapSpeed = -flapSpeed
EndIf
dTY = dTY + flapSpeed
dX = dX + duckSpeed
Shapes.Remove(frontWing) 'animate WING by redraw
If TY[3]+dTY > 0 Then
GraphicsWindow.BrushColor = "Maroon"
Else
GraphicsWindow.BrushColor = "DarkGoldenrod"
EndIf
frontWing = Shapes.AddTriangle(TX[1]+dx,TY[1]+oT,TX[2]+dx,TY[2]+oT,TX[3]+dx,TY[3]+dTY+oT)
Shapes.Remove(rearWing)
If TY[3]+dTY < 0 Then
dRTY = dRTY + flapSpeed/2
GraphicsWindow.BrushColor = "Maroon"
rearWing = Shapes.AddTriangle(TX[4]+dx,TY[4]+oT,TX[5]+dx,TY[5]+oT,TX[6]+dx,TY[6]+dRTY+oT)
Else
dRTY = 0 'reset rearWing displacement
EndIf
For i = 1 To 5
Shapes.Move(duckShape[i], DS[i]["X"]+dX, DS[i]["Y"]+oT)
EndFor
If DS[4]["X"] + dX > gw Then 'If tail is off screen right
dX = -DS[2]["X"] - DS[2]["W"]
dTY = 0 'BUG fixer??
SetAltitude()
FlightSpeed()
ElseIf flagCollision = 1 Then
Sound.Play(quack)
DeadDuck()
UpdateScore()
HideDeadDuck()
SetAltitude()
ResetDuck()
ResetSpear()
FlightSpeed()
Sound.Stop(quack)
flagCollision = 0
EndIf
Program.Delay(10) '10
EndWhile
'-------------------------------------------Duck Subroutines----------------------------------------------------------
Sub DuckData 'DUCK - DATA TABLE
' Table key: W = width; H = height; X = X rel to the body; Y = Y rel to body; R = rotate angle"
DS[1] = "W=28;H=8;X=62;Y=2;R=-10;BC=DarkGoldenrod" 'NECK
DS[2] = "W=22;H=6;X=89;Y=0;R=0;BC=Maroon" 'BEAK
DS[3] = "W=20;H=18;X=82;Y=-8;R=0;BC=Purple" 'HEAD y=-5
DS[4] = "W=65;H=12;X=0;Y=4;R=5;BC=Sienna" 'TAIL
DS[5] = "W=60;H=25;X=12;Y=0;R=0;BC=Sienna" 'BODY
TX = "1=40;2=57;3=44;4=34;5=42;6=37" 'FRONT WING X
TY = "1=8;2=8;3=28;4=0;5=0;6=0" 'FRONT WING Y . Y[3] animated by add/remove
Speed = "1=1;2=1.4;3=1.6;4=1.8"
Altitude = "1=200;2=130;3=280;4=100;5=230"
EndSub
Sub SetAltitude
If a < 5 Then
a = a + 1
Else
a = 1
EndIf
oT = Altitude[a]
EndSub
Sub AddDuck 'ADD DUCK w/o WINGS
dX = -DS[2]["X"] - DS[2]["W"] 'position off Left
For i = 1 To 5
GraphicsWindow.BrushColor = DS[i]["BC"]
duckShape[i] = Shapes.AddEllipse(DS[i]["W"], DS[i]["H"])
Shapes.HideShape(duckShape[i]) 'reduce 0,0 flash
Shapes.Rotate(duckShape[i], DS[i]["R"])
Shapes.Move(duckShape[i], DS[i]["X"]+dx, DS[i]["Y"]+oT)
Shapes.ShowShape(duckShape[i])
EndFor
EndSub
Sub ResetDuck
dTY = 0 'BUG fixer??
dX = -DS[2]["X"] - DS[2]["W"]
For i = 1 To 5
Shapes.Move(duckShape[i], DS[i]["X"]+dX, DS[i]["Y"]+oT)
Shapes.ShowShape(duckShape[i])
EndFor
EndSub
Sub FlightSpeed
k = k + 1
If k > 4 Then
k = 1
EndIf
flapSpeed = Speed[k] * 2.5
duckSpeed = Speed[k] * 5
EndSub
Sub Fire
xS = gw / 2
yS = gh
xT = scopeX + 8
yT = scopeY
rise = yS - yT
run = xT - xS
slope = run / rise 'inverted
angle = slope * 45
Shapes.Rotate(spear, angle)
While yS > - 35 And xS > -35 And xS < gw +35 And flagCollision = 0 'animate Spear till Spear off screen
yS = yS - spearSpeed ' 2.0 ' constant = spear speed
xS = xS + spearSpeed * slope '2.0
Shapes.Move(spear, xS, yS) 'TODO adjust speed for angle
If DS[5]["Y"]+oT > yS And DS[3]["Y"]+oT < yS And DS[5]["X"]+dX < xS And DS[3]["X"]+20 + dX > xS Then
flagCollision = 1
If xS > DS[3]["X"]+dX Then
Shapes.SetText(headShot, "Head Shot!! Bonus 50")
flagHeadShot = 1
EndIf
EndIf
If speedTest > 5 Then 'sb ide is closed
spearSpeed = 8
delay = 1
Else 'sb ide is running
spearSpeed = 1.8
delay = 2
EndIf
EndWhile
EndSub
Sub DeadDuck
get_xS = xS 'need to get so xS, yS is not shared
get_yS = yS
got_xS = get_xS 'don't need to store in got unless used in another event as well
got_yS = get_yS
Shapes.SetText(ducksMessage, "Ouch! Quack Quack")
While oT < gh - 40 'And flag <> "Game Over"
If flag <> "Game Over" Then
UpdateTime()
EndIf
While pause = -1
EndWhile
oT = oT + 3
got_yS = got_yS + 3 'yS is being shared on SPACE down so use oT
Shapes.Move(spear, got_xS, got_yS)
Shapes.Move(ducksMessage, got_xS, got_yS-25)
For i = 1 To 5
Shapes.Move(duckShape[i], DS[i]["X"]+dX, DS[i]["Y"]+oT)
EndFor
Shapes.Remove(frontWing)
frontWing = Shapes.AddTriangle(TX[1]+dx,TY[1]+oT,TX[2]+dx,TY[2]+oT,TX[3]+dx,TY[3]+dTY+oT)
Shapes.Remove(rearWing)
rearWing = Shapes.AddTriangle(TX[4]+dx,TY[4]+oT,TX[5]+dx,TY[5]+oT,TX[6]+dx,TY[6]+dRTY+oT)
Program.Delay(10)
EndWhile
EndSub
Sub HideDeadDuck
For i = 1 To 5
Shapes.HideShape(duckShape[i])
EndFor
Shapes.Remove(frontWing)
Shapes.Remove(rearWing)
Shapes.HideShape(spear)
Shapes.SetText(headShot, "")
Shapes.SetText(ducksMessage, "")
EndSub
For i = 1 To 7 'Draw GAME Text
GraphicsWindow.FontSize = Msg[i]["FS"]
GraphicsWindow.BrushColor = Msg[i]["BrC"]
GraphicsWindow.DrawText(Msg[i]["oX"], gh-BO+Msg[i]["LS"], Msg[i]["Txt"]) '
EndFor
If pause < 0 Then
accumulatedSeconds = accumulatedSeconds + gameSeconds
ElseIf pause > 0 Then
totalSeconds = accumulatedSeconds + gameSeconds
EndIf
seconds = Math.Floor(Math.Remainder(totalSeconds, 60))
minutes = Math.Floor(Math.Remainder(totalSeconds / 60, 60))
If seconds < 10 And minutes < 10 Then
Shapes.SetText(displayTime, "0" + minutes + ":0" + seconds)
ElseIf seconds >= 10 And minutes < 10 Then
Shapes.SetText(displayTime, "0" + minutes + ":" + seconds)
EndIf
If minutes = 1 Then
flag = "Game Over"
EndIf
EndSub
Sub ResetTimeAndScore ' PlayAgain
minutes = 0
seconds = 0
accumulatedSeconds = 0
startTime = Clock.ElapsedMilliseconds
score = 0 'WIP need to update after restart
Shapes.SetText(displayScore, score)
Mouse.HideCursor()
Controls.HideControl(playAgainButton)
EndSub
'-----------------------------------------------Score Subroutines----------------------------------
Sub UpdateScore
If flagHeadShot = 1 Then
score = score + 50
flagHeadShot = 0
EndIf
score = score + 10
Shapes.SetText(displayScore, score)
EndSub
Sub IndexHighScores
j = j + 1
gotScore[j] = score
For ranked = 1 To 3
For i = 1 To Array.GetItemCount(gotScore) 'get the max
HS[ranked] = Math.Max(HS[ranked], gotScore[i])
EndFor
For i = 1 To Array.GetItemCount(gotScore)
If HS[ranked] = gotScore[i] Then
gotScore[i] = ""
EndIf
EndFor
index = Array.GetAllIndices(gotScore)
For i = 1 To Array.GetItemCount(gotScore)
newVal[i] = gotScore[index[i]]
gotScore[i] = newVal[i]
EndFor
Shapes.SetText(displayHighScore[ranked], HS[ranked])
EndFor
For i = Array.GetItemCount(gotScore) + 1 To Array.GetItemCount(gotScore) + 3
n = n + 1
gotScore[i] = HS[n]
EndFor
n = 0
EndSub
'----------------------------------------------Scope Subroutines-----------------------------------
Sub CreateScopeShapes
GraphicsWindow.BrushColor = "black" 'ADDING THIS MAKES SCOPE APPEAR ON TOP?
scopeLens = Shapes.AddEllipse(scopeRadius*2, scopeRadius*2)
Shapes.SetOpacity(scopeLens, scopeLensOpacity)
Shapes.HideShape(scopeLens) 'add then hide (on next line to minimise screen flash)
scopeHorzLine = Shapes.AddRectangle(scopeRadius*2, 1)
Shapes.HideShape(scopeHorzLine) 'using rectangle so i don't need x & y coord yet
scopeVertLine = Shapes.AddRectangle(1, scopeRadius*2)
Shapes.HideShape(scopeVertLine)
EndSub
OM[1] = "X=0;Y=20;FS=20;BC=NavajoWhite;Txt=Hello & Welcome to"
OM[2] = "X=0;Y=50;FS=32;BC=NavajoWhite;Txt=Eora Duck Hunt"
OM[3] = "X=0;Y=95;FS=12;BC=NavajoWhite;Txt=local version 1.0"
OM[4] = "X=0;Y=115;FS=10;BC=NavajoWhite;Txt=a duck shoot game by Jibba Jabba, August 2013"
' OM[5] = "X=0;Y=150;FS=20;BC=Salmon;Txt=Please wait while sound effects d/load"
OM[6] = "X=0;Y=180;FS=12;BC=NavajoWhite;Txt=Plays best with an internet connection"
OM[7] = "X=0;Y=250;FS=20;BC=NavajoWhite;Txt=How to play:"
OM[8] = "X=0;Y=280;FS=14;BC=NavajoWhite;Txt=The aim is to spear as many ducks as you can in 1 minute"
OM[9] = "X=0;Y=305;FS=14;BC=NavajoWhite;Txt=You'll score 10 points per duck and a bonus 50 for head shots"
OM[10] = "X=0;Y=340;FS=14;BC=NavajoWhite;Txt=Aim: mouse/touchpad"
OM[11] = "X=0;Y=360;FS=14;BC=NavajoWhite;Txt=Fire: space bar"
OM[12] = "X=0;Y=380;FS=14;BC=NavajoWhite;Txt=Pause: P"
OM[13] = "X=0;Y=460;FS=9;BC=NavajoWhite;Txt=This game does NOT intend to portray hunting as a sport or recreation"
OM[14] = "X=0;Y=480;FS=9;BC=NavajoWhite;Txt=And suggests when hunting or gathering you only take what you need"
leftOffset = 20
For i = 1 To 14
GraphicsWindow.FontSize = OM[i]["FS"]
GraphicsWindow.BrushColor = OM[i]["BC"]
GraphicsWindow.DrawText(OM[i]["X"] + leftOffset, OM[i]["Y"], OM[i]["Txt"])
EndFor
EndSub
Program Listing: XCC705-1