Crystals battle

 

ulis, 27-01-2005. Un "grand jeu, haut en couleurs". Inspiré du jeu 7colors de Tatou (Infogrames).

02-02-2005 : v 0.9.4b

27-02-05: v 1.0. Ils scintillent !!!


Pourquoi

Pour le plaisir de programmer un jeu facile.


Comment

Une interface toute simple qui ne laisse actifs que les widgets nécessaires.


Le script

  # ====================
  #
  #   CrystalsBattle
  #
  #   v 1.0b
  #   ulis (NOL)
  # ====================

  # ####################
  # Documentation
  # ####################
  # compile:
  #   use freewrap (http://sourceforge.net/projects/freewrap/)
  # install:
  #   put the executable in your path
  # use:
  #   run & play
  # ####################

  # --------------------
  #   parameters
  # --------------------
    set size 15
    set level 1
    set time 0
    set cdelay 2000
    array set sizes {15 {25 20 "SMALL"} 30 {15 10 "BIG"}}
    array set cb {1 0 2 1}
    array set times {0 0 1 15000 2 30000 3 60000 4 120000}
    array set txTimes {0 "TIME" 1 "15 s" 2 "30 s" 3 "1 mn" 4 "2 mn"}
    array set txLevels {0 "NOVICE" 1 "NORMAL" 2 "EXPERT" 3 "KNIGHT"}
    set txTitle "La bataille des cristaux"
    set txName1 "me"
    set txName2 "computer"
    set txAuto "auto"
    set txStart "START"
    set txStop "STOP"
    set txQuit "QUIT"

  # --------------------
  #   colors & animation
  # --------------------
    set glints 16
    set period 250
    array set colors0 \
    {
      01 #8888ff 11 #7373cf 21 #5d5daf 31 #5d5daf
      02 #98e898 12 #73ba73 22 #5fa55f 32 #5f955f
      03 #98e8e8 13 #73baba 23 #5fa5a5 33 #5f9595
      04 #e89898 14 #ba7373 24 #a55f5f 34 #955f5f
      05 #e898e8 15 #ba73ba 25 #a55fa5 35 #955f95
      06 #e8e898 16 #baba73 26 #a5a55f 36 #95955f
      07 #c8c8c8 17 #aaaaaa 27 #959595 37 #858585
    }
    array set colors1 \
    {
      01 #3333df 11 #4848ff 21 #2d2dcf 31 #1d1daf
      02 #13ba13 12 #18e818 22 #0fa50f 32 #0f950f
      03 #13baba 13 #18e8e8 23 #0fa5a5 33 #0f9595
      04 #ba1313 14 #e81818 24 #a50f0f 34 #950f0f
      05 #ba13ba 15 #e818e8 25 #a50fa5 35 #950f95
      06 #baba13 16 #e8e818 26 #a5a50f 36 #95950f
      07 #cacaca 17 #f8f8f8 27 #b5b5b5 37 #a5a5a5
    }

  # --------------------
  #   registered parameters
  # --------------------
    catch { source CrystalsBattle.conf }

  # --------------------
  #   packages
  # --------------------
    package require Tk

  # --------------------
  #   procs
  # --------------------

    # --------------------
    # createDisplay
    # --------------------
    proc createDisplay {} \
    {
      # frames
      # --------------------
      catch \
      {
        destroy .c
        destroy .f
        array unset ::set
        array unset ::crysiz
        array unset ::crycol
        array unset ::cryset
        array unset ::crytag
      }
      canvas .c -width $::width -height $::height \
        -bd 0 -highlightt 0
      frame .f
      # create header
      # --------------------
      set font {Arial 16 bold}
      set xc $::header
      set yc [expr {round($::header * 0.25)}]
      .c create text [expr {$xc - 1}] [expr {$yc - 1}] \
        -tags t1 -font $font -text $::count1 -fill white
      set xc [expr {$::width - $::header}]
      .c create text [expr {$xc - 1}] [expr {$yc - 1}] \
        -tags t2 -font $font -text $::count2 -fill white
      entry .c.e1 -width 10 -textvariable ::txName1 \
        -bd 1 -relief groove -justify center
      entry .c.e2 -width 10 -textvariable ::txName2 \
        -bd 1 -relief groove -justify center
      set xc $::header
      set yc [expr {round($::header * 0.55)}]
      .c create window $xc $yc -window .c.e1
      set xc [expr {$::width - $::header}]
      .c create window $xc $yc -window .c.e2
      set xc $::header
      set yc [expr {round($::header * 0.9)}]
      .c create text [expr {$xc - 1}] [expr {$yc - 1}] \
        -tags l1 -font $font -text 0% -fill white
      .c create text $xc $yc \
        -tags {l1 lr1} -font $font -text 0% -fill gray25
      set xc [expr {$::width - $::header}]
      .c create text [expr {$xc - 1}] [expr {$yc - 1}] \
        -tags l2 -font $font -text 0% -fill white
      .c create text $xc $yc \
        -tags {l2 lr2} -font $font -text 0% -fill gray25
      set xc [expr {$::width / 2}]
      set yc [expr {round($::header * 0.33)}]
      set font {Times 28 italic}
      .c create text [expr {$xc - 1}] [expr {$yc - 1}] \
        -font $font -text $::txTitle -fill white
      .c create text $xc $yc \
        -font $font -text $::txTitle -fill gray25
      button .c.b1 -width 15 -pady 3 -bd 1 -relief ridge \
        -command setSize -text $::txSize
      set xc [expr {$::width / 3}]
      set yc [expr {round($::header * 0.85)}]
      .c create window $xc $yc -window .c.b1
      button .c.b2 -width 15 -pady 3 -bd 1 -relief ridge \
        -command setLevel
      set xc [expr {$::width / 2}]
      .c create window $xc $yc -window .c.b2
      setLevel $::level
      button .c.b3 -width 15 -pady 3 -bd 1 -relief ridge \
        -command setTime
      set xc [expr {$::width * 2 / 3}]
      .c create window $xc $yc -window .c.b3
      setTime $::time
      # create crystals
      # --------------------
      array set ::colors [array get ::colors0]
      set ::total 0
      set xci0 [expr {$::size * 3 + $::padx * 2}]
      set xci1 [expr {$xci0 + $::size}]
      set yci [expr {$::size + $::pady + $::header}]
      set xc $xci0
      set yc $yci
      for {set i 0} {$i < $::imax} {incr i} \
      {
        for {set j 0} {$j < $::jmax} {incr j} \
        {
          if {$j == $::jmax - 1 && $i % 2 == 1} { break }
          set c 0
          while {$c == 0} \
          {
            for {set k 0} {$k < 3} {incr k} \
            { set c [expr {2 * $c + (rand() > 0.5 ? 1 : 0)}] }
          }
          createCrystal $xc $yc $::size $c
          incr ::total
          incr xc $::size2
        }
        incr yc $::size
        set xc [expr {$i % 2 == 0 ? $xci1 : $xci0}]
      }
      set ::half [expr {$::total / 2}]
      # create selection
      # --------------------
      array set ::colors [array get ::colors1]
      set xc [expr {$::size + $::padx}]
      set yc [expr {$::height - $::pady}]
      checkbutton .c.cb1 -variable ::cb(1) -text $::txAuto
      .c create window $xc $yc -window .c.cb1
      set yc [expr {$::height - $::size2 - $::pady}]
      .c create rectangle \
        [expr {$xc - $::size}] [expr {$yc + $::size}] \
        [expr {$xc + $::size}] [expr {$yc + $::size - $::size2 * 7}] \
        -tags r1 -outline "" -fill ""
      for {set i 1} {$i < 8} {incr i} \
      {
        createCrystal $xc $yc $::size $i
        .c bind t$yc:$xc <Button-1> [list selectColor 1 $i]
        .c bind t$yc:$xc <Enter> [list enterColor 1 $i]
        .c bind t$yc:$xc <Leave> [list leaveColor 1 $i]
        set yc [expr {$yc - $::size2}]
      }
      set xc [expr {$::width - $::size - $::padx}]
      set yc [expr {$::pady + $::header}]
      checkbutton .c.cb2 -variable ::cb(2) -text $::txAuto
      .c create window $xc $yc -window .c.cb2
      set yc [expr {$::size2 + $::pady + $::header}]
      .c create rectangle \
        [expr {$xc - $::size}] [expr {$yc - $::size}] \
        [expr {$xc + $::size}] [expr {$yc - $::size + $::size2 * 7}] \
        -tags r2 -outline "" -fill ""
      for {set i 1} {$i < 8} {incr i} \
      {
        createCrystal $xc $yc $::size $i
        .c bind t$yc:$xc <Button-1> [list selectColor 2 $i]
        .c bind t$yc:$xc <Enter> [list enterColor 2 $i]
        .c bind t$yc:$xc <Leave> [list leaveColor 2 $i]
        set yc [expr {$yc + $::size * 2}]
      }
      # create buttons
      # --------------------
      button .f.b1 -width 30 -pady 3 -bd 1 -relief ridge \
        -text $::txStart -command start
      button .f.b2 -width 30 -pady 3 -bd 1 -relief ridge \
        -text $::txQuit -command quit
      grid .f.b1 .f.b2 -padx 20 -pady 10
      # display
      # --------------------
      pack .c
      pack .f
      focus .c.e1
      .c.e1 selection range 0 end
      .c.e1 icursor end
      # colors
      # --------------------
      set ::abg [.c.e1 cget -bg]
      set ::dbg [.c.e1 cget -disabledback]
    }

    # --------------------
    # setSize
    # --------------------
    proc setSize {{size ""}} \
    {
      if {$size == ""} \
      {
        set sizes [array names ::sizes]
        set n [lsearch -exact $sizes $::size]
        set n [expr {$n == 0 ? 1 : 0}]
        set size [lindex $sizes $n]
      }
      set ::size $size
      foreach {::imax ::jmax ::txSize} $::sizes($size) break
      set ::size2 [expr {$::size * 2}]
      set ::height [expr {$::imax * $::size + $::size + $::pady * 2 + $::header}]
      set ::width [expr {($::jmax + 2) * $::size2 + $::padx * 4}]
      set ::start 1
      createDisplay
    }

    # --------------------
    # setLevel
    # --------------------
    proc setLevel {{level ""}} \
    {
      if {$level == ""} \
      {
        set level [incr ::level]
        if {$level > 3} { set level [set ::level 0] }
      }
      .c.b2 config -text $::txLevels($level)
    }

    # --------------------
    # setTime
    # --------------------
    proc setTime {{time ""}} \
    {
      if {$time == ""} \
      {
        set time [incr ::time]
        if {$time > 4} { set time [set ::time 0] }
      }
      .c.b3 config -text $::txTimes($time)
    }

    # --------------------
    # createTriangle
    # --------------------
    proc createTriangle {xc yc num size color} \
    {
      if {$size == $::size} \
      { set tags [list t$yc:$xc t$yc:$xc:$num] } \
      else \
      { set tags [list t:$::turn t$yc:$xc:$num] }
      set size1 $size
      set size2 $size
      if {$num % 2 == 0} { set size1 -$size1 }
      if {$num < 2} { set size2 -$size2 }
      .c create polygon \
        $xc [expr {$yc + $size1}] \
        [expr {$xc + $size2}] $yc \
        $xc $yc -fill $color -tags $tags
    }

    # --------------------
    # changeTriangle
    # --------------------
    proc changeTriangle {tag num color} \
    {
      .c itemconfig $tag:$num -fill $color
    }

    # --------------------
    # createCrystal
    # --------------------
    proc createCrystal {xc yc size c {player 0}} \
    {
      for {set i 0} {$i < 4} {incr i} \
      { set id [createTriangle $xc $yc $i $size $::colors($i$c)] }
      set tag t$yc:$xc
      set ::crysiz($tag) $size
      set ::crycol($tag) $c
      set ::cryset($tag) $player
      set ::crytag($tag) $tag
    }

    # --------------------
    # changeCrystal
    # --------------------
    proc changeCrystal {tag c} \
    {
      for {set i 0} {$i < 4} {incr i} \
      { changeTriangle $tag $i $::colors($i$c) }
      set ::crycol($tag) $c
    }

    # --------------------
    # selectColor
    # --------------------
    proc selectColor {player color} \
    {
      if {$player != $::turn || $::cb($player) == 1} { return }
      if {$color == $::set(c1) || $color == $::set(c2)} { return }
      .c config -cursor ""
      displayResult [llength [computeNewSet $player $color]]
    }

    # --------------------
    # twinkle
    # --------------------
    proc twinkle {args} \
    {
      if {[llength $args] == 1} \
      {
        # restore
        set tag [lindex $args 0]
        if {[info exists ::crycol($tag)] && $::crycol($tag) > 0} \
        {
          set c $::crycol($tag)
          set s $::cryset($tag)
          if {$s > 0} { set s 1 }
          foreach i {0 1 2 3} \
          { .c itemconf $tag:$i -fill [set ::colors${s}($i$c)] }
        }
        set delay [expr {$::period + int(rand() * $::period)}]
        after $delay twinkle
      } \
      else \
      {
        # exchange
        while 1 \
        {
          set xci0 [expr {$::size * 3 + $::padx * 2}]
          set xci1 [expr {$xci0 + $::size}]
          set xc $xci0
          set yci [expr {$::size + $::pady + $::header}]
          set yc $yci
          set imax [expr {$::imax - 1}]
          set jmax [expr {$::jmax - 1}]
          set i [expr {round(rand() * $imax)}]
          if {$i % 2 == 1} { set xc $xci1; incr jmax -1 }
          set j [expr {round(rand() * $jmax)}]
          incr xc [expr {$j * $::size2}]
          incr yc [expr {$i * $::size}]
          set tag t$yc:$xc
          if {[info exists ::crytag($tag)]} \
          {
            while {$::crytag($tag) != $tag} { set tag $::crytag($tag) }
            break
          }
        }
        set c $::crycol($tag)
        set i [expr {int(rand() * 4 - 0.001)}]
        set s $::cryset($tag)
        if {$s > 0} { set s 1 }
        .c itemconf $tag:$i -fill [set ::colors${s}(0$c)]
        after 1 twinkle $tag
      }
    }

    # --------------------
    # computeNewSet
    # --------------------
    proc computeNewSet {player color {do 1}} \
    {
      # extend limits
      if {$do} { set ::set(c$player) $color }
      set sz $::size
      set newset $::set($player)
      for {set ndx 0} {$ndx < [llength $newset]} {incr ndx} \
      {
        set stag [lindex $newset $ndx]
        if {$do} { changeCrystal $stag $color }
        foreach {yc xc} [split [string range $stag 1 end] :] break
        set size $::crysiz($stag)
        set n [expr {$size / $sz}]
        set xc1 [expr {$xc - $size - $sz}]
        set xc2 [expr {$xc + $size + $sz}]
        set yc1 $yc
        set yc2 $yc
        for {set i 0} {$i < $n + 2} {incr i} \
        {
          foreach xc [list $xc1 $xc1 $xc2 $xc2] yc [list $yc1 $yc2 $yc1 $yc2] \
          {
            set tag t$yc:$xc
            if {![info exists ::cryset($tag)]} { continue }
            if {$::cryset($tag) != 0} { continue }
            if {$::crycol($tag) == $color} \
            {
              if {[lsearch -exact $newset $tag] == -1} \
              {
                lappend newset $tag
                if {$do} \
                {
                  lappend ::set($player) $tag
                  set ::cryset($tag) $player
                }
              }
            }
          }
          incr xc1 $sz
          incr xc2 -$sz
          incr yc1 $sz
          incr yc2 -$sz
        }
      }
      # return newset
      if {$do} \
      {
        set ::current($player) [llength $newset]
        grow $player $color
      }
      return $newset
    }

    # --------------------
    # grow
    # --------------------
    proc grow {player color} \
    {
      set sz $::size
      # restore set
      .c delete t:$player
      set newset [lsort -decr $::set($player)]
      foreach t $newset \
      { set ::crycol($t) $color; set ::crysiz($t) $sz }
      # grow crystals
      foreach stag $newset \
      {
        if {$::crycol($stag) != $color} { continue }
        foreach {yc xc} [split [string range $stag 1 end] :] break
        set size $sz
        while 1 \
        {
          set n [expr {$size / $sz}]
          set s [list]
          set xc1 [expr {$xc - $size}]
          set xc2 [expr {$xc + $size}]
          set yc0 [expr {$yc - $sz}]
          for {set nn 0} {$nn < $n} {incr nn} \
          {
            set t t$yc0:$xc1
            if {
                   ![info exists ::cryset($t)]
                || $::crycol($t) != $color
                || $::crysiz($t) != $sz
               } \
            { break }
            lappend s $t
            set t t$yc0:$xc2
            if {
                   ![info exists ::cryset($t)]
                || $::crycol($t) != $color
                || $::crysiz($t) != $sz
               } \
            { break }
            lappend s $t
            incr xc1 $sz
            incr xc2 -$sz
            incr yc0 -$sz
          }
          set t t$yc0:$xc
          if {
               [llength $s] == 2 * $n
            && [info exists ::cryset($t)]
            && $::crycol($t) == $color
            && $::crysiz($t) == $sz
             } \
          {
            lappend s $t $stag
            set yc [expr {$yc - $sz}]
            set size [expr {$size + $sz}]
            set stag t$yc:$xc
            createCrystal $xc $yc $size $color $player
            foreach t $s \
            {
              set ::crycol($t) 0
              set ::crytag($t) $stag
            }
          } \
          else \
          { break }
        }
      }
    }

    # --------------------
    # displayResult
    # --------------------
    proc displayResult {count} \
    {
      set player $::turn
      set ratio [expr {$count / double($::total) * 100}]
      .c itemconfig l$player -text [format %2d [expr {round($ratio)}]]%
      update
      if {$ratio == 50
       && [llength $::set(c1)] == $::half
       && [llength $::set(c2)] == $::half} \
      {
        .c itemconfig l1 -text 50%
        .c itemconfig l2 -text 50%
        stop
      } \
      elseif {$ratio >= 50} \
      {
        .c itemconfig t$player -text [incr ::count$player]
        stop
        displayWinner
      } \
      else \
      {
        changeTurn
      }
    }

    # --------------------
    # displayWinner
    # --------------------
    proc displayWinner {} \
    {
      if {$::start} { return }
      set color [.c.e$::turn cget -fg]
      set color [expr {$color == "red" ? "black" : "red"}]
      .c.e$::turn config -fg $color
      .c itemconfig lr$::turn -fill $color
      after 500 displayWinner
    }

    # --------------------
    # changeTurn
    # --------------------
    set ::turnID ""
    proc changeTurn {} \
    {
      catch [list after cancel $::turnID]
      if {!$::start} { return }
      set player $::turn
      .c.e$player config -disabledback $::dbg
      .c itemconfig r$player -fill $::dbg
      set player [expr {$player == 1 ? 2 : 1}]
      set ::turn $player
      .c.e$player config -disabledback $::abg
      .c itemconfig r$player -fill $::abg
      # computer?
      if {$::cb($player)} { after $::cdelay play } \
      elseif {$::time > 0} \
      { set ::turnID [after $::times($::time) changeTurn] }
    }

    # --------------------
    # enterColor
    # --------------------
    proc enterColor {player color} \
    {
      if {$player != $::turn || $::cb($player) == 1} { return }
      if {$color == $::set(c1) || $color == $::set(c2)} { return }
      .c config -cursor target
    }

    # --------------------
    # leaveColor
    # --------------------
    proc leaveColor {player color} \
    {
      if {$player != $::turn || $::cb($player) == 1} { return }
      if {$color == $::set(c1) || $color == $::set(c2)} { return }
      .c config -cursor ""
    }

    # --------------------
    # play
    # --------------------
    proc play {} \
    {
      set player $::turn
      set level $::level
      if {$level == 2} \
      {
        set other [expr {$player == 1 ? 2 : 1}]
        if {$::current($player) < $::current($other)} \
        { set level 1 }
      }
      switch -exact $level \
      {
        0 \
        {
          # novice
          set c 0
          while {$c == 0} \
          {
            for {set k 0} {$k < 3} {incr k} \
            { set c [expr {2 * $c + (rand() > 0.5 ? 1 : 0)}] }
            if {$c == $::set(c1) || $c == $::set(c2)} { set c 0 }
          }
        }
        1 \
        {
          # normal
          set mc 0
          set n 0
          foreach c {1 2 3 4 5 6 7} \
          {
            if {$c == $::set(c1) || $c == $::set(c2)} { continue }
            set t [llength [computeNewSet $player $c [set do 0]]]
            if {$t > $n} { set n $t; set mc $c }
          }
          set c $mc
        }
        2 \
        {
          # expert
          set mc 0
          set n 0
          foreach c {1 2 3 4 5 6 7} \
          {
            if {$c == $::set(c1) || $c == $::set(c2)} { continue }
            set t [llength [computeNewSet $player $c [set do 0]]]
            if {$t > ($::total / 2.0 + 0.001)} { set mc $c; break }
            incr t $t
            incr t [llength [computeNewSet $other $c [set do 0]]]
            if {$t > $n} { set n $t; set mc $c }
          }
          set c $mc
        }
        3 \
        {
          # knight
          set mc1 0
          set mc2 0
          set n 0
          set dx 0
          set dy 0
          set s 0
          foreach {xi yi} $::first($player) break
          foreach t $::set($player) \
          {
            foreach {y x} [split [string range $t 1 end] :] break
            set ss [expr {abs($xi - $x) + abs($yi - $y)}]
            if {$ss > $s} { set s $ss }
          }
          set s0 $s
          foreach c {1 2 3 4 5 6 7} \
          {
            if {$c == $::set(c1) || $c == $::set(c2)} { continue }
            set tt [computeNewSet $player $c [set do 0]]
            set t [llength $tt]
            if {$t > $n} { set n $t; set mc1 $c }
            set ss 0
            foreach t $tt \
            {
              foreach {y x} [split [string range $t 1 end] :] break
              incr ss [expr {abs($xi - $x) + abs($yi - $y)}]
            }
            if {$ss > $s} { set s $ss; set mc2 $c }
          }
          set c [expr {$s > $s0 ? $mc2 : $mc1}]
        }
      }
      displayResult [llength [computeNewSet $player $c]]
    }

    # --------------------
    # quit
    # --------------------
    proc quit {} \
    {
      set fn CrystalsBattle.conf
      catch \
      {
        set fp [open $fn w]
        puts $fp \
  "
  set ::size  $::size;
  set ::level $::level;
  set ::time $::time;
  set ::cdelay $::cdelay;
  array set ::sizes {[array get ::sizes]};
  array set ::cb {[array get ::cb]};
  array set ::times {[array get ::times]};
  array set ::txTimes {[array get ::txTimes]};
  array set ::txLevels {[array get ::txLevels]};
  set ::txTitle \"$::txTitle\";
  set ::txName1 \"$::txName1\";
  set ::txName2 \"$::txName2\";
  set ::txAuto  \"$::txAuto\";
  set ::txStart \"$::txStart\";
  set ::txStop  \"$::txStop\";
  set ::txQuit  \"$::txQuit\";
  set ::glints $::glints;
  set ::period $::period;
  array set ::colors0 [array get ::colors0];
  array set ::colors1 [array get ::colors1];
  "
        close $fp
      } msg
      if {$msg != ""} { puts stderr $msg }
      exit
    }

    # --------------------
    # start
    # --------------------
    set restart 0
    set start 0
    proc start {} \
    {
      set ::start 1
      if {$::restart} { createDisplay }
      .f.b1 config -text $::txStop -command stop
      .c.b1 config -state disabled
      .c.b2 config -state disabled
      .c.b3 config -state disabled
      .c.e1 config -state disabled -fg black -bg $::abg
      .c.e2 config -state disabled -fg black -bg $::abg
      .c.cb1 config -state disabled
      .c.cb2 config -state disabled
      .c itemconfig l1 -state ""
      .c itemconfig l2 -state ""
      .c itemconfig lr1 -fill gray25
      .c itemconfig lr2 -fill gray25
      array unset ::set
      set xc [expr {$::size * ($::jmax * 2 + 1) + $::padx * 2}]
      set yc [expr {$::size + $::pady + $::header}]
      set tag t$yc:$xc
      set ::set(2) [list $tag]
      set ::set(c2) $::crycol($tag)
      set ::first(2) [list $xc $yc]
      set ::cryset($tag) 2
      set xc [expr {$::size * 3 + $::padx * 2}]
      set yc [expr {$::size * $::imax + $::pady + $::header}]
      set tag t$yc:$xc
      set ::set(1) [list $tag]
      set ::set(c1) $::crycol($tag)
      set ::first(1) [list $xc $yc]
      set ::cryset($tag) 1
      set ::turn [expr {rand() > 0.5 ? 1 : 2}]
      array set ::current {1 0 2 0}
      changeTurn
    }

    # --------------------
    # stop
    # --------------------
    proc stop {} \
    {
      catch [list after cancel $::turnID]
      set ::start 0
      set ::restart 1
      .f.b1 config -text $::txStart -command start
      .c.b1 config -state normal
      .c.b2 config -state normal
      .c.b3 config -state normal
      .c.e1 config -state normal
      .c.e2 config -state normal
      .c.cb1 config -state normal -fg black
      .c.cb2 config -state normal -fg black
      .c itemconfig r1 -fill $::dbg
      .c itemconfig r2 -fill $::dbg
    }

  # --------------------
  #   bgerror
  # --------------------
  proc bgerror {args} { tk_messageBox -message "bgerror:\n$args" }

  # --------------------
  #   computed values
  # --------------------
    set padx 10
    set pady 10
    set header 80
    set turn 0
    set count1 0
    set count2 0
    setSize $::size

  # --------------------
  #   animate
  # --------------------
    set delay 0
    for {set i 0} {$i < $glints} {incr i} \
    { after $delay twinkle; incr delay $period }

  # --------------------
  #   global events
  # --------------------
    wm protocol . WM_DELETE_WINDOW quit
    bind . <Escape> quit

  # --------------------
  #   go
  # --------------------
    wm title . "Crystals Battle"
    focus -force .
    raise .

Voir aussi


Discussion

ulis, 05-02-2005: Pour obtenir un exécutable, utiliser freewrap (http://sourceforge.net/projects/freewrap/, choisir son OS suivant son goût).

VWa, 25-02-2005 : Jeu superbe ! bravo ulis.


Catégorie Exemple | Catégorie Jeu | Applications ludiques