'-- Spaceship Flyaround Demo --
'------------------------------
'by Avinash "aetherFox" Vora
'http://avinash.apeshell.net
'avinashvora@gmail.com
'
'Availible on http://avinash.apeshell.net/stuff/?dir=./ship/
'
'Spaceship Flyaround Demo
'Copyright (C) 2005 Avinash Vora
'
'See the accompanying readme.txt for license details.
'
'Inspired by Lucky's VB Tutorials from a long time ago.
'
'History:
'9th April, 2005
'  18:14 Idea concieved.
'        Engine started.
'10th April, 2005
'  00:15 Engine finished.
'  19:53 Engine enhanced.
'  21:49 Debug mode through preprocessor added.
'  23:09 Background added (stars.bmp).
'  23:15 Added further debug mode checks.
'11th April, 2005
'  01:17 Bullet system implemented.
'  04:03 Bullet system update (speed increase).
'        Minor performance tweaks.
'  15:03 Implemented FMOD for sample files.
'        Used battle.ogg (from "The Quest For Opa Opa!").
'  15:29 Added further conditional compilation checks (NOSOUND/DEBUG enhanced).

'General
'-------

'$Dynamic
'$Include: 'win/kernel32.bi'
'$INCLUDE: 'fmod.bi'

Option Explicit

'Defines:
'Keys for MULTIKEY()
#define SC_UP      &h48
#define SC_LEFT    &h4B
#define SC_RIGHT   &h4D
#define SC_DOWN    &h50
#define SC_CONTROL &h1D
#define SC_ALT     &h38
#define SC_SPACE   &h39
#define SC_ESCAPE  &h01

'Debugging
'Uncomment the following line to remove debugging outputs
'#define DEBUG

'Nosound
'Uncomment the following line to compile without any sound options
'#define NOSOUND

'Declarations:
'-------------

'Subroutines And Functions
Declare Sub KeyCheck()
Declare Sub Physics()
Declare Sub DrawShip()
Declare Sub DrawBullets()
Declare Sub Quit()

'Constants
Const PI = 3.14159          'Pi
Const ACCEL = 0.1           'Acceleration
Const ROTATION_RATE = 15    'Rotation/Angular speed
Const SHIP_RADIUS = 15      'From center of triangle to vertex
Const MS_DELAY = 25         'Milliseconds per frame (25 = 40 frames per second)
Const MAX_SPEED = 10        'Maximum speed for ship

Const SCREENWIDTH = 640     'X-Resolution
Const SCREENHEIGHT = 480    'Y-Resolution

Const FIRE_DELAY = 400      'Milliseconds per shot
Const BULLET_RADIUS = 1     'Radius of bullets
Const BULLET_SPEED = 15     'Relative speed of bullets

'Colours in RGB format
Const CLR_RED = RGB(255, 0, 0)
Const CLR_GREEN = RGB(0, 255, 0)
Const CLR_WHITE = RGB(255, 255, 255)

'Dimensions
Dim Shared lTimer As Long       'Holds system time since last frame was displayed
Dim Shared lFireDelay As Long   'Time passed since last shot

Dim Shared iRunning As Integer         'Render Loop check
Dim Shared iMoving As Integer          'Ship speed <> 0 check
Dim Shared iNumBullets As Integer      'Number of bullets

Dim Shared iBackgroundMusic As Integer  'ID for the background music loop - battle.ogg
Dim Shared iSoundEnabled As Integer     'Check for sound

Dim Shared stTitleInfo As String

'Types
Type SHIP_TYPE
   sX As Single          'X Coord
   sY As Single          'Y Coord
   sSpeed As Single      'Speed
   sHeading As Single    'Direction
   sFacing As Single     'Angle Facing
End Type

Type BULLET_TYPE
    sX As Single         'X Coord of this bullet
    sY As Single         'Y Coord of this bullet
    sSpeed As Single     'Speed of the bullet
    sHeading As Single   'Heading of the bullet
    iAlive As Integer    'Is this bullet still active?
End Type

'Main Program Flow:
'------------------

'Initialize the variables
Dim Shared Ship As SHIP_TYPE          'Create the ship
Dim Shared Bullet() As BULLET_TYPE    'Create an array of bullets

Ship.sX = SCREENWIDTH / 2
Ship.sY = SCREENHEIGHT / 2
Ship.sFacing = 0
Ship.sSpeed = 0
Ship.sHeading = 0

lTimer = GetTickCount()
iRunning = 1

stTitleInfo = ""

#ifndef NOSOUND
   'Initialise FMOD
   iSoundEnabled = 1
   FSOUND_Init(44100, 32, 0)
   
   iBackgroundMusic = FSOUND_Sample_Load(FSOUND_FREE, "battle.ogg", 0, 0, 0)
   IF iBackgroundMusic = 0 THEN
      iSoundEnabled = 0
      Print "Fatal Error: Failed to load the sample battle.ogg!"
      FSOUND_Close
      While Inkey$ = "": Wend
      End
   End If
