procedure helicoptergame %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%reset screen
View.Set ("graphics:400;300,position:middle;center,title:Helicopter Game,nocursor,noecho,offscreenonly,noecho")
%reset variables
x := 211
y := 150
howmany := 1
over := false
under := 4
score := 0
fontID := Font.New ("Sans Serif:14:bold")
continue := "q"
block (1).y := 400
block (2).y := 400
block (1).x := maxx
streamNumber := -1
filename := "helicopter"
scorerank := 11
for i : 0 .. 47
wall (i).x := i * 50
wall (i).y := num (i)
end for
colour (0)
colourback (7)
cls
%display welcome screen
put "WELCOME TO THE HELICOPTER GAME!", skip
put "The object of the game is to get as far into the"
put "tunnel as possible, without crashing. To move"
put "higher, hold down the mouse button. To fall,"
put "release it. The game ends when you hit the roof,"
put "ground, or the obstacles. Good luck!", skip
put "Press ENTER to continue." ..
View.Update
loop
Input.getch (continue)
exit when continue = chr (10)
end loop
View.Set ("nocursor")
cls
View.Update
%draw screen and wait for mouse click before starting
for i : 0 .. 47
Draw.FillBox (wall (i).x, 0, wall (i).x + 49, wall (i).y, 47) %draw floor
Draw.FillBox (wall (i).x, maxy, wall (i).x + 49, maxy - (75 - wall (i).y), 47) %draw ceiling
end for
Font.Draw ("CLICK TO START", 20, 144, fontID, 0)
Draw.FillOval (x, y, 10, 10, 53)
Font.Draw ("Distance: " + realstr (score, 0), 1, 1, fontID, 0)
Font.Draw ("Best: " + intstr (best), 200, 1, fontID, 0)
View.Update
loop
exit when Mouse.ButtonMoved ("down")
end loop
%at the beginning of each loop, a new obstacle (block) is created
var yspeed : real
var tempy : real
yspeed := 0
tempy := y
loop
block (2).x := maxx %set new block's x coordinate
if howmany = 2 then
%only set new block's y coordinate, if it is not the beginning of the game, and there are therefore 2 blocks on screen. At the beginning of the game, there are not any on screen blocks.
block (2).y := Rand.Int (75, 164)
end if
for i : 1 .. 125
if i rem 25 = 0 then %every 25 times through the loop, a new wall section moves under the player
under += 1
end if
%DATA INPUT SECTION
Mouse.Where (x1, y1, button) %get button status, and change the user's direction accordingly
%CALCULATION SECTION
if button = 0 then
yspeed -= 0.03
elsif button > 0 then
yspeed += 0.03
end if
tempy += yspeed
y := round (tempy)
%OUTPUT SECTION
cls
for i1 : 1 .. 2 % change blocks' coordinates and redraw then
block (i1).x -= 2
Draw.FillBox (block (i1).x, block (i1).y, block (i1).x + 20, block (i1).y + 60, 47)
end for
for i1 : 0 .. 47 %change all the wall sections' coordinates and redraw them
wall (i1).x -= 2
Draw.FillBox (wall (i1).x, 0, wall (i1).x + 49, wall (i1).y, 47)
Draw.FillBox (wall (i1).x, maxy, wall (i1).x + 49, maxy - (75 - wall (i1).y), 47)
end for
Draw.FillOval (x, y, 10, 10, 53) %redraw user, as well as new distance and best distance (it has not changed, but screen has been cleared (cls)
Font.Draw ("Distance: " + realstr (round (score), 0), 1, 1, fontID, 0)
Font.Draw ("Best: " + intstr (best), 200, 1, fontID, 0)
View.Update
%CALCULATION SECTION 2
%check if user hits block 2's (block 1 is behind the user already) front, top or bottom, or the walls bellow, on top, the next wall bellow and on top, as well as the "cliff" between the 2 wall sections
if Math.DistancePointLine (x, y, block (2).x, block (2).y, block (2).x, block (2).y + 60) < 13 or
Math.DistancePointLine (x, y, block (2).x, block (2).y + 60, block (2).x + 20, block (2).y + 60) < 13 or
Math.DistancePointLine (x, y, block (2).x, block (2).y, block (2).x + 20, block (2).y) < 13 or
Math.DistancePointLine (x, y, wall (under).x, wall (under).y, wall (under).x + 49, wall (under).y) < 12 or
Math.DistancePointLine (x, y, wall (under + 1).x, wall (under + 1).y, wall (under + 1).x + 49, wall (under + 1).y) < 12 or
Math.DistancePointLine (x, y, wall (under).x + 50, wall (under).y, wall (under + 1).x, wall (under + 1).y) < 12 or
Math.DistancePointLine (x, y, wall (under).x, maxy - (75 - wall (under).y), wall (under).x + 49, maxy - (75 - wall (under).y)) < 12 or
Math.DistancePointLine (x, y, wall (under + 1).x, maxy - (75 - wall (under + 1).y), wall (under + 1).x + 49, maxy - (75 - wall (under + 1).y)) < 12 or
Math.DistancePointLine (x, y, wall (under).x + 50, maxy - (75 - wall (under).y), wall (under + 1).x, maxy - (75 - wall (under + 1).y)) < 12 then
over := true
exit
end if
Time.Delay (10)
if wall (47).x = 350 then %if all walls have been displayed then reset their x coordinates and start displaying the wall sections again
for i1 : 0 .. 47
wall (i1).x := i1 * 50
end for
under := 4 %reset which wall section is under the user
end if
score += 0.5
end for
if over = true then % if user crashed, draw "crash ovals", update the best score, reset variables, and prepare for next round
for i : 1 .. 5
Draw.Oval (x, y, 10 + 5 * i, 10 + 5 * i, 12)
View.Update
Time.Delay (100)
end for
Time.Delay (2000)
if score > best then
best := round (score)
end if
y := 150
tempy := y
yspeed := 0
howmany := 1
over := false
under := 4
score := 0
block (1).y := 400
block (2).y := 400
block (1).x := maxx
for i : 0 .. 47
wall (i).x := i * 50
wall (i).y := num (i)
end for
%redraw screen for next round
cls
for i : 0 .. 47
Draw.FillBox (wall (i).x, 0, wall (i).x + 49, wall (i).y, 47)
Draw.FillBox (wall (i).x, maxy, wall (i).x + 49, maxy - (75 - wall (i).y), 47)
end for
Font.Draw ("CLICK TO START", 20, 144, fontID, 0)
Draw.FillOval (x, y, 10, 10, 53)
Font.Draw ("Distance: " + intstr (score div 2), 1, 1, fontID, 0)
Font.Draw ("Best: " + intstr (best), 200, 1, fontID, 0)
View.Update
%get mouse click to start, or the ESC key to quit
loop
Mouse.Where (x1, y1, button)
exit when button > 0
if hasch then
getch (continue)
if continue = chr (27) then
over := true
exit
end if
end if
end loop
end if % end of "crashed" section
exit when over = true
block (1) := block (2) %set block 1 to block 2, as new block 1 will be created at top of loop
if howmany = 1 then %if game has just begun, and there is only 1 block on screen, there will now be 2
howmany += 1
end if
end loop
%HIGH SCORE SECTION AND CONCLUSION
cls
View.Set ("title:THANKS FOR PLAYING")
%if old score file exists, open it and save its values
open : streamNumber, "." + filename, get
if streamNumber > 0 then
for i : 1 .. 10
get : streamNumber, hiscore (i)
end for
for i : 1 .. 10
get : streamNumber, hiscorer (i) : *
end for
close : streamNumber
else % if old file doesn't exist then create new values
for i : 1 .. 10
hiscore (i) := 1000 * (11 - i)
end for
for i : 1 .. 10
hiscorer (i) := "Matt Guttman"
end for
end if
for decreasing i : 10 .. 1 %determine if user score is in the top 10 and if so, get its rank
if best > hiscore (i) then
scorerank := i
end if
end for
if scorerank < 11 then % if user gets a high score, move the existing high scores and scorers below the user's score down 1 place
for decreasing i : 10 .. 1
ioutofloop := i
exit when scorerank = i
hiscore (i) := hiscore (i - 1)
end for
hiscore (ioutofloop) := best
for decreasing i : 10 .. 1
exit when scorerank = ioutofloop
hiscorer (i) := hiscorer (i - 1)
end for
hiscorer (ioutofloop) := name
end if
%display user score and high scores
cls
locate (1, (maxcol div 2) - 4)
put "GAME OVER", skip
if scorerank < 11 then
put "Your score: ", best, " NEW HIGH SCORE #", scorerank, "!"
else
put "Your score: ", best
end if
locate (5, (maxcol div 2) - 5)
put "HIGH SCORES", skip
for i : 1 .. 10
put hiscorer (i) : 20, hiscore (i)
end for
open : streamNumber, "." + filename, put %save new high scores
assert streamNumber > 0
for i : 1 .. 10
put : streamNumber, hiscore (i)
end for
for i : 1 .. 10
put : streamNumber, hiscorer (i)
end for
close : streamNumber
put skip, "Press any key to quit." ..
View.Update
getch (continue)
%prepare screen for main program view
cls
View.Set ("graphics:500;500,title:4-in-1,nocursor,noecho,position:centre;middle,offscreenonly")
Pic.Draw (mainprogrampic1, 0, 0, 1)
Pic.Draw (mainprogrampic2, 250, 0, 1)
Pic.Draw (mainprogrampic3, 0, 250, 1)
Pic.Draw (mainprogrampic4, 250, 250, 1)
View.Update
end helicoptergame %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
