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
newVoir aussi
Questions/réponses
Discussion
Catégorie Exemple | Catégorie Jeu