#endif 'NOSOUND

'Debug check to reflect on window title
#ifdef DEBUG
   'Set the info to show debug
   stTitleInfo = "[DEBUG] "
#else 'DEBUG
   'Set the info to show nothing
   stTitleInfo = ""
#endif 'DEBUG

'Nosound check to reflect on window title
#ifdef NOSOUND
   'Set the info to show nosound
   stTitleInfo = stTitleInfo + "[NOSOUND] "
#else 'NOSOUND
   'Set the info to show nothing
   stTitleInfo = stTitleInfo + ""
#endif 'NOSOUND

'Set the window title
WINDOWTITLE stTitleInfo + "Spaceship Flyaround Demo by aetherFox - Press Alt+Enter for fullscreen"

'Set the screen mode (640x480, 24-bit, windowed)
Screen 18, 24, 2
If Not ScreenPtr Then
   Print "Fatal ErrorError setting video mode!"
   While Inkey$ = "" : Wend
   End
End If

'Make the work page 1 and the visible page 0
Screenset 1, 0

#ifndef NOSOUND
   'Set iBackgroundMusic to be played looped
   FSOUND_Sample_SetMode(iBackgroundMusic, FSOUND_LOOP_NORMAL)
   'Begin playing soundfile
   FSOUND_PlaySound(FSOUND_FREE, iBackgroundMusic)
#endif 'NOSOUND

'Render Loop
Do While iRunning = 1
   
   'Check it 25 ms have elapsed
   If lTimer + MS_DELAY <= GetTickCount() Then
      lTimer = GetTickCount()     'Reset lTimer
      Physics                     'Physics engine
      Cls                         'Clear screen
      DrawShip                    'Draw ship
      DrawBullets                 'Draw bullets
      
      'Quit if Esc is pressed
      If Multikey(SC_ESCAPE) Then Quit
      
      'Copy from work page 1 to visible page 0
      Screencopy

      #ifndef NOSOUND
         'Update FMOD
         FSOUND_Update
      #endif 'NOSOUND
   Else
      Sleep(0)
   End If
   
   If Ship.sSpeed = 0 Then iMoving = 0 Else iMoving = 1
      
Loop

Sub Physics()

   'Declarations
   'Resultant components
   Dim sXComp As Single
   Dim sYComp As Single
   'Bullet counter
   Dim i As Integer
   
   'Rotate right
   If Multikey(SC_RIGHT) Then
      Ship.sFacing = Ship.sFacing + ROTATION_RATE * PI / 180
   End If
   
   'Rotate left
   If Multikey(SC_LEFT) Then
      Ship.sFacing = Ship.sFacing - ROTATION_RATE * PI / 180
   End If
   
   
   'If Ship.sSpeed <= MAX_SPEED Then
   
   'Thrust
   If Multikey(SC_UP) Then
      'Calculate resultant vector components
      sXComp = Ship.sSpeed * Sin(Ship.sHeading) + ACCEL * Sin(Ship.sFacing)
      sYComp = Ship.sSpeed * Cos(Ship.sHeading) + ACCEL * Cos(Ship.sFacing)
      
      'Calculate speed using with |ai + bj| = Sqr (a^2 + b^2)
      Ship.sSpeed = Sqr(sXComp ^ 2 + sYComp ^ 2)
      
      'Calculate the resultant heading
      If sYComp >= 0 Then Ship.sHeading = Atn(sXComp / sYComp)
      If sYComp < 0 Then Ship.sHeading = Atn(sXComp / sYComp) + PI
   End If
   
   'Reverse Thrust
   If Multikey(SC_DOWN) Then
      'Calculate resultant vector components
      sXComp = Ship.sSpeed * Sin(Ship.sHeading) + ACCEL * Sin(Ship.sFacing + PI)
      sYComp = Ship.sSpeed * Cos(Ship.sHeading) + ACCEL * Cos(Ship.sFacing + PI)
            
      'Calculate speed using with |ai + bj| = Sqr (a^2 + b^2)
      Ship.sSpeed = Sqr(sXComp ^ 2 + sYComp ^ 2)
   
      'Calculate the resultant heading
      If Sgn(sYComp) > 0 Then Ship.sHeading = Atn(sXComp / sYComp)
      If Sgn(sYComp) < 0 Then Ship.sHeading = Atn(sXComp / sYComp) + PI
   End If
   
   'End If
   
   'Hard Stop
   If Multikey(SC_SPACE) Then Ship.sSpeed = 0
      
   'Update ship's position
   Ship.sX = Ship.sX + Ship.sSpeed * Sin(Ship.sHeading)
   Ship.sY = Ship.sY - Ship.sSpeed * Cos(Ship.sHeading)
   
   'Ensure that the ship is visible in the form (wrap edges)
   If Ship.sX > SCREENWIDTH Then Ship.sX = 0
   If Ship.sY > SCREENHEIGHT Then Ship.sY = 0
   If Ship.sX < 0 Then Ship.sX = SCREENWIDTH
   If Ship.sY < 0 Then Ship.sY = SCREENHEIGHT
   
   'Create bullet
   If Multikey(SC_CONTROL) And (GetTickCount() - lFireDelay >= FIRE_DELAY) Then
      'Reset the delay variable
      lFireDelay = GetTickCount()
      
      'Add a new entry to the array
      ReDim Preserve Bullet(iNumBullets) As BULLET_TYPE
      iNumBullets = iNumBullets + 1
      
      With Bullet(UBound(Bullet))
         'Initial coordinates of the bullet
         .sX = Ship.sX
         .sY = Ship.sY
         .iAlive = 1
         
         'Add the bullet and ship vectors, calculate resultant vector components
         sXComp = Ship.sSpeed * Sin(Ship.sHeading) + BULLET_SPEED * Sin(Ship.sFacing)
         sYComp = Ship.sSpeed * Cos(Ship.sHeading) + BULLET_SPEED * Cos(Ship.sFacing)
         
         'Calculate speed using with |ai + bj| = Sqr (a^2 + b^2)
         .sSpeed = Sqr(sXComp ^ 2 + sYComp ^ 2)
         
         'Calculate the resultant heading
         If sYComp > 0 Then .sHeading = Atn(sXComp / sYComp)
         If sYComp < 0 Then .sHeading = Atn(sXComp / sYComp) + PI
      End With
   End If
   
   'Move the bullets (if there are any)
   If iNumBullets > 0 Then
      For i = 0 To UBound(Bullet)
         'Update bullets's position
         Bullet(i).sX = Bullet(i).sX + Bullet(i).sSpeed * Sin(Bullet(i).sHeading)
         Bullet(i).sY = Bullet(i).sY - Bullet(i).sSpeed * Cos(Bullet(i).sHeading)
      Next
   End If

