%---------------------------------------------------------------------------
procedure hold
var ch : string (1)
getch (ch)
end hold
%---------------------------------Title Screen------------------------------
var font : int := Font.New ("Astron boy Video:35")
procedure PutFont (row, colour : int, word : string) % formal parameters
var start : int
start := (40 - length (word)) * 10 div 2 % center the text
for i : 1 .. length (word)
Font.Draw (word (i), start + i * 20, row * 18, font, colour)
% horizontal spacing 10, vertical spacing 22
end for
end PutFont
colour (red)
PutFont (16, 4, " The Basket-Ball Program")
font := Font.New ("alien:25")
PutFont (13, 1, " By: SunnY")
font := Font.New ("White Bold:25")
PutFont (10, 7, " I C S 3 M 1")
delay (2500)
colour (7)
cls
font := Font.New ("Monotype Corsiva:25")
%---------------------------------------------------------------------------
type playerType :
record
name : string (15)
possition : string (15)
points : int
rebounds : int
jersey : int
age : int
end record
var player : playerType
%open a file called school for writing
var fileNumber : int
open : fileNumber, "players.txt", read, write,
seek, mod
assert fileNumber > 0
const maxPlayers := 500
type whereAbouts :
record
name : string (15)
possition : string (15)
points : int
rebounds : int
jersey : int
age : int
location : int
end record
type directoryType : array 1 .. maxPlayers of whereAbouts
var directory : directoryType
var names : array 1 .. maxPlayers of string (15)
var locs : array 1 .. maxPlayers of int
var numRecords : int
%--------------------------------------------------------------------------
procedure fillDirectoryArray
var filePosition : int := 0
%read each file to detect pointer
numRecords := 0
seek : fileNumber, 0
loop
exit when eof (fileNumber)
numRecords := numRecords + 1
directory (numRecords).location := filePosition
locs (numRecords) := filePosition
read : fileNumber, player
directory (numRecords).name := player.name
names (numRecords) := player.name
tell : fileNumber, filePosition
%display records
%put numRecords : 2, player.name : 15, player.possition : 15,
% player.points
%delay (100)
%setup array for finding records
end loop
color (33)
end fillDirectoryArray
fillDirectoryArray
%----------------------------------------------------------------------------
% PRINT RECORD
%-------------------------------------------------------------------------
proc printRecords
seek : fileNumber, 0
for i : 1 .. numRecords
read : fileNumber, player
put i : 2, " ", player.name : 15, player.possition : 15,
player.points, player.rebounds : 15, player.jersey : 15,
player.age : 15
delay (100)
cls
end for
cls
seek : fileNumber, 0
put "##" : 2, "" : 2, "NAME" : 15, "POSITION" : 15, "POINTS " : 15,
"REBOUNDS" : 15,
"JERSEY #" : 15, "Age" : 15
put ""
for i : 1 .. numRecords
read : fileNumber, player
put i : 2, " ", player.name : 15, player.possition : 15,
player.points, player.rebounds : 15, player.jersey : 15,
player.age : 15
end for
hold
cls
end printRecords
%----------------------------------------------------------------------------
% FIND RECORDS
%-----------------------------------------------------------------------------
procedure find (var name : string (15), var position : int, count : int)
%use global variables directory and count
%see lookup program in chapter on arrays
if length (name) < 15 then
%pad with blanks
name := name + repeat (" ", 15 - length (name))
end if
position := - 1
%search list for name by linear search
for i : 1 .. count
if name = directory (i).name then
position := directory (i).location
exit
end if
end for
end find
%---------------------------------------------------------------------------
% ADD PLAYER
%----------------------------------------------------------------------------
var count : int
procedure addPlayers
var recordPosition : int
color (3)
put "How many players are there?" ..
color (4)
get count
color (23)
put "Enter ", count, " player record(s)"
put " "
%place labels to show user where to enter data
put "Name" : 15, "Position" : 15, "Points " : 15, "Rebounds" : 15,
"Jersey" : 15, "Age" : 15
for i : 1 .. count
numRecords := numRecords + 1
%determine where next record will start in file
tell : fileNumber, recordPosition
%store filePosition as location in directory
get skip, player.name : 15, player.possition : 15, player.points,
player.rebounds, player.jersey, player.age
directory (numRecords).name := player.name
names (numRecords) := player.name
directory (numRecords).location := recordPosition
locs (numRecords) := recordPosition
write : fileNumber, player
end for
end addPlayers
%---------------------------------------------------------------------------
% FIND RECORDS
%----------------------------------------------------------------------------
procedure findRecords (var place : int)
%access the records randomly
var wantedPlayer : string (15)
put "Enter name of Player."
get skip, wantedPlayer : *
find (wantedPlayer, place, numRecords)
if place not= - 1 then
seek : fileNumber, place
read : fileNumber, player
%put "new name"
%get skip, player.name:15
%write :fileNumber,player
put "Here is the information you want!"
put "NAME" : 15, "POSSITION" : 15, "POINTS " :
15,
"REBOUNDS" : 15,
"JERSEY #" : 15, "Age" : 15
put ""
put player.name : 15, player.possition : 15,
player.points, player.rebounds : 15, player.jersey : 15,
player.age : 15
else
put "Player not in file"
end if
end findRecords
%---------------------------------------------------------------------------
% MODIFY RECORD
%%----------------------------------------------------------------------------
var foundPlace : int
proc modifyRecord
var choice : int
findRecords (foundPlace)
% read found record
if foundPlace not= - 1 then
seek : fileNumber, foundPlace
read : fileNumber, player
put "Record to modify: ", player.name
put ""
put "Change What?"
put "1 .. Name"
put "2 .. Possition"
put "3 .. Points"
put "4 .. Rebounds"
put "5 .. Jersey"
put "6 .. Age"
put "Selection : " ..
get choice
case choice of
label 1 :
put "Enter new Name: " ..
get player.name : *
for i : 1 .. (15 - length (player.name))
player.name := player.name + " "
end for
label 2 :
put "Enter new Possition: " ..
get player.possition : *
for i : 1 .. (15 - length (player.possition))
player.possition := player.possition + " "
end for
label 3 :
put "Enter new Points: " ..
get player.points
label 4 :
put "Enter new Rebounds: " ..
get player.rebounds
label 5 :
put "Enter new Jersey: " ..
get player.jersey
label 6 :
put "Enter new Age: " ..
get player.age
end case
seek : fileNumber, foundPlace
write : fileNumber, player
put "new record"
put player.name : 15, player.possition : 15, player.points : 15,
player.rebounds : 15,
player.jersey : 15, player.age : 15
fillDirectoryArray
else
put "No record found"
end if
end modifyRecord
%_______________________________________________________________________
procedure swap (var list : array 1 .. * of string (*), i, j : int)
const temp := list (i)
list (i) := list (j)
list (j) := temp
end swap
procedure swap1 (var list : array 1 .. * of int, i, j : int)
const temp := list (i)
list (i) := list (j)
list (j) := temp
end swap1
%----------------------------------------------------------------------------
var num : int
procedure printList10 (list : array 1 .. * of int)
for i : 1 .. 1000
put list (i), " " ..
end for
put ""
end printList10
delay (1000)
%-----------------------------------------------------------------------------
procedure selectSort (var list : array 1 .. * of string (*), var list1 :
array 1 .. * of int,
numberOfElements : int)
% Sort list of string by selection
for i : 1 .. numberOfElements - 1
var locationOfSmallest := i
for j : i + 1 .. numberOfElements
if list (j) <= list (locationOfSmallest) then
locationOfSmallest := j
end if
end for
swap (list, i, locationOfSmallest)
swap1 (list1, i, locationOfSmallest)
%put i : 3, locationOfSmallest : 3, " " ..
%printList10 (list)
end for
end selectSort
procedure displaySort
for i : 1 .. numRecords
seek : fileNumber, locs (i)
read : fileNumber, player
put i : 2, " ", player.name : 15, player.possition : 15,
player.points, player.rebounds : 15, player.jersey : 15,
player.age : 15
delay (100)
cls
end for
cls
put "##" : 2, "" : 2, "NAME" : 15, "POSITION" : 15, "POINTS " : 15,
"REBOUNDS" : 15,
"JERSEY #" : 15, "Age" : 15
put ""
for i : 1 .. numRecords
seek : fileNumber, locs (i)
read : fileNumber, player
put i : 2, " ", player.name : 15, player.possition : 15,
player.points, player.rebounds : 15, player.jersey : 15,
player.age : 15
end for
hold
cls
end displaySort
%---------------------------------------------------------------------------------------------
procedure Quit
var font : int := Font.New ("desdemona:50")
for x : - 10 .. 200 by 10
Font.Draw ("THANK YOU", x, 150, font, Rand.Int (1,12))
delay (30)
Font.Draw ("THANK YOU", x, 150, font, white)
end for
for y : 150 .. 250 by 10
Font.Draw ("THANK YOU", 200, y, font, Rand.Int (1,12))
delay (30)
Font.Draw ("THANK YOU", 200, y, font, white)
end for
Font.Draw ("THANK YOU", 200, 250, font, Rand.Int (1,12))
delay (30000)
cls
end Quit
%-------------------------------------Menu Screen--------------------------
procedure MenueScreen
var font : int := Font.New ("monotype corsiva:25")
var choice : int
loop
PutFont (20, 2, "* * * * * * * * * * * *")
PutFont (19, 1, " Records")
PutFont (18, 2, "* * * * * * * * * * * *")
for x : - 10 .. 205 by 35
Font.Draw ("1. Add Players ", x, 255, font, 4)
delay (30)
Font.Draw ("1. Add Players ", x, 255, font, white)
end for
PutFont (14, 4, " 1. Add Players")
for decreasing x : 600 .. 205 by 35
Font.Draw ("2. Print Records", x, 215, font, 1)
delay (30)
Font.Draw ("2. Print Records", x, 215, font, white)
end for
PutFont (12, 1, " 2. Print Records")
for x : - 10 .. 205 by 35
Font.Draw ("3. Search Players", x, 175, font, 4)
delay (30)
Font.Draw ("3. Search Players", x, 175, font, white)
end for
PutFont (10, 4, " 3. Search Players")
for decreasing x : 600 .. 205 by 35
Font.Draw ("4. Sort By Name", x, 135, font, 1)
delay (30)
Font.Draw ("4. Sort By Name", x, 135, font, white)
end for
PutFont (8, 1, " 4. Sort By Name")
for x : - 10 .. 205 by 35
Font.Draw ("5. Modify Record", x, 95, font, 4)
delay (30)
Font.Draw ("5. Modify Record", x, 95, font, white)
end for
PutFont (6, 4, " 5. Modify Record")
for decreasing x : 600 .. 205 by 35
Font.Draw ("6. Quit", x, 65, font, 7)
delay (30)
Font.Draw ("6. Quit", x, 65, font, white)
end for
PutFont (4, 7, "6. Quit")
for y : 1 .. 20 by 5
Font.Draw ("* Please Enter Your Choice *", 145, y, font, 2)
delay (30)
Font.Draw ("* Please Enter Your Choice *", 145, y, font,
white)
end for
PutFont (1, 2, "Please*Enter*Your*Choice")
%------------------------------------------------------------------------------------------------
get choice
cls
case choice of
label 1 :
addPlayers
label 2 :
printRecords
label 3 :
findRecords (foundPlace)
label 4 :
selectSort (names, locs, numRecords)
displaySort
label 5 :
modifyRecord
label 6 :
Quit
label : put"out of range"
end case
end loop
end MenueScreen
MenueScreen
|