Listing: 1 IMPLEMENTATION MODULE Sales; 2 (* 3 Copyright (C) 1988,1989 Jensen & Partners International 4 *) 5 6 IMPORT FIO, Str, IO, Misc, Globals, Window, Client, Items, Btree, Lib; 7 FROM Globals IMPORT WriteAt, PromptFore, DisplayBorder, ***** ^ duplicate identifier 8 DisplayFore, DisplayBack, GetMenu, TaxRate, 9 DataFore, DataBack, ItemIndex, ItemData, 10 ClientData, ClientIndex; 11 FROM Window IMPORT GotoXY, WinType, TextColor, TextBackground, ***** ^ duplicate identifier 12 ClrEol, Use, Used, PutOnTop, Open, WinDef, 13 Black, White, SingleFrame, DoubleFrame, SetFrame, 14 SetTitle, CenterLowerTitle, CursorOn, CursorOff, 15 Hide; 16 CONST 17 MAX_ROWS = 15; 18 FIRST_ROW = 6; 19 20 TYPE 21 SalesRec = RECORD 22 Item : Items.ItemRec; ***** ^ not supported yet 23 Qty : CARDINAL; 24 END; ***** ^ not supported yet 25 26 VAR 27 SaleItems : ARRAY[FIRST_ROW..MAX_ROWS] OF SalesRec; ***** ^ not supported yet ***** ^ not supported yet 28 SummaryFile : FIO.File; ***** ^ not supported yet 29 year, month, day : CARDINAL; 30 weekday : Lib.DayType; ***** ^ not supported yet 31 misc : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 32 ok : BOOLEAN; 33 SalesWin, lastWin : WinType; 34 SummaryWin, psumWin : WinType; 35 OnScreen : BOOLEAN; 36 keyPressed : CHAR; 37 blankItem : Items.ItemRec; ***** ^ not supported yet 38 CurrentTotals : TotalRec; ***** ^ undeclared identifier 39 SubTotal, GrandTotal, SalesTax : LONGREAL; 40 41 PROCEDURE PressAKey( txt : ARRAY OF CHAR); ***** ^ not supported yet 42 VAR 43 ch : CHAR; 44 BEGIN 45 TextColor(PromptFore); ***** ^ not supported yet ***** ^ not supported yet 46 TextBackground(DisplayBack); ***** ^ not supported yet ***** ^ not supported yet 47 WriteAt(MAX_ROWS+1,1,txt); ***** ^ not supported yet ***** ^ not supported yet 48 GotoXY(30,MAX_ROWS+1); ***** ^ not supported yet ***** ^ not supported yet 49 ch := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 GotoXY(1,MAX_ROWS+1); ***** ^ not supported yet ***** ^ not supported yet 51 ClrEol(); ***** ^ not supported yet ***** ^ not supported yet 52 keyPressed := CAP(ch); ***** ^ undeclared identifier ***** ^ not supported yet 53 END PressAKey; ***** ^ not supported yet 54 55 56 PROCEDURE Template(); 57 (* 58 This procedure un-hides the item display window and displays 59 the field names. 60 *) 61 VAR 62 x : CARDINAL; 63 BEGIN 64 lastWin := Used(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 Use(SalesWin); ***** ^ not supported yet ***** ^ not supported yet 66 PutOnTop(SalesWin); ***** ^ not supported yet ***** ^ not supported yet 67 Clear(); ***** ^ undeclared identifier ***** ^ not supported yet 68 OnScreen := TRUE; 69 IF FIO.Exists(TotalFile) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 70 SummaryFile := FIO.Open(TotalFile); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 71 FIO.Seek(SummaryFile,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 72 x := FIO.RdBin(SummaryFile,CurrentTotals,SIZE(TotalRec)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 73 FIO.Close(SummaryFile); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 74 ELSE 75 WITH CurrentTotals DO ***** ^ not supported yet 76 TotalDollars := 0.0; ***** ^ undeclared identifier 77 TotalCash := 0.0; ***** ^ undeclared identifier 78 TotalCharge := 0.0; ***** ^ undeclared identifier 79 NumTrans := 0; ***** ^ undeclared identifier 80 END; ***** ^ not supported yet 81 END; 82 END Template; ***** ^ not supported yet 83 84 PROCEDURE Clear(); 85 (** 86 Clear information off the Sales screen 87 **) 88 VAR 89 i : CARDINAL; 90 BEGIN 91 TextColor(DataFore); ***** ^ not supported yet ***** ^ not supported yet 92 TextBackground(DataBack); ***** ^ not supported yet ***** ^ not supported yet 93 WriteAt(1,11," "); ***** ^ not supported yet ***** ^ not supported yet 94 WriteAt(1,37," "); ***** ^ not supported yet ***** ^ not supported yet 95 WriteAt(1,63," "); ***** ^ not supported yet ***** ^ not supported yet 96 WriteAt(2,11," "); ***** ^ not supported yet ***** ^ not supported yet 97 WriteAt(2,40," "); ***** ^ not supported yet ***** ^ not supported yet 98 FOR i := FIRST_ROW TO MAX_ROWS DO 99 WriteAt(i,3," "); ***** ^ not supported yet ***** ^ not supported yet 100 WriteAt(i,16," "); ***** ^ not supported yet ***** ^ not supported yet 101 WriteAt(i,45," "); ***** ^ not supported yet ***** ^ not supported yet 102 WriteAt(i,53," "); ***** ^ not supported yet ***** ^ not supported yet 103 WriteAt(i,66," "); ***** ^ not supported yet ***** ^ not supported yet 104 END; 105 WriteAt(MAX_ROWS+2,45," "); ***** ^ not supported yet ***** ^ not supported yet 106 WriteAt(MAX_ROWS+2,66," "); ***** ^ not supported yet ***** ^ not supported yet 107 END Clear; ***** ^ not supported yet 108 109 PROCEDURE DisplayClient( aClient : Client.ClientRec); ***** ^ not supported yet 110 VAR 111 S : ARRAY[0..9] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 112 ok : BOOLEAN; 113 BEGIN 114 TextColor(DataFore); ***** ^ not supported yet ***** ^ not supported yet 115 TextBackground(DataBack); ***** ^ not supported yet ***** ^ not supported yet 116 WriteAt(1,11," "); ***** ^ not supported yet ***** ^ not supported yet 117 WriteAt(1,37," "); ***** ^ not supported yet ***** ^ not supported yet 118 WriteAt(1,63," "); ***** ^ not supported yet ***** ^ not supported yet 119 WriteAt(2,11," "); ***** ^ not supported yet ***** ^ not supported yet 120 WriteAt(2,40," "); ***** ^ not supported yet ***** ^ not supported yet 121 WITH aClient DO ***** ^ not supported yet 122 WriteAt(1,11,CNum); ***** ^ not supported yet ***** ^ undeclared identifier 123 WriteAt(1,37,LName); ***** ^ not supported yet ***** ^ undeclared identifier 124 WriteAt(1,63,FName); ***** ^ not supported yet ***** ^ undeclared identifier 125 WriteAt(2,11,Phone); ***** ^ not supported yet ***** ^ undeclared identifier 126 WriteAt(2,40," "); ***** ^ not supported yet ***** ^ not supported yet 127 Str.FixRealToStr(Balance,2,S,ok); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 128 IF ok = FALSE THEN 129 WriteAt(2,40,"???"); ***** ^ not supported yet ***** ^ not supported yet 130 ELSE 131 WriteAt(2,40,S); ***** ^ not supported yet ***** ^ not supported yet 132 END; 133 END; ***** ^ not supported yet 134 END DisplayClient; ***** ^ not supported yet 135 136 PROCEDURE GetClient( VAR aClient : Client.ClientRec ) : BOOLEAN; ***** ^ not supported yet 137 VAR 138 CNum : Globals.FileKey; ***** ^ not supported yet 139 ReEnter, 140 GotClient : BOOLEAN; 141 ch : CHAR; 142 BEGIN 143 GotClient := FALSE; 144 CNum := ""; ***** ^ not supported yet 145 REPEAT (* until GotClient *) 146 ReEnter := FALSE; 147 Clear(); ***** ^ not supported yet ***** ^ not supported yet 148 GotoXY(11,1); Misc.InputStr(CNum, 10); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 IF CNum[0] <= ' ' THEN (* cancel the transaction *) ***** ^ not supported yet ***** ^ not supported yet 150 RETURN FALSE; 151 ELSE (* a CNum was entered *) 152 IF Btree.Find(ClientIndex,CNum,aClient) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 DisplayClient(aClient); ***** ^ not supported yet ***** ^ not supported yet 154 GotClient := TRUE; 155 ELSIF Btree.Search(ClientIndex,CNum,aClient) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 156 REPEAT 157 DisplayClient(aClient); ***** ^ not supported yet ***** ^ not supported yet 158 GetMenu("T)his One, N)ext, P)revious, or R)e-enter? ", ***** ^ not supported yet ***** ^ not supported yet 159 Globals.CharSet{'T','N','P'},ch); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 CASE ch OF 161 'T' : GotClient := TRUE; 162 | 'N' : IF Btree.Next(ClientIndex,aClient) THEN 163 DisplayClient(aClient); 164 ELSE 165 Globals.Beep(); 166 END; 167 | 'P' : IF Btree.Prev(ClientIndex,aClient) THEN 168 DisplayClient(aClient); 169 ELSE 170 Globals.Beep(); 171 END; 172 | 'R' : ReEnter := TRUE; 173 ELSE 174 Globals.Beep(); 175 END; (* case *) 176 UNTIL GotClient OR ReEnter; 177 ELSE 178 Globals.Beep(); Globals.Beep(); Globals.Beep(); 179 PressAKey("That client is not in our records!"); 180 TextColor(DataFore); 181 TextBackground(DataBack); 182 END; 183 END; 184 UNTIL GotClient; 185 RETURN TRUE; 186 END GetClient; 187 188 189 PROCEDURE DisplayItem( row : CARDINAL; anItem : Items.ItemRec ); 190 VAR 191 ok : BOOLEAN; 192 S : ARRAY[0..9] OF CHAR; 193 BEGIN 194 TextColor(DataFore); 195 TextBackground(DataBack); 196 WriteAt(row,16,anItem.Description); 197 WriteAt(row,53," "); 198 Str.FixRealToStr(anItem.Retail,2,S,ok); 199 IF ok = FALSE THEN 200 WriteAt(row,53,"???"); 201 ELSE 202 WriteAt(row,53,S); 203 END; 204 END DisplayItem; 205 206 207 PROCEDURE GetOneItem( row: CARDINAL; 208 VAR anItem : Items.ItemRec ): BOOLEAN; 209 VAR 210 item : Globals.FileKey; 211 ReEnter, 212 GotItem : BOOLEAN; 213 ch : CHAR; 214 BEGIN 215 GotItem := FALSE; 216 Str.Copy(item,""); 217 REPEAT 218 ReEnter := FALSE; 219 GotoXY(3,row); Misc.InputStr(item,10); 220 IF item[0] <= ' ' THEN (* cancel the transaction *) 221 RETURN FALSE; 222 ELSE (* an item number was entered *) 223 IF Btree.Find(ItemIndex,item,anItem) THEN 224 DisplayItem(row,anItem); 225 GotItem := TRUE; 226 ELSIF Btree.Search(ItemIndex,item,anItem) THEN 227 REPEAT 228 DisplayItem(row,anItem); 229 GetMenu("T)his One, N)ext, P)revious, or R)e-enter? ", 230 Globals.CharSet{'T','N','P'},ch); 231 CASE ch OF 232 'T' : GotItem := TRUE; 233 | 'N' : IF Btree.Next(ItemIndex,anItem) THEN 234 DisplayItem(row,anItem); 235 ELSE 236 Globals.Beep(); 237 END; 238 | 'P' : IF Btree.Prev(ItemIndex,anItem) THEN 239 DisplayItem(row,anItem); 240 ELSE 241 Globals.Beep(); 242 END; 243 | 'R' : ReEnter := TRUE; 244 ELSE 245 Globals.Beep(); 246 END; (* case *) 247 UNTIL GotItem OR ReEnter; 248 ELSE 249 Globals.Beep(); Globals.Beep(); Globals.Beep(); 250 PressAKey("That item is not in our records!"); 251 TextColor(DataFore); 252 TextBackground(DataBack); 253 END; 254 END; 255 UNTIL GotItem; 256 RETURN TRUE; 257 END GetOneItem; 258 259 PROCEDURE GetSaleItem( VAR which : CARDINAL; 260 VAR action : CARDINAL ) : BOOLEAN; 261 VAR 262 item : Items.ItemRec; 263 qty : CARDINAL; 264 qtyStr : ARRAY[0..4] OF CHAR; 265 ok : BOOLEAN; 266 ch : CHAR; 267 thisTotal : LONGREAL; 268 S : ARRAY[0..10] OF CHAR; 269 BEGIN 270 action := 0; 271 ok := FALSE; 272 qtyStr := "1"; 273 IF GetOneItem(which,item) THEN 274 REPEAT 275 WriteAt(which,45," "); 276 GotoXY(45,which); Misc.InputStr(qtyStr,5); 277 qty := CARDINAL(Str.StrToCard(qtyStr,10,ok)); 278 UNTIL ok; 279 SaleItems[which].Qty := qty; 280 SaleItems[which].Item := item; 281 thisTotal := LONGREAL(qty) * item.Retail; 282 WriteAt(which,66," "); 283 Str.FixRealToStr(thisTotal,2,S,ok); 284 IF ok = FALSE THEN 285 WriteAt(which,66,"???"); 286 ELSE 287 WriteAt(which,66,S); 288 END; 289 SubTotal := SubTotal + thisTotal; 290 SalesTax := (SubTotal * TaxRate)/100.0; 291 GrandTotal := SubTotal + SalesTax; 292 293 WriteAt(MAX_ROWS+2,45," "); 294 WriteAt(MAX_ROWS+2,66," "); 295 Str.FixRealToStr(SalesTax,2,S,ok); 296 IF ok = FALSE THEN 297 WriteAt(MAX_ROWS+2,45,"???"); 298 ELSE 299 WriteAt(MAX_ROWS+2,45,S); 300 END; 301 Str.FixRealToStr(GrandTotal,2,S,ok); 302 IF ok = FALSE THEN 303 WriteAt(MAX_ROWS+2,66,"???"); 304 ELSE 305 WriteAt(MAX_ROWS+2,66,S); 306 END; 307 308 END; 309 GetMenu("C)ancel item, N)o Sale, A)nother item, D)one with sale: ", 310 Globals.CharSet{'C','N','A','D'},ch); 311 CASE ch OF 312 'D' : RETURN TRUE; 313 | 'A' : RETURN FALSE; 314 | 'C' : DEC(which); 315 DisplayItem(which+1,blankItem); 316 WriteAt(which+1,45," "); 317 WriteAt(which+1,66," "); 318 | 'N' : action := 99; 319 RETURN TRUE; 320 ELSE 321 Globals.Beep(); 322 END; 323 RETURN FALSE; 324 END GetSaleItem; 325 326 327 PROCEDURE Work(); 328 (** 329 Perform the entry of sales, information requests, etc. 330 Template should be called first to open the window. 331 **) 332 VAR 333 theClient : Client.ClientRec; 334 ch : CHAR; 335 transDone : BOOLEAN; 336 choice, i, 337 row : CARDINAL; 338 BEGIN 339 SubTotal := 0.0; 340 GrandTotal := 0.0; 341 SalesTax := 0.0; 342 IF GetClient(theClient) THEN 343 transDone := FALSE; 344 FOR row := FIRST_ROW TO MAX_ROWS DO 345 SaleItems[row].Qty := 0; 346 END; 347 row := FIRST_ROW; 348 REPEAT 349 transDone := GetSaleItem( row, choice ); 350 INC(row); 351 UNTIL (transDone) OR (row>MAX_ROWS); 352 IF choice = 0 THEN 353 (* take the cash or charge *) 354 GetMenu("Will that be C)ash or cH)arge? ", 355 Globals.CharSet{'C','H'},ch); 356 CASE ch OF 357 'C' : CurrentTotals.TotalCash := 358 CurrentTotals.TotalCash + GrandTotal; 359 | 'H' : CurrentTotals.TotalCharge := 360 CurrentTotals.TotalCharge + GrandTotal; 361 theClient.Balance := theClient.Balance + 362 GrandTotal; 363 Btree.Delete(ClientData); 364 Btree.Add(ClientData,theClient,SIZE(Client.ClientRec)); 365 ELSE 366 Globals.Beep(); 367 END; 368 CurrentTotals.TotalDollars := 369 CurrentTotals.TotalDollars + GrandTotal; 370 INC(CurrentTotals.NumTrans); 371 ELSE 372 (* cancel transaction *) 373 Clear(); 374 END; 375 END; (* if *) 376 END Work; 377 378 PROCEDURE Summary(); 379 (** 380 Summarize current sales figures in a window 381 **) 382 VAR 383 SummaryWin, psumWin : WinType; 384 ch : CHAR; 385 S : ARRAY[0..10] OF CHAR; 386 ok : BOOLEAN; 387 BEGIN 388 psumWin := Used(); 389 SummaryWin := Open( WinDef( 28, 10, 52, 17, 390 White,Black,TRUE,FALSE,TRUE,TRUE, 391 SingleFrame,White,Black) ); 392 SetFrame(SummaryWin,DoubleFrame,DataFore, 393 DataBack); 394 SetTitle(SummaryWin,"Daily Totals",CenterLowerTitle); 395 Use(SummaryWin); 396 CursorOff(); 397 TextColor(DataFore); 398 TextBackground(DataBack); 399 Window.Clear(); 400 WriteAt(2,3,"Total Sales: $"); 401 WriteAt(3,3,"Cash Sales: "); 402 WriteAt(4,3,"Charge Sales: "); 403 WriteAt(5,3,"# Trans: "); 404 PutOnTop(SummaryWin); 405 (* write out the current totals *) 406 WITH CurrentTotals DO 407 Str.FixRealToStr(TotalDollars,2,S,ok); 408 WriteAt(2,18,S); 409 Str.FixRealToStr(TotalCash,2,S,ok); 410 WriteAt(3,18,S); 411 Str.FixRealToStr(TotalCharge,2,S,ok); 412 WriteAt(4,18,S); 413 GotoXY(18,5); 414 IO.WrCard(NumTrans,4); 415 END; 416 ch := IO.RdKey(); 417 Window.Close(SummaryWin); 418 PutOnTop(psumWin); 419 Use(psumWin); 420 CursorOn(); 421 END Summary; 422 423 PROCEDURE Close(); 424 (** 425 Remove the Sales screen from the screen 426 **) 427 BEGIN 428 Hide(SalesWin); 429 Use(lastWin); 430 PutOnTop(lastWin); 431 OnScreen := FALSE; 432 (* write out summary file *) 433 SummaryFile := FIO.Create(TotalFile); 434 FIO.Seek(SummaryFile,0); 435 FIO.WrBin(SummaryFile,CurrentTotals,SIZE(TotalRec)); 436 FIO.Close(SummaryFile); 437 END Close; 438 439 BEGIN (* init code *) 440 441 (* set up the summary file name *) 442 TotalFile := "000000.TOT"; (* default name *) 443 444 Lib.GetDate(year,month,day,weekday); 445 IF year > 1900 THEN year := year - 1900; END; 446 447 Str.CardToStr(LONGCARD(year),misc,10,ok); 448 IF misc[1] = 0C THEN 449 TotalFile[4] := '0'; 450 TotalFile[5] := misc[0]; 451 ELSE 452 TotalFile[4] := misc[0]; 453 TotalFile[5] := misc[1]; 454 END; 455 456 Str.CardToStr(LONGCARD(month),misc,10,ok); 457 IF misc[1] = 0C THEN 458 TotalFile[0] := '0'; 459 TotalFile[1] := misc[0]; 460 ELSE 461 TotalFile[0] := misc[0]; 462 TotalFile[1] := misc[1]; 463 END; 464 465 Str.CardToStr(LONGCARD(day),misc,10,ok); 466 IF misc[1] = 0C THEN 467 TotalFile[2] := '0'; 468 TotalFile[3] := misc[0]; 469 ELSE 470 TotalFile[2] := misc[0]; 471 TotalFile[3] := misc[1]; 472 END; 473 474 (* create the sales window *) 475 476 SalesWin := Open( WinDef( 0, 4, 79, 22, 477 White,Black,TRUE,FALSE,TRUE,TRUE, 478 SingleFrame,White,Black) ); 479 SetFrame(SalesWin,SingleFrame,DisplayBorder, 480 DisplayBack); 481 Use(SalesWin); 482 TextColor(DisplayFore); 483 TextBackground(DisplayBack); 484 Window.Clear(); 485 WriteAt(1,3,"Client:"); 486 WriteAt(2,3,"Phone:"); 487 WriteAt(1,30,"Last:"); 488 WriteAt(1,55,"First:"); 489 WriteAt(2,30,"Balance:"); 490 WriteAt(4,3,"ITEM"); 491 WriteAt(4,16,"DESCRIPTION"); 492 WriteAt(4,45,"QTY"); 493 WriteAt(4,53,"EACH"); 494 WriteAt(4,66,"TOTAL"); 495 WriteAt(17,40,"TAX:"); 496 WriteAt(17,57,"TOTAL:"); 497 498 blankItem.Retail := 0.0; 499 blankItem.Description := " "; 500 501 END Sales. 169 errors