End Sub

Private Sub DrawShip()
 
   'Declarations
   'Coordinates of the 3 triangle verticies
   Dim iX1 As Integer    
   Dim iY1 As Integer
   Dim iX2 As Integer
   Dim iY2 As Integer
   Dim iX3 As Integer
   Dim iY3 As Integer
 
   'Calculate ship vertices
   iX1 = Ship.sX + SHIP_RADIUS * Sin(Ship.sFacing)
   iY1 = Ship.sY - SHIP_RADIUS * Cos(Ship.sFacing)
   iX2 = Ship.sX + SHIP_RADIUS * Sin(Ship.sFacing + 2 * PI / 3)
   iY2 = Ship.sY - SHIP_RADIUS * Cos(Ship.sFacing + 2 * PI / 3)
   iX3 = Ship.sX + SHIP_RADIUS * Sin(Ship.sFacing + 4 * PI / 3)
   iY3 = Ship.sY - SHIP_RADIUS * Cos(Ship.sFacing + 4 * PI / 3)
   
   
   'Load the background (640x480, 24-bit bitmap image)
   Bload "stars.bmp", 0
   
   'Draw the ship
   Line (iX1, iY1)-(iX2, iY2), CLR_RED
   Line (iX2, iY2)-(iX3, iY3), CLR_WHITE
   Line (iX3, iY3)-(iX1, iY1), CLR_RED
   
   #ifdef DEBUG
      'Debug to check Ship stats
      Print ":: Debug Mode ::"
      Print "Speed   :"; Ship.sSpeed
      Print "Heading :"; Ship.sHeading
      Print "Facing  :"; Ship.sFacing
      Print "X-Pos   :"; INT(Ship.sX)
      Print "Y-Pos   :"; INT(Ship.sY)
      Print "Moving? :"; iMoving
      Print "Sound?  :"; iSoundEnabled
   #endif 'DEBUG
   
End Sub

Sub DrawBullets()

Dim i As Integer

   'If there are no bullets, then exit
   If iNumBullets = 0 Then Exit Sub

   'Step through each bullet and draw it
   For i = 0 To UBound(Bullet)
      'Only draw "live" bullets
      If Bullet(i).iAlive Then
         Circle (Bullet(i).sX, Bullet(i).sY), BULLET_RADIUS, CLR_GREEN
      End If
   Next i
   
End Sub

Sub Quit()
   
   iRunning = 0
   
   #ifndef NOSOUND
      'Deactivate FMOD
      iSoundEnabled = 0
      FSOUND_Close
   #endif 'NOSOUND
   
   While Multikey(SC_ESCAPE) : Wend
      
   Cls
   Print "Spaceship Flyaround Demo"
   Print "by aetherFox"
   Print "http://avinash.apeshell.net"
   Print
   Print "Press Escape to quit."
   
   Screencopy
   
   While Multikey(SC_ESCAPE) = 0 : Wend
      
   End
   
End Sub