Microsoft Small Basic

Program Listing:
Embed this in your website
'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")

GraphicsWindow.KeyDown = OnKeyDown       'fire
GraphicsWindow.MouseMove = OnMouseMove   'crossHairs
Controls.ButtonClicked = OnButtonClicked
'Timer.Tick = OnTick 'animate spear & check collision SET in PlayMusic()

OpenningScreen()

GraphicsWindow.BrushColor = "Salmon"
GraphicsWindow.FontSize = 20
openningMessage = Shapes.AddText("Please wait while sound effects d/load")
Shapes.Move(openningMessage, 20, 150)

Sound.PlayAndWait(quack)

Shapes.SetText(openningMessage, "Press Enter to Start")

While start <> "Yes"
EndWhile

Shapes.Remove(openningMessage)
'--------------------------------------------------Main Program Data---------------------------------------------------------------

GraphicsWindow.Hide()
GraphicsWindow.Clear()
SetGW()
DuckData()
GraphicsData()
SetAltitude()
FlightSpeed()

pause = 1 'minus 1 = Pause On
flagFire = 1
flagCollision = 0

scopeRadius = 20
scopeLensOpacity = 20
accumulatedSeconds = 0
'-------------------------------------------------Sound Track Thread----------------------------------

Timer.Interval = 10'0
Timer.Tick = PlayMusic

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

    start_Time = Clock.ElapsedMilliseconds
    Program.Delay(delay)  'was 2
    finish_Time = Clock.ElapsedMilliseconds
    speedTest = finish_Time - start_Time
    'TextWindow.WriteLine(speedTest)

    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

Sub CreateSpear
  GraphicsWindow.BrushColor = "DarkGreen"
  spear = Shapes.AddRectangle(3, 35)
  Shapes.Move(spear, gw/2, gh)
EndSub

Sub ResetSpear
  Shapes.Move(spear, gw/2, gh)
  Shapes.ShowShape(spear)
EndSub

Sub CreateDuckMessages
  GraphicsWindow.BrushColor = "Purple"
  ducksMessage = Shapes.AddText("") 'positioned in DeadDuck()
  headShot = Shapes.AddText("")
  Shapes.Zoom(headShot, 3, 3)
  Shapes.Move(headShot, 300, 250)
EndSub

'===========================Screen Graphics Subroutines==============
Sub GraphicsData
  Msg[1] = "FS=26;BrC=Khaki;oX=10;LS=0;Txt=Game Controls"
  Msg[2] = "FS=16;BrC=DarkKhaki;oX=10;LS=30;Txt=Fire: SPACE BAR"
  Msg[3] = "FS=16;BrC=DarkKhaki;oX=10;LS=50;Txt=Aim: MOUSE/TOUCH PAD"
  Msg[4] = "FS=16;BrC=DarkKhaki;oX=10;LS=70;Txt=Pause: P"
  Msg[5] = "FS=26;BrC=Khaki;oX=980;LS=0;Txt=Time"
  Msg[6] = "FS=26;BrC=Khaki;oX=520;LS=0;Txt=Score"
  Msg[7] = "FS=16;BrC=SaddleBrown;oX=960;LS=-475;Txt=Eora Duck Hunt" '10
  Tot[1] = "W=130;Op=30;X=485;Y=10;BrC=Yellow"
  Tot[2] = "W=80;Op=30;X=300;Y=230;BrC=Yellow"
  Tot[3] = "W=60;Op=70;X=730;Y=270;BrC=LimeGreen"
  BO = 100 'bottom offset
EndSub

