% Battleship
% Steven Smiley
%===============Importing GUI==================
import GUI
%======================Text=============
var Font2 : int
%================Constants=====================
const size := 10
const boxWidth := 50
%===========Global Data Structure============
type matrix : array 0 .. size, 0 .. size of string (4)
%====================variables==============
%==========Puddle===============
var puddle1 : matrix
var puddle2 : matrix
%=======Global Values For Ship Lengths========
var aclen, bslen, dslen, sblen : int
%============Vital Global Cords===============
var urow, ucol : int
%=====Variables For Player 1 And Player 2=====
var achits1, bshits1, dshits1, sbhits1 : int := 0
var onewins : boolean
var achits2, bshits2, dshits2, sbhits2 : int := 0
var twowins : boolean
%=================Procedures===================
%==========Read Mouse========
proc readMouse (var mrow, mcol : int)
loop
var xmouse, ymouse, button, updown : int
buttonwait ("down", xmouse, ymouse, button, updown)
mcol := xmouse div boxWidth
% ymouse := ymouse - boxWidth
mrow := (maxy - ymouse) div boxWidth
exit when mrow > 0 and mrow <= size
and mcol > 0 and mcol <= size
locate (40, 25)
colour (brightred)
put "Click inside"
delay (1200)
locate (40, 25)
put " "
end loop
end readMouse
%===========Clear Board=============
procedure clearboard (var grid : matrix)
var r, c : int
% r := 0 % TOP LABELS <-- will replace later
% for col : 0 .. size
% grid (r, col) := intstr (col, 2)
% end for
%
% c := 0 % SIDE LABELS
% for row : 0 .. size
% grid (row, c) := intstr (row, 2)
% end for
for row : 1 .. size
for col : 1 .. size
grid (row, col) := "+"
end for
end for
end clearboard
%=================Draw Boxes=============
proc drawBoxes % <---------- Creates the new grid type board
locate (2, 40)
colour (brightred)
put "BATTLESHIP!!!"
var x, y, x1, y1 : int
for row : 1 .. size
for col : 1 .. size
x := col * boxWidth
y := (maxy - row * boxWidth) - boxWidth
x1 := x + boxWidth
y1 := y + boxWidth
drawfillbox (x, y, x1, y1, black)
drawbox (x, y, x1, y1, yellow)
end for
end for
end drawBoxes
%=============Place Ships===============
procedure placeShips (var puddle1 : matrix) % replace with user entry
for row : 5 .. 8
for col : 1 .. 1
puddle1 (row, col) := "BS"
end for
end for
for row : 5 .. 5
for col : 4 .. 8
puddle1 (row, col) := "AC"
end for
end for
for row : 1 .. 1
for col : 2 .. 4
puddle1 (row, col) := "DS"
end for
end for
for row : 8 .. 9
for col : 9 .. 9
puddle1 (row, col) := "SB"
end for
end for
end placeShips
%=============Display=============
procedure display (var grid : matrix, showShips : boolean)
var aString : string (4)
var x, y, x1, y1 : int
for row : 1 .. size
for col : 1 .. size
x := col * boxWidth
y := (maxy - row * boxWidth) - boxWidth
locatexy (x + boxWidth div 3, y + boxWidth div 2)
aString := grid (row, col)
if aString (1) = "H" or aString (1) = "M" then
color (brightred)
put grid (row, col) ..
elsif showShips and aString not= "+" then
color (black)
put aString ..
end if
color (white)
end for
end for
end display
%================Shooting===============
procedure shoot (var grid : matrix, var ac, bs, ds, sb : int, var win :
boolean)
% put "Where in the ocean are you going to shoot?"
% put "ROW ==> " ..
% get urow
% put "COL ==> " ..
% get ucol
readMouse (urow, ucol)
locatexy (ucol * boxWidth, (maxy - urow * boxWidth) - boxWidth)
if grid (urow, ucol) = "AC" then
locate (40, 30)
colour (brightred)
put "YOU HIT!!!!" ..
delay (1400)
grid (urow, ucol) := "HIT"
ac := ac + 1
if ac = aclen then
locate (40, 30)
put "YOU SUNK MY AIRCRAFT CARRIER!!!" ..
delay (1400)
end if
elsif grid (urow, ucol) = "BS" then
locate (40, 30)
colour (brightred)
put "YOU HIT!!!!" ..
delay (1400)
grid (urow, ucol) := "HIT"
bs := bs + 1
if bs = bslen then
locate (40, 30)
colour (brightred)
put "YOU SUNK MY BATTLESHIP!!!" ..
delay (1400)
end if
elsif grid (urow, ucol) = "DS" then
locate (40, 30)
colour (brightred)
put "YOU HIT!!!!" ..
delay (1400)
grid (urow, ucol) := "HIT"
ds := ds + 1
if ds = dslen then
locate (40, 30)
colour (brightred)
put "YOU SUNK MY DESTROYER!!!" ..
delay (1400)
end if
elsif grid (urow, ucol) = "SB" then
locate (40, 30)
colour (brightred)
put "YOU HIT!!!!" ..
delay (1400)
grid (urow, ucol) := "Hit"
sb := sb + 1
if sb = sblen then
locate (40, 30)
colour (brightred)
put "You SUNK my Submarine!!!" ..
delay (1400)
end if
else
locate (40, 30)
colour (brightred)
put "YOU MISSED!!!!" ..
delay (1400)
grid (urow, ucol) := "MISS"
end if
% put (aclen + bslen + dslen + sblen)
% if (ac + bs + ds + sb) = (aclen + bslen + dslen + sblen) then
% win := true
% else
% win := false
% end if
end shoot
%====================Hold==================
proc hold
var key : char
locate (40,30)
put "Any key . . ." ..
key := getchar
end hold
%=============Variable For Text=================
var Font1 : int
%=========================Text=====================
Font1 := Font.New ("comicsans:52:bold")
Font.Draw ("Battleship", 175, 310, Font1, brightred)
%===========Play===========
proc Player_Two
cls
colourback (black)
aclen := 5
bslen := 4
dslen := 3
sblen := 2
clearboard (puddle1)
placeShips (puddle1)
cls
locate (36, 70)
colour (yellow)
put " Battleship = 4 Squares"
locate (34, 70)
put " Aircraft carrier = 5 Squares"
locate (32, 70)
put " Destroyer = 3 Squares"
locate (30, 70)
put " Submarine = 2 Squares"
locate (7,80)
colour (yellow)
put " Player 2"
drawBoxes
display (puddle1, true)
shoot (puddle1, achits1, bshits1, dshits1, sbhits1, onewins)
delay (1700)
end Player_Two
proc Play
cls
locate (10, 35)
colour (yellow)
put "Loading Player 1..."
delay (1500)
cls
setscreen ("graphics:800;700")
colourback (black)
aclen := 5
bslen := 4
dslen := 3
sblen := 2
clearboard (puddle1)
placeShips (puddle1)
loop
cls
locate (36, 70)
colour (yellow)
put " Battleship = 4 Squares"
locate (34, 70)
put " Aircraft carrier = 5 Squares"
locate (32, 70)
put " Destroyer = 3 Squares"
locate (30, 70)
put " Submarine = 2 Squares"
locate (7,80)
colour (yellow)
put " Player 1"
drawBoxes
display (puddle1, true)
shoot (puddle1, achits1, bshits1, dshits1, sbhits1, onewins)
delay (1700)
cls
locate (10, 35)
colour (yellow)
put "Loading Player 2..."
delay (1500)
Player_Two
end loop
end Play
%===================Second Player====================
proc Single_Player
cls
locate (10, 35)
colour (yellow)
put "Loading..."
delay (1500)
cls
setscreen ("graphics:800;700")
colourback (black)
aclen := 5
bslen := 4
dslen := 3
sblen := 2
clearboard (puddle1)
placeShips (puddle1)
loop
cls
locate (36, 70)
colour (yellow)
put " Battleship = 4 Squares"
locate (34, 70)
put " Aircraft carrier = 5 Squares"
locate (32, 70)
put " Destroyer = 3 Squares"
locate (30, 70)
put " Submarine = 2 Squares"
locate (7,80)
colour (yellow)
put " Player 1"
drawBoxes
display (puddle1, true)
shoot (puddle1, achits1, bshits1, dshits1, sbhits1, onewins)
delay (600)
end loop
hold
end Single_Player
%==========Instructions========
procedure Instructions
cls
colour (yellow)
put "Object Of Game"
put " "
put " To win Battleship you must sink all four of the opponent's ships"
put " "
put "Basic Play"
put " "
put " The basic rules for Battleship are that each player takes turns shooting"
put " at an empty grid trying to locate where their ships are located."
put " "
put "Instructions"
put " "
put " You take turns clicking in empty box on the grid, it will then tell you"
put " if you hit a ship or missed a ship."
put " "
put "Ship Lengths"
put " "
put " Battleship = 4 Squares"
put " Aircraft carrier = 5 Squares"
put " Destroyer = 3 Squares"
put " Submarine = 2 Squares"
var button2:int:=GUI.CreateButton(350,50,0,"Play",Play)
end Instructions
colourback (black)
%========Buttons==========
var button1:int:=GUI.CreateButton(275,175,0,"Instructions",Instructions)
var button2:int:=GUI.CreateButton(285,225,0,"1 Player",Single_Player)
var button3:int:=GUI.CreateButton(282,200,0,"2 Players", Play)
loop
exit when GUI.ProcessEvent
end loop
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
