Here is a simple illustration of some of the ideas found in the last two sections. The program is designed to keep track of a small inventory. Each item is recorded by name, price, quantity and location (bin number). The records are kept in a disk file, and any new items are added to that disk file whenever the user chooses to save the data or exits the program.
The first version of the program keeps track of the inventory in a file that is manipulated by SeqFile as a rewindable stream, and the actual I/O is done by RawIO. Logically, the items in the stream consist of records; physically they are binary recordings. The planning information has been left out so as to save space.
MODULE Inventory;
(* Keeps track of a demonstration inventory in a file called "inventory.data." *)
(* Written by R.J. Sutcliffe *)
(* to demonstrate the use of records and RawIO *)
(* using ISO standard Modula-2 *)
(* last revision 1994 03 24 *)
FROM STextIO IMPORT
WriteString, ReadString, SkipLine, WriteLn, ReadChar, WriteChar;
FROM SWholeIO IMPORT
ReadCard, WriteCard;
FROM SRealIO IMPORT
ReadReal, WriteFixed;
FROM RawIO IMPORT
Read, Write;
FROM SIOResult IMPORT
ReadResult, ReadResults;
IMPORT IOResult;
FROM SeqFile IMPORT
OpenRead, OpenResults, raw, write, Reread, Rewrite, Close, ChanId;
CONST
max = 10; (* a small inventory *)
VAR
fileOpen, fileDirty : BOOLEAN; (* to know what the status is *)
TYPE
Name = ARRAY [0 .. 20] OF CHAR;
Item =
RECORD
name : Name;
price : REAL;
quantity : CARDINAL;
bin : CHAR;
END; (* Item *)
Items = ARRAY [1 .. max] OF Item;
VAR
emptyItem : Item;
stock : Items;
Ok : BOOLEAN;
dataChan : ChanId;
res : OpenResults;
(* This group of procedures displays current contents of fields on the screen for viewing or editing. *)
PROCEDURE DisplayName (name: Name);
BEGIN
WriteString ("Name ==> ");
WriteString (name);
END DisplayName;
PROCEDURE DisplayPrice (price : REAL);
BEGIN
WriteString ("Price ==> ");
WriteFixed (price, 2,6);
END DisplayPrice;
PROCEDURE DisplayQuantity (quantity : CARDINAL);
BEGIN
WriteString ("Quantity ==> ");
WriteCard (quantity, 10);
END DisplayQuantity;
PROCEDURE DisplayLocation (bin : CHAR);
BEGIN
WriteString ("Bin Location ==> ");
WriteChar (bin);
END DisplayLocation;
PROCEDURE DisplayItem (item : Item);
(* calls the above to display an item. *)
BEGIN
WITH item
DO
WriteString (" Item");
WriteLn;
DisplayName (name);
WriteString (" ");
DisplayPrice (price);
WriteString (" ");
WriteLn;
DisplayQuantity (quantity);
WriteString (" ");
DisplayLocation (bin);
WriteLn;WriteLn;
END;
END DisplayItem;
VAR
numItems : CARDINAL; (* global *)
PROCEDURE ListItems; (* list all items *)
VAR
count : CARDINAL;
BEGIN
FOR count := 1 TO numItems
DO
WriteCard (count, 1);
WriteString (". ");
DisplayName (stock [count].name);
WriteLn;
END;
END ListItems;
PROCEDURE EditItem (VAR item : Item); (* change contents *)
VAR
tempName : Name;
tempPrice : REAL;
tempQuantity : CARDINAL;
tempBin : CHAR;
BEGIN
WITH item
DO
WriteString (" Edit Item");
WriteLn;
DisplayName (name);
WriteLn;
ReadString (tempName);
IF (ReadResult() = allRight)
THEN
name := tempName;
fileDirty := TRUE;
END;
SkipLine;
WriteLn;
DisplayPrice (price);
WriteLn;
ReadReal (tempPrice);
IF (ReadResult() = allRight)
THEN
price := tempPrice;
fileDirty := TRUE;
END;
SkipLine;
WriteLn;
DisplayQuantity (quantity);
WriteLn;
ReadCard (tempQuantity);
IF (ReadResult() = allRight)
THEN
quantity := tempQuantity;
fileDirty := TRUE;
END;
SkipLine;
WriteLn;
DisplayLocation (bin);
WriteLn;
ReadChar (tempBin);
IF (ReadResult() = allRight)
THEN
bin := tempBin;
fileDirty := TRUE;
END;
SkipLine;
END; (* with *)
END EditItem;
PROCEDURE AddItem;
(* make an empty item, and then edit it. *)
VAR
temp : Item;
BEGIN
IF numItems < max
THEN
temp := emptyItem;
EditItem (temp);
INC (numItems);
stock [numItems] := temp;
END;
END AddItem;
PROCEDURE GetItem (VAR itemNum : CARDINAL);
(* Find out which one to deal with *)
BEGIN
IF numItems > 0
THEN
REPEAT
ListItems;
WriteString ("Pick one 1 .. "); WriteCard (numItems,1);
WriteString (" ==>");
ReadCard (itemNum);
SkipLine;
Ok := (ReadResult() = allRight) AND (itemNum <= numItems);
IF NOT Ok
THEN
WriteString ("Error in selection; try again");
WriteLn;
END;
UNTIL Ok;
ELSE
WriteString ("No items to list");
WriteLn;WriteLn;
itemNum := 0;
END;
END GetItem;
PROCEDURE Menu (VAR menuNum : CARDINAL);
(* print a menu of program choices and get a valid choice *)
VAR
Ok : BOOLEAN;
BEGIN
REPEAT
WriteString ("Do you wish to");WriteLn;
WriteString ("1. Get existing/ open new disk file");WriteLn;
WriteString ("2. Display an item");WriteLn;
WriteString ("3. Add an item");WriteLn;
WriteString ("4. Edit an item");WriteLn;
WriteString ("5. Save disk file");WriteLn;
WriteString ("6. Quit the program");WriteLn;
WriteString ("Pick one 1 .. 6 ==> ");
ReadCard (menuNum);
WriteLn;
SkipLine;
Ok := (ReadResult () = allRight) AND (menuNum <7);
IF NOT Ok
THEN
WriteString ("Error in menu selection; try again");
WriteLn;WriteLn;
END;
UNTIL Ok;
END Menu;
PROCEDURE GetFile;
(* Open and read contents of Inventory.data, if any. *)
BEGIN
numItems := 0;
OpenRead (dataChan, "InventoryData", raw+write, res);
IF (res = opened)
THEN
fileOpen := TRUE;
REPEAT
Read (dataChan, stock [numItems + 1]);
IF IOResult.ReadResult (dataChan) = allRight
THEN
INC (numItems);
END;
UNTIL (numItems = max) OR (IOResult.ReadResult (dataChan) # allRight)
END;
END GetFile;
PROCEDURE SaveFile;
(* write out entire file. If file not already open, opens and reads stuff in first. *)
VAR
count : CARDINAL;
BEGIN
IF NOT fileOpen
THEN
IF NOT fileDirty
THEN
WriteString ("No data collected & no file open");
WriteLn;
RETURN;
END;
GetFile;
END;
Rewrite (dataChan);
FOR count := 1 TO numItems
DO
Write (dataChan, stock [count]);
END;
Close (dataChan);
fileOpen := FALSE;
fileDirty := FALSE;
numItems := 0;
END SaveFile;
VAR (* main *)
action, itemNum : CARDINAL;
BEGIN
numItems := 0;
fileOpen := FALSE;
fileDirty := FALSE;
(* make a default or empty item for later editing *)
WITH emptyItem
DO (* initialize one *)
name := "";
price := 0.0;
quantity := 0;
bin := "*"; (* nowhere *)
END; (* with *)
WriteString (" Rick's Inventory program");
WriteLn;WriteLn;
REPEAT
Menu (action); (* print menu + get action *)
(* take action according to request from menu *)
IF (action = 1) AND NOT fileOpen
THEN
GetFile;
ELSIF (action = 2) THEN
GetItem (itemNum);
IF itemNum # 0
THEN
DisplayItem (stock [itemNum]);
END;
ELSIF (action = 3) THEN
AddItem;
ELSIF (action = 4) THEN
GetItem (itemNum);
IF itemNum # 0
THEN
EditItem (stock [itemNum]);
END;
ELSIF (action = 5) THEN
SaveFile;
ELSIF (action = 6) THEN
IF fileOpen
THEN
SaveFile;
END;
END;
UNTIL action = 6; (* and then quietly exit *)
END Inventory.
NOTES: 1. Observe the free use of numerous small specialized procedures to encapsulate program tasks for easy debugging.
2. Note the use of a menu that is reprinted on the screen repeatedly whenever the current task is complete.
This program was run and the data file created, added to, and edited. The program was run again and more items added. However, these runs are lengthy and the output is not reproduced here. It is left as an exercise to the student to make some improvements.
In this second module, the same file is opened and manipulated as in the last, except that a random access model is used, and only one record item is kept in memory at a time. The fact that a random access model can be imposed upon a file previously created with a sequential model device driver illustrates that the logical view of a file is independent of the physical recording. In the program listing below, many of the procedures from the first version are not duplicated.
MODULE RndInventory;
(* Keeps track of a demonstration inventory in a file called "inventory.data." *)
(* Written by R.J. Sutcliffe *)
(* to demonstrate the use of records, random access and RawIO *)
(* using ISO standard Modula-2 *)
(* last revision 1994 03 25 *)
FROM STextIO IMPORT
WriteString, ReadString, SkipLine, WriteLn, ReadChar, WriteChar;
FROM SWholeIO IMPORT
ReadCard, WriteCard;
FROM SRealIO IMPORT
ReadReal, WriteFixed;
FROM RawIO IMPORT
Read, Write;
FROM SIOResult IMPORT
ReadResult, ReadResults;
IMPORT IOResult;
FROM RndFile IMPORT
OpenOld, OpenResults, raw, read, write, Close, ChanId,
FilePos, StartPos, NewPos, EndPos, SetPos;
VAR
fileOpen : BOOLEAN; (* to know what the status is *)
TYPE
Name = ARRAY [0 .. 20] OF CHAR;
Item =
RECORD
name : Name;
price : REAL;
quantity : CARDINAL;
bin : CHAR;
END; (* Item *)
VAR
emptyItem, currentItem : Item;
Ok : BOOLEAN;
dataChan : ChanId;
res : OpenResults;
(* Put same display procedures here *)
VAR
numItems : CARDINAL; (* global *)
PROCEDURE ListItems; (* list all items *)
(* Pre : file is open *)
VAR
count : CARDINAL;
BEGIN
SetPos (dataChan, StartPos (dataChan));
count := 0;
REPEAT
Read (dataChan, currentItem);
IF IOResult.ReadResult (dataChan) = allRight
THEN
WriteCard (count+1, 1);
WriteString (". ");
DisplayName (currentItem.name);
WriteLn;
INC (count);
END;
UNTIL IOResult.ReadResult (dataChan) # allRight;
numItems := count;
END ListItems;
PROCEDURE PutItem (item: Item);
(* Write out item at current file position *)
BEGIN
Write (dataChan, item);
END PutItem;
PROCEDURE FetchItem (itemNum: CARDINAL; VAR item : Item);
(* Obtain that item number in the file
Assume program numbering 1 ... and file numbering 0... *)
VAR
pos : FilePos;
BEGIN
pos := NewPos (dataChan, itemNum-1, SIZE (Item), StartPos (dataChan));
SetPos (dataChan, pos);
Read (dataChan, item);
SetPos (dataChan, pos);
END FetchItem;
PROCEDURE EditItem (VAR item : Item); (* change contents *)
(* same as last time, but omit fileDirty lines *)
PROCEDURE GetFile;
(* Open or create Inventory.data *)
BEGIN
OpenOld (dataChan, "InventoryData", raw+write+read, res);
IF (res = opened)
THEN
fileOpen := TRUE;
SetPos (dataChan, StartPos(dataChan))
END;
END GetFile;
PROCEDURE CloseFile;
(* close file. If file not already open, does nothing. *)
VAR
count : CARDINAL;
BEGIN
IF NOT fileOpen
THEN
WriteString ("No file open");
WriteLn;
RETURN;
END;
Close (dataChan);
fileOpen := FALSE;
numItems := 0;
END CloseFile;
PROCEDURE AddItem;
(* make an empty item, and then edit it. *)
VAR
temp : Item;
BEGIN
IF NOT fileOpen
THEN
GetFile;
ELSE
SetPos (dataChan, EndPos (dataChan));
END;
temp := emptyItem;
EditItem (temp);
END AddItem;
PROCEDURE GetItem (VAR itemNum : CARDINAL);
(* Find out which one to deal with *)
BEGIN
IF fileOpen
THEN
REPEAT
ListItems;
WriteString ("Pick one 1 .. "); WriteCard (numItems,1);
WriteString (" ==>");
ReadCard (itemNum);
SkipLine;
Ok := (ReadResult() = allRight) AND (itemNum <= numItems);
IF NOT Ok
THEN
WriteString ("Error in selection; try again");
WriteLn;
END;
UNTIL Ok;
ELSE
WriteString ("File not open");
WriteLn;WriteLn;
itemNum := 0;
END;
END GetItem;
PROCEDURE Menu (VAR menuNum : CARDINAL);
(* identical to last version *)
END Menu;
VAR (* main *)
action, itemNum : CARDINAL;
BEGIN
numItems := 0;
fileOpen := FALSE;
(* make a default or empty item for later editing *)
WITH emptyItem
DO (* initialize one *)
name := "";
price := 0.0;
quantity := 0;
bin := "*"; (* nowhere *)
END; (* with *)
WriteString (" Rick's Inventory 2 program");
WriteLn;WriteLn;
REPEAT
Menu (action); (* print menu + get action *)
(* take action according to request from menu *)
IF (action = 1) AND NOT fileOpen
THEN
GetFile;
ELSIF (action = 2) THEN
GetItem (itemNum);
IF itemNum # 0
THEN
FetchItem(itemNum, currentItem);
DisplayItem (currentItem);
END;
ELSIF (action = 3) THEN
AddItem;
ELSIF (action = 4) THEN
GetItem (itemNum);
IF itemNum # 0
THEN
FetchItem(itemNum, currentItem);
EditItem (currentItem);
END;
ELSIF (action = 5) THEN
CloseFile;
ELSIF (action = 6) THEN
IF fileOpen
THEN
CloseFile;
END;
END;
UNTIL action = 6 (* and then quietly exit *)
END RndInventory.
Observe that only one item is kept in memory at a time, and that after it is read the file position is set back to its starting point so that if editing is done, the item will be written back to the correct location. Much of the other logic remains the same, but new procedures have been inserted to fetch an item by number and to return it to the disk.