ʾ6#6>!)*&P ~"::H:H:H:H"!6!4:_jYO jM*"S*" 3@bl*M1͓!""7 *M^͆ \͔!":͎H*#"ͧÝ/ :>͛9ͯ .*#":_!' !'6!36' :1/!aE*#">z?C9IͲÁ.!6> !ڇ*&' ~2 ʀ: y.*M!4Q>!қ:=2á:2:Ҭ\>!ҿ:=2K:ʾ6#6>!)*&P ~"::H:H:H:H"!6!4:_jYO jM*"S*" 3@bl*M1͓!""7 *M^͆ \͔!":͎H*#"ͧÝ/ :>͛9ͯ .*#":_!' !'6!36' :1/!aE*#">z?C9IͲÁ.!6> !ڇ*&' ~2 ʀ: y.*M!4Q>!қ:=2á:2:Ҭ\>!ҿ:=2K:t used *) (* Disc Serial Numbers and their Categories is built. *) (* *) (* 2.0 The Categories, together with 'New Category' and *) (* NRS are presented to the User who can choose *) (* a) to use an existing Category, or *) (* b) to use a new Category, or *) (* c) to request a display of the allocated Serial *) (* numbers. This mode will return to main *) (* menu selection after examination *) (* *) (* 3.0 The next available Serial Number is selected and a *) (* file of the form *) (* <-category Name.Serial Number> *) (* is written to the disc in Drive B. *) (* *) (* 4.0 The Program cycles until all initialising is *) (* completed. *) (* *) (* *) (* *) (* Note: This Program uses the Serial Number '0' to mean *) (* 'Undefined'. Therefore this program will not *) (* work if your current MAST.CAT has entries for *) (* Serial Number 0. *) (* *) (****************************************************************) (*$L+,C-,F-,I-,M-,P-,R-,S-,U- *) Const Max#Nr#Discs = 999; Max#Nr#Cats = 100; (* So, we can have 999 *) (* discs and upto 100 *) (* categories. *) MaxFilNam = 8; (* Max 8 Chars in Name *) MaxRecLn = 25; (* Mac MAST.CAT rec Len *) NewSelect = 0; (* Menu increment for *) (* New Category *) DiscDisp = 1; (* Menu increment for a *) (* display of current *) (* Disc Serial Numbers *) Type Serial#Nrs = 0..Max#Nr#Discs; (* See Introduction re. *) (* the use of 0. *) Nr#categories = 0..Max#Nr#Cats; High#Ser#Nrs = Array (. Nr#categories .) of Serial#Nrs; Category = Packed Array (.1..MaxFilNam.) of Char; NewFileName = Packed Array (.1..15.) of Char; Disc#Nrs = Array (. Serial#Nrs .) of Boolean; CatNames = Array (. Nr#categories .) of category; Mast#Format = Packed Array(. 1..MaxRecLn .) of Char; Var Disc#Nr : Disc#Nrs; (* Disc#Nr(I) = True implies that*) (* Serial Nr I is already in use *) Cat#Name : CatNames ; Highest#Ser#Nr : High#Ser#Nrs ; Cname : Category; Cur#category : Category; Coni, Cono : Text; Dummy : Text; Mast#File : Text; Mast#RecORD : Mast#Format; Found : Boolean; Unique#Name : Boolean; I,K : Integer; Inchar : Char; Cat# : Nr#categories; Upper#Bound : Nr#categories; Catalog#Index : Nr#categories; New#Disc#Nr : Serial#Nrs; Cur#Disc#Nr : Serial#Nrs; New# : Serial#Nrs; New#File#Name : NewFileName; (*$L+ *) Procedure Decode#Cats ( Var Mast#Record : Mast#Format; Var Cur#category: Category; Var Cur#Disc#Nr : Serial#Nrs ); (****************************************************************) (* *) (* Decode#Cats decodes a part of the MAST.CAT records. *) (* At the time of call, the next invocation of READ will fetch *) (* the first Char of the category. The Caller of Decode#Cats has*) (* pre-edited to ensure that *) (* 1. No File-Exclusions will be passed to Decode#Cats *) (* 2. The File Name part of each record is skipped *) (* *) (* File-Exclusions are those files which are not to be shown in *) (* the Catalogue. Please refer to the Documentation given in *) (* Vol 9 of PASCAL Z User Group Library. *) (* *) (* The result of this procedure is the (upto) 8 Char *) (* category name in Cur#Category, and *) (* the corresponding Disc Number in Cur#Disc#Nr. *) (* Mast#Record is Read-Only. *) (* *) (****************************************************************) Var I, Num : Integer; Ch : Char; Begin I := 1; Read(Mast#File, Ch); (* Skip over the , *) While Ch <> '.' Do Begin (* Pull in the category Name, terminated by '.' *) Cur#category(. I .) := Ch; Read ( Mast#File, Ch); I := I +1; End; (* Spacefill the remainder *) For I := I to MaxFilNam Do Begin Cur#Category(. I .) := ' '; End; Num := 0; For I := 1 to 3 Do Begin (* Extract the three digit number *) Read ( Mast#File, Ch ); Num := Num * 10 + ORD (Ch) - ORD('0'); End; Cur#Disc#Nr := Num; End; (*$L+ *) Procedure Sort (Var Catalog#Index : Integer; Var Highest#Ser#Nr : High#Ser#Nrs; Var Cat#Name : CatNames ); (****************************************************************) (* *) (* Procedure Sort sorts the Catalog names, and the correspond- *) (* -ing Highest#Ser#Nr into alphabetic sequence. *) (* *) (* The updates are made directly in the input Arrays. *) (* *) (* *) (****************************************************************) Var T#Ser : Serial#Nrs; I, J : Integer; T#Cat : category; Begin For I := 1 to Catalog#Index-1 Do Begin; For J := I+1 to Catalog#Index Do If Cat#Name(. I .) > Cat#Name (. J .) then Begin; T#Cat := Cat#Name(. I .); T#Ser := Highest#Ser#Nr(. I .); Cat#Name(. I .) := Cat#Name(. J .); Highest#Ser#Nr(. I .) := Highest#Ser#Nr(. J .); Cat#Name(. J .) := T#Cat; Highest#Ser#Nr(. J .) := T#Ser; End; End; (* ***** DEBUG Code For I := 1 to Catalog#Index Do Begin; Writeln(Cono, 'Sorted Catalog ',Cat#Name(.I.)); End; *) End; (*$L+ *) Procedure Select#Disc#Nr ( Var Highest#Val : Serial#Nrs; Var Disc#Nr : Disc#Nrs; Var New#Disc#Nr : Serial#Nrs ); (****************************************************************) (* *) (* The procedure selects the next appropriate Serial Number *) (* for the given category. *) (* Appropriate is taken to mean the 'nearest' free serial Number*) (* so that given categories will tend to have their allocated *) (* Serial Numbers clustered. *) (* If there are no free Serial Numbers left, then 0 is returned*) (* This case is further analysed by the caller. *) (* *) (****************************************************************) Var I, Intstart : Serial#Nrs; Start : Serial#Nrs; Intsize ,Nint : Integer; Begin New#Disc#Nr := 0; Intsize := 0; Intstart :=0; Start := 0; Nint := 0; If Highest#Val = 0 (* Must be a new allocation *) then Begin (* The search is for the largest unused interval in the Serial *) (* Nrs set. When the interval is found, the center-value is *) (* selected. *) (* Note that in all cases, if no serial number is found, then *) (* New#Disc#Nr is left 0. *) For I := 1 to Max#Nr#Discs Do Begin; If Disc#Nr(. I .) = False then Begin; If Start = 0 then Begin Start := I; Nint := 0; End Else Nint := Nint + 1; End Else Begin; If Nint >= Intsize then Begin Intsize := Nint; Intstart := Start; End; Nint := 0; Start:= 0; End; End; New#Disc#Nr :=TRUNC (Intstart+Intsize/2); End Else Begin; (* The scan is from the current highest Serial Number for the *) (* current category, to the next (higher) Available Number. *) I := Highest#Val; While(( I <= Max#Nr#Discs) and (New#Disc#Nr = 0) ) Do Begin; If Disc#Nr(. I .) = False then New#Disc#Nr := I; I := I+ 1; End; End; (* This final scan is for the exceptional case that no number *) (* has yet been found. If this scan fails, then there are no *) (* available numbers, and 0 is returned to the caller *) If New#Disc#Nr = 0 then Begin; I := 1; While(( I <= Max#Nr#Discs) and (New#Disc#Nr = 0) ) Do Begin; If Disc#Nr(. I .) = False then New#Disc#Nr := I; I := I+ 1; End; End; (* Now remember the new allocation of the Seraial Number *) Disc#Nr(. New#Disc#Nr .) := True; (* ****** DEBUG CODE Writeln(Cono, 'New Serial Nr', New#Disc#Nr, 'Start ',Start, 'Nint ',Nint,'HighestVal ',Highest#Val); *) End; (*$L+ *) Procedure Menu#Display( Var Cat#Name : CatNames; Var Catalog#Index : Nr#Categories ); (* This procedure displays a menu of the Category Names, with *) (* index number. The Index Number is used to select the required*) (* Category for the new disc. The set of Categories found in *) (* MAST.CAT has ***NEW** and **NRS** appended. If the user *) (* selects either of these from the menu, then he can allocate *) (* a new category, or see a display of the current disc nrs *) (* which are in use. *) Var Nr#Cycles, N, I : Integer; Begin Cat#Name(. Catalog#Index+1.) := '***NEW**'; Cat#Name(. Catalog#Index+2.) := '***NRS**'; Nr#Cycles := TRUNC((Catalog#Index+2)/4); Writeln(Cono); Writeln(Cono); Writeln(Cono); Writeln(Cono,' Catalog Menu '); Writeln(Cono); Writeln(Cono); I := 1; For N:=1 to Nr#Cycles Do Begin; Writeln(Cono,I ,' ', Cat#Name(.I .) , I+1,' ', Cat#Name(.I+1.) , I+2,' ', Cat#Name(.I+2.) , I+3,' ', Cat#Name(.I+3.) ); I := I+4; End; For N:= 1 to Catalog#Index+2 - Nr#Cycles * 4 Do Begin; Write(Cono, I+N-1,' ',Cat#Name(.I+N-1.)); End; Writeln(Cono ); (* Housekeeping *) End; (*$L+ *) Procedure Build#File#Name ( Var NewDiscNr :Serial#Nrs; Var Cat#Name :Category; Var File#Name :NewFileName ); (* This procedure builds an unambiguous File Name for the file *) (* which is written to the New Disc. *) (* The name is of the form *) (* where NAME and SERIALNR are given to this procedure as input *) (* parameters. *) Var I :1..MaxFilNam; J, X, K :Integer; Nr# :Serial#Nrs; Begin Nr# := NewDiscNr; File#Name := ' '; File#Name(.1.):='B'; File#Name(.2.):=':'; File#Name(.3.):='-'; (* Components of name are built, now the next part gives *) I:= 1; While (Cat#Name(. I .) <> ' ') and (I <= MaxFilNam ) Do Begin; File#Name(.I+3.) := Cat#Name(.I.); I := I +1; End; (* *) File#Name(.I+3.) := '.'; (* and this code added '.' to give *) K:= 100; For J:= I+4 to I+6 Do Begin; X :=TRUNC( Nr# / K); File#Name (.J.) := CHR( X+ ORD('0') ); Nr# := Nr# - X*K; K := TRUNC(K/10); End; (* Finally the File Name is completed with the Serial Nr *) (* DEBUG CODE Writeln(Cono,'Build FName ','InNr ',NewDiscNr,'InName ',Cat#Name); *) End; (*$L+ *) Procedure Select#Category; (* This procedure selects a new disc serial number for either an*) (* existing Category, or a new Category. *) (* New categories are checked for name uniqueness before being *) (* allocated, and the case of no disc numbers being vacant is *) (* also detected. *) Var Inchar : Char; Begin; If Cat# = Catalog#Index + NewSelect then Begin; (* The ***NEW** was selected, so a NEW Category will be read in *) (* from the Console. *) Unique#Name := False; While Not Unique#Name Do Begin; Writeln(Cono,'Give me the new category Name'); Readln(Coni, Cname); (* Convert all lower case chars to upper case *) K := 1; While K <= MaxFilNam Do Begin; (* DEBUG Writeln( Cono, Cname(.K.), ORD(Cname(.K.)) );*) If (ORD(Cname(.K.)) > 96) and (ORD(Cname(.K.)) < 123) then Cname(.K.):=CHR(ORD(Cname(.K.))-32) ; (* DEBUG Writeln(Cono, Cname(.K.),K);*) K:=K+1; (* 97 is a, 122 is z, and 32 is the difference between Upper and*) (* Lower case. *) End; (* Verify that the name does not already exist *) Cat#Name(.Cat#.) := Cname; K :=1; While Cat#Name(.K.) <> Cname Do Begin K:=K+1; End; If K = Cat# then Unique#Name:=True Else Writeln(Cono, 'Name already in use'); End; Select#Disc#Nr (New#, Disc#Nr, New#Disc#Nr); Catalog#Index := Cat# + 1; Highest#Ser#Nr(. Cat# .) := New#Disc#Nr; Upper#Bound :=Cat#; Cat#Name(. Cat#.) := Cname; End Else If Cat# < Catalog#Index + NewSelect then Select#Disc#Nr(Highest#Ser#Nr(.Cat#.), Disc#Nr, New#Disc#Nr); If New#Disc#Nr > 0 then Begin; Writeln(Cono); Writeln(Cono,'New Serial Nr is :-', New#Disc#Nr); Cname := Cat#Name(. Cat# .); (* Now form the complete file name for the New Disc *) Build#File#Name( New#Disc#Nr, Cname, New#File#Name); Writeln(Cono, 'Press RETURN when disc in drive B is ready'); Writeln(Cono, 'Or S(kip) RETURN if you dont want the Initialisation'); Readln(Coni,Inchar); If Inchar <>'S' then Begin; Writeln(Cono, 'Initialising Drive Now with ',New#File#Name); Rewrite ( New#File#Name , Dummy ); End; End Else Begin; (* We have no Discs left !!!!!! *) Writeln( Cono, 'Sorry, All out of Discs'); End; End; (*$L+ *) Procedure Display#Discs; (* This procedure produces a sorted list of the Disc Serial *) (* numbers which are in use. *) (* The boolean table DIsc#Nr is scanned, and TRUE entries *) (* have their Index into the table displayed *) Const Nr#Cols = 7; Var I,K : Serial#Nrs; Ch : Char; Begin; I :=0; K:= 0; Writeln(Cono); Writeln(Cono); Writeln(Cono,' Allocated Disc Serial Numbers'); Writeln(Cono); While I <= Max#Nr#Discs Do Begin; If Disc#Nr(. I .) = TRUE then Begin; (* For each allocated Disc Number, print the number, with up *) (* to Nr#Cols of numbers per line. *) K:=K+1; Write (Cono, I); If K = Nr#Cols then Begin; K:=0; Writeln(Cono); End; End; I:=I+1; End; Writeln(Cono ); Writeln(Cono,'Press RETURN to get back to menu'); Readln(Coni,Ch); End; (*$L+ *) Begin (* The MAIN Procedure *) (* Initialization of the Files *) Reset ('A:MAST.CAT', Mast#file); Reset ('CON:' , Coni ); Rewrite('CON:' , Cono ); (* Init the Global Tables and Scalers *) New#:=0; Catalog#Index := 1; For I:= 1 to Max#Nr#Discs Do Begin; Disc#Nr (. I .) := False; End; For I:= 1 to Max#Nr#Cats Do Begin; Highest#Ser#Nr (. I .) := 0; End; (* End of Inits *) (*$L+ *) While Not EOF ( Mast#file ) Do Begin; Readln (Mast#file , Mast#Record ); While Not EOLN ( Mast#file ) Do Begin; Read ( Mast#file , Inchar ); (* Skip thru the file until the first/next ',' is found. *) (* Following ',' is always the Category name and Serial Nr *) If Inchar = ',' then Begin; Decode#Cats ( Mast#Record, Cur#category, Cur#Disc#Nr ); (* We have the Disc#Nr and the Cur#Cat, now we have to record *) (* them in our central tables *) (* DEBUG CODE Writeln (Cono,'Disc Nr ', Cur#Disc#Nr); *) (* DEBUG CODE Writeln (Cono,'Cur Cat ', Cur#category); *) (* Define the Selected Disc to be IN USE *) (* and insert the category into the category Name Table *) Disc#Nr (. Cur#Disc#Nr .):= True; Cat#Name (. Catalog#Index .) := Cur#category; K := 1; While Cat#Name(. K .) <> Cur#category Do Begin; K := K + 1; End; (* If we have re-found the Cat Name insertion, then the name was*) (* not already in the table and so we must increment the current*) (* Catalog#Index to allow the name to stay there. *) If K = Catalog#Index then Catalog#Index := Catalog#Index + 1; (* Log the highest Serial Nr used by a category. This is an aid *) (* to the selection of a new Serial Number for the new disc. *) If Highest#Ser#Nr(. K .) < Cur#Disc#Nr then Highest#Ser#Nr(. K .) := Cur#Disc#Nr; End; End; End; (*$L+ *) (* The processing of MAST.CAT is completed, we now display the *) (* results and request User-input *) Upper#Bound := Catalog#Index-1;(* Becuase Catalog#Index is the *) (* next available entry. *) Sort( Upper#Bound, Highest#Ser#Nr, Cat#Name); Cat# := 1; While Cat# <> 0 Do Begin; (* Start the Dialog Processing for Category Selection *) Menu#Display ( Cat#Name, Upper#Bound); Writeln(Cono,' '); Writeln( Cono, 'Please select a category from the menu'); Writeln( Cono, 'Use 0 to exit '); Readln(Coni, Cat#); If Cat# <> 0 then Begin; If Cat# > Catalog#Index+ DiscDisp then While Cat# > Catalog#Index+ DiscDisp Do Begin; Writeln(Cono,'Thats not in my menu, try again'); Readln(Coni, Cat#); End; If Cat# <= Catalog#Index + NewSelect then Select#Category; If Cat# = Catalog#Index + DiscDisp then Display#Discs; End; End; Writeln (Cono, 'BYE BYE '); END.