Listing: 1 MODULE Address; 2 (* 3 Copyright 1989 by Jensen & Partners International, All Rights Reserved 4 *) 5 6 7 IMPORT IO, FIO, Window, Btree, Str, Lib, Misc; 8 9 10 TYPE 11 AddrKey = ARRAY[0..25] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 12 AddrRec = RECORD 13 LName : ARRAY[0..14] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 14 FName : ARRAY[0..9] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 15 Street : ARRAY[0..25] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 16 City : ARRAY[0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 17 State : ARRAY[0..1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 18 Zip : ARRAY[0..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 19 Phone : ARRAY[0..12] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 20 END; (* record *) ***** ^ not supported yet 21 CharSet = SET OF CHAR; ***** ^ not supported yet 22 23 24 VAR 25 choice, ch2 : CHAR; 26 FOUND, 27 DONE : BOOLEAN; 28 DataColor, 29 TemplateColor : Window.Color; ***** ^ not supported yet 30 NameFile : Btree.FHandle; (* physical file handle *) ***** ^ not supported yet 31 NameData, (* logical data file handle *) 32 NameIndex : Btree.IHandle; (* logical index file handle *) ***** ^ not supported yet 33 blankAddr, 34 tempAddr : AddrRec; ***** ^ not supported yet 35 Create : BOOLEAN; 36 37 38 PROCEDURE MAKEKEY(keyA,myRecA: ADDRESS); ***** ^ undeclared identifier 39 VAR 40 key : POINTER TO AddrKey; ***** ^ not supported yet 41 myRec : POINTER TO AddrRec; ***** ^ not supported yet 42 i,j : CARDINAL; 43 BEGIN 44 key := keyA; ***** ^ not supported yet ***** ^ not supported yet 45 myRec := myRecA; ***** ^ not supported yet ***** ^ not supported yet 46 Str.Copy(key^,myRec^.LName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 i := Str.Length(key^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 WHILE (i#0) AND (key^[i-1]=' ') DO ***** ^ not supported yet ***** ^ not supported yet 49 key^[i-1] := 0C; ***** ^ not supported yet ***** ^ not supported yet 50 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 51 END; (* while *) 52 Str.Append(key^," "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 53 Str.Append(key^,myRec^.FName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 i := Str.Length(key^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 WHILE (i#0) AND (key^[i-1]=' ') DO ***** ^ not supported yet ***** ^ not supported yet 56 key^[i-1] := 0C; ***** ^ not supported yet ***** ^ not supported yet 57 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 58 END; (* while *) 59 Str.Caps(key^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 END MAKEKEY; ***** ^ not supported yet 61 62 63 PROCEDURE COMPARE(key1,key2: ADDRESS): Btree.CmpRes; ***** ^ undeclared identifier ***** ^ not supported yet 64 (* compare two keys, and determine which is "smaller" *) 65 BEGIN 66 RETURN Btree.CmpRes(Str.Compare(AddrKey(key1^),AddrKey(key2^))+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 END COMPARE; ***** ^ not supported yet 68 69 70 PROCEDURE Beep(); 71 BEGIN 72 Lib.Speaker(1500,10); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 73 END Beep; ***** ^ not supported yet 74 75 76 PROCEDURE WriteAt(row,col: CARDINAL; txt: ARRAY OF CHAR); ***** ^ not supported yet 77 BEGIN 78 Window.GotoXY(col,row); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 IO.WrStr(txt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 END WriteAt; ***** ^ not supported yet 81 82 83 PROCEDURE Template(); 84 BEGIN 85 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 WriteAt(3,3,"Name:"); ***** ^ not supported yet ***** ^ not supported yet 87 WriteAt(3,50,"(first last)"); ***** ^ not supported yet ***** ^ not supported yet 88 WriteAt(4,3,"Address:"); ***** ^ not supported yet ***** ^ not supported yet 89 WriteAt(5,3,"City:"); ***** ^ not supported yet ***** ^ not supported yet 90 WriteAt(5,40,"State:"); ***** ^ not supported yet ***** ^ not supported yet 91 WriteAt(5,55,"Zip:"); ***** ^ not supported yet ***** ^ not supported yet 92 WriteAt(6,3,"Phone:"); ***** ^ not supported yet ***** ^ not supported yet 93 END Template; ***** ^ not supported yet 94 95 96 PROCEDURE Display(myRec: AddrRec); 97 BEGIN 98 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 WriteAt(3,12,myRec.FName); IO.WrStr(" "); IO.WrStr(myRec.LName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 100 WriteAt(4,12,myRec.Street); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 101 WriteAt(5,12,myRec.City); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 102 WriteAt(5,47,myRec.State); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 103 WriteAt(5,60,myRec.Zip); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 104 WriteAt(6,12,myRec.Phone); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 END Display; ***** ^ not supported yet 106 107 108 PROCEDURE GetMenu(Prompt: ARRAY OF CHAR; OKChars: CharSet; ***** ^ not supported yet 109 VAR ch: CHAR); 110 VAR 111 OK : BOOLEAN; 112 MenuWin : Window.WinType; ***** ^ not supported yet 113 i : CARDINAL; 114 BEGIN 115 MenuWin := Window.Open( Window.WinDef( 0, 22, 79, 24, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 Window.White,Window.Black,TRUE,FALSE,TRUE,TRUE, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 Window.SingleFrame,Window.White,Window.Black) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 i := Str.Length(Prompt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 Window.Change(MenuWin,((80-i) DIV 2) -2,22, ((80-i) DIV 2) + i + 3, 24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 120 Window.SetFrame(MenuWin,Window.SingleFrame,TemplateColor,Window.Black); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 Window.Use(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 Window.PutOnTop(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 124 IO.WrStr(" "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 125 IO.WrStr(Prompt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 126 OK := FALSE; 127 REPEAT 128 ch := CAP(IO.RdKey()); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 IF ch IN OKChars THEN ***** ^ not supported yet 130 OK := TRUE; 131 ELSE 132 Beep(); ***** ^ not supported yet ***** ^ not supported yet 133 END; 134 UNTIL OK; 135 Window.Close(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 END GetMenu; ***** ^ not supported yet 137 138 139 PROCEDURE ShowNames(); 140 VAR 141 myRec : AddrRec; ***** ^ not supported yet 142 ch : CHAR; 143 row : CARDINAL; 144 switchColor : BOOLEAN; 145 BEGIN 146 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 147 Btree.Reset(NameData); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 row := 1; 149 switchColor := TRUE; 150 WHILE Btree.Next(NameIndex,myRec) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 IF switchColor THEN 152 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 ELSE 154 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 END; 156 switchColor := NOT switchColor; 157 IO.WrStrAdj(myRec.LName, -17); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 IO.WrStrAdj(myRec.FName, -12); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 IO.WrStrAdj(myRec.Phone, -15); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 IO.WrLn(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 161 INC(row); ***** ^ undeclared identifier ***** ^ not supported yet 162 IF row>23 THEN 163 IO.WrLn(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 164 IO.WrStr("Press to quit, any other key to continue: "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 ch := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 IF ch = 33C THEN RETURN; END; 167 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 168 row := 1; 169 END; (* if *) 170 END; (* while *) 171 END ShowNames; ***** ^ not supported yet 172 173 174 PROCEDURE FindName(); 175 VAR 176 fname : AddrKey; ***** ^ not supported yet 177 myRec : AddrRec; ***** ^ not supported yet 178 ch : CHAR; 179 BEGIN 180 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 181 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 182 FOUND := FALSE; 183 WriteAt(3,3,"Enter name as 'Last First' (e.g. 'Smith John')."); ***** ^ not supported yet ***** ^ not supported yet 184 WriteAt(4,3,"Be sure to include the space between the names."); ***** ^ not supported yet ***** ^ not supported yet 185 WriteAt(5,3,"> "); ***** ^ not supported yet ***** ^ not supported yet 186 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 187 fname := ''; ***** ^ not supported yet ***** ^ incompatible assignment 188 Misc.InputStr(fname,25); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 189 Str.Caps(fname); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 190 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 WriteAt(7,3,"Searching... "); ***** ^ not supported yet ***** ^ not supported yet 192 IF Btree.Find(NameIndex,fname,myRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 193 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 Template(); ***** ^ not supported yet ***** ^ not supported yet 195 Display(myRec); ***** ^ not supported yet ***** ^ not supported yet 196 FOUND := TRUE; 197 ELSE 198 WriteAt(7,20,"done. Failed exact search. Trying closest match."); ***** ^ not supported yet ***** ^ not supported yet 199 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 200 WriteAt(9,3,"Searching... "); ***** ^ not supported yet ***** ^ not supported yet 201 IF Btree.Search(NameIndex,fname,myRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 202 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 Template(); ***** ^ not supported yet ***** ^ not supported yet 204 Display(myRec); ***** ^ not supported yet ***** ^ not supported yet 205 FOUND := TRUE; 206 REPEAT 207 GetMenu("N)ext, P)revious, or T)his one? ", ***** ^ not supported yet ***** ^ not supported yet 208 CharSet{'N','P','T'},ch); ***** ^ 'CASE' expected ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 209 WriteAt(10,3," "); 210 CASE ch OF 211 'N' : IF Btree.Next(NameIndex,myRec) THEN 212 Display(blankAddr); 213 Display(myRec); 214 ELSE 215 WriteAt(10,3,"No more records found"); 216 Beep(); 217 Btree.Reset(NameIndex); 218 Display(blankAddr); 219 IF Btree.Prev(NameIndex,myRec) THEN 220 Display(myRec); 221 ELSE 222 FOUND := FALSE; 223 END; 224 END; 225 | 'P' : IF Btree.Prev(NameIndex,myRec) THEN 226 Display(blankAddr); 227 Display(myRec); 228 ELSE 229 WriteAt(10,3,"No more records found"); 230 Beep(); 231 Btree.Reset(NameIndex); 232 Display(blankAddr); 233 IF Btree.Next(NameIndex,myRec) THEN 234 Display(myRec); 235 ELSE 236 FOUND := FALSE; 237 END; 238 END; 239 ELSE 240 Beep(); 241 END; (* case *) 242 UNTIL ch = 'T'; 243 ELSE 244 WriteAt(9,20,"done. Failed closest match search."); 245 END; (* if *) 246 END; (* if *) 247 END FindName; 248 249 250 PROCEDURE AddName(); 251 VAR 252 myRec : AddrRec; 253 ch : CHAR; 254 BEGIN 255 Window.Clear(); 256 Template(); 257 ch := 'N'; 258 myRec := blankAddr; 259 REPEAT 260 Window.TextColor(DataColor); 261 Window.GotoXY(12,3); Misc.InputStr(myRec.FName,10); 262 Window.GotoXY(35,3); Misc.InputStr(myRec.LName,15); 263 Window.GotoXY(12,4); Misc.InputStr(myRec.Street,25); 264 Window.GotoXY(12,5); Misc.InputStr(myRec.City,15); 265 Window.GotoXY(47,5); Misc.InputStr(myRec.State,2); 266 Window.GotoXY(60,5); Misc.InputStr(myRec.Zip,5); 267 Window.GotoXY(12,6); Misc.InputStr(myRec.Phone,12); 268 GetMenu("Do these look ok? (Y/N) ",CharSet{'Y','N'},ch); 269 UNTIL ch = 'Y'; 270 (* Now put it in the file *) 271 Btree.Add(NameData,myRec,SIZE(myRec)); 272 END AddName; 273 274 275 PROCEDURE DeleteName(); 276 VAR 277 ch : CHAR; 278 BEGIN 279 FindName(); 280 IF FOUND THEN 281 GetMenu("Delete this one? (Y/N) ",CharSet{'Y','N'},ch); 282 IF ch = 'Y' THEN 283 Btree.Delete(NameData); 284 END; (* if *) 285 END; (* if *) 286 FOUND := FALSE; 287 END DeleteName; 288 289 290 BEGIN (* main program *) 291 TemplateColor := Window.LightGreen; 292 DataColor := Window.Yellow; 293 Str.Copy(blankAddr.LName," "); 294 Str.Copy(blankAddr.FName," "); 295 Str.Copy(blankAddr.Street," "); 296 Str.Copy(blankAddr.City," "); 297 Str.Copy(blankAddr.State," "); 298 Str.Copy(blankAddr.Zip," "); 299 Str.Copy(blankAddr.Phone," "); 300 Window.Clear(); 301 Create := NOT FIO.Exists("Addressb.ook"); 302 NameFile := Btree.Open("Addressb.ook",2,Btree.FixSize,FALSE,FALSE,Create); 303 NameData := Btree.OpenData(NameFile,1,SIZE(AddrRec),Create); 304 NameIndex := Btree.OpenIndex(NameFile,NameData,2,COMPARE,MAKEKEY, 305 SIZE(AddrKey),TRUE,Create); 306 DONE := FALSE; 307 choice := ' '; 308 REPEAT 309 GetMenu("S)howNames F)indSomeone A)ddSomeone D)eleteSomeone Q)uit :", 310 CharSet{'S','F','A','D','Q'},choice); 311 CASE choice OF 312 'S' : ShowNames(); 313 | 'F' : FindName(); 314 | 'A' : AddName(); 315 | 'D' : DeleteName(); 316 | 'Q' : DONE := TRUE; 317 ELSE 318 Beep(); 319 END; (* case *) 320 UNTIL DONE; 321 Btree.Close(NameFile); 322 END Address. 310 errors