SOLVEUR DE SUDOKU

alias init_sudoku { if ($hget(sudoku)) { hfree sudoku } | hmake sudoku
  var %i 1 | while (%i <= 81) { hadd sudoku %i $mid($1,%i,1) | inc %i }
}

alias ligne_sudoku {
  var %o , %i 1
  while (%i <= 9) { var %o $+(%o,$hget(sudoku,$calc(9*($1 -1)+%i))) | inc %i }
  return %o
}

alias colonne_sudoku {
  var %o , %i 1
  while (%i <= 9) { var %o $+(%o,$hget(sudoku,$calc((9*(%i -1))+$1))) | inc %i }
  return %o
}

alias carre_sudoku {
  var %i 1 , %o
  while (%i <= 3) {
    var %o $+(%o,$mid($ligne_sudoku($calc($gettok(1.1.1.4.4.4.7.7.7,$1,46) + %i -1)),$gettok(1.4.7.1.4.7.1.4.7,$1,46),3))
    inc %i
  }
  return %o
}

alias coord_sudoku {
  var %l $ceil($calc($1 /9)) , %c $replace($calc($1 - 9*$floor($calc($1 /9))),0,9)
  return $+(%l,.,%c,.,$gettok($gettok(1.2.3/4.5.6/7.8.9,$ceil($calc(%l /3)),47),$ceil($calc(%c /3)),46))       
}

alias candidats_sudoku {
  var %i 1
  while (%i <= 81) {
    if ($hget(sudoku,%i) == x) {
      var %j = 1 , %p = $coord_sudoku(%i) , %o
      while (%j <= 9) {
        if ((%j !isin $ligne_sudoku($gettok(%p,1,46))) && (%j !isin $colonne_sudoku($gettok(%p,2,46))) && (%j !isin $carre_sudoku($gettok(%p,3,46)))) { var %o = $+(%o,%j) }
        inc %j
      }
      if ($len(%o) == 1) { hadd sudoku %i %o | hdel sudoku $+(C,%i) }
      else { hadd sudoku $+(C,%i) %o }
      inc %i
    }
    else { inc %i }
  }
}

alias grille_sudoku {
  var %h , %i 1
  while (%i <= 9) { var %h = %h $+ $ligne_sudoku(%i) | inc %i }
  return %h
}

alias cand_uniq_sudoku {
  var %l 1
  while (%l <= 9) {
    var %k 1 , %m $lignecandi_sudoku(%l)
    while (%k <= 9) {
      if ($count(%m,%k) == 1) { 
        var %x = $calc(9*(%l -1)+$findtok(%m,$matchtok(%m,%k,1,32),32)) , %g $coord_sudoku(%x)
        if (%k !isin $+($ligne_sudoku($gettok(%g,1,46)),$colonne_sudoku($gettok(%g,2,46)),$carre_sudoku($gettok(%g,3,46)))) { hadd sudoku %x %k | hdel sudoku C $+ %x }
      }
      inc %k
    }
    inc %l
  }

  var %c 1
  while (%c <= 9) {
    var %j 1 , %n $colonnecandi_sudoku(%c)
    while (%j <= 9) {
      if ($count(%n,%j) == 1) { 
        var %y = $calc(9*($findtok(%n,$matchtok(%n,%j,1,32),32) -1) + %c) , %g $coord_sudoku(%y)
        if (%j !isin $+($ligne_sudoku($gettok(%g,1,46)),$colonne_sudoku($gettok(%g,2,46)),$carre_sudoku($gettok(%g,3,46)))) { hadd sudoku %y %j | hdel sudoku C $+ %y }
      }
      inc %j
    }
    inc %c
  }

  var %t 1
  while (%t <= 9) {
    var %h 1 , %v $carrecandi_sudoku(%t)
    while (%h <= 9) {
      if ($count(%v,%h) == 1) { 
        var %z = $calc(9*($calc($gettok(1.1.1.4.4.4.7.7.7,%t,46) + $ceil($calc($findtok(%v,$matchtok(%v,%h,1,32),32) /3)) -1) -1) + $calc($gettok(1.2.3.1.2.3.1.2.3,$findtok(%v,$matchtok(%v,%h,1,32),32),46) + (3*$gettok(0.1.2.0.1.2.0.1.2,%t,46)))) , %g $coord_sudoku(%z) 
        if (%h !isin $+($ligne_sudoku($gettok(%g,1,46)),$colonne_sudoku($gettok(%g,2,46)),$carre_sudoku($gettok(%g,3,46)))) { hadd sudoku %z %h | hdel sudoku C $+ %z } 
      }
      inc %h
    }
    inc %t
  }
  candidats_sudoku
}

