setscreen ("offscreenonly,graphics:700;500,nobuttonbar,position:middle;middle")
colorback (black)
color (white)

type bulletData :
    record
	x : real
	y : real
	dx : real
	dy : real
    end record

type asteroidData :
    record
	x : real
	y : real
	dx : real
	dy : real
	radius : int
    end record

type shipData :
    record
	x : real
	y : real
	vx : real
	vy : real
	dx : real
	dy : real
	speed : real
	ang : int
	lives : int
    end record

type keyData :
    record
	SHOOT : boolean
	LEFT : boolean
	RIGHT : boolean
	FORWARD : boolean
	BACKWARD : boolean
    end record

const decay := 0.995
const shipMaxSpeed := 0.5
const shipMinSpeed := -0.35
const shipTurnSpeed := 10
const gameSpeedIncrease := 1.25
const bulletSpeed := 10
const shootSpeed := 4

var gameSpeed := 1.0
var level := 0
var score := 0
var shootCounter := 0
var shipAccel : real := 0
var bullet : flexible array 1 .. 0 of bulletData
var asteroid : flexible array 1 .. 3 of asteroidData
var asteroidSize : array 1 .. 3 of int := init (10, 25, 50)
var ship : shipData
var keysDown : keyData
var asteroidPic : array 1 .. 3 of int
var shipPicOriginal, shipPic : int
var collisionPointsX : array 1 .. 14 of int := init (0, 0, 2, -3, 5, -6, 8, -9, 16, -17, 22, -23, 13, -14)
var collisionPointsY : array 1 .. 14 of int := init (29, -10, 20, 20, 10, 10, 0, 0, -7, -7, -14, -14, -12, -12)
var playAgain : string

shipPicOriginal := Pic.FileNew ("spaceship.bmp")
Pic.Draw (shipPicOriginal, 10, 25, picMerge)
shipPicOriginal := Pic.New (0, 10, 70, 70)

proc initLevel
    var tempAng : int
    level += 1
    gameSpeed *= gameSpeedIncrease
    new asteroid, 3
    if level = 1 then
	drawfillbox (0, 0, maxx, maxy, 7)
	locate (1, 35)
	put "ASTEROIDS\n\n"
	put "Welcome to ASTEROIDS. The object of the game is to destroy all the asteroids"
	put "while avoiding being hit. As you advance levels, the amount of points you get"
	put "for each destroyed asteroid increases. GOOD LUCK!!!\n"
	put "CONTROLS:\n"
	put "UP ARROW:      Accelerate"
	put "DOWN ARROW:    Decelerate"
	put "LEFT ARROW:    Turn Left"
	put "RIGHT ARROW:   Turn Right"
	put "CONTROL:       Shoot a Bullet\n\n\n"
	put "press any key to continue..."
	View.Update
	loop
	    exit when hasch
	end loop
	drawfillbox (0, 0, maxx, maxy, 0)
	View.Update
	shipPicOriginal := Pic.FileNew ("spaceship.bmp")
	Pic.Draw (shipPicOriginal, 10, 25, picMerge)
	shipPicOriginal := Pic.New (0, 10, 70, 70)
	ship.x := maxx div 2
	ship.y := maxy div 2
	ship.dx := 0
	ship.dy := 0
	ship.ang := 90
	ship.lives := 3
    end if
    asteroidPic (3) := Pic.FileNew ("sphere" + intstr (level mod 5) + "a.bmp")
    asteroidPic (2) := Pic.FileNew ("sphere" + intstr (level mod 5) + "b.bmp")
    asteroidPic (1) := Pic.FileNew ("sphere" + intstr (level mod 5) + "c.bmp")
    for i : 1 .. 3
	if Rand.Int (1, 2) = 1 then
	    asteroid (i).x := Rand.Int (1, maxx)
	    if Rand.Int (1, 2) = 1 then
		asteroid (i).y := maxy
	    else
		asteroid (i).y := 1
	    end if
	else
	    asteroid (i).y := Rand.Int (1, maxy)
	    if Rand.Int (1, 2) = 1 then
		asteroid (i).x := maxx
	    else
		asteroid (i).x := 1
	    end if
	end if
	tempAng := Rand.Int (1, 360)
	asteroid (i).dx := cosd (tempAng) * gameSpeed
	asteroid (i).dy := sind (tempAng) * gameSpeed
	asteroid (i).radius := asteroidSize (3)
    end for
