Code: Select all
% Drew Martell
% Pong
% This program will recreate the awesome Pong experience you once
% had as a young, young child.
% BUG : IF 2P TOUCHES ROOF, BALL PASSES THROUGH UNLESS TOUCHES BOTTOM
% Need to find out how to cancel a process
var scoresFile : int
var records : string
var downLine := 1
var x, y : int
var dx, dy := 1
var player1, player2 : string
var ok : boolean := false
var background := blue
var introFont := Font.New ("serif:25")
var scoreFont := Font.New ("serif:18")
var getKey : array char of boolean
var dir, dir3 := 100
var dir2, dir4 := 180
var score1P, score2P := 0
var stickSpeed := 3
var ballSpeed := 2
x := 70
y := 313
setscreen ("nocursor")
process DrawText
loop
for i : 0 .. 255
Draw.Text ("WELCOME TO PONG", maxx div 2 - 150, maxy div 2, introFont, i)
end for
exit when ok = true
end loop
end DrawText
procedure MainMenu
drawfillbox (0, 0, maxx, maxy, red)
fork DrawText
colorback (red)
locate (17, 25)
put "Enter Player 1's Name: " ..
get player1 : *
locate (18, 25)
put "Enter Player 2's Name: " ..
get player2 : *
if (player1 = "del") and (player2 = "del") then
if File.Exists ("High Scores.txt") then
File.Delete ("High Scores.txt")
locate (20, 33)
put "FILE DELETED"
else
locate (20, 30)
put "FILE DOESN'T EXIST"
end if
Input.Pause
player1 := "Player 1"
player2 := "Player 2"
elsif (player1 = "view") and (player2 = "high scores") then
open : scoresFile, "High Scores.txt", get
loop
if (scoresFile = -10) then
exit
end if
get : scoresFile, records : *
locate (downLine, 28)
put records
downLine += 1
exit when eof (scoresFile)
end loop
Input.Pause
player1 := "Player 1"
player2 := "Player 2"
end if
cls
score1P := 0
score2P := 0
ok := true
end MainMenu
MainMenu
View.Set ("offscreenonly")
drawfillbox (0, 0, maxx, maxy, background)
drawbox (0, 0, maxx, maxy, black)
drawfillbox (20, dir2, 30, dir, white)
drawbox (20, dir2, 30, dir, black)
drawfillbox (maxx - 20, dir4, maxx - 30, dir3, white)
drawbox (maxx - 20, dir4, maxx - 30, dir3, black)
procedure MoveUp1P
drawfillbox (20, dir2, 30, dir, background)
dir += 1
dir2 += 1
drawfillbox (20, dir2, 30, dir, white)
drawbox (20, dir2, 30, dir, black)
delay (stickSpeed)
%View.Update
end MoveUp1P
procedure MoveDown1P
drawfillbox (20, dir2, 30, dir, background)
dir -= 1
dir2 -= 1
drawfillbox (20, dir2, 30, dir, white)
drawbox (20, dir2, 30, dir, black)
delay (stickSpeed)
%View.Update
end MoveDown1P
procedure MoveUp2P
drawfillbox (maxx - 20, dir4, maxx - 30, dir3, background)
dir3 += 1
dir4 += 1
drawfillbox (maxx - 20, dir4, maxx - 30, dir3, white)
drawbox (maxx - 20, dir4, maxx - 30, dir3, black)
delay (stickSpeed)
%View.Update
end MoveUp2P
procedure MoveDown2P
drawfillbox (maxx - 20, dir4, maxx - 30, dir3, background)
dir3 -= 1
dir4 -= 1
drawfillbox (maxx - 20, dir4, maxx - 30, dir3, white)
drawbox (maxx - 20, dir4, maxx - 30, dir3, black)
delay (stickSpeed)
%View.Update
end MoveDown2P
procedure Pause
end Pause
process Sound
Music.Sound (100, 70)
Music.SoundOff
end Sound
process WriteScore
open : scoresFile, "High Scores.txt", put, mod
put : scoresFile, player1, " VS ", player2, " : ", score1P, " - ", score2P
close : scoresFile
end WriteScore
process BouncyBall
loop
locate (1, 1)
colorback (green)
%put " x ", x, " y ", y, " dir ", dir, " dir2 ", dir2, " dir3 ", dir3, " dir4 ", dir4
%Draw.Text ("1P Score = ", 0, maxy - 18, scoreFont, red)
put player1, ' ', score1P
locate (1, 43)
put player2, ' ', score2P
x += dx
y += dy
delay (ballSpeed) % Balls speed
drawfilloval (x, y, 5, 5, yellow)
drawoval (x, y, 5, 5, black)
drawfillbox ((maxx div 2) - 10, 0, (maxx div 2), maxy, white)
drawbox ((maxx div 2) - 10, 0, (maxx div 2), maxy, black)
View.Update
drawfilloval (x, y, 5, 5, background)
% BOUNDARIES
if (x = 40) and (y >= dir and y <= dir2) then
fork Sound
dx := -dx
elsif (x < 40) then
score2P += 1
fork DrawText
fork WriteScore
x := 550
y := 300
elsif (x >= maxx - 40) and (y >= dir3 and y <= dir4) then
fork Sound
dx := -dx
elsif (x > maxx - 40) then
score1P += 1
fork DrawText
fork WriteScore
x := 70
y := 300
elsif (y = 0) or (y = maxy - 20) then
fork Sound
dy := -dy
end if
end loop
end BouncyBall
fork BouncyBall
loop
Input.KeyDown (getKey)
if getKey ('w') then
MoveUp1P
end if
if getKey ('s') then
MoveDown1P
end if
if getKey (KEY_UP_ARROW) then
MoveUp2P
end if
if getKey (KEY_DOWN_ARROW) then
MoveDown2P
end if
if getKey (KEY_ENTER) then
Pause
end if
if getKey (KEY_ESC) then
% Need to find out how to cancel a process
% Take out fork writescore before you put this
% open : scoresFile, "High Scores.txt", put, seek, mod
% put : scoresFile, player1, " VS ", player2, " : ", score1P, " - ", score2P
% seek : scoresFile, *
% close : scoresFile
quit
MainMenu
end if
% 1P Boundaries
if (dir <= 0) and (dir2 <= 80) then
dir := 0
dir2 := 80
elsif (dir >= maxy - 80) and (dir2 >= maxy - 80) then
dir2 := maxy
dir := maxy - 80
end if
% 2P Boundaries
if (dir3 <= 0) and (dir4 <= 80) then
dir3 := 0
dir4 := 80
elsif (dir3 >= maxy - 80) and (dir4 >= maxy - 80) then
dir3 := maxy - 80
dir4 := maxy
end if
end loop
[code]
[color=#888888][size=85]Archived topic from Iceteks, old topic ID:3976, old post ID:35033[/size][/color]