alias lignecandi_sudoku {
  var %i 1 , %o
  while (%i <= 9) { var %o = %o $iif($hget(sudoku,$calc(9*($1 -1)+%i)) != x,x,$hget(sudoku,C $+ $calc(9*($1 -1)+%i))) | inc %i }
  return %o
}

alias colonnecandi_sudoku {
  var %i 1 , %o
  while (%i <= 9) { var %o = %o $iif($hget(sudoku,$calc((9*(%i -1))+$1)) != x,x,$hget(sudoku,C $+ $calc((9*(%i -1))+$1))) | inc %i }
  return %o
}

alias carrecandi_sudoku {
  var %i 1 , %o
  while (%i <= 3) { var %o = %o $gettok($lignecandi_sudoku($calc($gettok(1.1.1.4.4.4.7.7.7,$1,46) + %i -1)),$gettok(1-3.4-6.7-9.1-3.4-6.7-9.1-3.4-6.7-9,$1,46),32) | inc %i }
  return %o
}

alias reso_sudoku {
  var %i $ticks
  init_sudoku $1
  :u
  var %u $grille_sudoku
  candidats_sudoku
  if (%u != $grille_sudoku) { goto u }
  if (x !isin $grille_sudoku) { goto x }
  :m
  var %m $grille_sudoku
  cand_uniq_sudoku
  if (%m != $grille_sudoku) { goto m }
  :x
  hadd sudoku_option mode 3
  drawsudo
}

alias sudoku {
  var %s @sudoku
  if $hget(sudoku_option) { hfree sudoku_option } | hadd -m sudoku_option mode 1
  if ($window(%s)) window -c %s
  window -aBCdp +dL %s -1 -1 350 400
  drawfill -nr %s 0 0 0 0
  drawrect -nr %s 8421504 5 0 0 350 400
  drawdot %s
  hadd sudoku_option grille $str(x,81)
  drawsudo
}

alias drawsudo {
  var %s @sudoku
  drawrect -nrf %s 0 1 10 10 330 380
  drawrect -nr %s 255 2 55 20 35 310 | drawrect -nr %s 255 2 158 20 35 310 | drawrect -nr %s 255 2 261 20 35 310
  drawrect -nr %s 255 2 20 55 310 35 | drawrect -nr %s 255 2 20 158 310 35 | drawrect -nr %s 255 2 20 261 310 35
  drawrect -nr %s 16711680 3 20 20 310 310 | drawrect -nr %s 16711680 3 123 20 103 310 | drawrect -nr %s 16711680 3 20 123 310 103 
  var %i 1 | while (%i <= 81) {
    drawtext -nr %s 255 Verdana 25 $calc(($gettok($coord_sudoku(%i),2,46) -1)*34 + 35) $calc(($gettok($coord_sudoku(%i),1,46) -1)*34 +23) $replace($iif($hget(sudoku_option,mode) <= 2,$mid($hget(sudoku_option,grille),%i,1),$mid($grille_sudoku,%i,1)),x,$chr(160))
    inc %i
  }
  drawrect -nr %s 8421504 4 100 342 150 40
  drawtext -nr %s 255 Comic 20 110 348 $gettok(Résoudre.Patientez SVP.Quitter,$hget(sudoku_option,mode),46)
  drawdot %s
}

on *:KEYUP:@sudoku:*:{
  var %x $gettok($hget(sudoku_option,pos),1,32) , %y $gettok($hget(sudoku_option,pos),2,32)
  if (($inrect(%x,%y,20,20,310,310)) && ($hget(sudoku_option,mode) == 1)) {
    if (($keyval >= 97) && ($keyval <= 105)) {
      var %c $calc(9*($ceil($calc((%y -20)/34)) -1) +$ceil($calc((%x -20)/34)))
      hadd sudoku_option grille $+($left($hget(sudoku_option,grille),$calc(%c -1)),$keychar,$right($hget(sudoku_option,grille),$calc(81 -%c)))
      drawsudo
    }
    elseif ($keyval == 46) {
      var %c $calc(9*($ceil($calc((%y -20)/34)) -1) +$ceil($calc((%x -20)/34)))
      hadd sudoku_option grille $+($left($hget(sudoku_option,grille),$calc(%c -1)),x,$right($hget(sudoku_option,grille),$calc(81 -%c)))
      drawsudo
    }
  }
}

menu @sudoku {
  mouse:hadd sudoku_option pos $mouse.x $mouse.y
  sclick {
    var %x $gettok($hget(sudoku_option,pos),1,32) , %y $gettok($hget(sudoku_option,pos),2,32)
    if ($inrect(%x,%y,100,342,150,40)) {
      if ($hget(sudoku_option,mode) == 1) {
        hadd sudoku_option mode 2
        drawsudo
        reso_sudoku $hget(sudoku_option,grille)
      }
      elseif ($hget(sudoku_option,mode) == 3) {
        hfree -w sudoku*
        window -c @sudoku
      }
    }
  }
}