end initLevel

proc moveAsteroids
    for i : 1 .. upper (asteroid)
	asteroid (i).x += asteroid (i).dx
	asteroid (i).y += asteroid (i).dy
	if asteroid (i).x > maxx then
	    asteroid (i).x := 0
	elsif asteroid (i).x < 0 then
	    asteroid (i).x := maxx
	end if
	if asteroid (i).y > maxy then
	    asteroid (i).y := 0
	elsif asteroid (i).y < 0 then
	    asteroid (i).y := maxy
	end if
    end for
end moveAsteroids

proc getKeys
    var keys : array char of boolean
    Input.KeyDown (keys)
    keysDown.FORWARD := false
    keysDown.BACKWARD := false
    keysDown.LEFT := false
    keysDown.RIGHT := false
    keysDown.SHOOT := false
    if keys (KEY_UP_ARROW) then
	keysDown.FORWARD := true
    elsif keys (KEY_DOWN_ARROW) then
	keysDown.BACKWARD := true
    end if
    if keys (KEY_LEFT_ARROW) then
	keysDown.LEFT := true
    elsif keys (KEY_RIGHT_ARROW) then
	keysDown.RIGHT := true
    end if
    if keys (KEY_CTRL) then
	keysDown.SHOOT := true
    end if
end getKeys

proc shoot
    getKeys
    if keysDown.SHOOT then
	shootCounter += 1
	if shootCounter = shootSpeed then
	    shootCounter := 0
	    new bullet, upper (bullet) + 1
	    bullet (upper (bullet)).x := ship.x + cosd (ship.ang) * (Pic.Height (shipPicOriginal) / 2.2) %- (Pic.Width (shipPicOriginal) / 2)
	    bullet (upper (bullet)).y := ship.y + sind (ship.ang) * (Pic.Height (shipPicOriginal) / 2.2) %- (Pic.Height (shipPicOriginal) / 2)
	    bullet (upper (bullet)).dx := cosd (ship.ang) * bulletSpeed
	    bullet (upper (bullet)).dy := sind (ship.ang) * bulletSpeed
	end if
    else
	shootCounter := shootSpeed - 1
    end if
end shoot

proc breakAsteroid (num : int)
    %score += round (3 * level * gameSpeed)
    var tempX := asteroid (num).x
    var tempY := asteroid (num).y
    var tempRadius := asteroid (num).radius
    var tempAng : int
    for i : num .. upper (asteroid) - 1
	asteroid (i).x := asteroid (i + 1).x
	asteroid (i).y := asteroid (i + 1).y
	asteroid (i).dx := asteroid (i + 1).dx
	asteroid (i).dy := asteroid (i + 1).dy
	asteroid (i).radius := asteroid (i + 1).radius
    end for
    if tempRadius > asteroidSize (1) then
	new asteroid, upper (asteroid) + 2
	for i : 0 .. 2
	    asteroid (upper (asteroid) - i).x := tempX
	    asteroid (upper (asteroid) - i).y := tempY
	    tempAng := Rand.Int (0, 360)
	    asteroid (upper (asteroid) - i).dx := cosd (tempAng) * (gameSpeed * (40 / tempRadius))
	    asteroid (upper (asteroid) - i).dy := sind (tempAng) * (gameSpeed * (40 / tempRadius))
	    if tempRadius = asteroidSize (3) then
		if i = 0 then
		    score += round (level * gameSpeed)
		end if
		asteroid (upper (asteroid) - i).radius := asteroidSize (2)
	    else
		if i = 0 then
		    score += round (2 * level * gameSpeed)
		end if
		asteroid (upper (asteroid) - i).radius := asteroidSize (1)
	    end if
	end for
    else
	score += round (3 * level * gameSpeed)
	new asteroid, upper (asteroid) - 1
    end if
