ulis, 12-02-05. Un jeu...
N'y jouez pas ! Au mieux vous n'aimerez pas, au pire il vous rendra fou.
Pourquoi
Hmm... Des essais avec le canvas ?
Comment
Une image découpée en un tableau affiché sur le canvas. Cela permet toute sorte de redisposition. Idéal pour jouer au Taquin.
Le code
# ==================== # # TurnOut # # v 0.9.1 # ulis (NOL) # ==================== # #################### # Documentation # #################### # compile: # use freewrap (http://sourceforge.net/projects/freewrap/) # install: # put the executable in your path # use: # run & play # #################### # --------------- # parameters # --------------- set size 50 set flashy "beige" set ccount 4 set imagefile TurnImage.png # --------------- # procs # --------------- # turn-right # --------------- proc turn-right {ii jj {check ""}} \ { lappend tags i[expr {$ii - 1}]:[expr {$jj - 1}] lappend tags i[expr {$ii - 1}]:$jj lappend tags i$ii:[expr {$jj - 1}] lappend tags i$ii:$jj foreach i {1 2 3 4} tag $tags \ { set img($i) [.c itemcget $tag -image] } foreach i {3 1 4 2} tag $tags \ { .c itemconfig $tag -image $img($i) set ::current($tag) $img($i) } if {$check == "check"} { check } } # turn-left # --------------- proc turn-left {ii jj {check ""}} \ { lappend tags i[expr {$ii - 1}]:[expr {$jj - 1}] lappend tags i[expr {$ii - 1}]:$jj lappend tags i$ii:[expr {$jj - 1}] lappend tags i$ii:$jj foreach i {1 2 3 4} tag $tags \ { set img($i) [.c itemcget $tag -image] } foreach i {2 4 1 3} tag $tags \ { .c itemconfig $tag -image $img($i) set ::current($tag) $img($i) } if {$check == "check"} { check } } # begin # --------------- proc begin {} \ { set ::started 0 press restore set ::count 0 set ::start1 [list] set ::start2 [list] for {set cnt 0} {$cnt < $::level} {incr cnt} \ { while 1 \ { set i [expr {int(rand() * ($::ny - 1) - 0.1) + 1}] set j [expr {int(rand() * ($::nx - 1) - 0.1) + 1}] if {[lsearch -exact $::start1 $i:$j] == -1} { break } } set m [expr {int(rand() * 3 - 0.1) + 1}] lappend ::start1 $i:$j lappend ::start2 $m } .l1 config -text "Level : $::level" .l2 config -text "Score : $::score" } # start # --------------- proc start {} \ { set ::started 1 press restore foreach ij $::start1 m $::start2 \ { foreach {i j} [split $ij :] break for {set n 0} {$n < $m} {incr n} { turn-right $i $j } } } # new # --------------- proc new {} \ { set ::level 1 set ::score 0 set ::clevel $::ccount press restore begin } # check # --------------- proc check {} \ { if {!$::started} { return } incr ::count for {set i 0} {$i < $::ny} {incr i} \ { for {set j 0} {$j < $::nx} {incr j} \ { if {[.c itemcget i$i:$j -image] != $::img($i:$j)} \ { return } } } set gain [expr {$::level * 1000 - $::count * 25}] if {$gain > 0} { incr ::score $gain } if {[incr ::clevel -1] == 0} \ { incr ::level set ::clevel $::ccount } flash 8 [. cget -bg] begin } # flash # --------------- proc flash {count color} \ { if {$count == 0} { return } . config -bg [expr {$count %2 == 0 ? $::flashy : $color}] after 200 flash [incr count -1] $color } # press # --------------- proc press {{restore ""}} \ { for {set i 0} {$i < $::ny} {incr i} \ { for {set j 0} {$j < $::nx} {incr j} \ { .c itemconfig i$i:$j -image $::img($i:$j) if {$restore == "restore"} \ { set ::current(i$i:$j) $::img($i:$j) } } } } # release # --------------- proc release {} \ { for {set i 0} {$i < $::ny} {incr i} \ { for {set j 0} {$j < $::nx} {incr j} \ { .c itemconfig i$i:$j -image $::current(i$i:$j) } } } # bgerror # --------------- proc bgerror {args} { tk_messageBox -message $args } # --------------- # packages # --------------- package require Tk package require Img # --------------- # interface # --------------- wm title . "TurnOut" # initial image # --------------- catch \ { image create photo _img_ -file $imagefile } msg if {$msg != "_img_"} \ { wm withdraw . append msg "\nYou can download an image at " append msg "http://www.images.com/TurnImage.png" tk_messageBox -message $msg exit } set width [image width _img_] set height [image height _img_] # canvas # --------------- canvas .c -height $height -width $width \ -bd 0 -highlightt 0 # partial images & micro buttons # --------------- set nx [expr {$width / $size}] set ny [expr {$height / $size}] for {set i 0} {$i < $ny} {incr i} \ { for {set j 0} {$j < $nx} {incr j} \ { set img($i:$j) [image create photo -height $size -width $size] set x1 [expr {$j * $size}] set y1 [expr {$i * $size}] set x2 [expr {$x1 + $size}] set y2 [expr {$y1 + $size}] $img($i:$j) copy _img_ -from $x1 $y1 $x2 $y2 -to 0 0 .c create image $x1 $y1 -anchor nw -image $img($i:$j) -tags i$i:$j set current(i$i:$j) $img($i:$j) if {$i > 0 && $j > 0} \ { set x1 [expr {$x1 - 8}] set y1 [expr {$y1 - 8}] set x2 [expr {$x1 + 8}] set y2 [expr {$y1 + 8}] .c create oval $x1 $y1 $x2 $y2 \ -fill red -outline "" -tags b$i:$j .c bind b$i:$j <1> [list turn-right $i $j check] .c bind b$i:$j <3> [list turn-left $i $j check] } } } # level & score # --------------- label .l1 -font {Arial -20} label .l2 -font {Arial -20} # action buttons # --------------- button .b1 -width 20 -text New -command new button .b2 -width 20 -text Start -command start button .b3 -width 20 -text View bind .b3 <ButtonPress> press bind .b3 <ButtonRelease> release button .b4 -width 20 -text Quit -command exit # place & display # --------------- grid .l1 .l2 -padx 5 -pady 5 grid .c -columnspan 2 -padx 10 -pady 10 grid .b1 .b2 -padx 5 -pady 5 grid .b3 .b4 -padx 5 -pady 5 focus -force . raise . # --------------- # go # --------------- set started 0 new
Voir aussi
Questions/réponses
Discussion
Catégorie Exemple | Catégorie Jeu