Sub DrawGraphics
  GraphicsWindow.BrushColor = "black" 'BOTTOM RIBBON
  GraphicsWindow.DrawRectangle(0, gh - BO, gw, gh)
  GraphicsWindow.FillRectangle(0, gh - BO, gw, gh)

  For i = 1 To 3 'add TOTEMS
    GraphicsWindow.BrushColor = Tot[i]["BrC"]
    totem[i] = Shapes.AddEllipse(Tot[i]["W"], Tot[i]["W"])
    Shapes.HideShape(totem[i])
    Shapes.SetOpacity(totem[i], Tot[i]["Op"])
    Shapes.Move(totem[i], Tot[i]["X"], Tot[i]["Y"])
    Shapes.ShowShape(totem[i])
  EndFor

  GraphicsWindow.PenColor = "red" 'RAINBOW SNAKE
  GraphicsWindow.PenWidth = 15
  y2 = gh - BO
  y1 = y2
  For x2 = 1 To gw Step 5
    y2 = Math.Sin(10 * x2) * 7 + gh - BO
    GraphicsWindow.DrawLine(x1, y1, x2, y2)
    x1 = x2 - 1
    y1 = y2 - 1
  EndFor
  GraphicsWindow.PenWidth = 0
  x1 = 0
  y1 = 0

  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

  GraphicsWindow.FontSize = 26
  GraphicsWindow.BrushColor = "DarkKhaki"
  displayTime = Shapes.AddText("00:00") 'WIP
  Shapes.Move(displayTime, 985, gh-BO + 35)

  displayScore = Shapes.AddText("0")
  Shapes.Move(displayScore, 520, gh-BO + 35)

  GraphicsWindow.BrushColor = "DarkOliveGreen"
  GraphicsWindow.FontSize = 18
  GraphicsWindow.DrawText(10, 8, "High Scores")

  Rank = "1=1st;2=2nd;3=3rd;X=10"
  RankY = "1=30;2=47;3=64"
  GraphicsWindow.FontSize = 16

  For i = 1 To 3
    GraphicsWindow.DrawText(Rank["X"], RankY[i], Rank[i])
    displayHighScore[i] = Shapes.AddText("0")
    Shapes.Move(displayHighScore[i], 60, RankY[i])
  EndFor
EndSub

Sub zOrderTree
  tree = Shapes.AddImage(tree)
  Shapes.Move(tree, gw-605, (gh-380)/4)
  Shapes.Zoom(tree, 0.5, 0.5)
EndSub

'----------------------------------------------Time Subroutines------------------------------------
Sub UpdateTime
  gameSeconds = (Clock.ElapsedMilliseconds - startTime) / 1000

  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

Sub GetMouseCentre
  Mouse.MouseX = GraphicsWindow.Left + GraphicsWindow.Width/2
  Mouse.MouseY = GraphicsWindow.Top + GraphicsWindow.Height/2
EndSub

Sub ShowScope
  Shapes.ShowShape(scopeVertLine) 'pos 1st then show in centre of GW
  Shapes.ShowShape(scopeHorzLine)
  Shapes.ShowShape(scopeLens)
EndSub

Sub UpdateScopePosition
  scopeX = GraphicsWindow.MouseX
  scopeY = GraphicsWindow.MouseY
EndSub

Sub MoveScope
  Shapes.Move(scopeLens, scopeX - scopeRadius, scopeY - scopeRadius)
  Shapes.Move(scopeHorzLine, scopeX - scopeRadius, scopeY)
  Shapes.Move(scopeVertLine, scopeX, scopeY - scopeRadius)
EndSub

'-----------------------------------------Graphics Window Subroutines----------------------------
Sub SetGW
  gw = 1100
  gh = 580
  GraphicsWindow.Width = gw
  GraphicsWindow.Height = gh
  GraphicsWindow.Left = (Desktop.Width - gw) / 2
  GraphicsWindow.Top = (Desktop.Height - gh) / 3
  GraphicsWindow.Title = "Songline Software"
  'GraphicsWindow.CanResize = "false"
  GraphicsWindow.BackgroundColor = "DeepSkyBlue"
  GraphicsWindow.PenWidth = 0
EndSub

Sub OpenningScreen
  GraphicsWindow.CanResize = "false"
  gw = 470
  gh = 500
  GraphicsWindow.Width = gw
  GraphicsWindow.Height = gh
  GraphicsWindow.Left = (Desktop.Width - gw) / 2
  GraphicsWindow.Top = (Desktop.Height - gh) / 3
  GraphicsWindow.Title = "Songline Software"
  GraphicsWindow.BackgroundColor = "DarkOliveGreen"

  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
Copyright (c) Microsoft Corporation. All rights reserved.