end breakAsteroid

proc moveBullets
    var bulletLost := false
    for i : 1 .. upper (bullet)
	bulletLost := false
	bullet (i).x += bullet (i).dx
	bullet (i).y += bullet (i).dy
	if bullet (i).x > maxx or bullet (i).x < 1 or bullet (i).y > maxy or bullet (i).y < 1 then
	    for j : i .. upper (bullet) - 1
		bullet (j).x := bullet (j + 1).x
		bullet (j).y := bullet (j + 1).y
		bullet (j).dx := bullet (j + 1).dx
		bullet (j).dy := bullet (j + 1).dy
	    end for
	    new bullet, upper (bullet) - 1
	    exit
	end if
	for j : 1 .. upper (asteroid)
	    if Math.Distance (bullet (i).x, bullet (i).y, asteroid (j).x, asteroid (j).y) < asteroid (j).radius then
		breakAsteroid (j)
		for k : i .. upper (bullet) - 1
		    bullet (k).x := bullet (k + 1).x
		    bullet (k).y := bullet (k + 1).y
		    bullet (k).dx := bullet (k + 1).dx
		    bullet (k).dy := bullet (k + 1).dy
		end for
		new bullet, upper (bullet) - 1
		bulletLost := true
		exit
	    end if
	end for
	exit when bulletLost = true
    end for
end moveBullets

proc moveShip
    getKeys
    if keysDown.FORWARD then
	shipAccel := shipMaxSpeed
    elsif keysDown.BACKWARD then
	shipAccel := shipMinSpeed
    else
	shipAccel := 0
    end if
    if keysDown.LEFT then
	ship.ang += shipTurnSpeed
    elsif keysDown.RIGHT then
	ship.ang -= shipTurnSpeed
    end if
    ship.vx := cosd (ship.ang) * shipAccel
    ship.vy := sind (ship.ang) * shipAccel
    ship.dx += ship.vx
    ship.dy += ship.vy
    ship.dx *= decay
    ship.dy *= decay
    ship.x += ship.dx
    ship.y += ship.dy
    if ship.x > maxx then
	ship.x := 1
    elsif ship.x < 1 then
	ship.x := maxx
    end if
    if ship.y > maxy then
	ship.y := 1
    elsif ship.y < 1 then
	ship.y := maxy
    end if
end moveShip

fcn whatAngle (x, y : real) : real
    var ratio, angle : real
    if x not= 0 then
	ratio := y / x
    else
	ratio := y / 0.0001
    end if
    angle := arctand (abs (ratio))
    if x < 0 then
	angle := 180 - angle
    end if
    if y < 0 then
	angle := 360 - angle
    end if
    result angle
end whatAngle

fcn clear : boolean
    for i : 1 .. upper (asteroid)
	if Math.Distance (ship.x, ship.y, asteroid (i).x, asteroid (i).y) < asteroid (i).radius + 70 then
	    result false
	end if
    end for
    result true
end clear

fcn checkShipCollision : boolean
    var tempx, tempy : real
    for i : 1 .. upper (asteroid)
	if Math.Distance (ship.x, ship.y, asteroid (i).x, asteroid (i).y) < asteroid (i).radius + 30 then
	    for j : 1 .. upper (collisionPointsX)
		tempx := cosd (ship.ang + 270 + whatAngle (collisionPointsX (j), collisionPointsY (j))) * Math.Distance (0, 0, collisionPointsX (j), collisionPointsY (j))
		tempy := sind (ship.ang + 270 + whatAngle (collisionPointsX (j), collisionPointsY (j))) * Math.Distance (0, 0, collisionPointsX (j), collisionPointsY (j))
		tempx += ship.x
		tempy += ship.y
		if Math.Distance (asteroid (i).x, asteroid (i).y, tempx, tempy) < asteroid (i).radius then
		    ship.dx := 0
		    ship.dy := 0
		    ship.vx := 0
		    ship.vy := 0
		    drawfillbox (0, 0, maxx, maxy, 12)
		    View.Update
		    result true
		end if
	    end for
	end if
    end for
    result false
