1#!/usr/local/bin/wish8.6 -f 2 3###################################################################### 4# 5# dontspaceRules.tcl 6# 7# Copyright (C) 1993,1994 by John Heidemann <johnh@ficus.cs.ucla.edu> 8# All rights reserved. See the main dontspace file for a full copyright 9# notice. 10# 11# $Id: dontspaceRules.tcl,v 2.16 1997/03/26 17:46:26 johnh Exp $ 12# 13###################################################################### 14 15set rcsid(dontspaceRules.tcl) {$Id: dontspaceRules.tcl,v 2.16 1997/03/26 17:46:26 johnh Exp $} 16 17 18 19proc main {} { 20 global game table tk_version argv 21 22 source "$game(sourcedir)/table.tcl" 23 source "$game(sourcedir)/score.tcl" 24 source "$game(sourcedir)/help.tcl" 25 source "$game(sourcedir)/dontspaceMenus.tcl" 26 27 if {$tk_version < 4.0} { 28 bind . <Any-Enter> {focus [focus default]} 29 } 30 mkTableDefaults 31 if {[winfo screenheight .] < 600} { 32 set table(gutter) 10 33 set table(stackedCardOffset) 20 34 } 35 36 set game(numTableColumns) 8 37 set game(zeroBasedList) {0 1 2 3 4 5 6 7 8 9 10 11 12} 38 set game(tableList) [lrange $game(zeroBasedList) \ 39 0 [expr $game(numTableColumns)-1]] 40 41 set game(foundationList) {0 1 2 3} 42 set game(spaceList) {0 1 2 3} 43 44 set game(scoreMethod) official 45 set game(randomSeed) {} 46 set game(presetRandomSeed) {} 47 48 set cardWidth $game(numTableColumns) 49 if { $cardWidth < 9 } { set cardWidth 9 } 50 # Largest table is 51 set tableWidth [expr $cardWidth*$table(cardWidth)+$cardWidth*$table(gutter) ] 52 # Longest possible chain of cards: 7 card start w/a king on the bottom 53 # + 13 cards down from the king. This configuration is extremely 54 # unlikely and makes the table *way* too big for normal play. 55 # As a compromise we allow 15 stacked cards. 56 set tableHeight [expr 2*$table(cardHeight)+3.5*$table(gutter)+14*$table(stackedCardOffset) ] 57 58 set game(tableW) [mkTable $tableWidth $tableHeight gamePreActionProc] 59 set game(menuW) [mkMenus] 60 mkMenuBindings -default $game(tableW) 61 62 pack $game(menuW) -side top -fill x 63 pack $game(tableW) -side bottom -fill x 64 update idletasks 65 66 # fixed stuff 67 mkUnchangingItems 68 69 # Score stuff 70 mkScore $game(tableW) "dontspace" \ 71 [expr $table(gutter)+4*($table(cardWidth)+$table(gutter))] \ 72 $table(gutter) game(scoreMethod) 73 74 # a game 75 if {[llength $argv] <= 0} { 76 mkNewGame 77 } else { 78 set seed [lindex $argv 0] 79 # puts "Old game key $seed." 80 mkOldGame $seed 81 } 82} 83 84proc mkUnchangingItems {} { 85 global game table 86 87 set w $game(tableW) 88 set game(status) building 89 90 mkDeck 91 mkBindings $w 92 93 # spaces 94 foreach i $game(spaceList) { 95 set game(spaceId,$i) [createItemBitmap \ 96 [expr $table(gutter)+$i*($table(cardWidth)+$table(gutter))] \ 97 $table(gutter) "space"] 98 } 99 100 # foundation 101 foreach i $game(foundationList) { 102 set game(foundationId,$i) [createItemBitmap \ 103 [expr $table(gutter)+(5+$i)*($table(cardWidth)+$table(gutter))] \ 104 $table(gutter) "space"] 105 } 106 107 # table 108 set offset 0 109 if { $game(numTableColumns) <= 8 } { set offset 0.5 } 110 foreach i $game(tableList) { 111 set game(tableId,$i) [createItemBitmap \ 112 [expr $table(gutter)+($i+$offset)*($table(cardWidth)+$table(gutter))] \ 113 [expr 2.5*$table(gutter)+$table(cardHeight)] "space"] 114 } 115 116 # Make the notice text. 117 set game(noticeId) [$game(tableW) create text \ 118 [expr 4*($table(cardWidth)+$table(gutter))] \ 119 [expr 3.5*($table(cardHeight)+$table(gutter))] \ 120 -anchor c -font $table(font) ] 121 tableRegisterDumbItem $game(noticeId) 122 setNoticeText "\n\n\n\n\n\n\n\n\n\nPlease wait, starting game..." 123 set game(initialNoticeText) "\n\n\n\n\n\n\n\n\n\nCheck the ``Help'' menu\nin the upper-right\ncorner for game rules.\nClick on a card to start the game." 124 # Start the decay daemon. 125 set game(scoreDecayDelay) 15000 126 decayScore $game(scoreDecayDelay) 127 128 update idletasks 129} 130 131proc setNoticeText {text} { 132 global game 133 $game(tableW) itemconf $game(noticeId) -text $text 134 $game(tableW) raise $game(noticeId) 135} 136 137proc decayScore {delay} { 138 global game 139 if { $game(status) == "running" } { 140 incrScore -2 141 } 142 after $delay "decayScore $delay" 143} 144 145proc mkNewGame {} { 146 global deck game 147 148 set game(status) dealing 149 150 set w $game(tableW) 151 152 # Get a unique random number. 153 if { $game(presetRandomSeed) != {} } { 154 set game(randomSeed) $game(presetRandomSeed) 155 set randomNotice " (for game ``$game(presetRandomSeed)'')" 156 set game(presetRandomSeed) {} 157 } else { 158 set game(randomSeed) [mkRandomSeed] 159 set randomNotice "" 160 } 161 setRandomSeed $game(randomSeed) 162 shuffleDeck 163 164 mkNewScore 165 setScoreMessage "Good\nluck!" 166 setNoticeText "\n\n\n\n\n\n\n\n\n\nDealing cards${randomNotice}..." 167 set game(cardsToPlay) 52 168 set game(moveCount) 0 169 170 initSpaceAvailability 171 # spaces 172 foreach i $game(spaceList) { 173 setCard $w $game(spaceId,$i) -default -type place \ 174 -location space -sublocation $i \ 175 -dragTargetAcceptGlob {??} \ 176 -dragTargetAcceptProc singleOnlyAcceptProc \ 177 -adoptChildProc spaceAdoptChild \ 178 -orphanChildProc spaceOrphanChild 179 makeSpaceAvailable $w $game(spaceId,$i) 180 } 181 182 # foundation 183 foreach i $game(foundationList) { 184 setCard $w $game(foundationId,$i) -default -type place \ 185 -location foundation -sublocation $i \ 186 -dragTargetAcceptGlob {a?} \ 187 -dragTargetAcceptProc singleOnlyAcceptProc \ 188 -adoptChildProc foundationAdoptChild 189 set game(foundationTopId,$i) $game(foundationId,$i) 190 } 191 192 # table 193 foreach i $game(tableList) { 194 setCard $w $game(tableId,$i) -default -type place \ 195 -location table -sublocation $i \ 196 -dragTargetAcceptGlob {??} \ 197 -dragTargetAcceptProc tableSpaceAcceptProc \ 198 -adoptChildProc tableAdoptChild \ 199 -orphanChildProc tableSpaceOrphanChild 200 makeSpaceAvailable $w $game(tableId,$i) 201 } 202 203 # deal the cards 204 dirtyTableDragability disable 205 foreach column $game(tableList) { 206 set lastCard($column) $game(tableId,$column) 207 } 208 set column -1 209 foreach id $deck { 210 set column [expr ($column+1)%$game(numTableColumns)] 211 if {$column == 0} { update idletasks } 212 213 setCard $w $id \ 214 -default \ 215 -side face \ 216 -doubleClickProc cardDoubleClick \ 217 -numChildren 0 218 219 # place the card on the table 220 playCardOnCard $w $id {} $lastCard($column) 221 222 set lastCard($column) $id 223 } 224 225 # Recompute time to win. 226 set game(status) thinking 227 set game(dragableCards) "" 228 set game(cardsLeftToDrag) 52 229 230 dirtyTableDragability enable 231 dirtyTableDragability all 232 fixTableDragability $w 233 enablePatternDoubleClicking $w {a?} 234 235 setNoticeText $game(initialNoticeText) 236 set game(initialNoticeText) "" 237 238 set game(status) beginable 239} 240 241proc dirtyTableDragability {which} { 242 global game 243 switch -exact $which { 244 "disable" { set game(dragability) 0 } 245 "enable" { set game(dragability) 1 } 246 "all" { 247 foreach column $game(tableList) { 248 set game(columnDragabilityDirty,$column) 1 249 } 250 } 251 "count" { 252 set game(countDirty) 1 253 } 254 default { 255 set game(columnDragabilityDirty,$which) 1 256 } 257 } 258} 259 260 261proc fixTableDragability {w} { 262 global game 263 264 if { !$game(dragability) } { return } 265 266 # This is kind of slow so make sure the user has something to look at. 267 update idletasks 268 269 # First build up a list of each table. 270 foreach column $game(tableList) { 271 if { $game(columnDragabilityDirty,$column) } { 272 fixTableColumnDragability $w $column 273 set game(columnDragabilityDirty,$column) 0 274 } 275 } 276 # Now enable the correct cards to correct for a count failure. 277 if { $game(movableChildCount) > $game(oldMovableChildCount) } { 278 changeChildCountDragability $w -atag [lrange $game(zeroBasedList) $game(oldMovableChildCount) $game(movableChildCount)] 279 } elseif { $game(movableChildCount) < $game(oldMovableChildCount) } { 280 changeChildCountDragability $w -dtag [lrange $game(zeroBasedList) [expr $game(movableChildCount)+1] $game(oldMovableChildCount)] 281 } 282 set game(oldMovableChildCount) $game(movableChildCount) 283 set game(countDirty) 0 284} 285 286proc changeChildCountDragability {w action list} { 287 foreach i $list { 288 foreach id [$w find withtag "${i}child"] { 289 # puts "$id $action dragableCard" 290 setCard $w $id $action dragableCard 291 } 292 } 293} 294 295proc fixTableColumnDragability {w column} { 296 global game 297 298 set columnCards [figureColumnCards $game(tableW) $game(tableId,$column)] 299 set seq [lreverse [leftmostGoodSubsequence $w $columnCards]] 300 set i 0 301 foreach id $seq { 302 set oldI [getCard $w $id -numChildren] 303 setCard $w $id \ 304 -dtag "${oldI}child" \ 305 -atag "${i}child" \ 306 -numChildren $i 307 if { $i <= $game(movableChildCount) } { 308 setCard $w $id \ 309 -atag dragableCard 310 addCardToDragableList $id 311 } else { 312 setCard $w $id \ 313 -dtag dragableCard 314 } 315 incr i 316 } 317} 318 319proc figureColumnCards {w id} { 320 set l {} 321 # Intentionally skip the first card, it's the table card. 322 set id [getCard $w $id -child] 323 while {$id != {}} { 324 lappend l $id 325 set id [getCard $w $id -child] 326 } 327 return $l 328} 329 330proc leftmostGoodSubsequence {w seq} { 331 set seql [llength $seq] 332 if { $seql <= 1 } { 333 return $seq 334 } else { 335 set car [lindex $seq 0] 336 set cadr [lindex $seq 1] 337 set cdr [lrange $seq 1 end] 338 set goodsubseq [leftmostGoodSubsequence $w $cdr] 339 if { $cdr == $goodsubseq && \ 340 [string match [globNextLowerOtherColor \ 341 [getCard $w $car -subtype]] \ 342 [getCard $w $cadr -subtype]]} { 343 return $seq 344 } else { 345 return $goodsubseq 346 } 347 } 348} 349 350 351proc fixCardDoubleClickability {w id} { 352 # Adjust double-clickablility. 353 if { [foundationAccepts $w $id] != {} } { 354 setCard $w $id \ 355 -atag doubleClickableCard 356 } 357} 358 359 360proc enablePatternDoubleClicking {w pattern} { 361 if { $pattern == {a?} } { 362 foreach vs {ac ad ah as} { 363 enableVsDoubleClicking $w $vs 364 } 365 } elseif { [string match {x?} $pattern] == 0 } { 366 enableVsDoubleClicking $w $pattern 367 } 368} 369 370proc enableVsDoubleClicking {w vs} { 371 set id [rememberCard $vs] 372 if { [getCard $w $id -child] == {} } { 373 setCard $w $id \ 374 -atag doubleClickableCard 375 } 376} 377 378proc singleOnlyAcceptProc {w target src srcFriends} { 379 # debugLog "singleOnlyAcceptProc $w $target $src $srcFriends" 380 if { [llength $srcFriends] != 0 } { 381 return 0 382 } else { 383 return 1 384 } 385} 386 387proc tableSpaceAcceptProc {w target src srcFriends} { 388 # debugLog "tableSpaceAcceptProc $w $target $src $srcFriends" 389 if {[dangerousMove $w $target $src $srcFriends]} { 390 return 0 391 } else { 392 return 1 393 } 394} 395 396proc spaceAdoptChild {w target src srcFriends closure} { 397 # debugLog "spaceAdoptChild $w $target $src $srcFriends" 398 global game 399 400 if { [llength $srcFriends] != 0} { 401 error "spaceAdoptChild: child with friends" 402 } 403 # Disable the space. 404 setCard $w $target \ 405 -dragTargetAcceptGlob {} \ 406 -child $src 407 # Move the child. 408 moveCardOnCard $w $src $target 409 # Make the child outlineable and dragable. 410 setCard $w $src \ 411 -location space \ 412 -sublocation [getCard $w $target -sublocation] \ 413 -parent $target \ 414 -orphanChildProc spaceOrphanChild \ 415 -atag dragableCard 416 addCardToDragableList $src 417 418 # All dragability must change. 419 makeSpaceUnavailable $w $target 420 dirtyTableDragability count 421 fixTableDragability $w 422 423 checkForWin 424} 425 426proc spaceOrphanChild {w target src srcFriends closure} { 427 # debugLog "spaceOrphanChild $w $target $src $srcFriends" 428 global game 429 430 # Enable the space. 431 setCard $w $target \ 432 -dragTargetAcceptGlob {??} \ 433 -child {} 434 # All dragability must change. 435 makeSpaceAvailable $w $target 436 dirtyTableDragability count 437} 438 439proc foundationAdoptChild {w target src srcFriends closure} { 440 global game 441 442 # debugLog "foundationAdoptChild $w $target $src $srcFriends $closure" 443 if { [llength $srcFriends] != 0} { 444 error "foundationAdoptChild: child with friends" 445 } 446 # Disable the foundation. 447 setCard $w $target \ 448 -dragTargetAcceptGlob {} \ 449 -child $src 450 # Move the child. 451 # debugLogPause "foundationAdoptChild: moveCardOnCard $w $src $target" 452 moveCardOnCard $w $src $target 453 454 # Make the child accept the next card and otherwise unusable. 455 set vs [getCard $w $src -subtype] 456 set v [string index $vs 0] 457 set s [string index $vs 1] 458 set newV [figureNextValue $v 1] 459 set column [getCard $w $target -sublocation] 460 # debugLogPause "foundationAdoptChild: setCard (colmn: $column)" 461 setCard $w $src \ 462 -location foundation \ 463 -sublocation $column \ 464 -dragTargetAcceptGlob "$newV$s" \ 465 -adoptChildProc foundationAdoptChild \ 466 -childOffsetProc samePlaceChildOffsetProc \ 467 -dtag dragableCard \ 468 -dtag doubleClickableCard 469 unhilightCard $src $w {} {} 470 # Indicate the new top. 471 set game(foundationTopId,$column) $src 472 473 # Score the points 474 incrScore 10 475 476 # Change dragability, possibly making more cards double clickable. 477 fixTableDragability $w 478 # debugLogPause "foundationAdoptChild: enablePatternDoubleClicking" 479 enablePatternDoubleClicking $w "$newV$s" 480 481 # Finally, check for win. 482 incr game(cardsToPlay) -1 483 checkForWin 484} 485 486# Return foundation id that will accept this card or nil. 487proc foundationAccepts {w id} { 488 global game 489 490 set vs [getCard $w $id -subtype] 491 492 foreach i $game(foundationList) { 493 set targetId $game(foundationTopId,$i) 494 set targetGlob [getCard $w $targetId -dragTargetAcceptGlob] 495 if { [string match $targetGlob $vs] } { 496 return $targetId 497 } 498 } 499 return {} 500} 501 502proc tableAdoptChild {w target src srcFriends closure} { 503 global game 504 505 # debugLog "tableAdoptChild $w $target $src $srcFriends" 506 if { [llength $srcFriends] != 0} { 507 moveMultipleCards $w $target $src $srcFriends $closure 508 return 509 # error "tableAdoptChild: child with friends $srcFriends: [llength $srcFriends]" 510 } 511 # Disable the table, but give it children 512 setCard $w $target \ 513 -dragTargetAcceptGlob {} \ 514 -dragFindFriendsClosure $src \ 515 -dtag doubleClickableCard \ 516 -dtag dragableCard \ 517 -child $src 518 set column [getCard $w $target -sublocation] 519 # Move the child. 520 moveCardOnCard $w $src $target 521 # Make the child accept the next card. 522 setCard $w $src \ 523 -location table \ 524 -sublocation $column \ 525 -parent $target \ 526 -dragTargetAcceptGlob [globNextLowerOtherColor [getCard $w $src -subtype]] \ 527 -adoptChildProc tableAdoptChild \ 528 -childOffsetProc offsetChildOffsetProc \ 529 -orphanChildProc tableCardOrphanChild \ 530 -atag dragableCard 531 addCardToDragableList $src 532 # Adjust dragability. 533 if { [getCard $w $target -parent] == {} } { 534 makeSpaceUnavailable $w $target 535 } 536 dirtyTableDragability $column 537 fixTableDragability $w 538 539 checkForWin 540} 541 542proc tableSpaceOrphanChild {w target src srcFriends closure} { 543 global game 544 545 # debugLog "tableSpaceOrphanChild $w $target $src $srcFriends $closure" 546 # Enable the table. 547 setCard $w $target \ 548 -dragTargetAcceptGlob {??} 549 tableOrphanChild $w $target $src $srcFriends $closure 550 # All dragability must change. 551 makeSpaceAvailable $w $target 552 dirtyTableDragability count 553} 554 555proc tableCardOrphanChild {w target src srcFriends closure} { 556 # Enable the table. 557 setCard $w $target \ 558 -dragTargetAcceptGlob [globNextLowerOtherColor [getCard $w $target -subtype]] \ 559 -atag dragableCard 560 addCardToDragableList $target 561 tableOrphanChild $w $target $src $srcFriends $closure 562 # Some dragability must change. 563 dirtyTableDragability [getCard $w $target -sublocation] 564 # And double-clickability. 565 fixCardDoubleClickability $w $target 566} 567 568proc tableOrphanChild {w target src srcFriends closure} { 569 # debugLog "tableOrphanChild $w $target $src $srcFriends $closure" 570 # The target no longer has a friend. 571 setCard $w $target \ 572 -dragFindFriendsClosure {} \ 573 -child {} 574 # Undo stuff to the child. 575 set childNumChildren [getCard $w $src -numChildren] 576 setCard $w $src \ 577 -location {} \ 578 -parent {} \ 579 -dragTargetAcceptGlob {} \ 580 -adoptChildProc error \ 581 -childOffsetProc error \ 582 -dtag dragableCard \ 583 -dtag ${childNumChildren}child 584 # And any friends. 585 foreach id $srcFriends { 586 set childNumChildren [getCard $w $src -numChildren] 587 setCard $w $src \ 588 -dtag ${childNumChildren}child 589 } 590} 591 592proc cardDoubleClick {itemId w x y closure} { 593 # debugLog "cardDoubleClick $itemId $w $x $y $closure" 594 set target [foundationAccepts $w $itemId] 595 if { $target == {} } { 596 error "cardDoubleClick: double-click on card with no viable destination." 597 } 598 playCardOnCard $w $itemId {} $target 599} 600 601 602proc gamePreActionProc {action} { 603 global game 604 if { $action != "dragPress" } { return } 605 if { $game(status) == "beginable" } { 606 beginGame 607 } 608} 609 610proc beginGame {} { 611 global game 612 613 if { $game(status) != "beginable" } { return } 614 615 set game(status) running 616 setScoreMessage "" 617 setNoticeText "" 618 619 # Remember when we started for the possible winning bonus. 620 set game(startTime) [getclock] 621 set game(pauseTime) 0 622 623 beginGameChangeMenus 624} 625 626proc endGame {how} { 627 global game 628 629 if { $game(status) == "paused" } { unpauseGame } 630 if { $game(status) != "running" } { return } 631 632 set game(status) stopped 633 set game(endTime) [getclock] 634 set timeDelta [expr $game(endTime)-$game(startTime)] 635 if { $how == "win" } { 636 set bonusDelta [expr ([getScore]-$game(moveCount))*10] 637 setScoreMessage "You\nwon!" 638 } else { 639 set bonusDelta 0 640 setScoreMessage "Game\nover." 641 642 } 643 # Can't loose in bonus. 644 if { $bonusDelta < 0 } { set bonusDelta 0 } 645 # To track potential bonus bugs, squirrel away these values. 646 set game(timeDelta) $timeDelta 647 set game(bonusDelta) $bonusDelta 648 incrScore $bonusDelta 649 set timeMinutes [format "%d" [expr int($timeDelta/60)]] 650 set timeSeconds [expr $timeDelta % 60] 651 setNoticeText "Time: $timeMinutes:$timeSeconds\nMoves: $game(moveCount)\nBonus: $bonusDelta\nGame seed (for replay): $game(randomSeed)" 652 653 registerNewScore 654 if { $game(scoreMethod) == "unofficial" } { 655 set game(scoreMethod) official 656 } 657 endGameChangeMenus 658} 659 660proc addCardToDragableList {id} { 661 global game 662 663 if { $game(status) == "building" || $game(status) == "dealing" } { return } 664 if { [lsearch -exact $game(dragableCards) $id] == -1 } { 665 lappend game(dragableCards) $id 666 incr game(cardsLeftToDrag) -1 667 setScoreMessage "To go: $game(cardsLeftToDrag)" 668 } 669} 670 671 672proc checkForWin {} { 673 global game 674 675 if { $game(status) != "running" } { return } 676 incr game(moveCount) 677 if { ($game(cardsLeftToDrag) <= 0 && $game(scoreMethod) != "non-scoring") 678 || ($game(cardsToPlay) <= 0)} { 679 endGame win 680 } 681} 682 683 684# 685###################################################################### 686# 687# Code to automatically move card stacks around. 688# 689# External interfaces are marked proc's and 690# the variables game(movableChildCount) 691# 692# 693 694proc dangerousMove {w target src srcFriends} { 695 global game 696 697 # Check to make sure we're not moving to a space 698 # with too many cards. 699 if { [lsearch -exact $game(freeSpaces) $target] != -1} { 700 if { [llength $srcFriends] >= $game(movableChildCount) } { 701 # Too many things. Abort. 702 return 1 703 } 704 } 705 return 0 706} 707 708# external 709proc moveMultipleCards {w target src srcFriends closure} { 710 # Sigh. This would be more elegant if it were recursive. 711 global game 712 713 if {[dangerousMove $w $target $src $srcFriends]} { 714 error "moveMultipleCards: dangerousMove" 715 } 716 717 set spaces $game(freeSpaces) 718 set srcFriendsLen [llength $srcFriends] 719 720 if { $srcFriendsLen > [llength $spaces] } { 721 error "moveMultipleCarsd: out of spaces" 722 } 723 724 dirtyTableDragability disable 725 726 # Move the friends to the spaces temporarily. 727 for {set i [expr $srcFriendsLen-1]; set j 0} \ 728 { $i >= 0 } {incr i -1; incr j} { 729 set tmpTarget [lindex $spaces $j] 730 if { $tmpTarget == $target } { 731 incr j 732 set tmpTarget [lindex $spaces $j] 733 } 734 if { $tmpTarget == {} } { 735 error "moveMultipleCards: out of spaces (in-process)" 736 } 737 playCardOnCard $w [lindex $srcFriends $i] {} $tmpTarget 738 update idletasks 739 } 740 741 # Move the src to its final resting place. 742 # (We don't do the whole move because half of it is already done.) 743 tableAdoptChild $w $target $src {} $closure 744 update idletasks 745 746 # Move the friends under the src. 747 set nextTarget $src 748 for {set i 0} { $i < $srcFriendsLen } {incr i} { 749 set nextSrc [lindex $srcFriends $i] 750 playCardOnCard $w $nextSrc {} $nextTarget 751 set nextTarget $nextSrc 752 update idletasks 753 } 754 755 # Dropability. 756 dirtyTableDragability enable 757 dirtyTableDragability [getCard $w $target -sublocation] 758 fixTableDragability $w 759} 760 761# external 762proc makeSpaceAvailable {w id} { 763 global game 764 765 lappend game(freeSpaces) $id 766 set game(freeSpaces) [lsort -integer $game(freeSpaces)] 767 incr game(movableChildCount) 768} 769 770# external 771proc makeSpaceUnavailable {w id} { 772 global game 773 set i [lsearch -exact $game(freeSpaces) $id] 774 if { $i == -1 } { error "makeSpaceUnavailable: missing id <$id>" } 775 set game(freeSpaces) [lreplace $game(freeSpaces) $i $i] 776 incr game(movableChildCount) -1 777} 778 779# external 780proc initSpaceAvailability {} { 781 global game 782 set game(movableChildCount) 0 783 set game(freeSpaces) {} 784 set game(oldMovableChildCount) 0 785} 786 787