1# Copyright (C) 1987-2015 by Jeffery P. Hansen 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 16# 17# Last edit by hansen on Tue Jul 24 13:55:55 2007 18# 19 20font create title_f -family helvetica -weight bold -size 66 21font create button_f -family helvetica -weight bold -size 10 22font create empty_f -family helvetica -size 8 23font create coin_f -family helvetica -size 8 24 25############################################################################# 26# 27# Allow all proceedures in the coke machine to be executed from verilog. 28# 29if {[info exists tkgate_isInitialized]} { 30 VPD::register CokeMachine 31 VPD::allow CokeMachine::* 32} 33 34 35############################################################################# 36# 37# TkGate Interactive Module for Coke machine 38# 39namespace eval CokeMachine { 40 # size of the coke machine (do not change) 41 variable mWidth 300 42 variable mHeight 520 43 44 # options 45 variable useDollar 46 47 # colors of cans in slots 48 variable canColors {red red gray50 orange blue darkred} 49 50 # Array of windows for coke machines 51 variable coke_w 52 53 # number of each type of coin available for spending 54 variable numQuarters 55 variable numDimes 56 variable numNickles 57 variable numDollars 58 variable numBogus 59 60 # number of cans that have been bought 61 variable numBought 62 63 # number of each type of drink 64 variable numCans 65 66 # number of coins each type available for change 67 variable numChange 68 variable changeQuarters 69 variable changeDimes 70 variable changeNickles 71 72 # number of coins each type held in machine 73 variable holdQuarters 74 variable holdDimes 75 variable holdNickles 76 variable holdDollars 77 variable holdBogus 78 79 # number of coins each type inserted into machine 80 variable insertQuarters 81 variable insertDimess 82 variable insertNickles 83 84 variable displayCost 85 variable ENABLED 86 87 ############################################################################# 88 # 89 # Input signals 90 # 91 92 # lights 93 variable isEmpty 94 variable noChange 95 variable billLight 96 97 # input to bill reader and bill in scanner 98 variable readyBill 99 variable scannerBill 100 101 102 ############################################################################# 103 # 104 # Output signals 105 # 106 variable osigPRESS 107 variable osigEMPTY 108 variable osigINSQ 109 variable osigINSD 110 variable osigINSN 111 variable osigNUMQ 112 variable osigNUMD 113 variable osigNUMN 114 variable osigBILLSNS 115 variable osigBILLOK 116 variable osigBILLNG 117 variable osigBILLACK 118 variable osigCNRET 119 120 ############################################################################# 121 # 122 # Pending insertions 123 # 124 variable pendingCoins 125 126 127 ############################################################################# 128 # 129 # Initialize the coke machine. 130 # 131 proc initState {n} { 132 variable coke_w 133 variable numBought 134 variable numQuarters 135 variable numDimes 136 variable numNickles 137 variable changeQuarters 138 variable changeDimes 139 variable changeNickles 140 variable holdQuarters 141 variable holdDimes 142 variable holdNickles 143 variable holdDollars 144 variable holdBogus 145 variable insertQuarters 146 variable insertDimes 147 variable insertNickles 148 variable numDollars 149 variable numBogus 150 variable isEmpty 151 variable numCans 152 variable numChange 153 variable noChange 154 variable billLight 155 variable readyBill 156 variable scannerBill 157 variable osigPRESS 158 variable osigEMPTY 159 variable osigNUMQ 160 variable osigNUMD 161 variable osigNUMN 162 variable osigINSQ 163 variable osigINSD 164 variable osigINSN 165 variable osigBILLSNS 166 variable osigBILLOK 167 variable osigBILLNG 168 variable osigBILLACK 169 variable osigCNRET 170 variable pendingCoins 171 variable canColors 172 173# puts "CokeMachine::initState-1" 174 175 set w "." 176 catch { set w $coke_w($n) } 177 178 set numQuarters($n) 20 179 180# puts "CokeMachine::initState-1a" 181 182 set numDimes($n) 20 183 set numNickles($n) 20 184 set numDollars($n) 20 185 set numBogus($n) 20 186 set isEmpty($n) {0 0 0 0 0 0} 187 set numCans($n) {10 12 8 7 15 11} 188 set numChange($n) {10 8 10} 189 190# puts "CokeMachine::initState-1b" 191 192 set changeQuarters($n) 10 193 set changeDimes($n) 10 194 set changeNickles($n) 10 195 196 set holdQuarters($n) 0 197 set holdDimes($n) 0 198 set holdNickles($n) 0 199 set holdDollars($n) 0 200 set holdBogus($n) 0 201 202# puts "CokeMachine::initState-1c" 203 204 set insertQuarters($n) 0 205 set insertDimes($n) 0 206 set insertNickles($n) 0 207 208 set pendingCoins($n) {} 209 210# puts "CokeMachine::initState-1d" 211 212 set noChange($n) 0 213# puts "CokeMachine::initState-1e" 214 set billLight($n) 0 215# puts "CokeMachine::initState-1f" 216 217 if {[catch { set readyBill($n) "" } xxx]} { 218 puts "CokeMachine::xxx=$xxx" 219 } 220# puts "CokeMachine::initState-1g" 221 set scannerBill($n) "" 222 223# puts "CokeMachine::initState-2" 224 225 set numBought($n) 0 226 catch { $w.c delete boughtCans } 227 for {set i 0 } { $i < 6 } { incr i } { 228 catch { reloadHopper $w.c.int.h$i $n -color [lindex $canColors $i] -column $i } 229 } 230 231 set osigPRESS($n) {0 0 0 0 0 0} 232 set osigEMPTY($n) {0 0 0 0 0 0} 233 set osigNUMQ($n) 7 234 set osigNUMD($n) 7 235 set osigNUMN($n) 7 236 set osigINSQ($n) 0 237 set osigINSD($n) 0 238 set osigINSN($n) 0 239 set osigBILLSNS($n) 0 240 set osigBILLOK($n) 0 241 set osigBILLNG($n) 0 242 set osigBILLACK($n) 0 243 set osigCNRET($n) 0 244 245# puts "CokeMachine::initState-3" 246 } 247 248 ############################################################################# 249 # 250 # Respond to a change in the bill that is in the scanner. 251 # 252 proc seeScannerBill {n args} { 253 variable coke_w 254 variable scannerBill 255 variable osigBILLOK 256 variable osigBILLNG 257 258 $coke_w($n).c.int delete scanBill 259 switch $scannerBill($n) { 260 D { makeDollar $coke_w($n).c.int 254 135 -tag scanBill } 261 B { makeBogus $coke_w($n).c.int 254 135 -tag scanBill } 262 } 263 264 switch $scannerBill($n) { 265 D { set osigBILLOK($n) 1; set osigBILLNG($n) 0 } 266 B { set osigBILLOK($n) 0; set osigBILLNG($n) 1 } 267 default { set osigBILLOK($n) 0; set osigBILLNG($n) 0 } 268 } 269 270 } 271 272 ############################################################################# 273 # 274 # Pickup a bill that is in the "ready" slot. 275 # 276 proc pickupReady {n args} { 277 set dw [Dragger::make -command "CokeMachine::dropCoin $n $CokeMachine::readyBill($n)" -bd 0] 278 makeDragCoin $dw $n $CokeMachine::readyBill($n) 279 set CokeMachine::readyBill($n) "" 280 } 281 282 ############################################################################# 283 # 284 # Respond to a change in the "ready" bill. The ready bill is the one that 285 # is ready to be sucked into the scanner. 286 # 287 proc seeReadyBill {n args} { 288 variable coke_w 289 variable readyBill 290 variable osigBILLSNS 291 292 puts "CokeMachine::seeReadyBill" 293 294 set w $coke_w($n).c.ext.dslot 295 296 $w delete readyBill 297 switch $readyBill($n) { 298 D { makeDollar $w 25 22 -tag readyBill } 299 B { makeBogus $w 25 22 -tag readyBill } 300 } 301 302 if { $readyBill($n) != "" } { 303 $w bind readyBill <1> "CokeMachine::pickupReady $n" 304 set osigBILLSNS($n) 1 305 } else { 306 puts "CokeMachine::seeReadyBill-1" 307 set osigBILLSNS($n) 0 308 puts "CokeMachine::seeReadyBill-2" 309 } 310 311 } 312 313 ############################################################################# 314 # 315 # Make a coin/bill that can be dragged around. 316 # 317 proc makeDragCoin {dw n coin} { 318 319 if { $dw != "" } { 320 switch $coin { 321 25 { 322 canvas $dw.c -width 25 -height 23 323 makeCoin $dw.c 12 12 -value 25 324 } 325 10 { 326 canvas $dw.c -width 19 -height 18 327 makeCoin $dw.c 9 10 -value 10 328 } 329 5 { 330 canvas $dw.c -width 22 -height 20 331 makeCoin $dw.c 10 11 -value 5 332 } 333 D { 334 canvas $dw.c -width 27 -height 17 335 makeDollar $dw.c 14 9 336 } 337 B { 338 canvas $dw.c -width 27 -height 17 339 makeBogus $dw.c 14 9 340 } 341 A { 342 canvas $dw.c -width 35 -height 35 343 makeCoin $dw.c 20 12 -value 25 344 makeCoin $dw.c 10 25 -value 10 345 makeCoin $dw.c 25 12 -value 5 346 } 347 } 348 pack $dw.c 349 } 350 } 351 352 ############################################################################# 353 # 354 # Select a coin which has been selected with the mouse button 355 # 356 proc selectCoin {n coin x y} { 357 variable numQuarters 358 variable numDimes 359 variable numNickles 360 variable numDollars 361 variable numBogus 362 variable ENABLED 363 364 if {!$ENABLED($n)} return 365 366 set ok 0 367 368 # 369 # check for availability of funds 370 # 371 switch $coin { 372 25 { if {$numQuarters($n) > 0} { set ok 1}} 373 10 { if {$numDimes($n) > 0} { set ok 1}} 374 5 { if {$numNickles($n) > 0} { set ok 1}} 375 D { if {$numDollars($n) > 0} { set ok 1}} 376 B { if {$numBogus($n) > 0} { set ok 1}} 377 } 378 379 if {!$ok} return 380 381 382 set dw [Dragger::make -command "CokeMachine::dropCoin $n $coin" -bd 0] 383 makeDragCoin $dw $n $coin 384 switch $coin { 385 25 { incr numQuarters($n) -1 } 386 10 { incr numDimes($n) -1 } 387 5 { incr numNickles($n) -1 } 388 D { incr numDollars($n) -1 } 389 B { incr numBogus($n) -1 } 390 } 391 } 392 393 ############################################################################# 394 # 395 # Return a coin (bill) that was not put into the slot (bill reader) 396 # 397 proc returnCoin {n coin w x y} { 398 variable numQuarters 399 variable numDimes 400 variable numNickles 401 variable numDollars 402 variable numBogus 403 switch $coin { 404 25 { incr numQuarters($n) } 405 10 { incr numDimes($n) } 406 5 { incr numNickles($n) } 407 D { incr numDollars($n) } 408 B { incr numBogus($n) } 409 } 410 } 411 412 ############################################################################# 413 # 414 # Respond to a change in the acknowledge line 415 # 416 proc insertAck {n args} { 417 variable osigINSQ 418 variable osigINSD 419 variable osigINSN 420 variable pendingCoins 421 variable ENABLED 422 423 if {!$ENABLED($n)} return 424 425 426 set value 1 427 parseargs $args {-value -tag} 428 429 if { $value } { 430 set osigINSQ($n) 0 431 set osigINSD($n) 0 432 set osigINSN($n) 0 433 } else { 434 set pendingCoins($n) [lrange $pendingCoins($n) 1 end] 435 436 if {[llength $pendingCoins($n)] > 0} { 437 switch [lindex $pendingCoins($n) 0] { 438 25 { set osigINSQ($n) 1 } 439 10 { set osigINSD($n) 1 } 440 5 { set osigINSN($n) 1 } 441 } 442 } 443 } 444 } 445 446 ############################################################################# 447 # 448 # Respond to a coin (or bill) dropped in the coin slot (or bill reader) 449 # 450 proc dropCoin {n coin w x y} { 451 variable insertQuarters 452 variable insertDimes 453 variable insertNickles 454 variable readyBill 455 variable coke_w 456 variable osigINSQ 457 variable osigINSD 458 variable osigINSN 459 variable osigBILLSNS 460 variable pendingCoins 461 462 set ok 0 463 464 if { $w == "$coke_w($n).c.ext.cslot" || $w == "$coke_w($n).c.ext.cslot.e"} { 465 switch $coin { 466 25 { 467 incr insertQuarters($n) 468 if {[llength $pendingCoins($n)] == 0} { set osigINSQ($n) 1 } 469 lappend pendingCoins($n) 25 470 set ok 1 471 } 472 10 { 473 incr insertDimes($n) 474 if {[llength $pendingCoins($n)] == 0} { set osigINSD($n) 1 } 475 lappend pendingCoins($n) 10 476 set ok 1 477 } 478 5 { 479 incr insertNickles($n) 480 if {[llength $pendingCoins($n)] == 0} { set osigINSN($n) 1 } 481 lappend pendingCoins($n) 5 482 set ok 1 483 } 484 } 485 } 486 487 if { $w == "$coke_w($n).c.ext.dslot" && $readyBill($n) == ""} { 488 if { $coin == "D" } { set readyBill($n) "D"; set ok 1 } 489 if { $coin == "B" } { set readyBill($n) "B"; set ok 1 } 490 if { $readyBill($n) != ""} { 491 set osigBILLSNS($n) 1 492 } 493 } 494 495 if {!$ok} { 496 set x [expr $x + [winfo rootx $w]] 497 set y [expr $y + [winfo rooty $w]] 498 499 set X 20 500 switch $coin { 501 25 { set Y 30 } 502 10 { set Y 60 } 503 5 { set Y 90 } 504 D { set Y 120 } 505 B { set Y 150 } 506 } 507 508 set X [expr $X + [winfo rootx $coke_w($n)]] 509 set Y [expr $Y + [winfo rooty $coke_w($n)]] 510 511 set dw [Dragger::make -command "CokeMachine::returnCoin $n $coin" -bd 0 -interactive 0] 512 makeDragCoin $dw $n $coin 513 Dragger::animate -speed 10 514 Dragger::animate -step 30 515 Dragger::animate $x $y $X $Y 516 } 517 } 518 519 ############################################################################# 520 # 521 # Make a coin of a particular demonination. 522 # 523 proc makeCoin {w x y args} { 524 set size 10 525 526 set tag "" 527 set value 25 528 parseargs $args {-value -tag} 529 530 if {$value == 25 } { set size 10 } 531 if {$value == 10 } { set size 8 } 532 if {$value == 5 } { set size 9 } 533 534 set x1 [expr $x - $size] 535 set y1 [expr $y - $size] 536 set x2 [expr $x + $size] 537 set y2 [expr $y + $size] 538 $w create oval $x1 $y1 $x2 $y2 -fill gray20 -tags $tag 539 incr x1 2 540 incr y1 -1 541 incr x2 2 542 incr y2 -1 543 $w create oval $x1 $y1 $x2 $y2 -fill gray50 -tags $tag 544 $w create text [expr $x + 2] $y -text $value -font coin_f -tags $tag 545 } 546 547 ############################################################################# 548 # 549 # Make a dollar bill 550 # 551 proc makeDollar {w x y args} { 552 set tag "" 553 parseargs $args {-tag} 554 555 set x1 [expr $x - 13] 556 set y1 [expr $y - 8] 557 set x2 [expr $x + 13] 558 set y2 [expr $y + 8] 559 560 $w create rectangle $x1 $y1 $x2 $y2 -fill "\#008800" -tags $tag 561 $w create text $x $y -text "\$1" -tags $tag 562 } 563 564 ############################################################################# 565 # 566 # Make a bogus bill 567 # 568 proc makeBogus {w x y args} { 569 set tag "" 570 parseargs $args {-tag} 571 572 set x1 [expr $x - 13] 573 set y1 [expr $y - 8] 574 set x2 [expr $x + 13] 575 set y2 [expr $y + 8] 576 577 $w create rectangle $x1 $y1 $x2 $y2 -fill white -tags $tag 578 $w create text $x $y -text "bogus" -font empty_f -tags $tag 579 } 580 581 ############################################################################# 582 # 583 # Make the list of coins that can be dragged and inserted into the machine. 584 # 585 proc makeCoinList {w n} { 586 variable useDollar 587 588 makeCoin $w 20 30 -value 25 -tag usrQuarter 589 makeCoin $w 20 60 -value 10 -tag usrDime 590 makeCoin $w 20 90 -value 5 -tag usrNickle 591 592 $w bind usrQuarter <1> "CokeMachine::selectCoin $n 25 %x %y" 593 $w bind usrDime <1> "CokeMachine::selectCoin $n 10 %x %y" 594 $w bind usrNickle <1> "CokeMachine::selectCoin $n 5 %x %y" 595 596 $w create text 40 30 -text "X" 597 $w create text 40 60 -text "X" 598 $w create text 40 90 -text "X" 599 600 label $w.qcount -textvariable CokeMachine::numQuarters($n) 601 $w create window 55 30 -window $w.qcount 602 603 label $w.dcount -textvariable CokeMachine::numDimes($n) 604 $w create window 55 60 -window $w.dcount 605 606 label $w.ncount -textvariable CokeMachine::numNickles($n) 607 $w create window 55 90 -window $w.ncount 608 609 if {$useDollar($n)} { 610 makeDollar $w 20 120 -tag usrDollar 611 makeBogus $w 20 150 -tag usrBogus 612 $w bind usrDollar <1> "CokeMachine::selectCoin $n D %x %y" 613 $w bind usrBogus <1> "CokeMachine::selectCoin $n B %x %y" 614 $w create text 40 120 -text "X" 615 $w create text 40 150 -text "X" 616 label $w.lcount -textvariable CokeMachine::numDollars($n) 617 $w create window 55 120 -window $w.lcount 618 619 label $w.bcount -textvariable CokeMachine::numBogus($n) 620 $w create window 55 150 -window $w.bcount 621 } 622 } 623 624 ############################################################################# 625 # 626 # See a change in cost 627 # 628 proc setCost {n value args} { 629 variable displayCost 630 631 set displayCost($n) [format "\$%0.2f" [expr $value * 0.05]] 632 } 633 634 ############################################################################# 635 # 636 # Respond to a change in the reset line. A falling edge resets the machine, 637 # and a non-zero value allows the machine to operate. 638 # 639 proc resetMachine {n state args} { 640 variable coke_w 641 variable canColors 642 variable ENABLED 643 644 set w $coke_w($n) 645 646 set ENABLED($n) $state 647 if {$state == 0} { 648 initState $n 649 } 650 } 651 652 653 ############################################################################# 654 # 655 # See a change in any lights 656 # 657 proc seeLight {n args} { 658 variable coke_w 659 variable isEmpty 660 variable noChange 661 variable billLight 662 variable useDollar 663 664 for {set i 0 } { $i < 6 } { incr i } { 665 if {[lindex $isEmpty($n) $i]} { 666 $coke_w($n).c.ext.bbar.b$i.e configure -bg "\#ffcc40" -fg "\#904000" 667 } else { 668 $coke_w($n).c.ext.bbar.b$i.e configure -bg "\#a05010" -fg "\#904000" 669 } 670 } 671 672 if {$noChange($n)} { 673 $coke_w($n).c.ext.cslot.e configure -bg "\#ffcc40" -fg "\#904000" 674 } else { 675 $coke_w($n).c.ext.cslot.e configure -bg "\#a05010" -fg "\#904000" 676 } 677 678 if {$useDollar($n)} { 679 if {$billLight($n)} { 680 $coke_w($n).c.ext.dslot itemconfigure billok -fill green 681 } else { 682 $coke_w($n).c.ext.dslot itemconfigure billok -fill darkgreen 683 } 684 } 685 } 686 687 688 ############################################################################# 689 # 690 # Set the state of the empty light 691 # 692 proc setEmpty {n elist} { 693 variable isEmpty 694 695 set isEmpty($n) $elist 696 } 697 698 699 ############################################################################# 700 # 701 # Dispense product 702 # 703 proc dispense {n i} { 704 variable coke_w 705 variable canColors 706 variable numBought 707 variable mHeight 708 variable osigEMPTY 709 variable ENABLED 710 711 if {!$ENABLED($n)} return 712 713 set w $coke_w($n).c.int.h$i 714 715 set L [winfo children $w] 716 if {[llength $L] == 0 } return 717 718 if {[llength $L] == 1 } { 719 set osigEMPTY($n) [lreplace $osigEMPTY($n) $i $i 1] 720 } 721 722 723 set d [lindex $L [expr [llength $L]-1]] 724 725 set w [winfo width $coke_w($n).c.int.h$i] 726 set h [winfo height $coke_w($n).c.int.h$i] 727 set x0 [expr [winfo rootx $coke_w($n).c.int.h$i] + $w/2] 728 set y0 [expr [winfo rooty $coke_w($n).c.int.h$i] + $h] 729 730 destroy $d 731 732 733 set rX [winfo rootx $coke_w($n)] 734 set rY [winfo rooty $coke_w($n)] 735 736 set x1 [expr $rX + 500] 737 set y1 [expr $rY + 460] 738 739 set x2 [expr $rX + 200] 740 set y2 [expr $rY + 460] 741 742 set x3 [expr $rX + 25 + ($numBought($n) % 50)*14] 743 set y3 [expr $rY + $mHeight + 45 + ($numBought($n) / 50)*30] 744 745 746 set dw [Dragger::make -command "CokeMachine::drinkCan $n $i" -bd 0 -interactive 0] 747 if {$dw != ""} { 748 frame $dw.f -width 20 -height 15 -bg [lindex $canColors $i] 749 pack $dw.f 750 Dragger::animate -speed 10 751 Dragger::animate -step 10 752 Dragger::animate $x0 $y0 $x1 $y1 -jump $x2 $y2 $x3 $y3 753 } else { 754 drinkCan $n $i 755 } 756 } 757 758 ############################################################################# 759 # 760 # Add an empty can to the empties list 761 # 762 proc drinkCan {n i args} { 763 variable coke_w 764 variable numBought 765 variable mHeight 766 variable canColors 767 768 set x [expr 25 + ($numBought($n) % 50)*14] 769 set y [expr $mHeight + 45 + ($numBought($n) / 50)*30] 770 $coke_w($n).c create rectangle $x $y [expr $x + 10] [expr $y + 18] -fill [lindex $canColors $i] -outline "" -tags boughtCans 771 772 incr numBought($n) 773 } 774 775 ############################################################################# 776 # 777 # Dump coins into the coin hold 778 # 779 proc dumpInHold {n nQ nD nN args} { 780 variable holdQuarters 781 variable holdDimes 782 variable holdNickles 783 784 incr holdQuarters($n) $nQ 785 incr holdDimes($n) $nD 786 incr holdNickles($n) $nN 787 } 788 789 ############################################################################# 790 # 791 # Dump coins into the coin hold 792 # 793 proc dumpBack {n nQ nD nN args} { 794 variable numQuarters 795 variable numDimes 796 variable numNickles 797 798 incr numQuarters($n) $nQ 799 incr numDimes($n) $nD 800 incr numNickles($n) $nN 801 } 802 803 ############################################################################# 804 # 805 # Return inserted coins 806 # 807 proc returnInserted {n} { 808 variable coke_w 809 variable insertQuarters 810 variable insertDimes 811 variable insertNickles 812 variable numQuarters 813 variable numDimes 814 variable numNickles 815 variable ENABLED 816 817 if {!$ENABLED($n)} return 818 819 set L [list $insertQuarters($n) $insertDimes($n) $insertNickles($n)] 820 821 if { $L == {0 0 0} } return 822 823 set insertQuarters($n) 0 824 set insertDimes($n) 0 825 set insertNickles($n) 0 826 827 set X0 [winfo rootx $coke_w($n).c] 828 set Y0 [winfo rooty $coke_w($n).c] 829 830 set X1 [winfo rootx $coke_w($n).c.int] 831 set Y1 [winfo rooty $coke_w($n).c.int] 832 833 set dw [Dragger::make -command "CokeMachine::dumpBack $n $L" -bd 0 -interactive 0] 834 if {$dw != ""} { 835 makeDragCoin $dw $n A 836 Dragger::animate -speed 10 837 Dragger::animate -step 40 838 Dragger::animate [expr $X1 + 250] [expr $Y1 + 200] [expr $X0 + 50] [expr $Y0 + 50] 839 } else { 840 set numQuarters($n) [lindex $L 0] 841 set numDimes($n) [lindex $L 1] 842 set numNickles($n) [lindex $L 2] 843 } 844 } 845 846 ############################################################################# 847 # 848 # Commit inserted coins to buying a product 849 # 850 proc commitInserted {n} { 851 variable insertQuarters 852 variable insertDimes 853 variable insertNickles 854 variable holdQuarters 855 variable holdDimes 856 variable holdNickles 857 variable coke_w 858 variable ENABLED 859 860 if {!$ENABLED($n)} return 861 862 set L [list $insertQuarters($n) $insertDimes($n) $insertNickles($n)] 863 864 if { $L == {0 0 0} } return 865 866 set insertQuarters($n) 0 867 set insertDimes($n) 0 868 set insertNickles($n) 0 869 870 set X [winfo rootx $coke_w($n).c.int] 871 set Y [winfo rooty $coke_w($n).c.int] 872 873 set dw [Dragger::make -command "CokeMachine::dumpInHold $n $L" -bd 0 -interactive 0] 874 if {$dw != ""} { 875 makeDragCoin $dw $n A 876 Dragger::animate -speed 20 877 Dragger::animate -step 20 878 Dragger::animate -offset $X $Y 250 200 200 250 200 350 250 450 879 } else { 880 set holdQuarters($n) [lindex $L 0] 881 set holdDimes($n) [lindex $L 1] 882 set holdNickles($n) [lindex $L 2] 883 } 884 } 885 886 ############################################################################# 887 # 888 # Eject change 889 # 890 proc ejectChange {n coin} { 891 variable numQuarters 892 variable numDimes 893 variable numNickles 894 variable changeQuarters 895 variable changeDimes 896 variable changeNickles 897 variable osigNUMQ 898 variable osigNUMD 899 variable osigNUMN 900 variable coke_w 901 variable ENABLED 902 903 if {!$ENABLED($n)} return 904 905 set ok 0 906 907 switch $coin { 908 25 { 909 if { $changeQuarters($n) > 0 } { 910 incr changeQuarters($n) -1 911 incr numQuarters($n) 912 set osigNUMQ($n) [min $changeQuarters($n) 7] 913 set ok 1 914 } 915 } 916 10 { 917 if { $changeDimes($n) > 0 } { 918 incr changeDimes($n) -1 919 incr numDimes($n) 920 set osigNUMD($n) [min $changeDimes($n) 7] 921 set ok 1 922 } 923 } 924 5 { 925 if { $changeNickles($n) > 0 } { 926 incr changeNickles($n) -1 927 incr numNickles($n) 928 set osigNUMN($n) [min $changeNickles($n) 7] 929 set ok 1 930 } 931 } 932 } 933 934 if {$ok} { 935 set X [winfo rootx $coke_w($n)] 936 set Y [winfo rooty $coke_w($n)] 937 938 set dw [Dragger::make -bd 0 -interactive 0] 939 if { $dw != "" } { 940 makeDragCoin $dw $n $coin 941 Dragger::animate -speed 20 942 Dragger::animate -step 20 943 Dragger::animate -offset $X $Y 300 400 20 50 944 } 945 } 946 } 947 948 ############################################################################# 949 # 950 # Move bill into reader (and bill in reader into inserted coin bucket) 951 # 952 proc billIn {n args} { 953 variable readyBill 954 variable scannerBill 955 variable holdDollars 956 variable holdBogus 957 variable osigBILLSNS 958 variable osigBILLACK 959 variable ENABLED 960 961 if {!$ENABLED($n)} return 962 963 set value 1 964 parseargs $args {-value} 965 966 if {$value } { 967 # Bill in signal is asserted 968 switch $scannerBill($n) { 969 D { incr holdDollars($n) } 970 B { incr holdBogus($n) } 971 } 972 set scannerBill($n) $readyBill($n) 973 set readyBill($n) "" 974 975 set osigBILLSNS($n) 0 976 set osigBILLACK($n) 1 977 } else { 978 # Bill in signal is unasserted 979 set osigBILLACK($n) 0 980 } 981 } 982 983 ############################################################################# 984 # 985 # Reject bill in reader 986 # 987 proc billOut {n args} { 988 variable readyBill 989 variable scannerBill 990 variable numDollars 991 variable numBogus 992 variable osigBILLSNS 993 variable osigBILLACK 994 variable ENABLED 995 996 if {!$ENABLED($n)} return 997 998 set value 1 999 parseargs $args {-value} 1000 1001 if {$value} { 1002 switch $scannerBill($n) { 1003 D { incr numDollars($n) } 1004 B { incr numBogus($n) } 1005 } 1006 set scannerBill($n) "" 1007 switch $readyBill($n) { 1008 D { incr numDollars($n) } 1009 B { incr numBogus($n) } 1010 } 1011 set readyBill($n) "" 1012 1013 set osigBILLSNS($n) 0 1014 set osigBILLACK($n) 1 1015 } else { 1016 set osigBILLACK($n) 0 1017 } 1018 } 1019 1020 ############################################################################# 1021 # 1022 # But a drink button into the "down" state. 1023 # 1024 proc buttonDown {w n id} { 1025 variable osigPRESS 1026 $w configure -relief sunken 1027 1028 set osigPRESS($n) [lreplace $osigPRESS($n) $id $id 1] 1029 } 1030 1031 ############################################################################# 1032 # 1033 # But a drink button into the "up" state. 1034 # 1035 proc buttonUp {w n id} { 1036 variable coke_w 1037 variable osigPRESS 1038 $w configure -relief raised 1039 1040 set osigPRESS($n) [lreplace $osigPRESS($n) $id $id 0] 1041 } 1042 1043 ############################################################################# 1044 # 1045 # Create a drink selection button 1046 # 1047 proc evButton {w n args} { 1048 1049 set bcolor \#ffeedd 1050 1051 set title "" 1052 set id 0 1053 parseargs $args {-title -id} 1054 1055 frame $w -bd 2 -relief raised -bg $bcolor 1056 label $w.e -text empty -font empty_f -bg "\#a05010" -fg "\#904000" -borderwidth 0 1057 label $w.l -text $title -width 12 -font button_f -bg $bcolor 1058 pack $w.l -side bottom 1059 pack $w.e -side top -anchor w 1060 1061 bind $w <ButtonPress> "CokeMachine::buttonDown $w $n $id" 1062 bind $w <ButtonRelease> "CokeMachine::buttonUp $w $n $id" 1063 bind $w.e <ButtonPress> "CokeMachine::buttonDown $w $n $id" 1064 bind $w.e <ButtonRelease> "CokeMachine::buttonUp $w $n $id" 1065 bind $w.l <ButtonPress> "CokeMachine::buttonDown $w $n $id" 1066 bind $w.l <ButtonRelease> "CokeMachine::buttonUp $w $n $id" 1067 } 1068 1069 ############################################################################# 1070 # 1071 # Create the button box 1072 # 1073 proc evButtonBox {w n args} { 1074 frame $w 1075 evButton $w.b0 $n -title Coke -id 0 1076 evButton $w.b1 $n -title Coke -id 1 1077 evButton $w.b2 $n -title "Diet Coke" -id 2 1078 evButton $w.b3 $n -title "Root Beer" -id 3 1079 evButton $w.b4 $n -title "Pocari Sweat" -id 4 1080 evButton $w.b5 $n -title "Dr. Pepper" -id 5 1081 pack $w.b0 1082 pack $w.b1 1083 pack $w.b2 1084 pack $w.b3 1085 pack $w.b4 1086 pack $w.b5 1087 } 1088 1089 ############################################################################# 1090 # 1091 # Create the dollar bill reader external view 1092 # 1093 proc evDollarSlot {w args} { 1094 canvas $w -bg black -width 70 -height 30 -bg grey -bd 2 -relief raised 1095 1096 $w create rectangle 10 10 40 25 -fill gray60 1097 $w create rectangle 10 10 40 13 -fill gray40 1098 1099 $w create polygon 12 23 15 18 18 23 -fill green -tags billok 1100 $w create polygon 22 23 25 18 28 23 -fill green -tags billok 1101 $w create polygon 32 23 35 18 38 23 -fill green -tags billok 1102 1103 $w create text 60 18 -text "\$1" 1104 } 1105 1106 ############################################################################# 1107 # 1108 # Create the coin slot external view 1109 # 1110 proc evCoinSlot {w n args} { 1111 canvas $w -bg black -width 70 -height 60 -bg grey -bd 2 -relief raised 1112 1113 # coin slot 1114 $w create line 65 10 65 32 -width 4 1115 1116 # 1117 label $w.e -text "no\nchange" -font empty_f -bg "\#a05010" -fg "\#904000" -borderwidth 0 1118 $w create window 10 10 -window $w.e -anchor nw 1119 1120 # coin return lever 1121 $w create polygon 10 40 35 40 35 45 20 45 15 50 10 45 -fill gray20 -tags coinReturnLev 1122 1123 bind $w <1> "CokeMachine::setCRLever $n 1" 1124 bind $w <ButtonRelease-1> "CokeMachine::setCRLever $n 0" 1125 1126# pack $w.slot -padx 10 -pady 20 1127 } 1128 1129 proc setCRLever {n state} { 1130 variable coke_w 1131 variable ENABLED 1132 variable osigCNRET 1133 1134 if {!$ENABLED($n)} return 1135 1136 set w $coke_w($n).c.ext.cslot 1137 1138 set L {10 40 35 40 35 45 20 45 15 50 10 45} 1139 1140 if { $state } { 1141 set R {} 1142 foreach {x y} $L { 1143 lappend R [expr -$y + 60] [expr $x + 25] 1144 } 1145 1146 set osigCNRET($n) 1 1147 eval "$w coords coinReturnLev $R" 1148 } else { 1149 set osigCNRET($n) 0 1150 eval "$w coords coinReturnLev $L" 1151 } 1152 } 1153 1154 ############################################################################# 1155 # 1156 # Create the coin return external view 1157 # 1158 proc evCoinReturn {w args} { 1159 canvas $w -bg black -width 35 -height 35 -bg grey -bd 2 -relief raised 1160 1161 # coin return 1162 $w create rectangle 10 10 30 30 -fill gray20 1163 } 1164 1165 ############################################################################# 1166 # 1167 # Create the can out slot external view 1168 # 1169 proc evCanOutSlot {w args} { 1170 frame $w -bg black -width 175 -height 30 1171 } 1172 1173 ############################################################################# 1174 # 1175 # Create the drink cost window external view 1176 # 1177 proc evCostDisplay {w n} { 1178 variable displayCost 1179 1180 frame $w -bd 2 -relief raised 1181 label $w.l -textvariable CokeMachine::displayCost($n) -width 5 -height 2 -bg white -fg red3 1182 pack $w.l -padx 3 -pady 3 1183 } 1184 1185 1186 proc reloadHopper {w n args} { 1187 variable numCans 1188 1189 set width 25 1190 set color red 1191 set column 0 1192 parseargs $args {-width -height -color -column} 1193 1194 set L [winfo children $w] 1195 1196 set count [lindex $numCans($n) $column] 1197 for { set i [llength $L]} { $i < $count } { incr i } { 1198 frame $w.can$i -width [expr $width-4] -height [expr ($width-4)/2] -bd 0 -bg $color 1199 pack $w.can$i -padx 1 -pady 1 -side bottom 1200 } 1201 } 1202 1203 ############################################################################# 1204 # 1205 # Create the can hopper internal view 1206 # 1207 proc ivCanHopper {w n args} { 1208 variable numCans 1209 1210 set width 20 1211 set height 250 1212 set color red 1213 set column 0 1214 parseargs $args {-width -height -color -column} 1215 1216 frame $w -width $width -height $height -bd 2 -relief solid -bg white 1217 1218 pack propagate $w 0 1219 set count [lindex $numCans($n) $column] 1220 for { set i 0 } { $i < $count } { incr i } { 1221 frame $w.can$i -width [expr $width-4] -height [expr ($width-4)/2] -bd 0 -bg $color 1222 pack $w.can$i -padx 1 -pady 1 -side bottom 1223 } 1224 } 1225 1226 ############################################################################# 1227 # 1228 # Create the bill reader internal view. 1229 # 1230 proc ivBillReader {w n} { 1231 variable mWidth 1232 variable mHeight 1233 1234 # 1235 # copied from ivChangeHopper 1236 # 1237 set ch_w 50 1238 set cs_x1 [expr $mWidth - 55] 1239 set cs_x2 [expr $mWidth - 35] 1240 set x_cent [expr ($cs_x1+$cs_x2)/2] 1241 1242 set x1 [expr $x_cent - $ch_w/2] 1243 set x2 [expr $x_cent + $ch_w/2] 1244 set y1 120 1245 set y2 150 1246 1247 $w create text $x_cent $y1 -text "Bill Scanner" -anchor s 1248 $w create rectangle $x1 $y1 $x2 $y2 -fill white -outline black -width 2 1249 } 1250 1251 ############################################################################# 1252 # 1253 # Create the money box internal view. 1254 # 1255 proc ivMoneyBox {w n} { 1256 variable mWidth 1257 variable mHeight 1258 variable useDollar 1259 1260 # 1261 # copied from ivChangeHopper 1262 # 1263 set ch_w 75 1264 set cs_x1 [expr $mWidth - 55] 1265 set cs_x2 [expr $mWidth - 35] 1266 set x_cent [expr ($cs_x1+$cs_x2)/2] 1267 1268 set x3 [expr $x_cent - $ch_w/2] 1269 set x5 [expr $x_cent + $ch_w/2] 1270 1271 set x1 [expr $x3 - 25] 1272 set x2 [expr $x3 - 5] 1273 set x4 [expr $x3 + 20] 1274 1275 set y1 [expr $mHeight - 340] 1276 set y2 [expr $y1 + 58] 1277 set y3 [expr $y2 + 20] 1278 set y4 [expr $y3 + 25] 1279 set y5 [expr $mHeight - 142] 1280 set y6 [expr $mHeight - 117] 1281 set y7 [expr $mHeight - 5] 1282 1283 $w create polygon $x3 $y1 $x3 $y3 $x1 $y4 $x1 $y5 $x3 $y6 $x3 $y7 $x5 $y7 $x5 $y6 \ 1284 $x4 $y6 $x2 $y5 $x2 $y4 $x4 $y3 $x5 $y3 $x5 $y1 -width 2 -fill white -outline black 1285 1286 $w create text [expr $x_cent + 7] $y6 -text Collected -anchor s 1287 $w create text $x_cent $y1 -text Inserted -anchor s 1288 $w create text $x_cent 279 -text Change -anchor s 1289 1290 # 1291 # Repository for money that has been used to purchase a product 1292 # 1293 set x [expr $x3 + 15] 1294 set y [expr $y6 + 15] 1295 1296 if {$useDollar($n)} { 1297 set entries {D holdDollars B holdBogus 25 holdQuarters 10 holdDimes 5 holdNickles} 1298 } else { 1299 set entries {25 holdQuarters 10 holdDimes 5 holdNickles} 1300 } 1301 1302 foreach {coin aname} $entries { 1303 if {$coin == "D"} { 1304 makeDollar $w $x $y 1305 } elseif {$coin == "B"} { 1306 makeBogus $w $x $y 1307 } else { 1308 makeCoin $w $x $y -value $coin 1309 } 1310 $w create text [expr $x + 20] $y -text "X" 1311 1312 label $w.hld$coin -textvariable CokeMachine::${aname}($n) -bg white 1313 $w create window [expr $x + 35] $y -window $w.hld$coin 1314 1315 incr y 21 1316 } 1317 1318 # 1319 # Repository for money that has been inserted but not committed 1320 # 1321 set x [expr $x3 + 15] 1322 set y [expr $y1 + 15] 1323 foreach {coin aname} {25 insertQuarters 10 insertDimes 5 insertNickles} { 1324 if {$coin == "D"} { 1325 makeDollar $w $x $y 1326 } elseif {$coin == "B"} { 1327 makeBogus $w $x $y 1328 } else { 1329 makeCoin $w $x $y -value $coin 1330 } 1331 $w create text [expr $x + 20] $y -text "X" 1332 1333 label $w.ins$coin -textvariable CokeMachine::${aname}($n) -bg white 1334 $w create window [expr $x + 35] $y -window $w.ins$coin 1335 1336 incr y 21 1337 } 1338 } 1339 1340 ############################################################################# 1341 # 1342 # Create the change hopper internal view 1343 # 1344 proc ivChangeHopper {w n} { 1345 variable mWidth 1346 variable mHeight 1347 1348 # coin return slot 1349 set cs_x1 [expr $mWidth - 55] 1350 set cs_y1 [expr $mHeight - 155] 1351 set cs_x2 [expr $mWidth - 35] 1352 set cs_y2 [expr $mHeight - 135] 1353 1354 # change box 1355 set ch_w 75 1356 set ch_x1 [expr ($cs_x1+$cs_x2)/2 - $ch_w/2] 1357 set ch_x2 [expr ($cs_x1+$cs_x2)/2 + $ch_w/2] 1358 set ch_y1 281 1359 set ch_y2 345 1360 1361 $w create polygon $cs_x1 $cs_y1 $ch_x1 $ch_y2 $ch_x1 $ch_y1 $ch_x2 $ch_y1 \ 1362 $ch_x2 $ch_y2 $cs_x2 $cs_y1 -width 2 -fill white -outline black 1363 1364 set x [expr $ch_x1 + 15] 1365 set y [expr $ch_y1 + 15] 1366 1367 foreach {coin aname} {25 changeQuarters 10 changeDimes 5 changeNickles} { 1368 makeCoin $w $x $y -value $coin 1369 $w create text [expr $x + 20] $y -text "X" 1370 1371 label $w.chg$coin -textvariable CokeMachine::${aname}($n) -bg white 1372 $w create window [expr $x + 35] $y -window $w.chg$coin 1373 1374 incr y 21 1375 } 1376 1377 $w create rectangle $cs_x1 $cs_y1 $cs_x2 $cs_y2 -fill gray20 1378 } 1379 1380 ############################################################################# 1381 # 1382 # External view of coke machine 1383 # 1384 proc externalView {w n} { 1385 variable mWidth 1386 variable mHeight 1387 variable useDollar 1388 1389 set color "\#dd0000" 1390 1391 frame $w -background $color -width $mWidth -height $mHeight 1392 1393 # 1394 # "Soda" title on top of machine 1395 # 1396 label $w.title -text Soda -font title_f -background $color -foreground white 1397 place $w.title -x [expr $mWidth/2] -y 60 -anchor center 1398 1399 # 1400 # Can out slot 1401 # 1402 evCanOutSlot $w.canout 1403 place $w.canout -x 25 -y [expr $mHeight - 80] -anchor w 1404 1405 # 1406 # buttons 1407 # 1408 evButtonBox $w.bbar $n 1409 place $w.bbar -x 20 -y 120 -anchor nw 1410 1411 # 1412 # Cost display 1413 # 1414 evCostDisplay $w.costwin $n 1415 place $w.costwin -x 120 -y 120 -anchor nw 1416 1417 # 1418 # Dollar slot 1419 # 1420 if {$useDollar($n)} { 1421 evDollarSlot $w.dslot 1422 place $w.dslot -x [expr $mWidth - 20] -y 120 -anchor ne 1423 } 1424 1425 # 1426 # Coin slot 1427 # 1428 evCoinSlot $w.cslot $n 1429 place $w.cslot -x [expr $mWidth - 20] -y 170 -anchor ne 1430 1431 1432 # 1433 # Coin return 1434 # 1435 evCoinReturn $w.creturn 1436 place $w.creturn -x [expr $mWidth - 20] -y [expr $mHeight - 120] -anchor se 1437 } 1438 1439 ############################################################################# 1440 # 1441 # Create the internal view of the coke machine 1442 # 1443 proc internalView {w n args} { 1444 variable mWidth 1445 variable mHeight 1446 variable canColors 1447 variable useDollar 1448 1449 canvas $w -width $mWidth -height $mHeight -bg tan 1450 1451 set hwidth 25 1452 for {set i 0 } { $i < 6 } { incr i } { 1453 ivCanHopper $w.h$i $n -width $hwidth -color [lindex $canColors $i] -column $i 1454 $w create window [expr 15 + ($hwidth+5) *$i] 70 -window $w.h$i -anchor nw 1455 } 1456 1457 1458 # change holder 1459 ivChangeHopper $w $n 1460 1461 # change holder 1462 ivMoneyBox $w $n 1463 1464 if {$useDollar($n)} { 1465 # Bill reader 1466 ivBillReader $w $n 1467 } 1468 1469 # can output slot 1470 evCanOutSlot $w.co 1471 $w create window 25 [expr $mHeight - 80] -window $w.co -anchor w 1472 1473 } 1474 1475 1476 ############################################################################# 1477 # 1478 # Unpost the coke machine and clean everything up 1479 # 1480 proc unpost {n} { 1481 variable coke_w 1482 variable useDollar 1483 1484 set w $coke_w($n) 1485 unset coke_w($n) 1486 1487 trace vdelete CokeMachine::isEmpty($n) w "CokeMachine::seeLight $n" 1488 trace vdelete CokeMachine::noChange($n) w "CokeMachine::seeLight $n" 1489 trace vdelete CokeMachine::billLight($n) w "CokeMachine::seeLight $n" 1490 if { $useDollar($n)} { 1491 trace vdelete CokeMachine::scannerBill($n) w "CokeMachine::seeScannerBill $n" 1492 trace vdelete CokeMachine::readyBill($n) w "CokeMachine::seeReadyBill $n" 1493 } 1494 1495 destroy $w 1496 } 1497 1498 ############################################################################# 1499 # 1500 # Post the coke machine window. 1501 # 1502 proc post {n args} { 1503 variable coke_w 1504 variable isEmpty 1505 variable mWidth 1506 variable mHeight 1507 variable useDollar 1508 variable displayCost 1509 variable ENABLED 1510 1511 puts "CokeMachine::post $n $args" 1512 1513 set displayCost($n) "" 1514 set ENABLED($n) 0 1515 1516 set dollar 1 1517 parseargs $args {-dollar} 1518 set useDollar($n) $dollar 1519 1520 # Initialize state to make sure all variables exist 1521 initState $n 1522 1523 set i 0 1524 set w "" 1525 1526 set w [VPD::createWindow "Coke Machine $n" -shutdowncommand "CokeMachine::unpost $n"] 1527 set coke_w($n) $w 1528 1529 canvas $w.c -width [expr 125 + 2*$mWidth] -height [expr 100 + $mHeight] 1530 pack $w.c 1531 1532 externalView $w.c.ext $n 1533 internalView $w.c.int $n 1534 1535 $w.c create window 75 25 -window $w.c.ext -anchor nw 1536 $w.c create window [expr 100 + $mWidth] 25 -window $w.c.int -anchor nw 1537 1538 button $w.c.reset -text Reset -command "CokeMachine::resetMachine $n 0; CokeMachine::resetMachine $n 1" 1539 $w.c create window 4 [expr 25 + $mHeight] -window $w.c.reset -anchor sw 1540 1541 makeCoinList $w.c $n 1542 1543 trace variable CokeMachine::isEmpty($n) w "CokeMachine::seeLight $n" 1544 trace variable CokeMachine::noChange($n) w "CokeMachine::seeLight $n" 1545 trace variable CokeMachine::billLight($n) w "CokeMachine::seeLight $n" 1546 1547 if { $useDollar($n)} { 1548 trace variable CokeMachine::scannerBill($n) w "CokeMachine::seeScannerBill $n" 1549 trace variable CokeMachine::readyBill($n) w "CokeMachine::seeReadyBill $n" 1550 } 1551 1552 1553 puts "CokeMachine::post-2 $n $args" 1554 1555 if {[info exists ::tkgate_isInitialized]} { 1556 VPD::signal $n.PRESS CokeMachine::osigPRESS($n) 1557 VPD::signal $n.EMPTY CokeMachine::osigEMPTY($n) 1558 VPD::signal $n.INSQ CokeMachine::osigINSQ($n) 1559 VPD::signal $n.INSD CokeMachine::osigINSD($n) 1560 VPD::signal $n.INSN CokeMachine::osigINSN($n) 1561 VPD::signal $n.NUMQ CokeMachine::osigNUMQ($n) 1562 VPD::signal $n.NUMD CokeMachine::osigNUMD($n) 1563 VPD::signal $n.NUMN CokeMachine::osigNUMN($n) 1564 VPD::signal $n.BILLSNS CokeMachine::osigBILLSNS($n) 1565 VPD::signal $n.CNRET CokeMachine::osigCNRET($n) 1566 VPD::signal $n.BILLOK CokeMachine::osigBILLOK($n) 1567 VPD::signal $n.BILLNG CokeMachine::osigBILLNG($n) 1568 VPD::signal $n.BILLACK CokeMachine::osigBILLACK($n) 1569 1570 VPD::insignal $n.NOCHG -variable CokeMachine::noChange($n) -format %d 1571 VPD::insignal $n.BILLLT -variable CokeMachine::billLight($n) -format %d 1572 } else { 1573 set ENABLED($n) 1 1574 } 1575 1576 puts "CokeMachine::post-3 $n $args" 1577 1578 # Initialize state again to react to variable settings 1579 initState $n 1580 1581 puts "CokeMachine::post-4 $n $args" 1582 } 1583} 1584 1585############################################################################# 1586############################################################################# 1587# 1588# Code from here down is used for debugging and is only invoked if this 1589# script is run stand-alone. 1590# 1591if {![info exists tkgate_isInitialized]} { 1592 tk scaling 1 1593 wm state . withdrawn 1594 1595 source scripts/misc.tcl 1596 source scripts/simulator.tcl 1597 source scripts/udev.tcl 1598 source scripts/dragger.tcl 1599 1600 proc updateEmpty {} { 1601 global emptyLight 1602 1603 set L {} 1604 for {set i 0} { $i < 6 } { incr i } { 1605 lappend L $emptyLight($i) 1606 } 1607 set CokeMachine::isEmpty(test) $L 1608 } 1609 1610 proc oDisplay {w vname} { 1611 frame $w 1612 label $w.l -text ${vname}: 1613 label $w.v -textvariable CokeMachine::${vname}(test) 1614 pack $w.l $w.v -side left 1615 pack $w -side left -padx 5 -pady 5 1616 } 1617 1618 CokeMachine::post test 1619 1620 set w $CokeMachine::coke_w(test) 1621 1622 frame $w.sep -bd 2 -relief sunken -height 6 1623 pack $w.sep -padx 20 -fill x 1624 1625 frame $w.b 1626 pack $w.b -fill both 1627 checkbutton $w.b.nochg -text "No Change" -variable CokeMachine::noChange(test) 1628 pack $w.b.nochg -side left -padx 5 -pady 5 1629 1630 if {$CokeMachine::useDollar(test)} { 1631 checkbutton $w.b.insdol -text "Insert Dollar" -variable CokeMachine::billLight(test) 1632 pack $w.b.insdol -side left -padx 5 -pady 5 1633 } 1634 1635 button $w.b.chg25 -text "Chg 25" -command "CokeMachine::ejectChange test 25" 1636 button $w.b.chg10 -text "Chg 10" -command "CokeMachine::ejectChange test 10" 1637 button $w.b.chg5 -text "Chg 5" -command "CokeMachine::ejectChange test 5" 1638 pack $w.b.chg25 $w.b.chg10 $w.b.chg5 -side left -padx 5 -pady 5 1639 1640 if {$CokeMachine::useDollar(test)} { 1641 button $w.b.billin -text "Bill In" -command "CokeMachine::billIn test" 1642 button $w.b.billout -text "Bill Out" -command "CokeMachine::billOut test" 1643 pack $w.b.billin $w.b.billout -side left -padx 5 -pady 5 1644 } 1645 1646 button $w.b.commit -text "Commit" -command "CokeMachine::commitInserted test" 1647 pack $w.b.commit -side left -padx 5 -pady 5 1648 1649 1650 frame $w.b2 1651 pack $w.b2 -fill both 1652 1653 for {set i 0} { $i < 6 } { incr i } { 1654 checkbutton $w.b2.e$i -text "E$i" -variable emptyLight($i) -command updateEmpty 1655 pack $w.b2.e$i -side left -padx 5 -pady 5 1656 } 1657 for {set i 0} { $i < 6 } { incr i } { 1658 button $w.b2.d$i -text "D$i" -command "CokeMachine::dispense test $i" 1659 pack $w.b2.d$i -side left -padx 5 -pady 5 1660 } 1661 1662 button $w.b2.rins -text "RETINS" -command "CokeMachine::returnInserted test" 1663 pack $w.b2.rins -padx 5 -pady 5 -side left 1664 1665 ############################################################################# 1666 # 1667 # Output display 1668 # 1669 1670 frame $w.sep2 -bd 2 -relief sunken -height 6 1671 pack $w.sep2 -padx 20 -fill x 1672 1673 frame $w.out1 1674 pack $w.out1 -fill both 1675 oDisplay $w.out1.buttons osigPRESS 1676 oDisplay $w.out1.havecans osigEMPTY 1677 oDisplay $w.out1.numq osigNUMQ 1678 oDisplay $w.out1.numd osigNUMD 1679 oDisplay $w.out1.numn osigNUMN 1680 frame $w.out2 1681 pack $w.out2 -fill both 1682 oDisplay $w.out2.insq osigINSQ 1683 oDisplay $w.out2.insd osigINSD 1684 oDisplay $w.out2.indn osigINSN 1685 if {$CokeMachine::useDollar(test)} { 1686 oDisplay $w.out2.billsns osigBILLSNS 1687 oDisplay $w.out2.billok osigBILLOK 1688 } 1689 oDisplay $w.out2.cnret osigCNRET 1690} 1691