-- minidb.ex
-- --------------------------------------------------------------------
-- | |
-- | A Program to maintain a list |
-- | of names & phone numbers |
-- | |
-- | |
-- --------------------------------------------------------------------
-- This program maintains a simple file of names and telephone numbers.
-- The data is kept in a sequential file. For working with the records,
-- the program reads all the records (if any) into memory near the start
-- of the program, then writes the records out to the file at the end of
-- the program run.
-- For simplicity, the following are features:
-- (1) All records are read into and maintained in memory.
-- (2) The records' file is maintained as a sequential file
-- (3) Data typing and checking is not implemented for fields.
include graphics.e -- for screen colouring, get_position(), cursor()
include get.e -- for wait_key()
include wildcard.e -- for upper()
-- variables declared here are global to the program:
constant file_name = "myphones.dat", -- name of sequential data file
max_recs = 1000, -- maximum # of records can have
up_arrow = 328, -- define user keys
dn_arrow = 336,
esc = 27,
con = 0, -- define devices (I don't usually)
screen = 1,
prompt_line = 24,
bad_file = -1,
fg = YELLOW, -- main text colour
bg = BLUE, -- main background colour
fgf = BLACK, -- data field text colour
bgf = WHITE -- data field background colour
procedure blank_line(atom row)
-- Fills row 'row' on the screen with 80 spaces
-- Exits with cursor at col 1 of line 'row'
sequence filler
filler = repeat(' ', 80)
position(row,1)
puts(screen, filler)
position(row, 1)
end procedure
procedure any_key()
-- Invite user to press a key
atom reply
puts(screen, " [Press any key]")
cursor(UNDERLINE_CURSOR)
reply = wait_key()
end procedure
function ask(sequence question)
atom reply
puts(screen, question & " (Y/N): ")
reply = ' '
cursor(UNDERLINE_CURSOR)
while reply != 'Y' and reply != 'N' do
reply = wait_key()
reply = upper(reply)
end while
return reply
end function
function initial()
-- a function to initial the meta-data. Change this for different sorts of
-- data bases with more fields differently named (prompted).
sequence meta
-- meta describes the name (prompt) for each field, the
-- length of the field and whether the field is type alpha or integer.
-- It also gives the row and column for display of each field.
-- Field type is not implemented in this program - the fields will accept
-- anything typed.
meta = {
-- Prompt Length Type Row Col
{ "Name", 30, 'A', 4, 5}, -- alpha field
{ "Phone", 12, 'I', 4, 45} -- integer field
}
return meta
end function
function read_file(atom n_fields)
-- Opens and reads the data file into sequence rec_data
atom fn, n_recs -- Declare variables.
sequence fields_holder, rec_data
object getter
n_recs = 0 -- We start with no records, and
rec_data = {} -- with the data sequence empty.
fn = open(file_name, "r") -- Try to open the file to read it.
if fn != bad_file then -- If we are successful,
getter = " " -- initial object getter to be a 1-space seq.
while sequence(getter) do -- For so long as getter remains a sequence
fields_holder = {} -- To hold fields for each record (temp)
for i=1 to n_fields do -- For each field of a record
getter = gets(fn) -- read a field
if not sequence(getter) then -- if it's not a field
fields_holder = {} -- patch - no partial records
exit -- jump out of the for loop
else -- else add another field to record
getter = getter[1..length(getter)-1] -- crop newline
fields_holder = append(fields_holder, getter) -- add the field
end if
end for
-- a record is complete; add it to record collection
if length(fields_holder) > 0 then
rec_data = append(rec_data, fields_holder)
end if
end while
close(fn) -- close the file
end if
return rec_data -- send back the list of records
end function
procedure write_file(sequence data_list, sequence meta_data)
-- Writes the records (if any) to data file on disk
atom fn, n_recs, n_fields, del
n_recs = length(data_list) -- # of records in memory
n_fields = length(meta_data) -- # of fields per record
text_color(fg) bk_color(bg)
blank_line(prompt_line)
if n_recs > 0 then -- if there are records,
fn = open(file_name, "w") -- open the output file.
if fn != bad_file then -- if opened successfully,
for i=1 to n_recs do -- then for each record
del = match("DELETED", data_list[i][1])-- test if rec deleted
if del = 0 then -- if rec not deleted
for j= 1 to n_fields do -- for each field
puts(fn, data_list[i][j] & '\n') -- write the field
end for -- next field
end if
end for -- next record
close(fn) -- close the file
puts(screen, " File saved ")
else
puts(screen, " Save failure - records not saved ")
end if
else
puts(screen, " No records to save ")
end if
any_key() -- pause
end procedure
function empty_buffer(atom n_fields, sequence meta_data)
-- This function produces a buffer holding the required number
-- of fields for a record, each field padded to its length with spaces.
sequence buffer
buffer = repeat(' ', n_fields) -- Give buffer n_fields elements
for i = 1 to n_fields do -- Modify each element
buffer[i] = repeat(' ', meta_data[i][2]) -- by padding to length
end for
return buffer -- send back the buffer
end function
procedure display_rec (sequence buffer, sequence meta_data)
-- Displays the data in buffer on the screen, using info
-- contained in meta_data to position it.
atom n_fields, row, col
n_fields = length(meta_data) -- number of field in buffer
text_color(fgf) -- foreground color of a field
bk_color(bgf) -- background color of a field
cursor(NO_CURSOR) -- turn off cursor
for i=1 to n_fields do -- For each field,
row = meta_data[i][4] -- set up to position,
col = meta_data[i][5]
text_color(fg) bk_color(bg)
position(row, col) -- position and
puts(screen, meta_data[i][1] & ": ") -- show prompt
text_color(fgf) bk_color(bgf)
puts(screen,buffer[i]) -- display field
end for
end procedure
function add_record(sequence data_list, sequence meta_data)
-- Type in a new record. The record is added to the end
-- of the data_list.
atom n_recs, n_fields, field_length, reply, n_pads
sequence buffer, posn
object temp
n_recs = length(data_list) -- number of records in memory
n_fields = length(meta_data) -- number of fields in a record
buffer = empty_buffer(n_fields, meta_data) -- fill buffer with spaces
display_rec(buffer, meta_data) -- display the buffer
if n_recs < max_recs then -- if can add a record
for i=1 to n_fields do -- for each field
text_color(fg) bk_color(bg) -- set main colouring
blank_line(prompt_line) -- fill prompt line with spaces
puts (screen, meta_data[i][1] & ": ") -- display prompt
posn = get_position() -- capture cursor position
text_color(fgf) bk_color(bgf) -- set colours for field
puts(screen, buffer[i]) -- display the field
position(posn[1], posn[2]) -- cursor back to prompt
cursor(UNDERLINE_CURSOR) -- make cursor visible
temp = 0 -- force temp to be an atom
while not sequence(temp) do -- loop until we get sequence
temp = gets(con) -- get user's typing
end while -- end loop
temp = temp[1..length(temp)-1] -- crop newline from input
field_length = meta_data[i][2] -- measure input
if length(temp) > field_length then -- if input too long,
temp = temp[1..field_length] -- chop to max length
elsif length(temp) < field_length then
-- pad out to length
n_pads = field_length - length(temp) -- number to pad
temp &= repeat(' ', n_pads) -- do the padding
end if
for j=1 to length(temp) do -- put input into buffer
buffer[i][j] = temp[j]
end for
display_rec(buffer, meta_data) -- re-display buffer
end for -- next field
text_color(fg) bk_color(bg) -- set main colours
blank_line(prompt_line) -- ask user if ok
reply = ask(" Is this OK")
if reply = 'Y' then -- if it is
data_list = append(data_list, buffer) -- add new record to list, and
n_recs = n_recs + 1 -- bump record number
blank_line(prompt_line) -- tell user..
puts(screen, " A new record has been added ")
else -- tell user..
puts(screen, " No changes have been made ")
end if
else -- tell user..
text_color(fg) bk_color(bg)
blank_line(prompt_line)
puts(screen, " Database full, can add no records ")
end if
any_key() -- prompt for key press
return data_list -- send back the records
end function
function delete_record(atom rec_no, sequence data_list, sequence meta_data)
-- This marks record # rec_no for deletion. The record is not
-- actually deleted until it is written to disk.
atom reply, length1
length1 = meta_data[1][2]
text_color(fg) bk_color(bg)
blank_line(prompt_line)
reply = ask("Delete this record -- are you sure")
blank_line(prompt_line)
if reply = 'Y' and rec_no > 0 then
data_list[rec_no][1] = "DELETED" & repeat(' ', length1)
puts(screen, " Record marked for deletion ")
else
puts(screen, " No record deleted ")
end if
puts(screen, " [Press any key] ")
reply = wait_key()
return data_list
end function
function edit_data(sequence meta_data, sequence data_list)
-- Here we edit, add to, or delete records in the data_list.
atom n_fields, n_recs, rec_no, user_key
sequence buffer, prog_name, bar, prompts
n_fields = length(meta_data)
n_recs = length(data_list) -- number of records in memory
? graphics_mode(3) -- select graphic screen
bk_color(bg)
clear_screen() -- clear and set bk color
text_color(fg)
-- here is the screen "furniture" :
prog_name = "MINIDB.EX: Mini Data Base"
prompts =
" Arrow keys move through records, A to add, D to delete, Esc to quit."
bar = repeat('-', 79) & '\n'
user_key = ' ' -- initial for main loop
if n_recs > 0 then
rec_no = 1 -- start at record 1, if any records
else
rec_no = 0 -- start at record 0 (no records)
end if
-- main edit loop
while user_key != esc do -- Commence main editing loop
n_recs = length(data_list) -- number of records in memory
bk_color(bg) text_color(fg) -- set main colouring
-- set out main screen 'furniture' (Title, prompts, etc)
position(1,1)
puts(screen, prog_name)
position(23, 1)
puts(screen, bar)
puts(screen, prompts)
buffer = empty_buffer(n_fields, meta_data) -- make empty padded buffer,
if rec_no > 0 then -- if at a record,
for i = 1 to n_fields do -- get record rec_no
buffer[i] = data_list[rec_no][i]
end for
end if
position(1, 60)
printf(screen, "Record number %d/%d", {rec_no, n_recs}) -- show record #
display_rec(buffer, meta_data) -- display the buffer
user_key = wait_key() -- get user key
user_key = upper(user_key)
if user_key = up_arrow and rec_no > 1 then
rec_no = rec_no - 1 -- go up 1 record
elsif user_key = dn_arrow and rec_no < n_recs then
rec_no = rec_no + 1 -- go down 1 record
elsif user_key = 'A' then -- add a record
data_list = add_record(data_list, meta_data)
elsif user_key = 'D' then -- delete a record
data_list = delete_record(rec_no, data_list, meta_data)
end if
end while
return data_list
end function
procedure mainline()
-- This procedure controls the over-all operation of the program
sequence meta_data, data_list
atom n_fields, reply
meta_data = initial() -- Initial the meta_data
n_fields = length(meta_data) -- number of fields in a record
data_list = read_file(n_fields) -- Read the data file
data_list = edit_data(meta_data, data_list) -- Do main editing
write_file(data_list, meta_data) -- Write the data file
-- process program termination
reply = graphics_mode(-1) -- restore default screen
position(prompt_line, 30)
puts(screen, " That's all, Folks!") -- silly farewell
reply = wait_key() -- get key press
end procedure
mainline()
-- End program listing ---------------------------------------------------------
Conversion to HTML by PC2HTM.EXE