#!/usr/local/bin/wish
# @(#)tkyupei, v1.0 1998/07/09 Bluebat Exp
set Program tkyupei
set Version 1.0
set Data $Program.dat
set Font {Lucida 12 bold italic}
#====================== arguments =========================
for {set x 0} {$x < $argc} {incr x} {
  switch -- [lindex $argv $x] {
    -data {set Data [lindex $argv [incr x]]}
    default {
      puts stderr "usage: $Program \[-data %s\]"
      exit 1
    }
  }
}
set Modellist {}
if [file isfile $Data] {
  set d [open $Data r]
  while {[gets $d l]!=-1} {lappend Modellist [split $l]}
  close $d
} else {
  puts stderr "couldn\'t read file \"$Data\" !"
}
#=============================== initial ===============================
set Blockdata(0) {2 1 5 5 3 3}
set Blockdata(1) {5 3 3 1 1 0 0 5 5 3}
set Blockdata(2) {4 3 3 1 1 0 0 0 0 4 4 3}
set Blockdata(3) {0 5 5 3 3 2 2 1 1 0 0 4}
set Model 0
set Block 0
set Name Unknown
set Userlist {Unknown -2 -3 2 1 2 5 3 -3 4 -3 2 0}
set Marked 0
#=============================== widget ===============================
wm title . $Program
wm resizable . 0 0
canvas .c -width 300 -height 300 -relief sunken -bd 2 -bg wheat -cursor hand2
frame .f
pack .c .f -side left -fill y
bind .c <Button1-Motion> "Move_Block %x %y"
bind .c <ButtonRelease-1> "set Marked 0"
entry .f.name -textvar Name -width 10 -bg wheat
button .f.insert -text Insert -command "Make_List insert" -font $Font
button .f.delete -text Delete -command "Make_List delete" -font $Font
button .f.last -text Last -command "incr Model -1; Show_Model" -font $Font
button .f.next -text Next -command "incr Model; Show_Model" -font $Font
label .f.label -text "" -bg white
canvas .f.c -width 100 -height 100 -bg white
button .f.about -text About -command "About $Program $Version" -font $Font
button .f.exit -text Exit -command exit -font $Font
pack .f.name .f.insert .f.delete .f.last .f.next .f.label .f.c .f.about .f.exit -fill x -expand 1
#=============================== procedure ===============================
proc Mark_Block {b} {
  global Blocktag Block Marked
  set Marked 1
  set Block $b
  .c raise $Blocktag($Block)
}

proc Make_Block {c b l} {
  global Blockdata Blocktag
  set x [lindex $l 0]
  set y [lindex $l 1]
  set a [lindex $l 2]
  set tl {}
  foreach i $Blockdata($b) {
    switch -exact [expr ($i-[lindex $Blockdata($b) 0]+$a)%6] {
      0 {incr x}
      1 {incr y}
      2 {incr x -1; incr y}
      3 {incr x -1}
      4 {incr y -1}
      5 {incr x; incr y -1}
    }
    lappend tl $x $y
  }
  set s [expr [string compare $c model]?3:1]
  foreach {x y} $tl {
    lappend pl [expr ($x*2+$y)*8*$s/sqrt(3)+50*$s] [expr (50-$y*8)*$s]
  }
  return $pl
}

proc Move_Block {x y} {
  global Userlist Blocktag Marked Block
  if $Marked&&$x>0&&$x<300&&$y>0&&$y<300 {
    set nx [expr round((($x-150)*sqrt(3)-(150-$y))/48.0)]
    set ny [expr round((150-$y)/24.0)]
    set a [lindex $Userlist [expr $Block*3+3]]
    set Userlist [lreplace $Userlist [expr $Block*3+1] [expr $Block*3+2] $nx $ny]
    set l [Make_Block user $Block [list $nx $ny $a]]
    eval .c coords $Blocktag($Block) $l
  }
}

proc Rotate_Block {} {
  global Userlist Blocktag Block Marked
  if $Marked {
    set Marked 0
    set x [lindex $Userlist [expr $Block*3+1]]
    set y [lindex $Userlist [expr $Block*3+2]]
    set b [expr $Block*3+3]
    set a [expr ([lindex $Userlist $b]-1)%6]
    set Userlist [lreplace $Userlist $b $b $a]
    set l [Make_Block user $Block [list $x $y $a]]
    eval .c coords $Blocktag($Block) $l
  }
}

proc Show_Model {} {
  global Modellist Model
  .f.c delete all
  if [llength $Modellist]==0 {
    .f.label config -text "0"
  } else {
    set Model [expr $Model%[llength $Modellist]]
    set bl [lindex $Modellist $Model]
    .f.label config -text "[expr $Model+1] [lindex $bl 0]"
    foreach b {0 1 2 3} {
      set l [lrange $bl [expr $b*3+1] [expr $b*3+3]]
      set pl [Make_Block model $b $l]
      eval .f.c creat polygon $pl -fill green4
    }
  }
}

proc Make_List {f} {
  global Modellist Userlist Model Name Data
  if [string compare $f delete] {
    if ![string compare $Name ""] {set Name Unknown}
    set Userlist [lreplace $Userlist 0 0 $Name]
    set Modellist [linsert $Modellist $Model $Userlist]
  } else {
    set Modellist [lreplace $Modellist $Model $Model]
  }
  Show_Model
  set d [open $Data w]
  foreach l $Modellist {puts $d $l}
  close $d
}

proc About {p v} {
  .f.about config -state disabled
  wm title [toplevel .about] About
  message .about.me -justify center -aspect 250 -text "\n$p  $v     GPL (c) 1998\n\nA game of Tetragram\n\nWei-Lun Chao\n<wchao@post.uni-bielefeld.de>\n" -relief raised
  message .about.tip -justify center -aspect 250 -text "\nUsing left mouse button\nto move the block\nUsing right mouse button\nto rotate the block\n" -relief raised
  button .about.b -text Close -command {
    destroy .about
    .f.about config -state normal
  }
  pack .about.me .about.tip .about.b -fill x
}
#=============================== main ===============================
Show_Model
foreach Block {0 1 2 3} {
  set l [lrange $Userlist [expr $Block*3+1] [expr $Block*3+3]]
  set pl [Make_Block user $Block $l]
  set Blocktag($Block) [eval .c creat polygon $pl -fill green4 -outline black]
  .c bind $Blocktag($Block) <ButtonPress> "Mark_Block $Block"
  .c bind $Blocktag($Block) <ButtonRelease-3> "Rotate_Block"
}