end checkShipCollision

proc drawScreen
    drawfillbox (0, 0, maxx, maxy, black)
    put "SCORE: ", score, " LIVES: ", ship.lives
    var tempIndex : int
    for i : 1 .. upper (asteroid)
	if asteroid (i).radius = asteroidSize (1) then
	    tempIndex := 1
	elsif asteroid (i).radius = asteroidSize (2) then
	    tempIndex := 2
	else
	    tempIndex := 3
	end if
	Pic.Draw (asteroidPic (tempIndex), round (asteroid (i).x - asteroid (i).radius), round (asteroid (i).y - asteroid (i).radius), picMerge)
    end for
    for i : 1 .. upper (bullet)
	drawdot (round (bullet (i).x), round (bullet (i).y), yellow)
    end for
    shipPic := Pic.Rotate (shipPicOriginal, ship.ang - 90, 35, 30)
    Pic.Draw (shipPic, round (ship.x - Pic.Width (shipPicOriginal) / 2), round (ship.y - Pic.Height (shipPicOriginal) / 2), picMerge)
    Pic.Free (shipPic)
end drawScreen

proc addHighScore
    setscreen ("nooffscreenonly")
    drawfillbox (0, 0, maxx, maxy, 7)
    var file : int
    var names : array 1 .. 10 of string
    var scores : array 1 .. 10 of int
    open : file, "topscores.txt", get
    for i : 1 .. 10
	get : file, names (i)
	get : file, scores (i)
    end for
    for i : 1 .. 10
	if score >= scores (i) then
	    for decreasing j : 10 .. i + 1
		scores (j) := scores (j - 1)
		names (j) := names (j - 1)
	    end for
	    put "Enter Name: " ..
	    get names (i)
	    scores (i) := score
	    exit
	end if
    end for
    close : file
    open : file, "topscores.txt", put
    locate (maxrow div 2 - 5, maxcol div 2 - 5)
    put "HIGH SCORES\n"
    for i : 1 .. 10
	put : file, names (i), " " ..
	put : file, scores (i)
	locate (maxrow div 2 - 5 + i, maxcol div 2 - 18)
	put names (i) : 30 ..
	put scores (i) : 6
    end for
    delay (1000)
    loop
	exit when hasch
    end loop
    drawfillbox (0, 0, maxx, maxy, 7)
    locate (maxrow div 2, maxcol div 2 - 5)
    put "GAME OVER"
    delay (1000)
    loop
	exit when hasch
    end loop
    close (file)
    cls
end addHighScore

proc checkIfLevelEnd
    if upper (asteroid) = 0 then
	initLevel
    end if
end checkIfLevelEnd

fcn checkIfDead : boolean
    if ship.lives < 0 then
	addHighScore
	result true
    end if
    result false
end checkIfDead

initLevel

loop
    loop
	shoot
	moveBullets
	moveShip
	moveAsteroids
	drawScreen
	checkIfLevelEnd
	if checkShipCollision then
	    ship.lives -= 1
	    loop
		cls
		moveBullets
		moveAsteroids
		drawScreen
		View.Update
		exit when clear or ship.lives < 0
	    end loop
	end if
	View.Update
	exit when checkIfDead
	cls
    end loop
    loop
	put "Play again? (yes/no)"
	get playAgain
	exit when playAgain = "yes" or playAgain = "no"
    end loop
    exit when playAgain = "no"
    setscreen ("offscreenonly")
    level := 0
    gameSpeed := 1
    score := 0
    initLevel
end loop