Listing: 1 MODULE Address2; 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 (* generic *) FIO.WrChar(FIO.StandardOutput,CHR(7)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 73 (* OS/2 *) (* Lib.Speaker(1500,10); *) 74 (* DOS *) (* Lib.Sound(1500); 75 Lib.Delay(10); 76 Lib.NoSound(); *) 77 END Beep; ***** ^ not supported yet 78 79 80 PROCEDURE WriteAt(row,col: CARDINAL; txt: ARRAY OF CHAR); ***** ^ not supported yet 81 BEGIN 82 Window.GotoXY(col,row); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 IO.WrStr(txt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 END WriteAt; ***** ^ not supported yet 85 86 87 PROCEDURE Template(); 88 BEGIN 89 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 WriteAt(3,3,"Name:"); ***** ^ not supported yet ***** ^ not supported yet 91 WriteAt(3,50,"(first last)"); ***** ^ not supported yet ***** ^ not supported yet 92 WriteAt(4,3,"Address:"); ***** ^ not supported yet ***** ^ not supported yet 93 WriteAt(5,3,"City:"); ***** ^ not supported yet ***** ^ not supported yet 94 WriteAt(5,40,"State:"); ***** ^ not supported yet ***** ^ not supported yet 95 WriteAt(5,55,"Zip:"); ***** ^ not supported yet ***** ^ not supported yet 96 WriteAt(6,3,"Phone:"); ***** ^ not supported yet ***** ^ not supported yet 97 END Template; ***** ^ not supported yet 98 99 100 PROCEDURE Display(myRec: AddrRec); 101 BEGIN 102 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 103 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 104 WriteAt(4,12,myRec.Street); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 WriteAt(5,12,myRec.City); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 106 WriteAt(5,47,myRec.State); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 107 WriteAt(5,60,myRec.Zip); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 WriteAt(6,12,myRec.Phone); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 109 END Display; ***** ^ not supported yet 110 111 112 PROCEDURE GetMenu(Prompt: ARRAY OF CHAR; OKChars: CharSet; ***** ^ not supported yet 113 VAR ch: CHAR); 114 VAR 115 OK : BOOLEAN; 116 MenuWin : Window.WinType; ***** ^ not supported yet 117 i : CARDINAL; 118 BEGIN 119 MenuWin := Window.Open( Window.WinDef( 0, 22, 79, 24, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 120 Window.White,Window.Black,TRUE,FALSE,TRUE,TRUE, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 Window.SingleFrame,Window.White,Window.Black) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 i := Str.Length(Prompt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 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 124 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 125 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 126 Window.Use(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 127 Window.PutOnTop(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 IO.WrStr(" "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 IO.WrStr(Prompt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 OK := FALSE; 131 REPEAT 132 ch := CAP(IO.RdKey()); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 133 IF ch IN OKChars THEN ***** ^ not supported yet 134 OK := TRUE; 135 ELSE 136 Beep(); ***** ^ not supported yet ***** ^ not supported yet 137 END; 138 UNTIL OK; 139 Window.Close(MenuWin); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 140 END GetMenu; ***** ^ not supported yet 141 142 143 PROCEDURE ShowNames(); 144 VAR 145 myRec : AddrRec; ***** ^ not supported yet 146 ch : CHAR; 147 row : CARDINAL; 148 switchColor : BOOLEAN; 149 loc : LONGCARD; ***** ^ undeclared identifier 150 BEGIN 151 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 152 Btree.Reset(NameData); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 row := 1; 154 switchColor := TRUE; 155 LOOP 156 IF Btree.Next(NameIndex,myRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 157 IF switchColor THEN 158 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 ELSE 160 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 161 END; 162 switchColor := NOT switchColor; 163 IO.WrStrAdj(myRec.LName, -17); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 164 IO.WrStrAdj(myRec.FName, -12); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 IO.WrStrAdj(myRec.Phone, -15); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 IO.WrLn(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 167 INC(row); ***** ^ undeclared identifier ***** ^ not supported yet 168 Btree.Release(NameIndex); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 169 IF row>23 THEN 170 IO.WrLn(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 171 IO.WrStr("Press to quit, any other key to continue: "); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 172 ch := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 173 IF ch = 33C THEN RETURN; END; 174 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 175 row := 1; 176 END; (* if *) 177 ELSE 178 CASE Btree.LastError(NameIndex) OF ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 Btree.OK : EXIT; ***** ^ not supported yet ***** ^ not supported yet 180 | Btree.Locked : IF Btree.NextIndex(NameIndex,loc) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 181 IO.WrStr('[LOCKED]'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 182 IO.WrLn; ***** ^ not supported yet ***** ^ not supported yet 183 ELSE 184 CASE Btree.LastError(NameIndex) OF ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 185 Btree.OK : EXIT; (* Huh? *) ***** ^ not supported yet ***** ^ not supported yet 186 | Btree.Locked : IO.WrStr('[INDEX LOCKED]'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 187 IO.WrLn; ***** ^ not supported yet ***** ^ not supported yet 188 EXIT; 189 ELSE 190 IO.WrStr('[ERROR]'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 IO.WrLn; ***** ^ not supported yet ***** ^ not supported yet 192 EXIT; 193 END; 194 END; 195 ELSE 196 IO.WrStr('[ERROR]'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 197 IO.WrLn; ***** ^ not supported yet ***** ^ not supported yet 198 EXIT; 199 END; 200 END; 201 END; 202 END ShowNames; ***** ^ not supported yet 203 204 205 PROCEDURE FindName(); 206 VAR 207 fname : AddrKey; ***** ^ not supported yet 208 myRec : AddrRec; ***** ^ not supported yet 209 ch : CHAR; 210 BEGIN 211 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 212 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 213 FOUND := FALSE; 214 WriteAt(3,3,"Enter name as 'Last First' (e.g. 'Smith John')."); ***** ^ not supported yet ***** ^ not supported yet 215 WriteAt(4,3,"Be sure to include the space between the names."); ***** ^ not supported yet ***** ^ not supported yet 216 WriteAt(5,3,"> "); ***** ^ not supported yet ***** ^ not supported yet 217 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 218 Misc.InputStr(fname,25); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 219 Str.Caps(fname); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 220 Window.TextColor(TemplateColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 WriteAt(7,3,"Searching... "); ***** ^ not supported yet ***** ^ not supported yet 222 IF Btree.Find(NameIndex,fname,myRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 223 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 Template(); ***** ^ not supported yet ***** ^ not supported yet 225 Display(myRec); ***** ^ not supported yet ***** ^ not supported yet 226 FOUND := TRUE; 227 ELSIF Btree.LastError(NameIndex) # Btree.Locked THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 WriteAt(7,20,"done. Failed exact search. Trying closest match."); ***** ^ not supported yet ***** ^ not supported yet 229 Window.TextColor(DataColor); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 230 WriteAt(9,3,"Searching... "); ***** ^ not supported yet ***** ^ not supported yet 231 IF Btree.Search(NameIndex,fname,myRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 Window.Clear(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 233 Template(); ***** ^ not supported yet ***** ^ not supported yet 234 Display(myRec); ***** ^ not supported yet ***** ^ not supported yet 235 FOUND := TRUE; 236 REPEAT 237 GetMenu("N)ext, P)revious, or T)his one? ", ***** ^ not supported yet ***** ^ not supported yet 238 CharSet{'N','P','T'},ch); ***** ^ 'CASE' expected ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 239 WriteAt(10,3," "); 240 CASE ch OF 241 'N' : IF Btree.Next(NameIndex,myRec) THEN 242 Display(blankAddr); 243 Display(myRec); 244 ELSIF Btree.LastError(NameIndex) = Btree.Locked THEN 245 WriteAt(10,3,"Locked"); 246 Beep(); 247 ELSE 248 WriteAt(10,3,"No more records found"); 249 Beep(); 250 Btree.Reset(NameIndex); 251 Display(blankAddr); 252 IF Btree.Prev(NameIndex,myRec) THEN 253 Display(myRec); 254 ELSE 255 FOUND := FALSE; 256 END; 257 END; 258 | 'P' : IF Btree.Prev(NameIndex,myRec) THEN 259 Display(blankAddr); 260 Display(myRec); 261 ELSIF Btree.LastError(NameIndex) = Btree.Locked THEN 262 WriteAt(10,3,"Locked"); 263 Beep(); 264 ELSE 265 WriteAt(10,3,"No more records found"); 266 Beep(); 267 Btree.Reset(NameIndex); 268 Display(blankAddr); 269 IF Btree.Next(NameIndex,myRec) THEN 270 Display(myRec); 271 ELSE 272 FOUND := FALSE; 273 END; 274 END; 275 ELSE 276 Beep(); 277 END; (* case *) 278 UNTIL ch = 'T'; 279 ELSE 280 WriteAt(9,20,"done. Failed closest match search."); 281 END; (* if *) 282 ELSE 283 WriteAt(9,20,"done. Locking conflict occured."); 284 END; (* if *) 285 END FindName; 286 287 288 PROCEDURE AddName(); 289 VAR 290 myRec : AddrRec; 291 ch : CHAR; 292 BEGIN 293 Window.Clear(); 294 Template(); 295 ch := 'N'; 296 myRec := blankAddr; 297 REPEAT 298 Window.TextColor(DataColor); 299 Window.GotoXY(12,3); Misc.InputStr(myRec.FName,10); 300 Window.GotoXY(35,3); Misc.InputStr(myRec.LName,15); 301 Window.GotoXY(12,4); Misc.InputStr(myRec.Street,25); 302 Window.GotoXY(12,5); Misc.InputStr(myRec.City,15); 303 Window.GotoXY(47,5); Misc.InputStr(myRec.State,2); 304 Window.GotoXY(60,5); Misc.InputStr(myRec.Zip,5); 305 Window.GotoXY(12,6); Misc.InputStr(myRec.Phone,12); 306 GetMenu("Do these look ok? (Y/N) ",CharSet{'Y','N'},ch); 307 UNTIL ch = 'Y'; 308 (* Now put it in the file *) 309 Btree.Add(NameData,myRec,SIZE(myRec)); 310 END AddName; 311 312 313 PROCEDURE DeleteName(); 314 VAR 315 ch : CHAR; 316 BEGIN 317 FindName(); 318 IF FOUND THEN 319 GetMenu("Delete this one? (Y/N) ",CharSet{'Y','N'},ch); 320 IF ch = 'Y' THEN 321 Btree.Delete(NameData); 322 END; (* if *) 323 END; (* if *) 324 Btree.Release(NameIndex); 325 FOUND := FALSE; 326 END DeleteName; 327 328 329 BEGIN (* main program *) 330 TemplateColor := Window.LightGreen; 331 DataColor := Window.Yellow; 332 Str.Copy(blankAddr.LName," "); 333 Str.Copy(blankAddr.FName," "); 334 Str.Copy(blankAddr.Street," "); 335 Str.Copy(blankAddr.City," "); 336 Str.Copy(blankAddr.State," "); 337 Str.Copy(blankAddr.Zip," "); 338 Str.Copy(blankAddr.Phone," "); 339 Window.Clear(); 340 Create := NOT FIO.Exists("Addressb.ook"); 341 LOOP 342 NameFile := Btree.Open("Addressb.ook",2,Btree.FixSize,FALSE,NOT Create,Create); 343 NameData := Btree.OpenData(NameFile,1,SIZE(AddrRec),Create); 344 NameIndex := Btree.OpenIndex(NameFile,NameData,2,COMPARE,MAKEKEY, 345 SIZE(AddrKey),TRUE,Create); 346 IF Create THEN 347 Btree.Close(NameFile); 348 Create := FALSE; 349 ELSE 350 EXIT; 351 END; 352 END; 353 DONE := FALSE; 354 choice := ' '; 355 REPEAT 356 GetMenu("S)howNames F)indSomeone A)ddSomeone D)eleteSomeone Q)uit :", 357 CharSet{'S','F','A','D','Q'},choice); 358 CASE choice OF 359 'S' : ShowNames(); 360 | 'F' : FindName(); 361 Btree.Release(NameIndex); 362 | 'A' : AddName(); 363 | 'D' : DeleteName(); 364 | 'Q' : DONE := TRUE; 365 ELSE 366 Beep(); 367 END; (* case *) 368 UNTIL DONE; 369 Btree.Close(NameFile); 370 END Address2. 358 errors