#! /bin/env tclsh

# 
# tkduke: 2D drawing tool
# 
#   [1998/11/03] OSHIRO Naoki.
#   [1999/01/21] OSHIRO Naoki. add polyAdd,Del
#   [1999/01/27] OSHIRO Naoki. Package name changed to tkduke
#   [1999/02/11] OSHIRO Naoki.
#     fix copyItem (mistake 'sy' to 'sx').
#     unify switch commands in some procedures using regexp matching.
#   [1999/02/17] OSHIRO Naoki. add toggleItem
#   [1999/02/19] OSHIRO Naoki. add changeZoom, fit win size to A4 landscape.
#   [1999/03/07] OSHIRO Naoki. add toggleTextAnchor
#   [1999/03/07] OSHIRO Naoki. add loadFont. make font loading dynamically.
#                              exchange type names box and boxx.
#   [1999/03/12] OSHIRO Naoki. add setItemAnchor, toggleItemAnchor
#   [1999/03/14] OSHIRO Naoki. add abutItem
#   [1999/03/15] OSHIRO Naoki. shift-key Selection
#                              add nodCut
#   [1999/03/16] OSHIRO Naoki. add image item type, importImage proc
#   [1999/03/19] OSHIRO Naoki. add setColor, darkenItem, blendItem
#   [1999/03/25] OSHIRO Naoki. fix flip{H,V} for coords of {arrow,line} item.
#                              change copyItem: add itemcget {arrow,smooth}
#   [1999/03/30] OSHIRO Naoki. add rotateItem
#   [1999/04/06] OSHIRO Naoki. add colSpoit, zoom icon, setLineCap menu
#   [1999/04/13] OSHIRO Naoki. fix related grid size (selection, copyItem).
#   [1999/04/14] OSHIRO Naoki. add toolbox some icon image.
#   [1999/04/18] OSHIRO Naoki. add (un)groupItem (cannot save this info.).
#   [1999/04/24] OSHIRO Naoki. add mode icon on select and move.
#   [1999/04/26] OSHIRO Naoki. use append command for string concatenate.
#   [1999/05/17] OSHIRO Naoki. add fontface 'Mincho:Times-Roman'. 
#   [1999/05/26] OSHIRO Naoki. add layer architecture.
#   [1999/06/03] OSHIRO Naoki. add '.mmp' file header and info editor.
#   [1999/06/12] OSHIRO Naoki. add file browser.
#                              add {split,join}TextEachLine.
#   [1999/06/18] OSHIRO Naoki. add Newfile.
#                              add edit text on drawing canvas.
#   [1999/06/27] OSHIRO Naoki. fix color specification in toggleItem.
#   [1999/06/28] OSHIRO Naoki. reduce array names search.
#   [1999/08/05] OSHIRO Naoki. enabled float tool menu to tearoff.
#   [1999/09/02] OSHIRO Naoki. separate toggle operation fontface and fontsize.
#   [1999/09/05] OSHIRO Naoki. add procs for nod duplication.
#   [1999/09/07] OSHIRO Naoki. add shearItem.
#   [1999/10/03] OSHIRO Naoki. add Balloon Help.
#   [1999/11/08] OSHIRO Naoki. add Reload button.
#   [2000/01/10] OSHIRO Naoki. add nod delete proc in pline/poly draw mode.
#   [2000/01/11] OSHIRO Naoki. fix width specification of rod item from file.
#   [2000/01/18] OSHIRO Naoki. add makeGridLine, and fix zooming bugs.
#                                                (Thanks SUEYOSHI Toshiyasu.)
#   [2000/02/27] OSHIRO Naoki. change/fix changeZoom centering parameters.
#   [2000/04/15] OSHIRO Naoki. fix font editting to keep current each fontsize.
#   [2000/04/21] OSHIRO Naoki. fix font size changing by scale bar.
#   [2000/05/02] OSHIRO Naoki. avoid duplicate grouping.
#   [2000/05/06] OSHIRO Naoki. fix setItemAnchor: caluculate minx fail.
#   [2001/08/09] OSHIRO Naoki. add OvalBox(obox) item type.
#   [2003/10/14] OSHIRO Naoki. add process of duplicate nodes in saveItem.
#


package require Tk

set tkduke_version 0.1
set tkduke_copyright "Copyright (C) OSHIRO Naoki 1998-2001"

set canvas_grid 2

############################################################
# Icon generation
# cat foo-icon.xbm | xbmtopbm | ppmtogif -transparent white | base64

############################################################
# Lupe Icons
set lupe_plus_gif_old {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIqjI+pAe1r
nATrHXtbpEznvyHaRHkh2YlcGmach21rN8to8kxKDPF9DSkAADs=
}
set lupe_plus_gif {
R0lGODlhEAAQAMIAAL//3wB/HwC/P9//v////wAAAAAAAAAAACH5BAEAAAQA
LAAAAAAQABAAAAM9SLrcTiLKp8QIOD8bgAcaw3mRF1add31CIHbRVbYv0Gaw
u7RsauuoFO8HVGQ+REdGcnM0ccUg5RWl0KaLBAA7
}
set lupe_minus_gif_old {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAInjI+pAe1r
nATrHXubwoxWH1GTCHadZGaQlpWhy3HvuGlT7X75ByUFADs=
}
set lupe_minus_gif {
R0lGODlhEAAQAMIAAL//3wB/HwC/PwB/AN//v////wAAAAAAACH5BAEAAAUA
LAAAAAAQABAAAAM9WLrcXiLKpwQJOD87gAcaw31fWHXkJwRiJ0nA2sZDXcfs
IqApmJ88FaaRIa1+i8xr2DgWMszWgCKltqyLBAA7
}
############################################################
set arrow_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIYjI+py+0P
FYgBzGctzrzn+kUadVHmiT4FADs=
}
set arrow_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8/AP+/v//f3////yH5BAEAAAMALAAAAAAQABAAAAIb
nI+py+0PVYgjABiCuM5uAIYiOIgUeVLqykYFADs=
}
set box_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIljI8ZwO3f
lgRz0luxy5z1HGmdSC7hd5XkqZqo5bXpm0J2pORGAQA7
}
set obox_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIlTICpaAcH
n4yzRnetTLkznXFgNYafR6HkWbKqqKZts9RPg+d5AQA7
}
set orect_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIhTICpaNcP
gYPUsEovfnpb6TWdN24ldlZpBoZOa4rL7FIFADs=
}
set box_icon_gif_tmp {
R0lGODlhEAAQAIAAAL8/AP///yH5BAEAAAEALAAAAAAQABAAAAIljI8ZwO3f
lgRz0luxy5z1HGmdSC7hd5XkqZqo5bXpm0J2pORGAQA7
}
set boxx_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIujI8ZwGuw
mJwQukrji3Q63V1bl1kY1zQXKX0p6aKwuXoqxlYP3uq1nBplFERDAQA7
}
set boxx_icon_gif_tmp {
R0lGODlhEAAQAMIAAL8AAL8/AP+/v/8AAP/f3////wAAAAAAACH5BAEAAAUA
LAAAAAAQABAAAAM0WLrcFQGMIYgYAGotqcXb1lVXFkLjZ55peaITCb7tzMbq
G+Euzduh2ir4G4qKOuHJwVwkAAA7
}
set circle_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjAOpcI1u
mJPwHVotzm9n5lUg14xkZJ2mipJY2JbityQnWQAAOw==
}
set fline_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAImjI+ZwKDX
kFNzvRpYvkZnbEEfuH0SGFHPma6Yp3YOzL4rd0v5WgAAOw==
}
set line_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAISjI+py+0P
o5wM2IszoLz7DwYFADs=
}
set oval_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjAOpcI3P
ooNUHolp3Th7z0FgF46jWG6pZZyMc07Iksj2VAAAOw==
}
set pixel_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIXjI+py43g
YoCSUXOrdvnt72GgOCrdVgAAOw==
}
set pline_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjGGpG+AM
UZOwrRcjTfvufnGVeIzlOVIgg6ysZZZuGJN1UgAAOw==
}
set pline_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8/AP/f3////wAAACH5BAEAAAIALAAAAAAQABAAAAIp
lAKmywgQmETmRXnSslMzrlCY8IReZ4ijqGLsiWajSc407CZ4bKe7XQAAOw==
}
set poly_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIpjGGpG+AM
34MH2cls2zhJ3nTaGHogiVQnl66o96Ix69bOfZ9thnfUUgAAOw==
}
set poly_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8AAP8AAP///wAAACH5BAEAAAIALAAAAAAQABAAAAIm
lGGpK+AMQQgPHiodilhrlnmiIpZbY45H6iVsu76P3NKfXUWlxRcAOw==
}
set rect_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIfjI8ZwO3P
lFxgqmgRzmZzn4GWOJGSeVVcp67Q66xIAQA7
}
set rect_icon_gif_tmp {
R0lGODlhEAAQAIAAAL8/AP///yH5BAEAAAEALAAAAAAQABAAAAIfjI8ZwO3P
lFxgqmgRzmZzn4GWOJGSeVVcp67Q66xIAQA7
}
set rod_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIYjI+py+0P
o2Qg1GsznrhrDYTiSE7miUoFADs=
}
set rod_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8AAP+/v/8AAP///yH5BAEAAAMALAAAAAAQABAAAAIb
nI+py+0Po1yi2otF2Lz7kIUWQJbmCUzqykoFADs=
}
set select_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIkhIOpaQ27
nINMzngpsrqG1n2POGolaCooVG5HWLXhCtPzC4sFADs=
}
set select_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8AAL8/AP8AAP///yH5BAEAAAMALAAAAAAQABAAAAIu
RDKpqxYCGTPuCalCPfCyA2ILGIrJMQiouaoIq7hwvEovfZuJrOO9/0sZgqlA
AQA7
}
set sphere_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIrjAOpcI0M
n5NQoZZuXSb3t2RRF1qiVkZqWoHs+orbS7LSkYITPblWD3QUAAA7
}
set sphere_icon_gif_tmp {
R0lGODlhEAAQAOMAAL8AAL8/AP+/v/8AAP/f3/////8Af/9/AL8APwAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAAUALAAAAAAQABAAAARFsMgCqgUz0xou
1hUheFVWFgR5VgKRqkBABcEIIzIHV/i2A4hD7gcQCH2wweH4GyhpkuRTNvEc
nAaohkZbcjUTrhhMLkcAADs=
}
set text_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIlDI6ZYerH
IGuTmmoniFhqrG3g6I1VaUZiGrLn6qKpTCLsA7tYAQA7
}
set text_icon_gif_tmp {
R0lGODlhEAAQAKEAAL8AAP+/v/8AAP///yH5BAEAAAMALAAAAAAQABAAAAIr
nI6ZYxEAowRMUGYuexVXzVyCl5Ej+aFquZpgy8KpPNMWvb2rA8HHpMMNCgA7
}
set colSpoit_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAImjI+gih3w
InRSTsegplXfllXYtmHGwpgnt7bc9akRO8dmypa0uxcAOw==
}
set colSpoit_icon_gif_tmp {
R0lGODlhEAAQAMIAAL8AAL8/AP/fv/+/v/8AAN//v////wAAACH5BAEAAAYA
LAAAAAAQABAAAAM0aLocHiyqQKqTi76Ljd6dR2xQR3IScHYCoD5s0QKhIciD
UN9FvuO6ncC3ywVDw2PNtlwkAAA7
}
############################################################
set hide_icon_gif {
R0lGODlhCAAIAPABAAAAAP///yH5BAEAAAEALAAAAAAIAAgAAAIPhH+ha4EO
nIotypramggVADs=
}
############################################################
set quit_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIkjI+py+0P
D5gQyGdNRjvsnlifp5ETVWZiapKte5YvqKoaGOUFADs=
}
set newfile_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIljI+py+0P
DTjT1XAZqHnN/4AcR4mYdEojtqHfBVJni7JkF+VBAQA7
}
set load_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAImjI+ZwA1q
2ILvIXvjvG4frICBmJXU+EFctTqu+klkis2aGS7uixQAOw==
}
set reload_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIpjI+pwIzw
moSB1nYmxYs7dTlcMl1d+YGkpWbpabzrJsev5I62Vu96UAAAOw==
}
set import_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIojAMJx5y2
mkNQnogtUtnG6Ulf8z0jCD2hc15iu3Gcq6VVnap4vMtGAQA7
}
set importtext_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIpjAOZx7cG
GosRSttqRopeD37OKGmmyFXalD1b+3UyeUFqPSl4vsZ6UAAAOw==
}
set save_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAImjI+pwA16
HmIwyGjhNXLz5HjeBFYZOZ4gNYUuubAYqpWVaIquUwAAOw==
}
set saveas_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIrjI+pwA16
ngwM0ukgvjVV6TzIto0m6FGRKnodGMbGtLxX2pbrip7sP4o5CgA7
}
set imagel_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIohI8Xm20b
UowISkAVc5Ltjn3QqGXc8zWb5VDTCLPxvL70Gt6i3uljAQA7
}
set print_icon_gif {
R0lGODlhEAAQAPABAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIpjA2pCxft
DnQtoUuj1PX5n2ngJk4Pg1pex55nCotlRcuqTJn4C6O7VgAAOw==
}
set info_icon_gif {
R0lGODlhEAAQAIAAAAAAAP///yH5BAEAAAEALAAAAAAQABAAAAIojI+pAQ17
GpLqGcqSvTtHeH0RFnqjVp5TyqEs2VmOw5quFncVDfZGAQA7
}
set colplt_icon_gif {
R0lGODlhEAAQAOMAAAAAAL8AAP//fwC/AL+/AP8AAH///////39//wAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAAcALAAAAAAQABAAAARQ8EhAgbx4hhOC
zRewSR4Ydlz3ZWLnqhV1tG+tzrY9eHQeDEBKp1DIAQfCANEYxBGLLoKAcJst
AwhDYCqo0rJZqbSkCRjAr9VEpHXJTLG3JAIAOw==
}
set colsel_icon_gif {
R0lGODlhEAAQAIQAAAAAAH//f78AAAA/v///fwD/AAC/AL+//7+/AP//v/+/
v/8AAP/f3///AH9//7//vwAA/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAEAAQAAAFZiAgjmQpMiiQrMDjAsdx
pmvSvvHMqKz7wDKTkKQoAghIQGAJcDhERcUxuQw0n4DolKBkOodgwGIMaJgB
hTQAAhGNF+VzurBui8nmBlrNDg8FgAAIgwAGhgADAyKAAoKEhgaIin4lIQA7
}
set colrnd_icon_gif {
R0lGODlhEAAQAOMAAAAAAL8AAP+/fz+/AL+/AAAAfwB//wB/AL8/AP8AAP//
////AH9/AP9/AAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARhUEkgqwKNWhD0
bEJWcUlHYUIqkkl5nGBGnIE7vJe8EFNwDMAXA0BYGCVDwE+ILPIUDCQTCiBq
olEoElCoIr/ZS8HQtYQnYwPZY0EyxuVALVFhZLkaea09qugDfHwIeoFtEQA7
}
set none_icon_gif {
R0lGODlhEAAQAIAAAP///wAAACH5BAEAAAAALAAAAAAQABAAAAIOhI+py+0P
o5y02ouzPgUAOw==
}
############################################################
image create photo lupe_plus  -format gif -data $lupe_plus_gif
image create photo lupe_minus -format gif -data $lupe_minus_gif
set lupe_minus_gif {}
set lupe_plus_gif {}
foreach i {arrow box obox boxx circle fline line oval pixel pline poly rect orect rod select sphere text colSpoit hide quit newfile load reload import importtext save saveas imagel print info colplt colsel colrnd none} {
    eval image create photo ${i}_icon -format gif -data $${i}_icon_gif
    unset ${i}_icon_gif
}

############################################################
# PI
set m_pi [expr atan2(1,1)*4]

############################################################
# Rand
set rand_next [clock seconds]
proc rand {} {
    global rand_next;
    set rand_next [expr $rand_next*1103515245 + 12345]
    return [expr (($rand_next/65536)%32768)/32768.0];
}

############################################################
# sets: set apply to lists (like foreach).
proc sets {{vars} {vals}} {
    foreach var $vars {
	upvar $var x
	set x [lindex $vals 0]
	set vals [lreplace $vals 0 0]
    }
}

############################################################
# lintersection
proc lintersection {a_lis b_lis} {
    set c ""
    foreach a $a_lis {
       if {[lsearch $b_lis $a]!=-1} {
           lappend c $a
       }
    }
    return $c
}

############################################################
# lreverse
proc lreverse {{src}} {
    set dest ""
    foreach l $src {
	set dest [linsert $dest 0 $l]
    }
    return $dest
}

############################################################
# basename
proc basename {{fname}} {
    return [lindex [split $fname "/"] end]
}

proc get_smooth {c id} {
    set smooth [$c itemcget $id -smooth]
    if {$smooth!=0} {set smooth 1}
    return $smooth
}

############################################################
# Canvas snapshot
#   (popupCanvasSnapshot: from tkgnuplot)
proc getCanvasSnapshot {w} {
    global fontsize cur_gridshow

    set tmp_gridshow $cur_gridshow
    if {$cur_gridshow} {set cur_gridshow 0; makeGridLine}
    set bbox [$w bbox all]
    if {$tmp_gridshow} {set cur_gridshow $tmp_gridshow; makeGridLine}
    if {$bbox==""} {return}

    set margin 0
    set shrink 1
    set snapwidth 80
    set snapheight 60
    set size $fontsize
    
    sets {x0 y0 x1 y1} $bbox
    set width [expr ($x1-$x0)]
    set height [expr ($y1-$y0)]
    if {$width>$height} {
	if {$width>$snapwidth} {
	    set shrink [expr 1.0*$width/$snapwidth]
	}
    } else {
	if {$height>$snapheight} {
	    set shrink [expr 1.0*$height/$snapheight]
	}
    }
    set width [expr $width/$shrink+$margin*2]
    set height [expr $height/$shrink+$margin*2]

    set t .csn
    toplevel $t
    set c $t.c
    canvas $c -width $width -height $height -background [$w cget -background]
    wm overrideredirect $t 1
    pack $c 
    bind $t <Control-q> "destroy $t"
    bind $t <Control-w> "destroy $t"
    update idletasks
    set id_create ""
    foreach id [$w find all] {
	set opts ""
	if {[lsearch [.c gettags $id] "grid"]!=-1} {continue}
	foreach opt [$w itemconfigure $id] {
	    set o_name [lindex $opt 0]
	    set o_value [list [lindex $opt end]]
	    if {$o_name=="-font" && [regexp -- "-(\[0-9\]+)$" $o_value null size]} {
		set size [expr int($size/$shrink)]
		if {$size<=1} {set size 2}
		loadFont $size
		regsub -- "-(\[0-9\]+)$" $o_value "-$size" o_value
	    } elseif {$o_name=="-arrowshape"} {
		set tmp ""
		foreach v [lindex $o_value 0] {
		    lappend tmp [expr 1.0*$v/$shrink]
		}
		set o_value [list $tmp]
	    } elseif {$o_name=="-width"} {
		set o_value [expr $o_value/$shrink]
	    }
	    append opts "$o_name $o_value "
	}
	lappend id_create "$c create [$w type $id] [$w coords $id] $opts"
    }
    foreach idc $id_create {eval $idc}
    $c move all [expr -$x0+$margin] [expr -$y0+$margin]
    $c scale all $margin $margin [expr 1.0/$shrink] [expr 1.0/$shrink]
    update idletasks
    set gif_base64 [exec xwd -id [winfo id $c] -nobdrs -silent | convert xwd:- gif:- | base64]
    destroy $t
    update idletasks

    return $gif_base64
}

############################################################
# setIconbitmap
proc setIconbitmap {w} {
    set bmp {
      48 48
      fc ff ff ff ff 3f 02 00 00 00 00 40 01 00 00 00 00 80
      01 00 00 80 be 80 01 00 00 00 00 80 01 00 00 fe 07 80
      01 00 00 01 00 80 01 00 00 01 00 80 01 00 80 00 00 80
      01 00 ff ff 00 80 01 00 41 80 00 80 01 00 01 80 00 80
      01 00 ff ff 00 96 01 80 00 00 01 80 01 40 00 00 f2 87
      01 40 00 00 0e 80 01 40 00 80 03 80 01 40 00 60 02 80
      5d 41 00 18 02 80 01 40 00 06 02 80 f1 4f 00 00 02 80
      01 50 00 f0 03 80 01 60 00 00 02 80 01 c0 79 f0 03 80
      01 40 86 00 02 80 01 40 9c f0 03 80 01 40 84 00 02 80
      01 40 84 f0 03 80 01 40 78 00 02 80 01 40 00 f0 03 80
      01 40 00 00 02 80 01 40 00 f0 03 80 01 40 00 00 02 80
      01 80 00 00 01 80 01 80 00 00 01 80 01 00 0f f0 00 80
      01 00 10 08 00 80 01 00 10 08 00 80 01 f8 8f f0 1f 80
      01 08 00 01 10 80 01 f8 ff ff 1f 80 01 00 00 02 00 80
      01 00 00 02 00 80 01 00 00 04 6c 9f 01 00 00 04 00 80
      01 00 00 f8 3f 80 02 00 00 00 00 40 fc ff ff ff ff 3f
    }
    
    set tmpfile "tmp[pid].xbm"
    set fd [open "$tmpfile" w]
    puts $fd "#define -_width [lindex $bmp 0]"
    puts $fd "#define -_height [lindex $bmp 1]"
    puts $fd "static char -_bits\[\] = {"
    foreach d [lrange $bmp 2 end] {
	puts -nonewline $fd "0x$d, "
    }
    puts $fd "};"
    close $fd
    
    wm iconbitmap $w @$tmpfile
    file delete $tmpfile
}

############################################################
# setColor
proc setColor {{col}} {
    global cur_id cur_col itemType gradation_id

    set m 65535.0
    if {$col==""} {return}
    sets {r g b} [winfo rgb . $col]
    .op.col.cur_col configure -background $col
    set cur_col [list 255 [expr $r/$m] [expr $g/$m] [expr $b/$m]]
    if {$cur_id==""} {return}
    foreach id $cur_id {
	set type $itemType($id)
	if {$type=="text" || $type=="arrow" || $type=="line" || $type=="pline" || $type=="poly" || $type=="orect"} {
	    .c itemconfigure $id -fill $col
	} elseif {$type=="box" || $type=="obox"|| $type=="oval"} {
	    .c itemconfigure $id -fill $col -outline $col
	} elseif {$type=="rect" || $type=="circle"} {
	    .c itemconfigure $id -outline $col
	}
    }
}

proc makeColorMenu {{m}} {
    menu $m.m -borderwidth 0 -activeborderwidth 1
    set clmn 5
    set i 1
    foreach c {
	000000 1f1f1f 3f3f3f 5f5f5f 7f7f7f
	ffffff efefef dfdfdf bfbfbf 9f9f9f
	ffdfdf ffbfbf ff0000 bf0000 7f0000
	ffdfbf ffbf7f ff7f00 bf3f00 7f1f00
	ffffbf ffff7f ffff00 bfbf00 7f7f00
	dfffbf bfff7f 7fff00 3fbf00 1f7f00
	bfffbf 7fff7f 00ff00 00bf00 007f00
	bfffdf 7fffbf 00ff7f 00bf3f 007f1f
	bfffff 7fffff 00ffff 00bfbf 007f7f
	bfdfff 7fbfff 007fff 003fbf 001f7f
	bfbfff 7f7fff 0000ff 0000bf 00007f
	dfbfff bf7fff 7f00ff 3f00bf 1f007f
	ffbfff ff7fff ff00ff bf00bf 7f007f
	ffbfdf ff7fbf ff007f bf003f 7f001f
    } {
	set col col$i
	set size 16
	image create photo $col -width $size -height $size
	$col put #$c -to 0 0 $size $size
	$m.m add checkbutton -image $col -hidemargin 1 \
		-command "setColor #$c" \
		-columnbreak [expr (fmod($i-1, $clmn)==0)]
	incr i
    }
    return $m.m
}
    
proc makeColorString {{dst_col}} {
    set col [lindex $dst_col 0]
    set r [expr int($col*[lindex $dst_col 1])]
    set g [expr int($col*[lindex $dst_col 2])]
    set b [expr int($col*[lindex $dst_col 3])]
    if {$r>255} {set r 255} elseif {$r<0} {set r 0}
    if {$g>255} {set g 255} elseif {$g<0} {set g 0}
    if {$b>255} {set b 255} elseif {$b<0} {set b 0}
    set col [format "#%02x%02x%02x" $r $g $b]
    return $col
}

proc randomColor {} {
    sets {col_r col_g col_b} [list [rand] [rand] [rand]]
    set col [expr int(([rand]*.6+.4)*255)]
    if {($col_r+$col_g+$col_b)/3<.3} {
	set col 255
	sets {col_r col_g col_b} [list [expr $col_r*.6+.4] \
		                       [expr $col_g*.6+.4] \
				       [expr $col_b*.6+.4]]
    }
    setColor [makeColorString [list $col $col_r $col_g $col_b]]
}

proc changeColorIntensity {{col} {ratio}} {
    global cur_id cur_col itemType

    sets {r g b} [winfo rgb . $col]
    return [makeColorString [list [expr $ratio*255] [expr $r/65535.0] [expr $g/65535.0] [expr $b/65535.0]]]
}

proc darkenItem {{c_id}} {
    global itemType

    foreach id $c_id {
	set col [changeColorIntensity [.c itemcget $id -fill] .95]
	set type $itemType($id)
	if {$type=="oval" || $type=="box" || $type=="obox"} {
	    .c itemconfigure $id -fill $col -outline $col
	} else {
	    .c itemconfigure $id -fill $col
	}
    }
}

proc lightenItem {{c_id}} {
    global itemType
    
    foreach id $c_id {
	if {[info exists itemType($id)]==0} {continue}
	set col [changeColorIntensity [.c itemcget $id -fill] 1.1]
	if {$col=="#000000"} {set col "#505050"}
	set type $itemType($id)
	if {$type=="oval" || $type=="box" || $type=="obox"} {
	    .c itemconfigure $id -fill $col -outline $col
	} else {
	    .c itemconfigure $id -fill $col
	}
    }
}

############################################################
# setStipple
proc setStipple {p} {
    global cur_stipple

    set cur_stipple [list $p]
}

proc makeStippleMenu {m} {
    menu $m.m -borderwidth 0 -activeborderwidth 1
    set clmn 4
    set i 1
    foreach p {
	gray12
	gray25
	gray50
	gray75
	error
	hourglass
	info
	questhead
	question
	warning
	{}
    } {
	$m.m add checkbutton -bitmap $p -hidemargin 1 \
		-command "setStipple [list $p]; $m configure -bitmap $p" \
		-columnbreak [expr (fmod($i-1, $clmn)==0)]
	incr i
    }
    return $m.m
}

############################################################
#
# GetValue: ¡ÖTcl/Tk ÆþÌç¡×¥¦¥§¥ë¥Á, p.276-277.
proc getValue {{string} {init ""}} {
    global prompt
    set f [toplevel .prompt -borderwidth 10]
    message $f.msg -text $string -width 300
    entry $f.entry -textvariable prompt(result)
    if {$init!=""} {$f.entry delete 0 end; $f.entry insert 0 $init}
    set b [frame $f.buttons -bd 10]
    pack $f.msg $f.entry $f.buttons -side top -fill x
    button $b.ok -text OK \
	    -command {set prompt(ok) 1} -underline 0
    button $b.cancel -text Cancel \
	    -command {set prompt(ok) 0} -underline 0
    pack $b.ok -side left
    pack $b.cancel -side right

    # ¥Ð¥¤¥ó¥É¤òÀßÄê¤¹¤ë
    foreach w [list $f.entry $b.ok $b.cancel] {
	bindtags $w [list .prompt [winfo class $w] $w all]
    }
    bind .prompt <Alt-o> "focus $b.ok; break"
    bind .prompt <Alt-c> "focus $b.cancel; break"
    bind .prompt <Alt-Key> break
    bind .prompt <Return> {set prompt(ok) 1}
    bind .prompt <Control-c> {set prompt(ok) 0}
    
    focus $f.entry
    grab $f
    tkwait variable prompt(ok)
    grab release $f
    destroy $f
    focus -force .
    if {$prompt(ok)} {
	return $prompt(result)
    } else {
	return {}
    }
}

############################################################
#
# ItemSnap
proc distance_sort {a b} {
    set a [lindex $a 0]
    set b [lindex $b 0]
    if {$a>$b} {
	return 1
    } elseif {$a<$b} {
	return -1
    } else {
	return 0
    }
}

proc itemSnap {{x} {y} {type edge}} {
    global cur_id
    set a 4
    set id_list [.c find overlapping \
	    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]]
    set coord ""
    foreach id $id_list {
	if {[lsearch [.c gettags $id] "grid"]!=-1} {continue}
	if {[info exists gradation($id)]} {set id $gradation($id)}
	set coord [.c coord $id]
	break
    }
    set dis_xy ""
    foreach {xx yy} $coord {
	lappend dis_xy [list \
		[expr ($xx-$x)*($xx-$x)+($yy-$y)*($yy-$y)] $xx $yy]
    }
    return [lrange [lindex [lsort -command distance_sort $dis_xy] 0] 1 end]
}

############################################################
#
proc splitTextEachLine {t_id} {
    global itemType

    set new_id ""
    unselectItem t_id
    set tt_id ""
    foreach id $t_id {
	if {$itemType($id)!="text"} {continue}
	sets {x0 y0 x1 y1} [.c bbox $id]
	incr x0
	set text [.c itemcget $id -text]
	sets {x y} [list $x0 $y0]
	regsub "\n$" $text "" text
	foreach t [split $text "\n"] {
	    if {$t==""} {set t " "}
	    .text.e delete 0.0 end
	    .text.e insert 0.0 $t
	    set tmp_id [makeItem text -justify left -anchor nw [list $x $y]]
	    set y [lindex [.c bbox $tmp_id] 3]
	    lappend new_id $tmp_id
	}
	lappend tt_id $id
    }
    selectItem new_id
    deleteItem $tt_id
    return $new_id
}

proc itemcoordy_sort {a b} {
    set ay [lindex [.c bbox $a] 1]
    set by [lindex [.c bbox $b] 1]
    if {$ay>$by} {
	return 1
    } elseif {$ay<$by} {
	return -1
    } else {
	return 0
    }
}

proc joinTextEachLine {t_id} {
    global itemType

    unselectItem t_id
    set t_id [lsort -command itemcoordy_sort $t_id]
    sets {x0 y0 x1 y1} [.c bbox [lindex $t_id 0]]
    incr x0
    set text ""
    set tt_id ""
    foreach id $t_id {
	if {$itemType($id)!="text"} {continue}
	append text "[.c itemcget $id -text]\n"
	lappend tt_id $id
    }
    regsub "\n$" $text "" text
    .text.e delete 0.0 end
    .text.e insert 0.0 $text
    set new_id [makeItem text -justify left -anchor nw [list $x0 $y0]]
    selectItem new_id
    deleteItem $tt_id
    return $new_id
}

proc editText {{w} {x} {y} {id}} {
    set e [winfo parent $w]
    if {$e=="."} {
	set e ".e"
    } else {
	append e ".e"
    }
    text $e -width 30 -height 3
    pack slave $e
    $e delete 0.0 end
    $e insert 0.0 [$w itemcget $id -text]
    set e_id [$w create window $x $y -window $e]
    bind $e <Key-Return> "$w itemconfigure $id -text \[$e get 0.0 end-1chars\]; $w delete $e_id; destroy $e; break"
    bind $e <Escape> "$w delete $e_id; destroy $e; set text \[$w itemcget $id -text\]; if {\$text==\"\"} {$w delete $e_id; $w delete $id}"
    update idletasks
    bind $e <Control-o> {
	%W insert insert "\n"
	%W mark set current [%W index insert]+2chars
	%W see current
	break
    }
    focus $e
    grab $e
    tkwait window $e
}

############################################################
proc getLineCoord {id} {
    global itemType
    global nod_dupinfo

    set i 0
    set coord ""
    set skip 0
    set type $itemType($id)
    if {$type=="obox" || $type=="orect"} {
	set cd [.c coord $id]
	return "[lindex $cd 8] [lindex $cd 15] [lindex $cd 0] [lindex $cd 3]"
    }
    if {$nod_dupinfo($id)==""} {
	return [.c coords $id]
    }
    foreach {x y} [.c coords $id] {
	if {$skip==1} {
	    set skip 0
	} else {
	    append coord "$x $y "
	    if {[lsearch $nod_dupinfo($id) $i]!=-1} {
		set skip 1
	    }
	    incr i
	}
    }
    return $coord
}

proc makeLineCoord {id coord} {
    global itemType
    global nod_dupinfo
    global cur_zoom

    set i 0
    set coord_tmp ""
    set type $itemType($id)
    if {$type=="obox" || $type=="orect"} {
	sets {x y x0 y0} $coord
	set d [expr 20*$cur_zoom]
	sets {xa ya x0a y0a} \
		[list [expr $x-$d] [expr $y-$d] \
		      [expr $x0+$d] [expr $y0+$d]]
	set coord_tmp [list \
		$x0  $y0a $x0 $y0 $x0a $y0 \
		$xa  $y0  $x  $y0 $x   $y0a \
		$x   $ya  $x  $y  $xa  $y \
		$x0a $y   $x0 $y  $x0  $ya \
		$x0  $y0a ]
	return $coord_tmp
    }
    foreach {x y} $coord {
	append coord_tmp " $x $y"
	if {[lsearch $nod_dupinfo($id) $i]!=-1} {
	    append coord_tmp " $x $y"
	}
	incr i
    }
    return $coord_tmp
}

proc toggleItemNodDup {id n} {
    global selectnod_id selectnod nod_dupinfo

    set coord [getLineCoord $id]
    set i [lsearch $nod_dupinfo($id) $n]
    if {$i==-1} {
	lappend nod_dupinfo($id) $n
	set col_f orange
    } else {
	set nod_dupinfo($id) [lreplace $nod_dupinfo($id) $i $i]
	set col_f blue
    }
    .c itemconfigure [lindex $selectnod_id($id) $n] -fill $col_f
    eval .c coords $id [makeLineCoord $id $coord]
}

############################################################
#
proc ButtonPress-1 {{x} {y}} {
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow cur_arrowshape cur_col
    global cur_cursor
    global cur_layer layer_id
    #global cur_itemsnap
    global itemType
    global selectnod_id selectnod
    global gradation_id gradation
    global nod_dupinfo
    global raiselower
    global fontsize cur_linewidth linecap rodwidth
    global fline_cnt fline_skipnum
    global canvas_grid grid_unit cur_zoom

    set fill "PeachPuff"
    if {$cur_col!=""} { ;# ËÜÅö¤Ï ButtonPress Ëè¤Ë¹Ô¤¦¤Ù¤­½èÍý¤¸¤ã¤Ê¤¤
	sets {color col_r col_g col_b} $cur_col
	set fill [format "#%02x%02x%02x" \
		[expr int($color*$col_r)] \
		[expr int($color*$col_g)] \
		[expr int($color*$col_b)]]
    }

    #sets {sn_x sn_y} [itemSnap $x $y]
    #if {![regexp $cur_mode "select|move"] && $cur_itemsnap} {
    #	if {$sn_x==""} {
    #	    sets {x y} [list $sn_x $sn_y]
    #	}
    #}

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    sets {xx yy} [list [.c canvasx $x] [.c canvasy $y]]
    if {$grid>0} {
	sets {x y} [list [.c canvasx $x $grid] [.c canvasy $y $grid]]
    } else {
	sets {x y} [list $xx $yy]
    }
    switch -regexp $cur_mode {
	"^(select)$" {
	    set cur_bbox [list $x $y]
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id!="" && [lsearch [.c gettags $id] "grid"]==-1 && $cur_layer==$layer_id($id) } {
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($id)
		    set cur_mode resize
		    return
		} elseif {[info exists gradation($id)]} {
		    set id $gradation($id)
		}
		if {$layer_id($id)!=$cur_layer} {return}
		set cur_mode "move"
		if {$cur_id=="" || [lsearch $cur_id $id]==-1} {
		    unselectItem cur_id
		    selectItem id
		    if {$cur_cursor!="fleur"} {
			set cur_cursor "fleur"
			.c configure -cursor $cur_cursor
			update idletasks
		    }
		} else {
		    unselectItem id
		}
	    } else {
		unselectItemAll
		set cur_id [.c create rectangle $xx $yy $xx $yy]
		set cur_bbox "$xx $yy"
	    }
	}
	"^(move)$"   {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    } elseif {$canvas_grid==0} {
		set a 10
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    set cur_bbox [list $x $y]
	    if {$id=="" || [lsearch $cur_id $id]==-1} {
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($id)
		    set cur_mode resize
		    return
		} elseif {[info exists gradation($id)]} {
		    set id $gradation($id)
		}
		if {[lsearch $cur_id $id]==-1} {
		    unselectItem cur_id
		    set cur_mode select
		}
	    }
	}
	"^(resize)$" {
	    puts "Why resize!?"
	}
	"^(colSpoit)$"   {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id!=""} {
		set col [.c itemcget $id -fill]
		set t .op.col
		$t.cur_col configure -background $col
		$t.cole delete 0 end
		$t.cole insert 0 $col
		set m 65535.0
		sets {r g b} [winfo rgb . $col]
		set cur_col [list 255 [expr $r/$m] [expr $g/$m] [expr $b/$m]]
	    }
	}
	"^(nodDel)$"   {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id=="" || [lsearch $cur_id $id]==-1} {
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($cur_nod)
		    set n [lsearch $selectnod_id($id) $cur_nod]
		    set coord [getLineCoord $id]
		    set coord [lreplace $coord [expr $n*2] [expr $n*2+1]]
		    set i [lsearch $nod_dupinfo($id) $n]
		    if {$i!=-1} {
			set nod_dupinfo($id) [lreplace $nod_dupinfo($id) $i $i]
		    }
		    set d ""
		    foreach dn $nod_dupinfo($id) {
			if {$dn>=$n} {incr dn -1}
			lappend d $dn
		    }
		    set nod_dupinfo($id) $d
		    if {[llength $coord]<4 || $itemType($id)=="poly" && [llength $coord]<6} {
			unselectItem id
			deleteItem $id
		    } else {
			eval .c coord $id [makeLineCoord $id $coord]
			.c delete $cur_nod
			unset selectnod($cur_nod)
			set selectnod_id($id) [lreplace $selectnod_id($id) $n $n]
		    }
		}
	    }
	}
	"^(nodCut)$"   {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id=="" || [lsearch $cur_id $id]==-1} {
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($cur_nod)
		    set n [lsearch $selectnod_id($id) $cur_nod]
		    set coord [getLineCoord $id]
		    set coord_a [lrange $coord [expr $n*2] end]
		    set coord_b [lrange $coord 0 [expr $n*2+1]]
		    set coord [lreplace $coord [expr $n*2] [expr $n*2+1]]
		    unselectItem id
		    set d ""
		    foreach dn nod_dupinfo($id) {
			if {$dn==$n} {
			    lappend d $dn
			}
		    }
		    set nod_dupinfo($id) $d
		    eval .c coord $id [makeLineCoord $id $coord_a]
		    makeItem $itemType($id) \
			    -fill [.c itemcget $id -fill] \
			    -smooth [get_smooth .c $id] \
			    $coord_b
		    selectItem id
		}
	    }
	}
	"^(nodAdd)$" {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id=="" || [lsearch $cur_id $id]==-1} {
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($cur_nod)
		    set n [lsearch $selectnod_id($id) $cur_nod]
		    unselectItem id
		    set d ""
		    foreach dn $nod_dupinfo($id) {
			if {$dn>=$n} {incr dn}
			lappend d $dn
		    }
		    set coord [linsert [getLineCoord $id] [expr $n*2] $x $y]
		    set nod_dupinfo($id) $d
		    eval .c coord $id [makeLineCoord $id $coord]
		    selectItem id
		    set cur_nod [lindex $selectnod_id($id) $n]
		}
	    }
	}
	"^(text)$"    {
	}
	"^(rect|orect)$"    {
	    unselectItem cur_id
	    set cur_id [.c create rectangle $x $y $x $y -width $cur_linewidth -outline $fill]
	    set cur_bbox [list $x $y]
	}
	"^(box|obox|boxx)$"    {
	    unselectItem cur_id
	    set cur_id [.c create rectangle $x $y $x $y -fill $fill -outline $fill]
	    set cur_bbox [list $x $y]
	}
	"^(circle)$"    {
	    unselectItem cur_id
	    set cur_id [.c create oval $x $y $x $y -outline $fill -width $cur_linewidth]
	    set cur_bbox [list $x $y]
	}
	"^(oval|sphere)$"    {
	    unselectItem cur_id
	    set cur_id [.c create oval $x $y $x $y -fill $fill -outline $fill]
	    set cur_bbox [list $x $y]
	}
	"^(arrow)$"  {
	    unselectItem cur_id
	    set cur_id [.c create line $x $y $x $y -arrow $cur_arrow -width $cur_linewidth -arrowshape $cur_arrowshape -capstyle $linecap -smooth $cur_smooth -fill $fill]
	    set cur_bbox [list $x $y]
	}
	"^(^line)$"   {
	    unselectItem cur_id
	    set cur_id [.c create line $x $y $x $y -width $cur_linewidth -arrowshape $cur_arrowshape -capstyle $linecap -smooth $cur_smooth -fill $fill]
	    set cur_bbox [list $x $y]
	}
	"^(^fline)$"   {
	    set fline_cnt 0
	    unselectItem cur_id
	    set cur_id [.c create line $x $y $x $y -width $cur_linewidth -arrowshape $cur_arrowshape -capstyle $linecap -smooth $cur_smooth  -fill $fill]
	    set cur_bbox [list $x $y]
	}
	"^(pline|poly)$"   {
	    unselectItem cur_id
	    if {$cur_id=="" || [llength $cur_bbox]<0} {
		if {0} {
		    set cur_id [.c create line $x $y $x $y \
			    -width $cur_linewidth -arrowshape $cur_arrowshape \
			    -capstyle $linecap -smooth $cur_smooth -fill $fill]
		    set cur_bbox "$x $y"
		}
	    } elseif {[llength $cur_bbox]>1} {
		eval .c coord $cur_id $cur_bbox $x $y
		append cur_bbox " $x $y"
	    } else {
		eval .c coord $cur_id $cur_bbox $x $y
	    }
	}
	"^(rod)$"   {
	    unselectItem cur_id
	    set cur_id [.c create line $x $y $x $y -width $rodwidth -smooth $cur_smooth -fill $fill]
	    set cur_bbox [list $x $y]
	}
	"^(pixel)$"   {
	    unselectItem cur_id
	    set cur_id [.c create line $x $y [expr $x+1] $y -fill $fill]
	    set cur_bbox [list $x $y]
	}
	default  {puts "Error: unknown mode specified.: $x $y $cur_mode"}
    }
}

proc Shift-ButtonPress-1 {{x} {y}} {
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global cur_cursor
    global itemType
    global selectnod_id selectnod
    global gradation_id gradation
    global raiselower
    global fontsize cur_linewidth linecap rodwidth
    global canvas_grid grid_unit cur_zoom

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    if {$grid>0} {
	set x [.c canvasx $x $grid]
	set y [.c canvasy $y $grid]
    } else {
	sets {x y} [list [.c canvasx $x] [.c canvasy $y]]
    }
    switch -regexp $cur_mode {
	"^(select|move)$" {
	    set cur_bbox "move"
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id != "" && [lsearch [.c gettags $id] "grid"]==-1} {
		set cur_mode "move"
		if {[info exists selectnod($id)]} {
		    set cur_nod $id
		    set id $selectnod($id)
		    if {1} {
			toggleItemNodDup $id [lsearch $selectnod_id($id) $cur_nod]
		    } else {
			set cur_mode resize
		    }
		    return
		} elseif {[info exists gradation($id)]} {
		    set id $gradation($id)
		}
		if {$cur_id=="" || [lsearch $cur_id $id]==-1} {
		    selectItem id
		    if {$cur_cursor!="fleur"} {
			set cur_cursor "fleur"
			.c configure -cursor $cur_cursor
			update idletasks
		    }
		} else {
		    unselectItem id
		}
	    }
	}
	"^(pline|poly)$"   {
	    unselectItem cur_id
	    if {$cur_id=="" || [llength $cur_bbox]<0} {
		if {0} {
		    set cur_id [.c create line $x $y $x $y \
			    -width $cur_linewidth -arrowshape $cur_arrowshape \
			    -capstyle $linecap -smooth $cur_smooth -fill $fill]
		    set cur_bbox "$x $y"
		}
	    } elseif {[llength $cur_bbox]>1} { ;# nod duplicate
		eval .c coord $cur_id $cur_bbox $x $y
		append cur_bbox " $x $y $x $y"
	    } else {
		eval .c coord $cur_id $cur_bbox $x $y $x $y
	    }
	}
        default {set cur_bbox ""; set cur_mode "select"}
    }
}

proc Button1-Motion {{x} {y}} {
    global cur_mode cur_id cur_bbox cur_nod
    global itemType
    global selectnod_id selectnod
    global gradation_id gradation
    global nod_dupinfo
    global fline_cnt fline_skipnum
    global canvas_grid grid_unit cur_zoom

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    sets {xx yy} [list [.c canvasx $x] [.c canvasy $y]]
    if {$grid>0} {
	sets {x y} [list [.c canvasx $x $grid] [.c canvasy $y $grid]]
    } else {
	sets {x y} [list $xx $yy]
    }
    set x0 [lindex $cur_bbox 0]
    set y0 [lindex $cur_bbox 1]
    switch -regexp $cur_mode {
	"^(select)$" {
	    if {$cur_id!="" && $cur_bbox!=""} {
		eval .c coord $cur_id [lrange $cur_bbox 0 1] $xx $yy
	    }
	}
	"^(move)$"   {
	    moveItem [expr $x-$x0] [expr $y-$y0] cur_id
	    set cur_bbox [list $x $y]
	}
	"^(resize)$" {
	    foreach id $cur_id {
		set n [lsearch $selectnod_id($id) $cur_nod]
		if {$n==-1} {continue}
		set coord [lreplace [getLineCoord $id] [expr $n*2] [expr $n*2+1] $x $y]
		# box ¤Ê¤É¤Ç¤Î¥ê¥µ¥¤¥º¤òÅ¬Åö¤Ë¤¹¤ë¤Ë¤Ï¤³¤³¤¤¤é¤ò¤¤¤¸¤ë
		eval .c coord $id [makeLineCoord $id $coord]
		eval .c coord $cur_nod [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3]
		#unselectItem id
		#selectItem id
		#set cur_nod [lindex $selectnod_id($id) $n]
		resizeItem id
		break
	    }
	}
	"^(colSpoit)$"   {
	}
	"^(nodDel|nodCut)$"   {
	}
	"^(nodAdd)$"   {
	    foreach id $cur_id {
		set n [lsearch $selectnod_id($id) $cur_nod]
		if {$n==-1} {
		    continue
		}
		set coord [lreplace [getLineCoord $id] [expr $n*2] [expr $n*2+1] $x $y]
		eval .c coord $id [makeLineCoord $id $coord]
		eval .c coord $cur_nod [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3]
		resizeItem id
		break
	    }
	}
	"^(text)$"    {
	    }
	"^(rect|orect|box|obox|boxx|circle|oval|sphere|line|rod)$" {
	    eval .c coord $cur_id $cur_bbox $x $y
	    }
	"^(arrow)$"  {
	    eval .c coord $cur_id $x $y $cur_bbox 
	    }
	"^(fline)$"   {
	    incr fline_cnt
	    if {fmod($fline_cnt, $fline_skipnum)==0} {
		append cur_bbox " $x $y"
		eval .c coord $cur_id $cur_bbox
	    }
	    }
	"^(pline|poly)$"   {
	    if {0 && [llength $cur_bbox]==2} {
		eval .c coord $cur_id $cur_bbox $x $y
	    } elseif {[llength $cur_bbox]>1} {
		eval .c coord $cur_id $cur_bbox $x $y
	    }
	    }
	"^(pixel)$"   {
	    eval .c coord $cur_id $x $y [expr $x+1] $y
	    }
	default  {puts "Error: unknown mode specified.: $cur_mode $x $y"}
    }
}

proc ButtonRelease-1 {{x} {y}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_col cur_smooth cur_arrowshape
    global fontsize cur_linewidth linecap rodwidth
    global canvas_grid grid_unit cur_zoom

    set fill "PeachPuff"
    if {$cur_col!=""} { ;# ËÜÅö¤Ï ButtonPress Ëè¤Ë¹Ô¤¦¤Ù¤­½èÍý¤¸¤ã¤Ê¤¤
	sets {color col_r col_g col_b} $cur_col
	set fill [format "#%02x%02x%02x" \
		[expr int($color*$col_r)] \
		[expr int($color*$col_g)] \
		[expr int($color*$col_b)]]
    }

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    sets {xx yy} [list [.c canvasx $x] [.c canvasy $y]]
    if {$grid>0} {
	sets {x y} [list [.c canvasx $x $grid] [.c canvasy $y $grid]]
    } else {
	sets {x y} [list $xx $yy]
    }
    switch -regexp $cur_mode {
	"^(select)$" {
	    if {$cur_id!="" && $cur_bbox!=""} {
		eval .c coord $cur_id $cur_bbox $xx $yy
		set cur_bbox [.c bbox $cur_id]
		.c delete $cur_id
		set cur_id ""
	    } else {
		set cur_bbox ""
	    }
	    if {$cur_bbox!=""} {
		set enclose_id [eval .c find enclose $cur_bbox]
		set id [canvasToItem enclose_id]
		if {$id!=""} {
		    selectItem id
		    set cur_mode "move"
		}
	    }
	}
	"^(move)$"   {
	    if {[llength $cur_id]==1} {
		set id [canvasToItem cur_id]
		selectItem id
		if {$itemType($id)=="text"} {
		    .text.e delete 0.0 end
		    .text.e insert 0.0 [.c itemcget $id -text]
		    set f [.c itemcget $id -font]
		    if {[llength f]>2} {
			set fontsize [lindex $f 1]
		    }
		} elseif {$itemType($id)=="line" || $itemType($id)=="arrow"} {
		    #set cur_linewidth [.c itemcget $id -width]
		    #set linecap   [.c itemcget $id -capstyle]
		} elseif {$itemType($id)=="rod"} {
		    #set rodwidth [.c itemcget $id -width]
		    #set cur_linewidth $rodwidth
		}
	    }
	    #set cur_mode "select"
	}
	"^(resize)$" {
	    #set cur_mode "select"
	    set cur_mode "move"
	}
	"^(colSpoit)$"   {
	}
	"^(nodDel|nodCut|nodAdd)$"   {
	}
	"^(fline)$" {
	    makeItem $cur_mode $cur_bbox
	}
	"^(pline|poly)$"  {
	    if {$cur_id=="" || [llength $cur_bbox]<0} {
	      set cur_id [.c create line $x $y $x $y \
		      -width $cur_linewidth -arrowshape $cur_arrowshape \
		      -capstyle $linecap -smooth $cur_smooth -fill $fill]
	      set cur_bbox "$x $y"
	    } elseif {0 && [llength $cur_bbox]==2
		&& [lindex $cur_bbox 0]==$x && [lindex $cur_bbox 1]==$y} {
	    } else {
	    }
	}
	default {
	    makeItem $cur_mode -fill $fill "$x $y $cur_bbox"
	}
    }
}

proc ButtonPress-2 {{x} {y}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_col cur_smooth
    global fontsize cur_linewidth linecap rodwidth
    global canvas_grid grid_unit cur_zoom

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    if {$grid>0} {
	set x [.c canvasx $x $grid]
	set y [.c canvasy $y $grid]
    } else {
	sets {x y} [list [.c canvasx $x] [.c canvasy $y]]
    }
    switch -regexp $cur_mode {
	"^(select|text)$" {
	    set a 1
	    if {$canvas_grid>2} {
		set a [expr $grid/2]
	    }
	    set id [lindex [.c find overlapping \
		    [expr $x-$a] [expr $y-$a] [expr $x+$a] [expr $y+$a]] end]
	    if {$id!="" && $itemType($id)=="text"} {
		unselectItemAll
		editText .c $x $y $id
		set cur_mode "select"
	    }
	}
    }
}

proc ButtonPress-3 {{x} {y}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_col
    global fontsize cur_linewidth linecap rodwidth
    global canvas_grid grid_unit cur_zoom
    global poly_tgiftype

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    if {$grid>0} {
	set x [.c canvasx $x $grid]
	set y [.c canvasy $y $grid]
    } else {
	sets {x y} [list [.c canvasx $x] [.c canvasy $y]]
    }
    switch -regexp $cur_mode {
	"^(pline|poly)$"  {
	    .c delete $cur_id
	    set cur_id ""
	    if {$poly_tgiftype} {append cur_bbox " $x $y"}
	    if {[llength $cur_bbox]>2} {
		makeItem $cur_mode $cur_bbox
	    }
	    if {$cur_bbox==""} {set cur_mode "select"}
	    set cur_bbox ""
	}
	default {
	}
    }
}

proc Shift-ButtonPress-3 {{x} {y}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_col
    global fontsize cur_linewidth linecap rodwidth
    global canvas_grid grid_unit cur_zoom

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    if {$grid>0} {
	set x [.c canvasx $x $grid]
	set y [.c canvasy $y $grid]
    } else {
	sets {x y} [list [.c canvasx $x] [.c canvasy $y]]
    }
    switch -regexp $cur_mode {
	"^(pline|poly)$"  {
	    if {$cur_id!=""} {
		set coord [.c coord $cur_id]
		set n [llength $coord]
		set nn 4
		if {$n>4} {
		    sets {x1 y1 x2 y2} [lrange $coord [expr $n-6] [expr $n-2]]
		    if {$x1==$x2 && $y2==$y2} {
			set nn 6
		    }
		}
		if {$n>$nn} {
		    set cur_bbox [lrange $coord 0 [expr $n-$nn-1]]
		    eval .c coord $cur_id $cur_bbox $x $y
		} else {
		    .c delete $cur_id
		    set cur_id ""
		    set cur_bbox ""
		}
	    }
	}
	default {
	}
    }
}

proc ButtonMotion {{x} {y}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_col cur_cursor
    global cur_layer layer_id
    global fontsize cur_linewidth linecap rodwidth
    global selectnod selectnod_id
    global gradation gradation_id
    global canvas_grid grid_unit cur_zoom

    set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    sets {xx yy} [list [.c canvasx $x] [.c canvasy $y]]
    if {$grid>0} {
	sets {x y} [list [.c canvasx $x $grid] [.c canvasy $y $grid]]
    } else {
	sets {x y} [list $xx $yy]
    }
    switch -regexp $cur_mode {
	"^(pline|poly)$"  {
	    if {[llength $cur_bbox]>0} {
		eval .c coord $cur_id $cur_bbox $x $y
		update idletasks
	    }
	}
	"^(move|select)" {
	    set a 1
	    if {0 && $canvas_grid>2} {
		set a [expr $grid/2]
	    } else {
		set a 2
	    }
	    set x0 [.c canvasx $xx]
	    set y0 [.c canvasy $yy]
	    set id [lindex [.c find overlapping \
		    [expr $x0-$a] [expr $y0-$a] [expr $x0+$a] [expr $y0+$a]] end]
	    if {[info exists gradation($id)]} {
		set id $gradation($id)
	    }
	    if {$id!="" && ([info exists selectnod($id)] || ([info exists layer_id($id)] && $layer_id($id)==$cur_layer))} {
		if {[lsearch $cur_id $id]==-1 || $cur_mode=="select"} {
		    set cursor "crosshair"
		} else {
		    set cursor "fleur"
		}
		if {$cur_cursor!=$cursor} {
		    set cur_cursor $cursor
		    .c configure -cursor $cur_cursor
		    update idletasks
		}
	    } elseif {$cur_cursor!="left_ptr"} {
		set cur_cursor "left_ptr"
		.c configure -cursor $cur_cursor
		update idletasks
	    }
	    update idletasks
	}
	default {
	}
    }
}

############################################################
#
proc changeLayer {{n}} {
    global cur_layer layer_id

    if {0} {
    foreach id [array names layer_id] {
	if {$layer_id($id)!=$n} {
	    set stipple gray75
	} else {
	    .c raise $id
	    set stipple {}
	}
	.c itemconfigure $id -stipple $stipple
    }
    }
    set cur_layer $n
}

############################################################
#
proc canvasToItem {enclose_id} {
    upvar $enclose_id e_id
    global selectnod selectnod_id
    global gradation gradation_id
    
    set tmp_id ""
    foreach id $e_id {
	if {[info exists gradation_id($id)]} {
	      lappend tmp_id $id
	}
    }
    return $tmp_id
}

proc raiselowerItem {{raiselower_id}} {
    upvar $raiselower_id l_id
    global gradation_id
    global raiselower

    foreach id $l_id {
	if {$raiselower=="lower"} {
	    if {[.c find withtag grid]!={}} {
		.c raise $id grid
	    } else {
		.c lower $id
	    }
	} else {
	    .c raise $id
	}
	set p $id
	foreach g_id $gradation_id($id) {
	    .c raise $g_id $p
	    set p $g_id
	}
    }
    if {$raiselower=="raise"} {
	set raiselower lower
    } else {
	set raiselower raise
    }
}

proc raiseItem {r_id} {
    global gradation_id
    global cur_editedp

    if {$r_id!=""} {
	set cur_editedp 1
    }
    unselectItem r_id
    foreach id $r_id {
	.c raise $id
	foreach g_id $gradation_id($id) {
	    .c raise $g_id
	}
    }
    selectItem r_id
}

proc lowerItem {l_id} {
    global gradation_id
    global cur_editedp

    if {$l_id!=""} {
	set cur_editedp 1
    }
    unselectItem l_id
    foreach id [lreverse $l_id] {
	if {[.c find withtag grid]!={}} {
	    .c raise $id grid
	} else {
	    .c lower $id
	}
	set p_id $id
	foreach g_id $gradation_id($id) {
	    .c raise $g_id $p_id
	    set p_id $g_id
	}
    }
    selectItem l_id
}

proc selectItem {{select_id}} {
    upvar $select_id s_id
    global itemType
    global cur_id
    global selectnod selectnod_id
    global gradation gradation_id
    global nod_dupinfo
    global raiselower
    global group itemgroup
    global cur_layer layer_id

    foreach id $s_id {
	if {[info exists itemgroup($id)]} {
	    foreach gname $itemgroup($id) {
		foreach gid $group($gname) {
		    if {[lsearch $cur_id $gid]==-1 && [lsearch $s_id $gid]==-1} {
			lappend s_id $gid
		    }
		}
	    }
	}
    }
    foreach id $s_id {
	if {[lsearch $cur_id $id]!=-1} {
	    continue
	}
	if {$layer_id($id)!=$cur_layer} {
	    continue
	}
	
	#.c raise $id
	set coord [getLineCoord $id]
	foreach g_id $gradation_id($id) {
	    #.c raise $g_id
	}
	set i 0
	foreach {x y} $coord {
	    set col_o blue
	    if {[lsearch $nod_dupinfo($id) $i]==-1} {
		set col_f blue
	    } else {
		set col_f orange
	    }
	    set n_id [.c create rectangle \
		    [expr $x-3] [expr $y-3] \
		    [expr $x+3] [expr $y+3] \
		    -outline $col_o -fill $col_f -width 2]
	    lappend selectnod_id($id) $n_id
	    set selectnod($n_id) $id
	    incr i
	}
	#set raiselower lower
	lappend cur_id $id
    }
}

proc selectItemAll {} {
    global cur_mode cur_id cur_bbox
    global selectnod selectnod_id
    global gradation gradation_id
    global width height

    set cur_bbox "0 0"
    foreach id [.c find all] {
	if {[info exists gradation_id($id)]} {
	    selectItem id
	}
    }
    set cur_mode "select"
}

proc unselectItem {{unselect_id}} {
    upvar $unselect_id u_id
    global cur_id
    global selectnod selectnod_id

    foreach id $u_id {
	if {![info exists selectnod_id($id)]} {
	    continue
	}
        foreach n_id $selectnod_id($id) {
	    .c delete $n_id
	    unset selectnod($n_id) 
	}
	unset selectnod_id($id)
	set n [lsearch $cur_id $id]
	if {$n>-1} {
	    set cur_id [lreplace $cur_id $n $n]
	}
    }
}

proc unselectItemAll {} {
    global cur_id cur_bbox
    global selectnod selectnod_id
    
    set u_id [array names selectnod_id]
    unselectItem u_id
    set cur_id ""
    set cur_bbox ""
}

proc moveItem {{sx} {sy} {move_id}} {
    upvar $move_id m_id
    global selectnod_id
    global gradation_id
    global cur_editedp
    global canvas_grid cur_zoom

    if {$m_id!=""} {
	set cur_editedp 1
    }
    foreach id $m_id {
	.c move $id $sx $sy
	foreach g_id $gradation_id($id) {
	    .c move $g_id $sx $sy
	    #.c raise $g_id
	}
	foreach n_id $selectnod_id($id) {
	    .c move $n_id $sx $sy
	    #.c raise $n_id
	}
    }
}

proc deleteItem {{d_id}} {
    global selectnod selectnod_id
    global gradation gradation_id
    global nod_dupinfo
    global cur_id cur_bbox
    global cur_editedp
    global cur_layer layer_id

    if {$d_id!=""} {
	set cur_editedp 1
    }
    unselectItem d_id
    foreach id $d_id {
	foreach g_id $gradation_id($id) {
	    .c delete $g_id
	    unset gradation($g_id)
	}
	unset gradation_id($id)
	unset layer_id($id)
	unset nod_dupinfo($id)
	.c delete $id
    }
    set cur_bbox ""
}

proc deleteItemAll {} {
    global cur_id

    selectItemAll; deleteItem $cur_id
}

proc deleteItemAll_old {} {
    global cur_mode cur_id cur_bbox
    global selectnod selectnod_id
    global gradation gradation_id
    global width height

    foreach id [.c find all] {
	if {[array names gradation $id]!="" ||
	    [array names selectnod $id]!=""} {
	    continue
	}
	deleteItem $id
    }
}

proc makeOptString {{w} {id} {opt}} {
    set val [$w itemcget $id $opt]
    if {"$val"!=""} {
	return "$opt $val"
    } else {
	return ""
    }
}

proc setCurrentInfo {{fname} {title} {creator} {createdate}} {
    global cur_filename cur_filetitle cur_creator cur_createdate
    
    set cur_filename $fname
    set cur_filetitle $title
    set cur_creator $creator
    set cur_createdate $createdate
}

proc editCurrentInfo {} {
    global cur_filename cur_filetitle cur_creator cur_createdate
    
    set t .eci
    toplevel $t
    wm title $t "tkduke: Current Info Editor"
    label $t.lfn -text "File Name" -justify right
    entry $t.fn  
    label $t.lft -text "Title" -justify right
    entry $t.ft  -width 40
    label $t.lcr -text "Creator" -justify right
    entry $t.cr  
    label $t.lcd -text "Create Date" -justify right
    entry $t.cd  

    $t.fn insert 0 $cur_filename
    $t.ft insert 0 $cur_filetitle
    $t.cr insert 0 $cur_creator
    $t.cd insert 0 $cur_createdate
    
    frame $t.f

    button $t.f.ok -text "OK" -command "setCurrentInfo \[$t.fn get\] \[$t.ft get\] \[$t.cr get\] \[$t.cd get\]
destroy $t
wm title . \"tkduke: \$cur_filename\"
"
    button $t.f.cancel -text "Cancel" -command "destroy $t"
    grid $t.lfn -column 0 -row 0 -sticky nes
    grid $t.fn -column 1 -row 0 -sticky news
    grid $t.lft -column 0 -row 1 -sticky nes
    grid $t.ft -column 1 -row 1 -sticky news
    grid $t.lcr -column 0 -row 2 -sticky nes
    grid $t.cr -column 1 -row 2 -sticky news
    grid $t.lcd -column 0 -row 3 -sticky nes
    grid $t.cd -column 1 -row 3 -sticky news
    grid $t.f.ok $t.f.cancel
    grid $t.f -columnspan 2
    bind $t <Key-Return> "setCurrentInfo \[$t.fn get\] \[$t.ft get\] \[$t.cr get\] \[$t.cd get\]
destroy $t
wm title . \"tkduke: \$cur_filename\"
"
    bind $t <Control-s> "setCurrentInfo \[$t.fn get\] \[$t.ft get\] \[$t.cr get\] \[$t.cd get\]
destroy $t
wm title . \"tkduke: \$cur_filename\"
"
    bind $t <Control-q> "destroy $t"

}

proc saveItem {fname} {
    global itemType
    global cur_mode cur_id cur_bbox
    global cur_filename cur_printname 
    global cur_filetitle cur_creator cur_createdate
    global cur_editedp cur_zoom
    global cur_paporient
    global cur_layer layer_id
    global selectnod selectnod_id
    global gradation gradation_id
    global nod_dupinfo
    global fontsizeId
    global itemgroup
    global width height
    global cur_editedp cur_backupedp
    global cur_saving
    global cur_savepreview
    global cur_gridshow
    global imageFileMap

    if {![regexp {\.mmp$} $fname]} {append fname ".mmp"}

    . configure -cursor watch
    update idletasks
    if {$cur_saving==1} {return}
    set cur_saving 1
    set gif_preview ""
    if {$cur_savepreview} {set gif_preview [getCanvasSnapshot .c]}
    set cur_bbox "0 0"
    set tmp_id ""
    foreach id [.c find all] {
	if {[lsearch [.c gettags $id] "grid"]!=-1} {
	    continue
	} elseif {[info exists gradation_id($id)]} {
	    lappend tmp_id $id
	}
    }
    if {!$cur_backupedp && $cur_filename!="" && [file exists $cur_filename]} {
	set f [glob $cur_filename]
	file rename -force $f $f.bak
	set cur_backupedp 1
    }
    set fid [open $fname w]
    set layer $cur_layer
    puts $fid "#!/usr/local/bin/tkduke"
    puts $fid ""
    puts $fid "# "
    puts $fid "# [basename $cur_filename]: $cur_filetitle"
    puts $fid "# "
    puts $fid "#     \[$cur_createdate\] $cur_creator"
    puts $fid "# "
    if {$cur_savepreview} {
	if {$gif_preview!=""} {
	    puts $fid ""
	    puts $fid "# preview: image/gif; base64"
	    foreach l $gif_preview {
		puts $fid "# $l"
	    }
	}
    }
    puts $fid ""
    puts $fid "title $cur_filetitle"
    puts $fid "creator $cur_creator"
    puts $fid "createdate $cur_createdate"
    puts $fid ""
    puts $fid "orient $cur_paporient"
    puts $fid "zoom $cur_zoom"
    puts $fid "layer $layer"
    foreach id $tmp_id {
	if {$layer_id($id)!=$layer} {
	    set layer $layer_id($id)
	    puts $fid "layer $layer"
	}
       if {[info exists itemgroup($id)] && $itemgroup($id)!=""} {
           puts $fid "#group $itemgroup($id)"
       }
	puts -nonewline $fid "$itemType($id) "
	switch -regexp $itemType($id) {
	    "^(text)$" {
		set str [.c itemcget $id -text]
		regsub -all "\n" $str "\\\n" str
		puts -nonewline $fid "\{$str\} "
	    }
	    "^(arrow)$" {
		set arrow [.c itemcget $id -arrow]
		puts -nonewline $fid "\{$arrow\} "
	    }
	}
	set opt ""
	switch -regexp -- $itemType($id) {
	    "^(arrow|line|pline)$" {
		set smooth [get_smooth .c $id]
		if {$smooth} {append opt " -smooth 1"}
		append opt " [makeOptString .c $id -width]"
		append opt " [makeOptString .c $id -capstyle]"
	    }
	    "^rod$" {
		set smooth [.c itemcget $id -smooth]
		if {$smooth} {append opt " -smooth 1"}
		append opt " [makeOptString .c [lindex $gradation_id($id) 0] -width]"
		puts $opt
	    }
	    "^(poly)$" {
		set smooth [get_smooth .c $id]
		if {$smooth} {append opt " -smooth 1"}
		append opt " [makeOptString .c $id -width]"
		append opt " [makeOptString .c $id -outline]"
	    }
	    "^(rect|circle)$" {
		append opt " [makeOptString .c $id -width]"
		append opt " [makeOptString .c $id -outline]"
	    }
	    "^(oval|orect|obox|box)$" {
		append opt " [makeOptString .c $id -width]"
		append opt " [makeOptString .c $id -fill]"
	    }
	    "^(text)$" {
		set tmp_font " [makeOptString .c $id -font]"
		regsub -- "-\[0-9\]+\$" [makeOptString .c $id -font] "-$fontsizeId($id)" tmp_font
		append opt " $tmp_font"
		append opt " [makeOptString .c $id -anchor]"
		append opt " [makeOptString .c $id -justify]"
	    }
	}
	if {$itemType($id)!="image"} {
	    append opt " [makeOptString .c $id -stipple]"
	    puts -nonewline $fid "\{[.c itemcget $id -fill]\}$opt "
	} else {
	    puts -nonewline $fid "\{$imageFileMap([.c itemcget $id -image])\}$opt "
	}
	set coord ""
	set coord_tmp [getLineCoord $id]
	set i 0
	foreach {x y} $coord_tmp {
	    set x [format "%.2f" [expr 1.0*$x/$cur_zoom]]
	    set y [format "%.2f" [expr 1.0*$y/$cur_zoom]]
	    regsub {\.00} $x "" x
	    regsub {\.00} $y "" y
	    if {[lsearch -exact $nod_dupinfo($id) $i]!=-1} {
		lappend coord $x $y
	    }
	    lappend coord $x $y
	    incr i
	}
	puts $fid $coord
    }
    puts $fid "#"
    puts $fid "# end of mmp file."
    close $fid
    set cur_filename $fname
    regsub ".mmp$" [file tail $cur_filename] "" cur_printname
    append cur_printname ".eps"
    wm title . "tkduke: $cur_filename"
    wm iconname . "$cur_filename"
    set cur_editedp 0
    set cur_saving 0
    . configure -cursor left_ptr
    update idletasks
}

############################################################
#
proc toggleOrient {} {
    global width height cur_paporient cur_zoom
    set tmp $width
    set width $height
    set height $tmp
    if {$cur_paporient=="landscape" || $cur_paporient=="horizontal"} {
	set cur_paporient "portrait"
    } elseif {$cur_paporient=="portrait" || $cur_paporient=="vertical"} {
	set cur_paporient "landscape"
    } else {
	set cur_paporient "landscape"
    }
    changeZoom $cur_zoom
}

proc toggleSmoothItem {{t_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

#puts toggleSmoothIterm
    if {$t_id!=""} {
	set cur_editedp 1
#puts toggleSmoothIterm:0
    } elseif {0} {
	switch $cur_smooth {
	    "0"     {set cur_smooth "1"}
	    "1"     {set cur_smooth "0"}
	    default {set cur_smooth "1"}
	}
#puts toggleSmoothIterm:1
#	return
    }
    foreach id $t_id {
	switch -regexp -- $itemType($id) {
	    "^(arrow|line|pline|poly)$"   {
		set type [get_smooth .c $id]
		switch $type {
		    "0"     {set type "1"}
		    "1"     {set type "0"}
		    default {set type "1"}
		}
		.c itemconfigure $id -smooth $type
	    }
	    default  {}
	}
    }
}

proc toggleArrowItem {{t_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$t_id!=""} {
	set cur_editedp 1
    } else {
	switch $cur_arrow {
	    "first" {set cur_arrow "last"}
	    "last"  {set cur_arrow "both"}
	    "both"  {set cur_arrow "first"}
	    default {set cur_arrow "first"}
	}
	return
    }
    foreach id $t_id {
	set itype $itemType($id)
	switch -regexp -- $itype {
	    "^(arrow|line|pline)$"   {
		set type [.c itemcget $id -arrow]
		switch $type {
		    "first" {set itype "arrow"; set type "last"}
		    "last"  {set itype "arrow"; set type "both"}
		    "both"  {set itype "line"; set type "none"}
		    "none"  {set itype "arrow"; set type "first"}
		    default {set itype "arrow"; set type "first"}
		}
		.c itemconfigure $id -arrow $type
	    }
	    default  {}
	}
	set itemType($id) $itype
    }
}

proc toggleTextJustify {{t_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global cur_textjustify
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$t_id==""} {
	set type $cur_textjustify
	switch $type {
	    "center" {set type "left"}
	    "left"   {set type "right"}
	    "right"  {set type "center"}
	    default  {set type "center"}
	}
	set cur_textjustify $type
	return
    }
    set cur_editedp 1
    foreach id $t_id {
	switch -regexp -- $itemType($id) {
	    "^(text)$"   {
		set type [.c itemcget $id -justify]
		switch $type {
		    "center" {set type "left"}
		    "left"   {set type "right"}
		    "right"  {set type "center"}
		    default  {set type "center"}
		}
		.c itemconfigure $id -justify $type
	    }
	    default  {}
	}
    }
}

proc toggleTextAnchor {{t_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global cur_textanchor
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$t_id==""} {
	set type $cur_textanchor
	switch $type {
	    "se" {set type "s"}
	    "s" {set type "sw"}
	    "sw" {set type "e"}
	    "e" {set type "center"}
	    "center" {set type "w"}
	    "w" {set type "ne"}
	    "ne" {set type "n"}
	    "n" {set type "nw"}
	    "nw" {set type "se"}
	    default  {set type "center"}
	}
	set cur_textanchor $type
	return
    }
    set cur_editedp 1
    foreach id $t_id {
	switch -regexp -- $itemType($id) {
	    "^(text)$"   {
		set type [.c itemcget $id -anchor]
		switch $type {
		    "se" {set type "s"}
		    "s" {set type "sw"}
		    "sw" {set type "e"}
		    "e" {set type "center"}
		    "center" {set type "w"}
		    "w" {set type "ne"}
		    "ne" {set type "n"}
		    "n" {set type "nw"}
		    "nw" {set type "se"}
		    default  {set type "center"}
		}
		.c itemconfigure $id -anchor $type
	    }
	    default  {}
	}
    }
}

proc makeFrame {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id $c_id
    unselectItem c_id
    set padx 8
    set pady 8
    if {[llength $c_id]>1} {
	sets {x0 y0 x1 y1} [eval .c bbox $c_id]
	incr x0 -$padx
	incr y0 -$pady
	incr x1  $padx
	incr y1  $pady
	lappend tmp_id [makeItem "rect" [list $x0 $y0 $x1 $y1]]
    } else {
	set id $c_id
	set type $itemType($id)
	sets {x0 y0 x1 y1} [.c bbox $id]
	if {$type=="box" || $type=="boxx" || $type=="obox"} {
	} else {
	    incr x0 -$padx
	    incr y0 -$pady
	    incr x1  $padx
	    incr y1  $pady
	}
	lappend tmp_id [makeItem "rect" [list $x0 $y0 $x1 $y1]]
    }
    selectItem tmp_id
}

proc makeShadow {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id $c_id
    unselectItem c_id
    set padx 8
    set pady 8
    set sx 8
    set sy 8
    if {[llength $c_id]>1} {
	sets {x0 y0 x1 y1} [eval .c bbox $c_id]
	incr x0 -$padx
	incr y0 -$pady
	incr x1  $padx
	incr y1  $pady
	lappend tmp_id [makeItem "box" [list $x1 [expr $y0+$sy] [expr $x1+$sx] [expr $y1+$sy]]]
	lappend tmp_id [makeItem "box" [list [expr $x0+$sx] $y1 [expr $x1+$sx] [expr $y1+$sy]]]
	lappend tmp_id [makeItem "rect" [list $x0 $y0 $x1 $y1]]
    } else {
	set id $c_id
	set type $itemType($id)
	sets {x0 y0 x1 y1} [.c bbox $id]
	if {$type=="box" || $type=="boxx"  || $type=="obox"} {
	} else {
	    incr x0 -$padx
	    incr y0 -$pady
	    incr x1  $padx
	    incr y1  $pady
	}
	lappend tmp_id [makeItem "box" [list $x1 [expr $y0+$sy] [expr $x1+$sx] [expr $y1+$sy]]]
	lappend tmp_id [makeItem "box" [list [expr $x0+$sx] $y1 [expr $x1+$sx] [expr $y1+$sy]]]
	lappend tmp_id [makeItem "rect" [list $x0 $y0 $x1 $y1]]
    }
    selectItem tmp_id
}

proc makeBrace {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id $c_id
    unselectItem c_id
    set padx 9
    set pady 9
    set w 10
    if {[llength $c_id]>1} {
	sets {x0 y0 x1 y1} [eval .c bbox $c_id]
	incr x0 -$padx
	incr y0 -$pady
	incr x1  $padx
	incr y1  $pady
    } else {
	set id $c_id
	set type $itemType($id)
	sets {x0 y0 x1 y1} [.c bbox $id]
	if {$type=="box" || $type=="boxx" || $type=="obox"} {
	} else {
	    incr x0 -$padx
	    incr y0 -$pady
	    incr x1  $padx
	    incr y1  $pady
	}
    }
    lappend tmp_id [makeItem "pline" \
	    [list [expr $x0+$w] $y0 $x0 $y0 $x0 $y1 [expr $x0+$w] $y1]]
    lappend tmp_id [makeItem "pline" \
	    [list [expr $x1-$w] $y0 $x1 $y0 $x1 $y1 [expr $x1-$w] $y1]]
    selectItem tmp_id
}

proc copyItem {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global font fontsizeId
    global nod_dupinfo
    global imageFileMap
    global cur_editedp
    global canvas_grid grid_unit cur_zoom
    global group itemgroup cur_group_id

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id {}
    if {$canvas_grid==0} {
	set grid $cur_zoom
    } else {
	set grid [expr ($canvas_grid*$grid_unit)*$cur_zoom]
    }
    if {$grid>0} {
	set sx [expr int(15/$grid)*$grid]
	set sy [expr int(10/$grid)*$grid]
	if {$sx==0} {set sx $grid}
	if {$sy==0} {set sy $grid}
    } else {
	set sx [expr int(15/$cur_zoom)*cur_zoom]
	set sy [expr int(10/$cur_zoom)*cur_zoom]
    }
    unselectItem c_id
    set copy_g() ""
    set gmap() ""
    foreach id $c_id {
	set t_id ""
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		set tmp [.c itemcget $id -text]
		.text.e delete 0.0 end
		.text.e insert 0.0 $tmp
		sets {x y} [.c coord $id]
		set facesize [.c itemcget $id -font]
		set face "gh"
		if {[regexp "^Gothic:Helvetica-Bold-(\[0-9\]+)" \
			$facesize null size]} {
		    set face "gh"
		} elseif {[regexp "^Mincho:Times-Roman-(\[0-9\]+)" \
			$facesize null size]} {
		    set face "mt"
		}
		set size $fontsizeId($id)
		if {[info exists font($face:$size)]==0} {loadFont $size $face}
		set t_id [makeItem $itemType($id) \
			-anchor [.c itemcget $id -anchor] \
			-justify [.c itemcget $id -justify] \
			-fill [.c itemcget $id -fill] \
			-font $font($face:$size) \
			[list [expr $x+$sx] [expr $y+$sy]]]
	    }
	    "^(rect|box|obox|boxx|circle|oval|sphere|pixel)$"   {
		sets {x y x0 y0} [getLineCoord $id]
		set x  [expr $x+$sx]
		set y  [expr $y+$sy]
		set x0 [expr $x0+$sx]
		set y0 [expr $y0+$sy]
		set t_id [makeItem $itemType($id) \
			-fill [.c itemcget $id -fill] \
			-outline [.c itemcget $id -outline] \
			-width [.c itemcget $id -width] \
			[list $x $y $x0 $y0]]
	    }
	    "^(orect)$"   {
		sets {x y x0 y0} [getLineCoord $id]
		set x  [expr $x+$sx]
		set y  [expr $y+$sy]
		set x0 [expr $x0+$sx]
		set y0 [expr $y0+$sy]
		set t_id [makeItem $itemType($id) \
			-fill [.c itemcget $id -fill] \
			-width [.c itemcget $id -width] \
			[list $x $y $x0 $y0]]
	    }
	    "^(arrow|line|rod)$"   {
		set coord [.c coord $id]
		sets {x0 y0} $coord
		set x0  [expr $x0+$sx]
		set y0  [expr $y0+$sy]
		set c_coord "$x0 $y0"
		foreach {x y} [lrange $coord 2 end] {
		    set x [expr $x+$sx]
		    set y [expr $y+$sy]
		    append c_coord " $x $y"
		}
		set t_id [makeItem $itemType($id) \
			-smooth [get_smooth .c $id] \
			-arrow [.c itemcget $id -arrow] \
			-fill [.c itemcget $id -fill] \
			-width [.c itemcget $id -width] \
			-capstyle [.c itemcget $id -capstyle] \
			$c_coord]
	    }
	    "^(pline)$"   {
		set coord [.c coord $id]
		set c_coord ""
		foreach {x y} $coord {
		    set x [expr $x+$sx]
		    set y [expr $y+$sy]
		    append c_coord " $x $y"
		}
		set t_id [makeItem $itemType($id) \
			-smooth [get_smooth .c $id] \
			-arrow [.c itemcget $id -arrow] \
			-fill [.c itemcget $id -fill] \
			-width [.c itemcget $id -width] \
			-capstyle [.c itemcget $id -capstyle] \
			$c_coord]
	    }
	    "^(poly)$"   {
		set coord [.c coord $id]
		set c_coord ""
		foreach {x y} $coord {
		    set x [expr $x+$sx]
		    set y [expr $y+$sy]
		    append c_coord " $x $y"
		}
		set t_id [makeItem $itemType($id) \
			-smooth [get_smooth .c $id] \
			-fill [.c itemcget $id -fill] \
			-width [.c itemcget $id -width] \
			$c_coord]
	    }
	    "^(image)$"   {
		sets {x y} [.c coord $id]
		set t_id [makeItem $itemType($id) -file $imageFileMap([.c itemcget $id -image]) [expr $x+$sx] [expr $y+$sy]]
	    }
	    default  {}
	}
	if {$t_id!=""} {
	    if {[info exists itemgroup($id)]} {
		foreach g $itemgroup($id) {
		    if {![info exists gmap($g)]} {
			set gname "g$cur_group_id"
			set gmap($g) $gname
			set group($gname) ""
			incr cur_group_id
		    } else {
			set gname $gmap($g)
		    }
		    lappend group($gname) $t_id
		    lappend itemgroup($t_id) $gname
		}
	    }
	    lappend tmp_id $t_id
	}
    }
    selectItem tmp_id
}

proc propdist_sort {a b} {
    set ax [lindex $a 1]
    set ay [lindex $a 2]
    set bx [lindex $b 1]
    set by [lindex $b 2]
    return [expr (sqrt($ax*$ax+$ay*$ay)>sqrt($bx*$bx+$by*$by))]
}

proc propdistItem {{prop_id}} {
    upvar $prop_id p_id
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global imageFileMap
    global cur_editedp
    global canvas_grid cur_zoom
    global group itemgroup cur_group_id

    set p_list ""
    set num [llength $p_id]
    if {$num<=1} {return}
    foreach id $p_id {
	sets {xx yy n} {0 0 0}
	foreach {x y} [.c coord $id] {
	    set xx [expr $xx+$x]
	    set yy [expr $yy+$y]
	    incr n
	}
	set xx [expr $xx/$n]
	set yy [expr $yy/$n]
	lappend p_list "$id $xx $yy"
    }
    set p_list [lsort -command propdist_sort $p_list]
    set x0 [lindex [lindex $p_list 0] 1]
    set y0 [lindex [lindex $p_list 0] 2]
    set xn [lindex [lindex $p_list end] 1]
    set yn [lindex [lindex $p_list end] 2]
    set sx [expr 1.0*($xn-$x0)/($num-1)]
    set sy [expr 1.0*($yn-$y0)/($num-1)]
    for {set i 1} {$i<$num-1} {incr i} {
	sets {id x y} [lindex $p_list $i]
	moveItem [expr $x0+$sx*$i-$x] [expr $y0+$sy*$i-$y] id
    }
}

proc flipHorizontalItem {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id {}
    unselectItem c_id
    set bbox_all [eval .c bbox $c_id]
    set xx [expr [lindex $bbox_all 0]+[lindex $bbox_all 2]]
    foreach id $c_id {
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		sets {x y} [.c coord $id]
		set x  [expr $xx-$x]
		.c coord $id $x $y
	    }
	    "^(rect|circle|pixel)$" {
		sets {x y x0 y0} [.c coord $id]
		set x  [expr $xx-$x]
		set x0 [expr $xx-$x0]
		.c coord $id $x $y $x0 $y0
	    }
	    "^(box|boxx|oval|sphere|rod)$"    {
		sets {x y x0 y0} [.c coord $id]
		set x  [expr $xx-$x]
		set x0 [expr $xx-$x0]
		.c coord $id $x $y $x0 $y0
		resizeItem id
	    }
	    "^(arrow|line|pline|poly|obox|orect)$"   {
		set coord [.c coord $id]
		set f_coord ""
		foreach {x y} $coord {
		    set x  [expr $xx-$x]
		    append f_coord " $x $y"
		}
		eval .c coord $id $f_coord
	    }
	    default  {}
	}
    }
    selectItem c_id
}

proc flipVerticalItem {{c_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$c_id==""} {return}
    set cur_editedp 1
    set tmp_id {}
    unselectItem c_id
    set bbox_all [eval .c bbox $c_id]
    set yy [expr [lindex $bbox_all 1]+[lindex $bbox_all 3]]
    foreach id $c_id {
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		sets {x y} [.c coord $id]
		set y  [expr $yy-$y]
		.c coord $id $x $y
	    }
	    "^(rect|circle|pixel)$"   {
		sets {x y x0 y0} [.c coord $id]
		set y  [expr $yy-$y]
		set y0 [expr $yy-$y0]
		.c coord $id $x $y $x0 $y0
	    }
	    "^(box|boxx|oval|sphere|rod)$"    {
		sets {x y x0 y0} [.c coord $id]
		set y  [expr $yy-$y]
		set y0 [expr $yy-$y0]
		.c coord $id $x $y $x0 $y0
		resizeItem id
	    }
	    "^(arrow|line|pline|poly|obox|orect)$"   {
		set coord [.c coord $id]
		set f_coord ""
		foreach {x y} $coord {
		    set y  [expr $yy-$y]
		    append f_coord " $x $y"
		}
		eval .c coord $id $f_coord
	    }
	    default  {}
	}
    }
    selectItem c_id
}

proc scaleSizeItem {{ratio} {s_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global cur_scaleratio
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$s_id==""} {return}
    if {$ratio=={}} {
	set ratio [getValue "Scale Ratio \[X:Y\] or Scale" $cur_scaleratio]
	if {$ratio=={}} {return}
	set cur_scaleratio $ratio
    }
    sets {ratio_x ratio_y} [split $ratio ":"]
    if {$ratio_y==""} {set ratio_y $ratio_x}
    set cur_editedp 1
    set tmp_id {}
    unselectItem s_id
    set bbox_all [eval .c bbox $s_id]
    set xc  [expr ([lindex $bbox_all 0]+[lindex $bbox_all 2])/2.0]
    set yc  [expr ([lindex $bbox_all 1]+[lindex $bbox_all 3])/2.0]
    set xcr [expr (1-$ratio_x)*$xc]
    set ycr [expr (1-$ratio_y)*$yc]
    foreach id $s_id {
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		sets {x y} [.c coord $id]
		set x  [expr $ratio_x*$x+$xcr]
		set y  [expr $ratio_y*$y+$ycr]
		.c coord $id $x $y
	    }
	    "^(rect|circle|pixel|box|boxx|oval|sphere|rod)$"   {
		sets {x y x0 y0} [.c coord $id]
		set x  [expr $ratio_x*$x+$xcr]
		set y  [expr $ratio_y*$y+$ycr]
		set x0 [expr $ratio_x*$x0+$xcr]
		set y0 [expr $ratio_y*$y0+$ycr]
		.c coord $id $x $y $x0 $y0
		resizeItem id
	    }
	    "^(arrow|line|pline|poly|obox|orect)$"   {
		set coord [.c coord $id]
		set f_coord ""
		foreach {x y} $coord {
		    set x  [expr $ratio_x*$x+$xcr]
		    set y  [expr $ratio_y*$y+$ycr]
		    append f_coord " $x $y"
		}
		eval .c coord $id $f_coord
	    }
	    "^(image)$" {
		set tmpfile "/tmp/tmp_tkduke[pid].ppm"
		set tmpfile2 "/tmp/tmp_tkduke[pid]a.ppm"
		set img_id [lindex [.c itemconfigure $id -image] end] 
		$img_id write $tmpfile -format ppm
		catch [list exec pnmscale -xscale $ratio_x -yscale $ratio_y $tmpfile > $tmpfile2]
		$img_id blank
		$img_id configure -width 1 -height 1
		$img_id configure -width 0 -height 0
		$img_id read $tmpfile2 -format ppm
		file delete $tmpfile $tmpfile2
	    }
	    default  {}
	}
    }
    selectItem s_id
}

proc rotateItem {{angle} {s_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global cur_rotateangle
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp
    global m_pi

    if {$s_id==""} {return}
    if {$angle=={}} {
	set angle [getValue "Rotate Angle" $cur_rotateangle]
	if {$angle=={}} {return}
	set cur_rotateangle $angle
    }
    set cur_editedp 1
    set tmp_id {}
    unselectItem s_id
    set bbox_all [eval .c bbox $s_id]
    set xc [expr ([lindex $bbox_all 0]+[lindex $bbox_all 2])/2.0]
    set yc [expr ([lindex $bbox_all 1]+[lindex $bbox_all 3])/2.0]
    set angle [expr -$angle*$m_pi/180]
    set ca [expr cos($angle)]
    set sa [expr sin($angle)]
    foreach id $s_id {
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		sets {x y} [.c coord $id]
		set xx  [expr $ca*($x-$xc)-$sa*($y-$yc)+$xc]
		set yy  [expr $sa*($x-$xc)+$ca*($y-$yc)+$yc]
		.c coord $id $xx $yy
	    }
	    "^(rect|circle|pixel|box|boxx|oval|sphere|rod)$"   {
		sets {x y x0 y0} [.c coord $id]
		set xx  [expr $ca*($x-$xc)-$sa*($y-$yc)+$xc]
		set yy  [expr $sa*($x-$xc)+$ca*($y-$yc)+$yc]
		set xx0  [expr $ca*($x0-$xc)-$sa*($y0-$yc)+$xc]
		set yy0  [expr $sa*($x0-$xc)+$ca*($y0-$yc)+$yc]
		.c coord $id $xx $yy $xx0 $yy0
		resizeItem id
	    }
	    "^(arrow|line|pline|poly|obox|orect)$"   {
		set coord [.c coord $id]
		set f_coord ""
		foreach {x y} $coord {
		    set xx  [expr $ca*($x-$xc)-$sa*($y-$yc)+$xc]
		    set yy  [expr $sa*($x-$xc)+$ca*($y-$yc)+$yc]
		    append f_coord " $xx $yy"
		}
		eval .c coord $id $f_coord
	    }
	    default  {}
	}
    }
    selectItem s_id
}

proc shearItem {{xshift} {s_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod
    global cur_shearxshift
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp
    global m_pi

    if {$s_id==""} {return}
    if {$xshift=={}} {
	set xshift [getValue "Rotate Angle" $cur_shearxshift]
	if {$xshift=={}} {return}
	set cur_shearxshift $xshift
    }
    set cur_editedp 1
    set tmp_id {}
    unselectItem s_id
    sets {x0 y0 x1 y1} [eval .c bbox $s_id]
    set ratio [expr 1.0*$xshift/($y0-$y1)]
    foreach id $s_id {
	switch -regexp $itemType($id) {
	    "^(text)$"   {
		sets {x y} [.c coord $id]
		set xx [expr $x+($y-$y1)*$ratio]
		set yy $y
		.c coord $id $xx $yy
	    }
	    "^(rect|circle|pixel|box|boxx|oval|sphere|rod)$"   {
		sets {x y xa ya} [.c coord $id]
		set xx [expr $x+($y-$y1)*$ratio]
		set yy $y
		set xxa [expr $xa+($ya-$y1)*$ratio]
		set yya $ya
		.c coord $id $xx $yy $xxa $yya
		resizeItem id
	    }
	    "^(arrow|line|pline|poly|obox|orect)$"   {
		set coord [.c coord $id]
		set f_coord ""
		foreach {x y} $coord {
		    set xx [expr $x+($y-$y1)*$ratio]
		    set yy $y
		    append f_coord " $xx $yy"
		}
		eval .c coord $id $f_coord
	    }
	    default  {}
	}
    }
    selectItem s_id
}

proc setGrid_getValue {string {init ""}} {
    global prompt

    set f [toplevel .prompt -borderwidth 10]
    message $f.msg -text $string -width 300
    entry $f.entry -textvariable prompt(result) -width 5
    if {$init!=""} {$f.entry delete 0 end; $f.entry insert 0 $init}
    menubutton $f.sel -text "Sel" -relief raised
    menu $f.sel.m 
    foreach v {0 1 2 5 10 20} {
	$f.sel.m add command -label $v -command "$f.entry delete 0 end; $f.entry insert 0 $v"
    }
    set b [frame $f.buttons -bd 10]
    $f.sel configure -menu $f.sel.m
    button $f.inc -text "+" \
	    -command "set tmp_v \[expr \[$f.entry get\]+1\]; $f.entry delete 0 end; $f.entry insert 0 \$tmp_v"
    button $f.dec -text "-" \
	    -command "set tmp_v \[expr \[$f.entry get\]-1\]; $f.entry delete 0 end; $f.entry insert 0 \$tmp_v"
    grid $f.msg -columnspan 4
    grid $f.entry $f.inc $f.dec $f.sel
    grid $f.buttons -sticky ew -columnspan 4
    button $b.ok -text OK \
	    -command {set prompt(ok) 1} -underline 0
    button $b.cancel -text Cancel \
	    -command {set prompt(ok) 0} -underline 0
    grid $b.ok $b.cancel

    # ¥Ð¥¤¥ó¥É¤òÀßÄê¤¹¤ë
    foreach w [list $f.entry $b.ok $b.cancel] {
	bindtags $w [list .prompt [winfo class $w] $w all]
    }
    bind .prompt <Alt-o> "focus $b.ok; break"
    bind .prompt <Alt-c> "focus $b.cancel; break"
    bind .prompt <Alt-Key> break
    bind .prompt <Return> {set prompt(ok) 1}
    bind .prompt <Control-c> {set prompt(ok) 0}
    bind .prompt <Control-q> {set prompt(ok) 0}
    bind .prompt <Key-Escape> {set prompt(ok) 0}
    
    focus $f.entry
    grab $f
    tkwait variable prompt(ok)
    grab release $f
    destroy $f
    if {$prompt(ok)} {
	return $prompt(result)
    } else {
	return {}
    }
}

proc setGrid {{grid ""}} {
    global canvas_grid cur_gridshow

    if {$grid=={}} {
	set grid [setGrid_getValue "Canvas Grid" $canvas_grid]
	if {$grid<0 || $grid=={}} {return}
    }
    set canvas_grid $grid
    if {$cur_gridshow} {makeGridLine}
}

proc makeGridLine {} {
    global canvas_grid grid_unit cur_zoom cur_gridshow
    global width height

    .c delete grid
    if {!$cur_gridshow} {return}
    set grid $canvas_grid
    sets {w h} [list [expr $width*$cur_zoom] [expr $height*$cur_zoom]]
    switch $grid {
	0 {set grid 5}
	1 {set grid 5}
	2 {set grid 8}
	3 {set grid 6}
	4 {set grid 8}
    }
    set grid [expr $grid*$grid_unit]
    set i 0
    for {set x 0} {$x<$width} {set x [expr $x+$grid]} {
	if {[expr fmod($i, 5)]==0} {set col gray80} else {set col gray90}
	.c lower [.c create line [expr $x*$cur_zoom] 0 [expr $x*$cur_zoom] $h \
		-fill $col -tag grid]
	incr i
    }
    set i 0
    for {set y 0} {$y<$height} {set y [expr $y+$grid]} {
	if {[expr fmod($i, 5)]==0} {set col gray80} else {set col gray90}
	.c lower [.c create line 0 [expr $y*$cur_zoom] $w [expr $y*$cur_zoom] \
		-fill $col -tag grid]
	incr i
    }
}

proc toggleClosePline {{p_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$p_id==""} {return}
    set cur_editedp 1
    foreach id $p_id {
	switch -regexp -- $itemType($id) {
	    "^(arrow|line|pline)$"   {
		set coord [.c coord $id]
		set n [llength $coord]
		if {$n<3} {continue}
		sets {x0 y0} $coord
		set x1 [lindex $coord [expr $n-2]]
		set y1 [lindex $coord [expr $n-1]]
		if {$x0!=$x1 && $y0!=$y1} {
		    eval .c coord $id $coord $x0 $y0
		} else {
		    eval .c coord $id [lrange $coord 0 [expr $n-3]]
		}
	    }
	    default  {}
	}
    }
}

proc toggleItem {{p_id}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow cur_col
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$p_id==""} {return}
    set cur_editedp 1
    set td_id ""
    unselectItem p_id
    set tmp_col $cur_col
    foreach id $p_id {
	set type ""
	set smooth ""
	switch -- $itemType($id) {
	    "rect"   {set type "orect" }
	    "orect"  {set type "box"   }
	    "box"    {set type "obox"  }
	    "obox"   {set type "boxx"  }
	    "boxx"   {set type "circle"}
	    "circle" {set type "oval"  }
	    "oval"   {set type "sphere"}
	    "sphere" {set type "rect"  }
	    "arrow"  {
		set smooth  [get_smooth .c $id]
		set type "line"
	    }
	    "line"   {
		set smooth  [get_smooth .c $id]
		set type "arrow"
	    }
	    "pline"  {
		set smooth  [get_smooth .c $id]
		set type "poly"
	    }
	    "poly"   {
		set smooth  [get_smooth .c $id]
		set type "pline"
	    }
	    "rod"    {set type "line"  }
	    default  {puts "unknown Type"}
	}
	if {$type!=""} {
	    set opt ""
	    set cur_type $itemType($id)
	    set coord [getLineCoord $id]
	    if {$type=="orect" || $type=="obox"} {
		set coord "[lindex $coord 2] [lindex $coord 3] [lindex $coord 0] [lindex $coord 1]"
	    }
	    if {$cur_type=="rect" || $cur_type=="circle"} {
		setColor [.c itemcget $id -outline]
	    } else {
		setColor [.c itemcget $id -fill]
	    }
	    deleteItem $id
	    if {$smooth!=""} {
		append opt " -smooth $smooth"
	    }
	    lappend td_id [eval makeItem $type $opt [list $coord]]
	} else {
	    lappend td_id $id
	}
    }
    setColor [makeColorString $tmp_col]
    selectItem td_id
}

proc toggleItemAnchor {{t_id}} {
    global cur_itemanchor

    if {$t_id==""} {return}
    set type $cur_itemanchor
    set cur_editedp 1
    switch $type {
	"se" {set type "s"}
	"s"  {set type "sw"}
	"sw" {set type "e"}
	"e"  {set type "c"}
	"c"  {set type "w"}
	"w"  {set type "ne"}
	"ne" {set type "n"}
	"n"  {set type "nw"}
	"nw" {set type "se"}
	default  {set type "c"}
    }
    setItemAnchor $t_id $type
    set cur_itemanchor $type
}

proc setItemAnchor {{p_id} {type "w"}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$p_id==""} {return}
    set cur_editedp 1
    
    sets {max_xx max_yy} [lrange [.c coord [lindex $p_id 0]] 0 1]
    sets {min_xx min_yy} [list $max_xx $max_yy]
    foreach id $p_id {
	foreach {x y} [.c coord $id] {
	    if {$max_xx<$x} {set max_xx $x}
	    if {$min_xx>$x} {set min_xx $x}
	    if {$max_yy<$y} {set max_yy $y}
	    if {$min_yy>$y} {set min_yy $y}
	}
    }
    set tmp_id $cur_id
    unselectItem tmp_id
    foreach id $p_id {
	set coord [eval .c coord $id]
	sets {maxx maxy} [lrange $coord 0 1]
	sets {minx miny} [list $maxx $maxy]
	foreach {x y} $coord {
	    if {$maxx<$x} {set maxx $x}
	    if {$minx>$x} {set minx $x}
	    if {$maxy<$y} {set maxy $y}
	    if {$miny>$y} {set miny $y}
	}
	set new_coord ""
	sets {sx sy} {0 0}
	switch $type {
	    "t"  {set sy [expr $min_yy-$miny]}
	    "b"  {set sy [expr $max_yy-$maxy]}
	    "r"  {set sx [expr $max_xx-$maxx]}
	    "l"  {set sx [expr $min_xx-$minx]}
	    "ne" {set sy [expr $min_yy-$miny]; set sx [expr $max_xx-$maxx]}
	    "n"  {set sy [expr $min_yy-$miny]; set sx [expr (($max_xx+$min_xx)-($maxx-$minx))/2.0-$minx]}
	    "nw" {set sy [expr $min_yy-$miny]; set sx [expr $min_xx-$minx]}
	    "se" {set sy [expr $max_yy-$maxy]; set sx [expr $max_xx-$maxx]}
	    "s"  {set sy [expr $max_yy-$maxy]; set sx [expr (($max_xx+$min_xx)-($maxx-$minx))/2.0-$minx]}
	    "sw" {set sy [expr $max_yy-$maxy]; set sx [expr $min_xx-$minx]}
	    "e"  {set sy [expr (($max_yy+$min_yy)-($maxy-$miny))/2.0-$miny]; set sx [expr $max_xx-$maxx]}
	    "w"  {set sy [expr (($max_yy+$min_yy)-($maxy-$miny))/2.0-$miny]; set sx [expr $min_xx-$minx]}
	    "c"  {set sx [expr (($max_xx+$min_xx)-($maxx-$minx))/2.0-$minx]}
	    "m"  {set sy [expr (($max_yy+$min_yy)-($maxy-$miny))/2.0-$miny]}
	}
	foreach {x y} $coord {
	    sets {x y} [list [expr $x+$sx] [expr $y+$sy]]
	    append new_coord " $x $y"
	}
	eval .c coord $id $new_coord
    }
    selectItem tmp_id
}

proc setLineCap {{type "butt"} {t_id}} {
    global itemType
    
    if {$t_id==""} {return}
    foreach id $t_id {
	switch -regexp $itemType($id) {
	    "^(line|arrow|pline)$" {
		.c itemconfigure $id -capstyle $type
	    }
	}
    }
}

proc cmpAbut {a b n} {
    set aa [lindex $a $n]
    set bb [lindex $b $n]
    if {$aa>$bb} {return 1} \
    elseif {$aa<$bb} {return -1} \
    else {return 0}
}

proc abutItem {{p_id} {type "h"}} {
    global itemType
    global cur_mode cur_id cur_bbox cur_nod cur_smooth cur_arrow
    global selectnod_id selectnod
    global gradation_id gradation
    global cur_editedp

    if {$p_id==""} {return}
    set cur_editedp 1
    
    set tmp_id ""
    foreach id $p_id {
	sets {max_x max_y} [.c coord $id]
	sets {min_x min_y} [list $max_x $max_y]
	foreach {x y} [.c coord $id] {
	    if {$max_x<$x} {set max_x $x}
	    if {$min_x>$x} {set min_x $x}
	    if {$max_y<$y} {set max_y $y}
	    if {$min_y>$y} {set min_y $y}
	}
	lappend tmp_id "$id $max_x $min_x $max_y $min_y"
    }
    if {$type=="h"} {
	set n 2
    } else {
	set n 4
    }
    set tmp_id "[lsort -increasing -real -index $n $tmp_id]"
    sets {id0 x1 x0 y1 y0} [lindex $tmp_id 0]
    unselectItem p_id
    foreach tmp $tmp_id {
	sets {id max_x min_x max_y min_y} $tmp
	sets {sx sy} {0 0}
	if {$type=="h"} {
	    set sx [expr $x0-$min_x]
	} else {
	    set sy [expr $y0-$min_y]
	}
	set coord ""
	foreach {x y} [.c coord $id] {
	    sets {x y} [list [expr $x+$sx] [expr $y+$sy]]
	    append coord " $x $y"
	}
	eval .c coord $id $coord
	sets {x0 y0} [list [expr $max_x+$sx] [expr $max_y+$sy]]
    }
    selectItem p_id
}

proc blendItem {{c_id} {step ""}} {
    global itemType
    global cur_blendstep
    
    if {$c_id==""} {return}
    if {[llength $c_id]!=2} {
	puts "Blend must apply to same two items."
	return
    }
    set cur_editedp 1
    if {$step=={}} {
	set step [getValue "Blend Step" $cur_blendstep]
	if {$step=={}} {return}
	set cur_blendstep $step
    }
    sets {id_a id_b} $c_id
    if {$itemType($id_a)!=$itemType($id_b)} {
	puts "Blend must apply to same two items."
	return
    }
    sets {coord_a coord_b} [list [getLineCoord $id_a] [getLineCoord $id_b]]
    set colopt fill
    set smtopt 0
    switch -regexp $itemType($id_a) {
	"circle|rect" {set colopt "outline"}
	"line|pline|fline|poly|arrow" {
	    set smtopt [get_smooth .c $id_a]
	}
    }
    sets {r_a g_a b_a} [winfo rgb . [.c itemcget $id_a -$colopt]]
    sets {r_b g_b b_b} [winfo rgb . [.c itemcget $id_b -$colopt]]
    set sr [expr 1.0*($r_b-$r_a)/255/($step+1)]
    set sg [expr 1.0*($g_b-$g_a)/255/($step+1)]
    set sb [expr 1.0*($b_b-$b_a)/255/($step+1)]
    sets {r g b} [list [expr $r_a/255] [expr $g_a/255] [expr $b_a/255]]
    set coord_num [llength $coord_a]
    for {set i 1} {$i<=$step} {incr i} {
	set new_coord ""
	for {set j 0} {$j<$coord_num} {incr j 2} {
	    sets {x_a y_a} [lrange $coord_a [expr $j] [expr $j+1]]
	    sets {x_b y_b} [lrange $coord_b [expr $j] [expr $j+1]]
	    set sx [expr 1.0*($x_b-$x_a)/($step+1)*$i]
	    set sy [expr 1.0*($y_b-$y_a)/($step+1)*$i]
	    sets {x y} [list [expr $x_a+$sx] [expr $y_a+$sy]]
	    append new_coord " $x $y"
	}
	sets {r g b} [list [expr int($r+$sr)] [expr int($g+$sg)] [expr int($b+$sb)]]
	if {$r>255} {set r 255}
	if {$g>255} {set g 255}
	if {$b>255} {set b 255}
	set coord $new_coord
 	makeItem $itemType($id_a) \
		-fill [format "#%02x%02x%02x" $r $g $b] \
		-smooth $smtopt \
		$coord
    }
}

############################################################
#
proc makeItem {{type} args} {
    global itemType
    global cur_mode cur_id cur_col cur_smooth cur_arrow cur_arrowshape
    global cur_stipple
    global cur_textanchor cur_textjustify
    global cur_zoom
    global selectnod_id selectnod
    global gradation_id gradation
    global nod_dupinfo
    global font fontface fontsize fontsizeId cur_linewidth linecap rodwidth
    global cur_layer layer_id
    global col_rand
    global cur_editedp
    global font

    set anchor "center"
    set smooth $cur_smooth
    set justify $cur_textjustify
    set linewidth $cur_linewidth
    set arrowshape [list $cur_arrowshape]
    set capstyle $linecap
    set joinstyle "round"
    if {$fontface=="gh"} {
	set fontfacesize "Gothic:Helvetica-Bold-$fontsize"
    } else {
	set fontfacesize "Mincho:Times-Roman-$fontsize"
    }
    set file ""
    switch $type {
	"arrow" {set arrow $cur_arrow}
	"text"  {set anchor $cur_textanchor; set justify $cur_textjustify}
	"default" {set arrow none}
    }
    set obj_col ""
    #puts "makeItem type:$type args:$args"
    while {1} {
	switch -- [lindex $args 0] {
	    "-fill" {
		set obj_col [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-outline" {
		set obj_col [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-anchor" {
		set anchor [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-justify" {
		set justify [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-smooth" {
		set smooth [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-splinesteps" {
		set spliesteps [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-stipple" {
		set stipple [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-tags" {
		set stipple [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-arrow" {
		set arrow [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-arrowshape" {
		set arrowshape [list [lindex $args 1]]
		set args [lreplace $args 0 1]
	    }
	    "-capstyle" {
		set capstyle [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-joinstyle" {
		set joinstyle [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-width" {
		switch -regexp $type {
		    "rod" {set rodwidth [lindex $args 1]}
		    default {set linewidth [lindex $args 1]}
		}
		set args [lreplace $args 0 1]
	    }
	    "-font" {
		set fontfacesize [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    "-file" {
		set file [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    default {
		break
	    }
	}
    }
    if {$obj_col==""} {
	sets {color col_r col_g col_b} $cur_col
	set obj_col [format "#%02x%02x%02x" \
		[expr int($color*$col_r)] \
		[expr int($color*$col_g)] \
		[expr int($color*$col_b)]]
    }
    set bbox [lindex $args end]
    sets {x y x0 y0} $bbox

    set cur_editedp 1
    .c delete $cur_id
    set cur_id ""
    set m_id ""
    if {$col_rand} {randomColor}
    switch -regexp $type {
	"^(text)$"   {
	    set val [.text.e get 0.0 "end-1chars"]
	    regsub "\n+$" $val "" val
	    set size $fontsize
	    set face $fontface
	    if {[regexp "^Gothic:Helvetica-Bold-(\[0-9\]+)" \
		    $fontfacesize null size]} {
		set face "gh"
	    } elseif {[regexp "^Mincho:Times-Roman-(\[0-9\]+)" \
		    $fontfacesize null size]} {
		set face "mt"
	    }
	    if {0} {
	    set tmp_size $size
	    } else {
	    set tmp_size [expr int($size*$cur_zoom)]
	    }
	    if {[info exists font($face:$tmp_size)]==0} {
		loadFont $tmp_size $face
	    }
	    set m_id [eval .c create text $x $y -text [list $val] \
		    -font $font($face:$tmp_size) \
		    -anchor $anchor -justify $justify \
		    -stipple $cur_stipple]
	    set fontsizeId($m_id) $size
	    if {$obj_col!=""} {.c itemconfigure $m_id -fill $obj_col}
	    set itemType($m_id) "text"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	    if {$val==""} {
		editText .c $x $y $m_id
	    }
	}
	"^(rect)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    set m_id [eval .c create rectangle $bbox \
		    -width $linewidth -outline $obj_col \
		    -stipple $cur_stipple]
	    set itemType($m_id) "rect"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(orect)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    set d [expr 20*$cur_zoom]
	    sets {x y x0 y0} $bbox
	    sets {xa ya x0a y0a} \
		    [list [expr $x-$d] [expr $y-$d] \
		          [expr $x0+$d] [expr $y0+$d]]
	    set m_id [.c create line \
		    $x0  $y0a $x0 $y0 $x0a $y0 \
		    $xa  $y0  $x  $y0 $x   $y0a \
		    $x   $ya  $x  $y  $xa  $y \
		    $x0a $y   $x0 $y  $x0  $ya \
		    $x0  $y0a \
		    -width $linewidth \
		    -fill $obj_col \
		    -smooth 1]
	    set itemType($m_id) "orect"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(box)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    set m_id [eval .c create rectangle $bbox \
		    -fill $obj_col -outline $obj_col \
		    -stipple $cur_stipple]
	    set itemType($m_id) "box"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(obox)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    set d [expr 20*$cur_zoom]
	    sets {x y x0 y0} $bbox
	    sets {xa ya x0a y0a} \
		    [list [expr $x-$d] [expr $y-$d] \
		          [expr $x0+$d] [expr $y0+$d]]
	    set m_id [.c create poly \
		    $x0  $y0a $x0 $y0 $x0a $y0 \
		    $xa  $y0  $x  $y0 $x   $y0a \
		    $x   $ya  $x  $y  $xa  $y \
		    $x0a $y   $x0 $y  $x0  $ya \
		    $x0  $y0a \
		    -fill $obj_col -outline $obj_col \
		    -smooth 1]
	    set itemType($m_id) "obox"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(boxx)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    if {$obj_col!=""} {
		set color 255
		sets {col_r col_g col_b} [winfo rgb . $obj_col]
		sets {col_r col_g col_b} [list \
			[expr 1.0*$col_r/0xffff] \
			[expr 1.0*$col_g/0xffff] \
			[expr 1.0*$col_b/0xffff]]
	    } else {
		sets {color col_r col_g col_b} $cur_col
	    }
	    set m_id [eval .c create rectangle $bbox \
		    -fill [format "#%02x%02x%02x" \
		    [expr int($color*$col_r)] \
		    [expr int($color*$col_g)] \
		    [expr int($color*$col_b)]] \
		    -stipple $cur_stipple]
	    set itemType($m_id) "boxx"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	    set im 30
	    for {set i 0} {$i<$im} {incr i} {
		set color [expr int(log($i+1)/log($im)*155+100)]
		set color [format "#%02x%02x%02x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
		sets {w h} [list [expr $x-$x0] [expr $y-$y0]]
		set id [eval .c create rectangle $x0 $y0 $x $y \
			-fill $color -outline $color \
			-stipple $cur_stipple]
		lappend gradation_id($m_id) $id
		set gradation($id) $m_id
		sets {x0 x} [list [expr $x0+$w*.08] [expr $x-$w*.03]]
	    }
	}
	"^(circle)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		set color "black"
	    }
	    set m_id [eval .c create oval $bbox \
		    -width $linewidth -outline $color \
		    -stipple $cur_stipple]
	    set itemType($m_id) "circle"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(oval)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		sets {color col_r col_g col_b} $cur_col
		set color [format "#%02x%02x%02x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
	    }
	    set m_id [eval .c create oval $bbox \
		    -fill $color -outline $color \
		    -stipple $cur_stipple]
	    set itemType($m_id) "oval"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(sphere)$"    {
	    if {$x0==$x || $y0==$y} {return}
	    if {$obj_col!=""} {
		set color 255
		sets {col_r col_g col_b} [winfo rgb . $obj_col]
		sets {col_r col_g col_b} [list \
			[expr 1.0*$col_r/0xffff] \
			[expr 1.0*$col_g/0xffff] \
			[expr 1.0*$col_b/0xffff]]
	    } else {
		sets {color col_r col_g col_b} $cur_col
	    }
	    set m_id [eval .c create oval $bbox -outline {{}} \
		    -fill [format "#%02x%02x%02x" \
		    [expr int($color*$col_r)] \
		    [expr int($color*$col_g)] \
		    [expr int($color*$col_b)]] \
		    -stipple $cur_stipple]
	    set itemType($m_id) "sphere"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	    sets {x0 y0 x1 y1} [.c coord $m_id]
	    set im 50
	    for {set i 0} {$i<$im} {incr i} {
		set color [expr int(log($i+1)/log($im)*(0xfff-100)+100)]
		set color [format "#%03x%03x%03x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
		set id [eval .c create oval $x0 $y0 $x1 $y1 \
			-fill $color -outline {{}} \
			-stipple $cur_stipple]
		lappend gradation_id($m_id) $id
		set gradation($id) $m_id
		sets {w h} [list [expr $x1-$x0] [expr $y1-$y0]]
		sets {x0 y0 x1 y1} \
			[list [expr $x0+$w*1.45/$im] \
		              [expr $y0+$h*.725/$im] \
			      [expr $x1-$w*.725/$im] \
			      [expr $y1-$h*1.45/$im]]
	    }
	}
	"^(arrow)$"  {
	    if {$x0==$x && $y0==$y} {return}
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		set color "black"
	    }
	    set m_id [eval .c create line $bbox \
		    -arrow $arrow -width $linewidth -arrowshape $arrowshape \
		    -capstyle $capstyle -fill $color -smooth $smooth \
		    -stipple $cur_stipple]
	    set itemType($m_id) "arrow"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(line)$"   {
	    if {$x0==$x && $y0==$y} {return}
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		set color "black"
	    }
	    set m_id [eval .c create line $bbox \
		    -width $linewidth -arrowshape $arrowshape -arrow $arrow \
		    -capstyle $capstyle -fill $color -smooth $smooth \
		    -stipple $cur_stipple]
	    set itemType($m_id) "line"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(pline|fline)$"   {
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		sets {color col_r col_g col_b} $cur_col
		set color [format "#%02x%02x%02x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
	    }
	    set m_id [eval .c create line $bbox \
		    -width $linewidth -arrow $arrow -arrowshape $arrowshape \
		    -capstyle $capstyle -fill $color -smooth $smooth \
		    -stipple $cur_stipple]
	    set itemType($m_id) "pline"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(poly)$"   {
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		sets {color col_r col_g col_b} $cur_col
		set color [format "#%02x%02x%02x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
	    }
	    set m_id [eval .c create polygon $bbox \
		    -width $linewidth -fill $color -smooth $smooth \
		    -stipple $cur_stipple]
	    set itemType($m_id) "poly"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(rod)$"   {
	    if {$x0==$x && $y0==$y} {return}
	    if {$obj_col!=""} {
		set color 255
		sets {col_r col_g col_b} [winfo rgb . $obj_col]
		sets {col_r col_g col_b} [list \
			[expr 1.0*$col_r/0xffff] \
			[expr 1.0*$col_g/0xffff] \
			[expr 1.0*$col_b/0xffff]]
	    } else {
		sets {color col_r col_g col_b} $cur_col
	    }
	    if {$rodwidth<=2} {set rodwidth 4}
	    set m_id [eval .c create line $bbox -width $rodwidth \
		    -fill [format "#%02x%02x%02x" \
		    [expr int($color*$col_r)] \
		    [expr int($color*$col_g)] \
		    [expr int($color*$col_b)]] \
		    -stipple $cur_stipple]
	    set itemType($m_id) "rod"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	    sets {x0 y0 x1 y1} [.c coord $m_id]
	    sets {w h} [list [expr $x1-$x0] [expr $y1-$y0]]
	    if {$w==0 || $h==0} {
		    set d 1
	    } else {
		set d [expr $h/$w]
	    }
	    set im $rodwidth
	    for {set i 0} {$i<$im} {incr i} {
		if {$d<0} {
		    set ii [expr $i]
		} else {
		    set ii [expr $im-$i]
		}
		if {$ii<($im*.7)} {
		    set color [expr int(log($ii+1)/log(($im+1)*.7)*155+100)]
		} else {
		    set color [expr int(log(($ii-($ii-($im*.7))*2)-1)/log($im*.7)*155+100)]
		}
		set color [format "#%02x%02x%02x" [expr int($color*$col_r)] [expr int($color*$col_g)] [expr int($color*$col_b)]]
		set ww [expr $i-$im/2]
		if {$d==1 && $w==0} {
		    set xx0 [expr $x0+$ww]
		    set yy0 $y0
		    set xx1 [expr $x1+$ww]
		    set yy1 $y1
		} elseif {$d==1 && $h==0} {
		    set xx0 $x0
		    set yy0 [expr $y0+$ww]
		    set xx1 $x1
		    set yy1 [expr $y1+$ww]
		} elseif {$d>1 || $d<-1} {
		    set xx0 [expr $x0+$ww]
		    set yy0 [expr -$ww/$d+$y0]
		    set xx1 [expr $x1+$ww]
		    set yy1 [expr -$ww/$d+$y1]
		} else {
		    set yy0 [expr $y0+$ww]
		    set xx0 [expr -$ww*$d+$x0]
		    set yy1 [expr $y1+$ww]
		    set xx1 [expr -$ww*$d+$x1]
		}
		set id [.c create line $xx0 $yy0 $xx1 $yy1 \
			-fill $color -width 2]
		lappend gradation_id($m_id) $id
		set gradation($id) $m_id
		set nod_dupinfo($m_id) ""
	    }
	}
	"^(pixel)$"   {
	    if {$obj_col!=""} {
		set color $obj_col
	    } else {
		set color "black"
	    }
	    set m_id [eval .c create line $x $y [expr $x+1] $y \
		    -fill $color -stipple $cur_stipple]
	    set itemType($m_id) "pixel"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	}
	"^(image)$"   {
	    set x [lindex $args 0]
	    set y [lindex $args 1]
	    if {![file exists $file]} {
	    } else {
	    set img_id [createImage $file]
	    set m_id [eval .c create image $x $y \
		    -image $img_id]
	    set itemType($m_id) "image"
	    set gradation_id($m_id) {}
	    set nod_dupinfo($m_id) ""
	    }
	}
	default  {puts "Error: unknown mode specified.: $type $x $y"}
    }
    
    # ½ÅÊ£ÄºÅÀ¡Ê¥¹¥×¥é¥¤¥ó½ü³°ÅÀ¡Ë¤Î½èÍý
    sets {x y} {{} {}}
    set i 0
    foreach {xx yy} $bbox {
	if {$xx==$x && $yy==$y} {
	    lappend nod_dupinfo($m_id) [expr $i-1]
	    sets {x y} {{} {}}
	} else  {
	    sets {x y} "$xx $yy"
	    incr i
	}
    }
    if {[llength $m_id]>0} {
	set layer_id($m_id) $cur_layer
	return $m_id
    } else {
	return ""
    }
}

proc resizeItem {{resize_id}} {
    # ¥Ù¡¼¥¹¥¢¥¤¥Æ¥à¤Î¥ê¥µ¥¤¥º¤Ë¹ç¤ï¤»¤Æ¥°¥é¥Ç¡¼¥·¥ç¥ó¤Ê¤É¤òÉÁ¤­´¹¤¨¤ë
    upvar $resize_id r_id
    global itemType
    global cur_mode cur_id cur_col cur_zoom
    global selectnod_id selectnod
    global gradation_id gradation
    global rodwidth

    set bbox [.c bbox $r_id]
    set x0 [lindex $bbox 0]
    set y0 [lindex $bbox 1]
    set x  [lindex $bbox 2]
    set y  [lindex $bbox 3]
    switch -regexp $itemType($r_id) {
	"^(text)$"   {
	}
	"^(rect|orect|box|obox|oval|circle|arrow|line|pline|poly)$"  {
	}
	"^(boxx)$"    {
	    if {$x0==$x || $y0==$y} return
	    sets {x0 y0 x y} [.c coord $r_id]
	    set im 30
	    for {set i 0} {$i<$im} {incr i} {
		.c coord [lindex $gradation_id($r_id) $i] \
			$x0 $y0 $x $y
		set w [expr $x-$x0]
		set h [expr $y-$y0]
		set x0 [expr $x0+$w*.08]
		#set y0 [expr $y0+$h*.08]
		set x [expr $x-$w*.03]
		#set y [expr $y-$h*.03]
	    }
	}
	"^(sphere)$"    {
	    if {$x0==$x || $y0==$y} return
	    set coord [.c coord $r_id]
	    set x0 [lindex $coord 0]
	    set y0 [lindex $coord 1]
	    set x1 [lindex $coord 2]
	    set y1 [lindex $coord 3]
	    set im 50
	    for {set i 0} {$i<$im} {incr i} {
		.c coord [lindex $gradation_id($r_id) $i] $x0 $y0 $x1 $y1
		set w [expr $x1-$x0]
		set h [expr $y1-$y0]
		set x0 [expr $x0+$w*1.45/$im]
		set y0 [expr $y0+$h*.725/$im]
		set x1 [expr $x1-$w*.725/$im]
		set y1 [expr $y1-$h*1.45/$im]
	    }
	}
	"^(rod)$"   {
	    if {$x0==$x && $y0==$y} return
	    set coord [.c coord $r_id]
	    set x0 [lindex $coord 0]
	    set y0 [lindex $coord 1]
	    set x1 [lindex $coord 2]
	    set y1 [lindex $coord 3]
	    set w [expr $x1-$x0]
	    set h [expr $y1-$y0]
	    if {$w==0 || $h==0} {
		    set d 1
	    } else {
		set d [expr $h/$w]
	    }
	    set im $rodwidth
	    for {set i 0} {$i<$im} {incr i} {
		set ww [expr $i-$im/2]
		if {$d==1 && $w==0} {
		    set xx0 [expr $x0+$ww]
		    set yy0 $y0
		    set xx1 [expr $x1+$ww]
		    set yy1 $y1
		} elseif {$d==1 && $h==0} {
		    set xx0 $x0
		    set yy0 [expr $y0+$ww]
		    set xx1 $x1
		    set yy1 [expr $y1+$ww]
		} elseif {$d>1 || $d<-1} {
		    set xx0 [expr $x0+$ww]
		    set yy0 [expr -$ww/$d+$y0]
		    set xx1 [expr $x1+$ww]
		    set yy1 [expr -$ww/$d+$y1]
		} else {
		    set yy0 [expr $y0+$ww]
		    set xx0 [expr -$ww*$d+$x0]
		    set yy1 [expr $y1+$ww]
		    set xx1 [expr -$ww*$d+$x1]
		}
		.c coord [lindex $gradation_id($r_id) $i] $xx0 $yy0 $xx1 $yy1
	    }
	}
	"^(pixel)$"   return
	"^(image)$"   return
	default  {puts "Error: unknown mode specified.: $itemType($r_id) $x $y"}
    }
    if {[llength $r_id]} {
	#puts "$r_id:$itemType($r_id)"
	return $r_id
    }
}

############################################################
#
proc printCanvas {{fname}} {
    global cur_id cur_paporient cur_gridshow cur_zoom
    global fmap
    global width height

    set retvalue 0
    set tmp_id $cur_id
    unselectItem tmp_id

    sets {viewx viewy} [list [.c xview] [.c yview]]
    set tmp_zoom $cur_zoom
    if {$cur_zoom!=1} {changeZoom 1}
    set tmp_gridshow $cur_gridshow
    if {$cur_gridshow} {set cur_gridshow 0; makeGridLine}

    set bbox [.c bbox all]
    if {$bbox!=""} {
	set x [lindex $bbox 0]
	set y [lindex $bbox 1]
	set w [expr [lindex $bbox 2]-$x]
	set h [expr [lindex $bbox 3]-$y]
	set pad 5
	
	if {$w+$pad*2<$width && $h+$pad*2<$height} {
	    incr x -$pad
	    incr y -$pad
	    incr w  [expr $pad*2]
	    incr h  [expr $pad*2]
	}
	if {$cur_paporient=="landscape"} {
	    set rotate true
	    set pagex [expr $y*.96]
	    set pagey [expr $x*.96]
	} else {
	    set rotate false
	    set pagex [expr $x*.96]
	    set pagey [expr ($height-$y)*.96]
	}
	.c postscript \
		-file $fname -width $w -height $h -x $x -y $y \
		-pagewidth [expr 0.9596*$w] -pageheight [expr 0.9596*$h] \
		-colormode color -fontmap fmap \
		-rotate $rotate \
		-pageanchor nw -pagex $pagex -pagey $pagey
	set retvalue 1
    }
    selectItem tmp_id
    if {$tmp_gridshow} {set cur_gridshow $tmp_gridshow; makeGridLine}
    if {$tmp_zoom!=1} {changeZoom $tmp_zoom}
    .c xview moveto [lindex $viewx 0]
    .c yview moveto [lindex $viewy 0]
    makeGridLine
    if {!$retvalue} {
	tk_dialog .notice "Print Error" "No printing items." warning 0 ok
    }
    return $retvalue
}

proc fileDialog_old {} {
    global cur_id
    
    set t .fd
    toplevel $t
    wm title $t "tkduke"
    wm iconname $t "tkduke"
    label $t.l -text "Open File"
    entry $t.e
    bind $t.e <Key-Return> "\
	    selectItemAll; deleteItem $cur_id;\
	    loadFile \[$t.e get\];\
	    destroy $t"
    bind $t.e <Control-c> "destroy $t"
    bind $t.e <Control-q> "destroy $t"
    button $t.ok -text "OK" -command "\
	    selectItemAll; deleteItem $cur_id;\
	    loadFile \[$t.e get\];\
	    destroy $t"
    button $t.canc -text "Cancel" -command "destroy $t"
    pack $t.l $t.e -side top
    pack $t.ok $t.canc -side left
}

proc getPreviewImage {{fname}} {
    set fd [open "$fname" "r"]
    set preview 0
    while {![eof $fd]} {
	gets $fd str
	if {[regexp "^#|^ *$" $str]==-1} {
	    break
	} elseif {[regexp "# *preview:" $str]} {
	    set preview 1
	    break
	}
    }

    set gif ""
    set id -1
    if {$preview} {
	while {![eof $fd]} {
	    gets $fd str
	    if {[regexp "# .+" $str]==-1} {
		break
	    }
	    regsub "^# " $str "" str
	    append gif $str
	}
    }
    close $fd
    if {$gif!=""} {set id [image create photo -format gif -data $gif]}

    return $id
}

proc fileBrowser {} {
    global cur_importdir cur_filename
    
    set t .fdw
    toplevel $t
    $t configure -background white
    wm title $t "Tkduke: File Browser"
    set c $t.c
    canvas $c -width 200 -height 400 -background white \
	    -xscrollcommand "$t.x set" -yscrollcommand "$t.y set"
    scrollbar $t.y -command "$c yview"
    scrollbar $t.x -command "$c xview" -orient horizontal
    button $t.close -image hide_icon -command "destroy $t"
    bind $t <Control-q> "destroy $t"
    bind $t <Control-w> "destroy $t"
    grid $t.close -columnspan 2 -sticky nes
    grid $c $t.y -sticky news
    grid $t.x -sticky news
    grid rowconfigure $t 1 -weight 1
    grid columnconfigure $t 0 -weight 1
    sets {x y} {100 10}
    set margin 3
    set width 0
    foreach f [lsort [glob -nocomplain $cur_importdir/*.mmp]] {
	set img_id [getPreviewImage $f]
	if {0} {
	set img_id [image create photo -format gif]
	$img_id copy $img_id_src -zoom 2 2
	}
	if {$img_id!=-1} {
	    set id [$c create image $x $y -image $img_id -anchor ne]
	    $c bind $id <Enter> "$c configure -cursor hand2"
	    $c bind $id <Leave> "$c configure -cursor left_ptr"
	    $c bind $id <Double-Button-1> "loadFile $f"
	    sets {x0 y0 x1 y1} [$c bbox $id]
	    set id [$c create text [expr $x+$margin] $y1 -text $f -anchor sw]
	    $c bind $id <Enter> "$c configure -cursor hand2"
	    $c bind $id <Leave> "$c configure -cursor left_ptr"
	    $c bind $id <Double-Button-1> "loadFile $f"
	    set y [expr $y1+$margin]
	    set x1 [lindex [$c bbox $id] 2]
	    if {$width<$x1} {set width $x1}
	} else {
	    set y [expr $y+$margin]
	    $c create line [expr $x-20] $y $x $y -width 1 -fill gray
	    set id [$c create text [expr $x+$margin] $y -text $f -anchor w]
	    $c bind $id <Enter> "$c configure -cursor hand2"
	    $c bind $id <Leave> "$c configure -cursor left_ptr"
	    $c bind $id <Double-Button-1> "loadFile $f"
	    set x1 [lindex [$c bbox $id] 2]
	    set y1 [lindex [$c bbox $id] 3]
	    set y [expr $y1+$margin]
	    if {$width<$x1} {set width $x1}
	}
	$c configure -scrollregion "0 0 $width $y" 
	update idletasks
    }
}

proc fileDialog {{proc} {mess} {type Open}} {
    global cur_importdir

    set tmp [tk_get${type}File \
	    -title "tkduke: $mess" \
	    -initialdir $cur_importdir \
	    -filetypes {{MMP {.mmp}} {ALL {*}}}]
    if {$tmp != ""} {$proc $tmp}
}

proc textfileDialog {{proc} {mess} {type Open}} {
    global cur_importdir
    global cur_importtext    
    
    set tmp [tk_get${type}File \
	    -title "tkduke: $mess" \
	    -initialdir $cur_importdir \
	    -filetypes {{TXT {.txt .text}} {ALL {*}}}]
    if {$tmp != ""} {$proc $tmp $cur_importtext}
}

proc imagefileDialog {{proc} {mess} {type Open}} {
    global cur_importdir tmp_img

if {0} {
    set tmp [tk_get${type}File \
	    -title "tkduke: $mess" \
	    -initialdir $cur_importdir \
	    -filetypes {{GIF/JPEG {.gif .jpeg .jpg .GIF .JPEG .JPG}} {PNM {.pbm .pnm .ppm}} {ALL {*}}}]
} else {
	toplevel .tmp_img
	listbox .tmp_img.l -yscrollcommand {.tmp_img.ly set}
	scrollbar .tmp_img.ly -command {.tmp_img.l yview}
	foreach f [lsort [glob *.gif *.jpeg *.jpg]] {
	    .tmp_img.l insert end $f
        }
	button .tmp_img.ok -text OK -command {set tmp_img [.tmp_img.l get [.tmp_img.l curselection]]; destroy .tmp_img}
	button .tmp_img.cancel -text Cancel -command {set tmp_img ""; destroy .tmp_img}
	pack .tmp_img.ly -side right -expand yes -fill y
	pack .tmp_img.l -expand yes -fill both
	pack .tmp_img.ok
	pack .tmp_img.cancel
	tkwait window .tmp_img
	puts $tmp_img
set tmp $tmp_img
}
    if {$tmp != ""} {$proc $tmp}
}

proc printfileDialog {{proc} {mess} {type Save}} {
    global cur_importdir cur_printname

    set tmp [tk_get${type}File \
	    -title "tkduke: $mess" \
	    -initialdir $cur_importdir \
	    -initialfile $cur_printname \
	    -filetypes {{PS {.ps .eps .epsi}} {ALL {*}}}]
    if {$tmp != ""} {$proc $tmp}
}

proc newFile {} {
    global cur_filename cur_printname cur_editedp
    global cur_layer

    set cur_filename "default.mmp"
    wm title . "tkduke: $cur_filename"
    wm iconname . "$cur_filename"
    regsub ".mmp$" [file tail $cur_filename] ".eps" cur_printname
    foreach layer {1 2 3 4} {
	changeLayer $layer
	deleteItemAll
    }
    changeLayer 1
}

proc loadFile {{fname}} {
    global cur_filename cur_printname cur_editedp
    global cur_layer

    set cur_filename $fname
    wm title . "tkduke: $cur_filename"
    wm iconname . "$cur_filename"
    regsub ".mmp$" [file tail $cur_filename] ".eps" cur_printname
    set tmp_layer $cur_layer
    foreach layer {1 2 3 4} {
	changeLayer $layer
	deleteItemAll
    }
    changeLayer $tmp_layer
    if {![file exists $fname]} {
	# New file
	set cur_editedp 0
	return
    }
    importFile $fname
}

proc importFile {{fname}} {
    global cur_filename cur_printname cur_editedp cur_zoom
    global cur_filetitle cur_creator cur_createdate
    global cur_paporient cur_smooth cur_stipple
    global cur_layer layer_id
    global cur_zoom
    global cur_saving
    global cur_importdir
    global rodwidth
    global font fontface fontsize fontsizeId

    if {$cur_saving} {return}  ;# ÊÝÂ¸Ãæ¤ÏÂ¾¤Î¥Õ¥¡¥¤¥ë¤òÆÉ¤ß¹þ¤Þ¤Ê¤¤
    if {![file exists $fname]} return

    set cur_importdir [file dirname $fname]

    . config -cursor watch
    #update ;# ¤³¤Î¹Ô¤òÍ­¸ú¤Ë¤¹¤ë¤È¥³¥Þ¥ó¥É¥é¥¤¥ó¤«¤é¤Î¥Õ¥¡¥¤¥ë»ØÄê¤ÇÄä»ß¡©¡©
    set fd [open $fname "r"]
    set str_hang "" ;# \ Ï¢·ë¹Ô¤Î°ì»þÊÝÂ¸ÍÑ
    set im_id ""
    set tmp_smooth $cur_smooth
    set cur_smooth 0
    set tmp_stipple $cur_stipple
    set tmp_rodwidth $rodwidth
    set cur_stipple {{}}
    set tmp_zoom ""
    set tmp_grid ""
    while {![eof $fd]} {
	gets $fd str
	append str_hang $str
	if {[regsub {\\$} $str_hang "\n" str_hang]} {
	    continue
	}
	set str $str_hang
	set str_hang ""
	if {[regexp "^ *#" $str]} {
	    continue
	}
	if {[regexp "^(\[^ \]+) +((.| )+)" $str null type val]} {
	    if {$type=="orient"} {
		if {$val!=$cur_paporient} {toggleOrient}
		continue
	    } elseif {$type=="layer"} {
		changeLayer $val
		continue
	    } elseif {$type=="title"} {
		set cur_filetitle $val
		continue
	    } elseif {$type=="zoom"} {
		set tmp_zoom $val
		continue
	    } elseif {$type=="grid"} {
		set tmp_grid $val
		continue
	    } elseif {$type=="creator"} {
		set cur_creator $val
		continue
	    } elseif {$type=="createdate"} {
		set cur_createdate $val
		continue
	    } elseif {$type=="comment"} {
		continue
	    }
	    set val [eval list $val]
	    switch $type {
		"text" {
		    .text.e delete 0.0 end
		    .text.e insert 0.0 [lindex $val 0]
		    set val [lreplace $val 0 0]
		}
		"arrow" {
		    set arrow [lindex $val 0]
		    set val [lreplace $val 0 0]
		}
	    }
	    if {$type!="image"} {
		set color [lindex $val 0]
	    } else {
		set image [lindex $val 0]
	    }
	    set val [lreplace $val 0 0]
	    set opt ""
	    while {[regexp "^-\[^0-9\]" [lindex $val 0]]} {
		set tmp_opt "[lindex $val 0] [lindex $val 1]"
		if {$type=="rod" && [regexp "^-width" $tmp_opt]} {
		    set rodwidth [lindex $tmp_opt 1]
		}
		if {[regexp "^-font" [lindex $val 0]]} {
		    set face $fontface
		    set size $fontsize
		    if {[regexp "^-font +Gothic:Helvetica-Bold-(\[0-9\]+)" \
			    $tmp_opt null size]} {
			set face "gh"
		    } elseif {[regexp "^-font +Mincho:Times-Roman-(\[0-9\]+)" \
			    $tmp_opt null size]} {
			set face "mt"
		    }
		    regsub -all -- "-font +\[^ \]+ *" $tmp_opt "" tmp_opt
		    if {[info exists font($face:$size)]==0} {loadFont $size $face}
		    set fontsize $size
		    set fontface $face
		}
		append opt " $tmp_opt"
		set val [lreplace $val 0 1]
	    }
	    set tmp_val $val
	    set val ""
	    foreach x $tmp_val {
		lappend val [expr $x*$cur_zoom]
	    }
	    if {$type!="image"} {
		set id [makeItem $type -fill $color $val]
	    } else {
		set id [makeItem $type -file $image $val]
	    }
	    if {$type=="arrow"} {
		.c itemconfigure $id -arrow $arrow
	    }
	    if {$id!=""} {
		eval .c itemconfigure $id $opt
	    }
	    lappend im_id $id
	}
    }
    close $fd
    set cur_stipple $tmp_stipple
    set cur_smooth $tmp_smooth
    set cur_editedp 0
    set rodwidth $tmp_rodwidth
    if {$tmp_zoom!=""} {changeZoom $tmp_zoom}
    if {$tmp_grid!=""} {setGrid $tmp_grid}
    . config -cursor left_ptr
    return $im_id
}

proc importTextFile {fname {type "whole"} {x 0} {y 0}} {
    global cur_saving

    if {$cur_saving} {return}  ;# ÊÝÂ¸Ãæ¤ÏÂ¾¤Î¥Õ¥¡¥¤¥ë¤òÆÉ¤ß¹þ¤Þ¤Ê¤¤
    if {![file exists $fname]} {return}

    set fd [open "$fname" "r"]
    set text ""
    while {![eof $fd]} {
	append text "[gets $fd]\n"
    }
    close $fd
    
    if {$type=="whole"} {
	.text.e delete 0.0 end
	.text.e insert 0.0 $text
	makeItem text [list $x $y]
    } elseif {$type=="each"} {
	foreach t [split $text "\n"] {
	    .text.e delete 0.0 end
	    .text.e insert 0.0 $t
	    makeItem text [list $x $y]
	    incr y 10
	}
    }
}

proc createImage {{file}} {
    global imageFileMap
    global env

    set tmpfile "/tmp/tkduke[pid].ppm"
    
    # Image format translation
    set format "ppm"
    if [regexp "\.jpe?g" $file] {
	catch "exec djpeg $file > $tmpfile"
    } elseif [regexp "\.JPE?G" $file] {
	catch "exec djpeg $file > $tmpfile"
    } elseif [regexp "\.jpe" $file] {
	catch "exec djpeg $file > $tmpfile"
    } elseif [regexp "\.gif" $file] {
	set format "gif"
	set tmpfile $file
    } elseif [regexp "\.tiff?" $file] {
	catch "exec tifftopnm $file > $tmpfile"
    } elseif [regexp "\.pbm" $file] {
	catch "exec cat $file | pgmtoppm #fff > $tmpfile"
    } elseif [regexp "\.pgm" $file] {
	catch "exec cat $file | pgmtoppm #fff > $tmpfile"
    } elseif [regexp "\.ppm" $file] {
	catch "exec cat $file > $tmpfile"
    } elseif [regexp "\.bmp" $file] {
	catch "exec bmptoppm $file > $tmpfile"
    } elseif [regexp "\.xbm" $file] {
	catch "exec xbmtopbm $file | pgmtoppm #fff > $tmpfile"
    } elseif [regexp "\.xpm" $file] {
	catch "exec xpmtoppm $file > $tmpfile"
    } elseif [regexp "\.tga" $file] {
        catch "exec tgatoppm $file > $tmpfile"
    } elseif [regexp "\.e?psi?" $file] {
        catch "exec pstopnm2 $file > $tmpfile"
    } else {
	return
    }

    if {[file size $tmpfile]<=0} return
    set img_id [image create photo -file "$tmpfile" -format $format]
    if {$tmpfile!=$file} {puts "$tmpfile!=$file"; file delete $tmpfile}
    regsub [exec \pwd]/ $file "" file
    set imageFileMap($img_id) $file

    return $img_id
}

proc importImage {{fname}} {
    global cur_filename cur_printname cur_editedp
    global width height
    
    set x [expr ([rand]*.6+.2)*$width ]
    set y [expr ([rand]*.6+.2)*$height]
    makeItem image -file $fname [list $x $y]
}

proc changeZoom {{zoom}} {
    global cur_id cur_zoom
    global canvas_grid grid_unit cur_gridshow
    global canvas_column canvas_row
    global fontface font fontsizeId
    global itemType
    global width height

    if {$zoom<0.1} return

    set z_w [expr $width*$zoom]
    set z_h [expr $height*$zoom]
    set bbox [grid bbox . $canvas_column $canvas_row]
    set c_w [expr [lindex $bbox 2]]
    set c_h [expr [lindex $bbox 3]]
    set tmp_zoom [expr 1.0/$cur_zoom*$zoom]
    set tmp_id $cur_id
    unselectItem tmp_id
    .file.zoom_v configure -text [format "%4.1f" $zoom]
    set grid [expr ($canvas_grid*$grid_unit)*$zoom]
    .c configure -width  $z_w
    .c configure -height $z_h
    .c configure -scrollregion "0 0 $z_w $z_h";
    if {$tmp_id!=""} {
	set bbox [eval .c bbox $tmp_id]
    } else {
	set tmp_gridshow $cur_gridshow
	if {$cur_gridshow} {set cur_gridshow 0; makeGridLine}
	set bbox [.c bbox all]
	if {$tmp_gridshow} {set cur_gridshow $tmp_gridshow; makeGridLine}
    }
    if {$bbox!=""} {
	set x [expr ([lindex $bbox 2]+[lindex $bbox 0])/2.0]
	set y [expr ([lindex $bbox 3]+[lindex $bbox 1])/2.0]
	set x [expr $x*$tmp_zoom-$c_w/2.0]
	set y [expr $y*$tmp_zoom-$c_h/2.0]
	.c xview moveto [expr 1.0*$x/$z_w]
	.c yview moveto [expr 1.0*$y/$z_h]
    } else {
	sets {x0 x1} [.c xview]
	sets {y0 y1} [.c yview]
	.c xview moveto [expr .5-($x1-$x0)/2]
	.c yview moveto [expr .5-($y1-$y0)/2]
    }
    foreach id [.c find all] {
	set coord ""
	foreach {x y} [.c coord $id] {
	    set x [expr $x*$tmp_zoom]
	    set y [expr $y*$tmp_zoom]
	    lappend coord $x
	    lappend coord $y
	}
	eval .c coord $id $coord
	if {1 && [array names itemType $id]!="" && $itemType($id)=="text"} {
	    set tmp_face [.c itemcget $id -font]
	    if {[regexp "Gothic" $tmp_face]} {
		set tmp_face "gh"
	    } else {
		set tmp_face "mt"
	    }
	    if {0} {
		regexp ".+-(\[0-9\]+)$" [.c itemcget $id -font] null size
	    } else {
		set size [expr int($fontsizeId($id)*$zoom)]
		if {$size==0} {set size 1}
	    }
	    if {[info exists font($tmp_face:$size)]==0} {
		loadFont $size $tmp_face
	    }
	    .c itemconfigure $id -font $font($tmp_face:$size)
	}
    }
    selectItem tmp_id
    set cur_zoom $zoom
    if {$cur_gridshow} {makeGridLine}
}

proc loadFont {{size} {face ""}} {
    global font fontface fmap
    global tcl_platform
    global kfont_mt kfont_gh
    
    if {$face==""} {set face $fontface}
    if {[info exists font($face:$size)]!=0} {return}
    set win_fontscale .9
    if {$face=="gh"} {
	set font($face:$size) Gothic:Helvetica-Bold-$size
	eval set kfont $kfont_gh
	if {$tcl_platform(platform)=="windows"} {
	    font create $font($face:$size) \
		    -copy [list $kfont [expr int($size*$win_fontscale)]]
	} else {
	    catch [font create $font($face:$size) \
		    -compound \
		    "-adobe-helvetica-bold-r-normal--$size-*-*-*-p-*-iso8859-1 \
		    $kfont"]
	    # "-*-*-*-*-*--$size-*-*-*-*-*-jisx02*-*"
	}
	set fmap($font($face:$size)) \
		[list {Helvetica-Bold GothicBBB-Medium-EUC-H} $size]
    } elseif {$face=="mt"} {
	set font($face:$size) Mincho:Times-Roman-$size
	eval set kfont $kfont_mt
	if {$tcl_platform(platform)=="windows"} {
	    font create $font($face:$size) \
		    -copy [list $kfont [expr int($size*$win_fontscale)]]
	} else {
	    catch [font create $font($face:$size) \
		    -compound \
		    "-adobe-times-medium-r-normal--$size-*-*-*-p-*-iso8859-1 \
		    $kfont"]
	# "-*-*-*-*-*--$size-*-*-*-*-*-jisx02*-*"
	}
	set fmap($font($face:$size)) \
		[list {Times-Roman Ryumin-Light-EUC-H} $size]
    } else {
	error "Unknown typeface specified '$fontface'"
    }

}

proc toggleFontFace {} {
    global font fontface fontsize cur_id itemType
    if {$fontface=="gh"} {
	set fontface "mt"
    } else {
	set fontface "gh"
    }
    .text.fs_lf configure -text $fontface
    if {$cur_id!={}} {
	foreach id $cur_id {
	    if {$itemType($id)=="text"} {
		set tmp_fontsize $fontsize
		regexp ".+-(\[0-9\]+)$" [.c itemcget $id -font] null fontsize
		if {[info exists font($fontface:$fontsize)]==0} {
		    loadFont $fontsize
		}
		.c itemconfigure $id -font $font($fontface:$fontsize)
		set fontsize $tmp_fontsize
	    }
	}
    }
}

proc groupItem {{group_id}} {
    upvar $group_id g_id
    global group itemgroup cur_group_id

    set gname "g$cur_group_id"
    set group($gname) $g_id
    set g ""
    set grouping_p 0
    foreach id $g_id {
       if {[info exists itemgroup($id)] && $itemgroup($id)!=""} {
           if {$g!="" && [lintersection $itemgroup($id) $g]==""} {
               set grouping_p 1
               break
           }
           set g $itemgroup($id)
       } else {
           set grouping_p 1
           break
       }
    }
    if {$grouping_p==0} {return}
    foreach id $g_id {
	lappend itemgroup($id) $gname
    }
    incr cur_group_id
}

proc ungroupItem {{group_id}} {
    upvar $group_id g_id
    global group itemgroup

    foreach id $g_id {
	if {[info exists itemgroup($id)]} {
	    set itemgroup($id) [lreplace $itemgroup($id) end end]
	}
    }
}

############################################################
# Balloon Help
proc balloon_activate {w msg} {
    global bhinfo balloon_show
    if {$balloon_show} {
	set bhinfo(w) [after 500 balloon_popup $w [list $msg]]
    }
}

proc balloon_cancel {w} {
    global bhinfo
    if {[info exists bhinfo(w)]} {
	after cancel $bhinfo(w)
	unset bhinfo(w)
    }
    if {[winfo exists .bh]} {
	destroy .bh
    }
}

proc balloon_popup {w msg} {
    global balloon_lang

    if {$balloon_lang!="Japanese"} {
	set msg [lindex $msg 0]
    } else {
	set msg [lindex $msg 1]
    }
    set t .bh
    toplevel $t -background black -borderwidth 1 -relief flat
    label $t.l -text $msg -background LemonChiffon \
	    -font {-*-lucida-medium-r-normal-sans-*-120-*}
    pack $t.l
    wm overrideredirect $t 1

    set x [expr [winfo rootx $w]+[winfo reqwidth $w]/2]
    set y [expr [winfo rooty $w]+[winfo reqheight $w]+5]
    wm geometry $t [format "+%d+%d" $x $y]
    update idletasks
}

proc balloon_for {w msg {msg_jp ""}} {
    bind $w <Enter> [list balloon_activate $w [list $msg $msg_jp]]
    bind $w <Leave> [list balloon_cancel $w]
    bind $w <Button-1> [list balloon_cancel $w]
}

############################################################
proc exitProgram {} {
    global cur_editedp
    
    if {1 || $cur_editedp==0} {
	exit
    } else {
	puts "Warning: Please save before quit."
    }
}

############################################################
# Initialize
set cur_mode "select"
set cur_id {}
set cur_nod {}
set cur_bbox ""
if {0} {
    set cur_col [list [expr int(([rand]*.4+.6)*255)] [rand] [rand] [rand]]
} else {
    set cur_col {0 0 0 0}
}
set cur_filename "default.mmp"
set cur_filetitle ""
set cur_creator "unknown"
if {[array names env USER]!=""} {set cur_creator "$env(USER)"}
if {$cur_creator!="" && $cur_creator!="unknown"} {
    set tmp [exec perl -e {print ((getpwnam("oshiro"))[6])}]
    if {$tmp!=""} {
	set cur_creator $tmp
    }
}
set cur_createdate [clock format [clock seconds] -format "%Y/%m/%d"]
set cur_arrow "first"
set cur_arrowshape {10 10 2}
set cur_smooth "0"
set cur_editedp 0
set cur_backupedp 0
set cur_printname "tmp_tkduke.eps"
set cur_zoom 1
set cur_itemanchor "c"
set cur_scaleratio .7
set cur_rotateangle 90
set cur_shearxshift 50
set cur_blendstep 20
set cur_paporient "landscape"
set cur_cursor "left_ptr"
set cur_textjustify "center"
set cur_textanchor "center"
set cur_saving 0
set cur_savepreview 0
set cur_importdir .
set cur_importtext whole
set poly_tgiftype 1
#set cur_itemsnap 0
set tmp_cur_id ""
set group() ""
set itemgroup() ""
set cur_group_id 0
set cur_layer 1
set layer_id() ""
set fline_skipnum 1
set fline_cnt 0
set raiselower lower
sets {width height} {876 620} ;# A4 paper size
set floatmenubase_limit 7
set floatmenubase_x 0
set floatmenubase_y 0
set balloon_lang "English"
set balloon_show 1
set bhinfo(w) ""

set fontface "gh"
if {$tcl_platform(platform)=="windows"} {
set fontsize_list {2 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 24 25 26 30 33 34 40 50 60 70 80 90 100 120}
set kfont_gh {{£Í£Ó £Ð¥´¥·¥Ã¥¯}}
set kfont_mt {{£Í£Ó £ÐÌÀÄ«}}
} else {
if {0} {
set fontsize_list {2 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 24 25 26 30 33 34 40 50 60 70 80 90 100 120}     ;# X-tt ¤Î¾ì¹ç¤Ë¿ä¾©
set kfont_gh "-wadalab-gothic-*-r-*--\$size-*-*-*-*-*-jisx02*-*"
set kfont_mt "-watanabe-mincho-*-r-*--\$size-*-*-*-*-*-jisx02*-*"
} else {
set fontsize_list {10 12 16 24} ;# ÄÌ¾ï¤Î X ¤ËÍÑ°Õ¤µ¤ì¤Æ¤¤¤ëÆüËÜ¸ì¥Õ¥©¥ó¥È¤Ç¤Ï
                                ;# ¤³¤Á¤é¤¬¸Â³¦
set kfont_gh "-jis-*-*-r-*--\$size-*-*-*-*-*-jisx02*-*"
set kfont_mt "-jis-*-*-r-*--\$size-*-*-*-*-*-jisx02*-*"
}
}
set fontsize 16
set font_no [expr [lsearch $fontsize_list $fontsize] +1]
set cur_linewidth 2
set cur_gridshow 1
set linecap butt
set rodwidth 15
#set tk_strictMotif 1
set no_toolbutton 0


############################################################
# ½é´üÀßÄê¥Õ¥¡¥¤¥ë¤ÎÆÉ¤ß¹þ¤ß
if {[info exists env(LANG)] && [regexp "^ja_JP" $env(LANG)]} {
    set balloon_lang "Japanese"
}
if {[file exists [glob ~]/.tkdukerc]} {
    source [glob ~]/.tkdukerc
}

while {1} {
    set v [lindex $argv 0]
    if {![regexp "^-" $v] || [regexp "^--$" $v]} break
    switch -- $v {
	"-notoolbutton" {
	    set no_toolbutton 1
	    set cur_gridshow 0
	    set argv [lrange $argv 1 end]
	}
	"--help"	{
	    puts "Usage: tkduke \[-notoolbutton\] file"
	    exit
	}
	default {
	    puts "Unknown option specified $v."
	    puts "Usage: tkduke \[-notoolbutton\] file"
	    exit
	}
    }
}

############################################################
canvas .c \
	-width [expr $width*$cur_zoom] \
	-height [expr $height*$cur_zoom] \
	-background white
#.c configure -background SteelBlue
if {0} {
    set grid_unit 1
} else {
    foreach {name u} {cm c mm m in i pt p} {
	set tmp_id [.c create line 1$u 0 0 0]
	set gridUnit($name) [lindex [.c coords $tmp_id] 0]
	.c delete $tmp_id
    }
    set grid_unit $gridUnit(mm)
}
scrollbar .cscrolly -orient vertical   -command ".c yview"
scrollbar .cscrollx -orient horizontal -command ".c xview"
grid .cscrolly -row 4 -column 5 -sticky ns
grid .cscrollx -row 5 -column 3 -columnspan 2 -sticky ew
sets {canvas_column canvas_row} {3 4}
grid .c -row $canvas_row -column $canvas_column -columnspan 2
grid rowconfigure . $canvas_row -weight 1
grid columnconfigure . $canvas_column -weight 1
.c configure -scrollregion \
	"0 0 [expr $width*$cur_zoom] [expr $height*$cur_zoom]" \
	-xscrollcommand ".cscrollx set" -yscrollcommand ".cscrolly set" 
focus .c
if {$cur_gridshow} {makeGridLine}

##################################################
# Font map, fontmap
if {1} {
. config -cursor watch
set i 1
foreach size $fontsize_list {
    set fontsize_array($i) $size
    #loadFont $size ;#¢«»Ï¤á¤Ë¼Â¹Ô¤¹¤ë¤È¥Õ¥©¥ó¥È¿ô¤¬Â¿¤¤¤È¤­¤Ë»þ´Ö¤¬¤«¤«¤ë
    incr i
}
. config -cursor left_ptr
} else {
    set font Ryumin:Helvetica-12
}
setIconbitmap .

##################################################
frame .file
frame .tool
frame .op
frame .op.col
frame .text
if {$no_toolbutton==0} {
grid .file -row 0 -column 2 -columnspan 2 -sticky w
grid .tool -row 3 -column 1 -rowspan 5 -sticky nw
grid .text -row 2 -column 3 -columnspan 2 -sticky w
grid .op -row 0 -column 0 -rowspan 5 -sticky n
}

##################################################
set t .file
foreach {i} {quit newfile load reload save saveas import importtext imagel info} {
    button $t.$i -image ${i}_icon
}
foreach {i m} {print menu} {
    menubutton $t.$i -image ${i}_icon -menu $t.$i.$m -relief raised
}
set m $t.print.menu
menu $m -tearoff false
$m add command -label "Send to Printer" -command {if {[printCanvas /tmp/tkduke[pid].eps]} {exec lpr -Plbp67 -r -s /tmp/tkduke[pid].eps}}
$m add command -label "Save to EPS" -command {printfileDialog printCanvas "Print Out to File" Save}
foreach {w msg msg_jp} {
  quit "Quit" "½ªÎ»"
  newfile "New" "¿·µ¬"
  load "Load" "ÆÉ¤ß¹þ¤ß"
  reload "Reload" "ºÆÆÉ¤ß¹þ¤ß"
  save "Save" "ÊÝÂ¸"
  saveas "Save as" "ÊÌÌ¾ÊÝÂ¸"
  import "Import" "¸½ÊÔ½¸Ê¬¤ØÆÉ¤ß¹þ¤ß"
  importtext "Import Text File" "¥Æ¥­¥¹¥È¥Õ¥¡¥¤¥ë¤òÆÉ¤ß¹þ¤ß"
  imagel "Load Image File" "²èÁü¤òÆÉ¤ß¹þ¤ß"
  print "Print" "°õºþ"
  info "Document Info Editor" "¥Õ¥¡¥¤¥ë¾ðÊó¤òÊÔ½¸"
} {
    balloon_for $t.$w $msg $msg_jp
}
set t .tool
foreach {i d} {\
	bs select bt text brct rect borct orect bb box bob obox bx boxx \
	bc circle bo oval bsp sphere 
} {
    radiobutton $t.$i -image ${d}_icon -value $d \
	    -variable cur_mode -indicatoron false
}
foreach {i d} {\
	ba arrow bl line bfl fline bpl pline bpo poly br rod bp pixel \
        spoit colSpoit
} {
    radiobutton $t.$i -image ${d}_icon -value $d \
	    -variable cur_mode -indicatoron false
}
foreach {w msg msg_jp} {
  bs "Select" "ÁªÂò"
  bt "Text" "¥Æ¥­¥¹¥È"
  brct "Rectangle" "¶ë·Á"
  borct "OvalRectangle" "´Ý¶ë·Á"
  bb "Box" "ÃæµÍ¤á¶ë·Á"
  bob "OvalBox" "ÃæµÍ¤á´Ý¶ë·Á"
  bx "Boxx" "È¢"
  bc "Circle" "±ß"
  bo "Oval" "ÃæµÍ¤á±ß"
  bsp "Sphere" "µå·Á"
  ba "Arrow" "Ìð"
  bl "Line" "Àþ"
  bfl "Free" "¼«Í³Àþ"
  bpl "Poly Line" "Â¿³ÑÀþ"
  bpo "Poly Fill" "Â¿³Ñ·Á"
  br "Rod" "ËÀ·Á"
  bp "Pixel" "ÅÀ"
  spoit "Spoit Color" "¿§¥¹¥Ý¥¤¥È"
} {
    balloon_for $t.$w $msg $msg_jp
}

proc fontmapNumToSize {} {
    global font_no fontsize fontsize_array
    while {1} {
	tkwait variable font_no
	set fontsize $fontsize_array($font_no)
    }
}
after 10000 fontmapNumToSize

##################################################
set t .text
label $t.e_l -text Text -relief ridge
text $t.e -width 30 -height 1
balloon_for $t.e_l "Text Input" "Ê¸»úÎó¤ÎÆþÎÏ"

##################################################
set c .op.col
entry $c.cole -width 9
button $c.cur_col -background [makeColorString $cur_col] -relief raised
button $c.col_rand -image colrnd_icon -relief raised
menubutton $c.col_sel -image colsel_icon -relief raised
$c.col_sel configure -menu [makeColorMenu $c.col_sel]
checkbutton $c.col_randchk -variable col_rand
button $c.col_plt -image colplt_icon -command {setColor [tk_chooseColor -title "Color Chooser" -initialcolor [.op.col.cur_col cget -background]]}

set cur_stipple {{}}
menubutton $c.stipple_sel -text stp -relief raised -justify center
$c.stipple_sel configure -menu [makeStippleMenu $c.stipple_sel]

foreach {w msg msg_jp} {
  cur_col "Set Current Color" "¸½ºß¿§¤òÀßÄê"
  col_rand "Random Color" "¥é¥ó¥À¥à¥«¥é¡¼"
  col_sel "Color Select" "¿§ÁªÂò"
  col_plt "Color Pallette" "¿§ºîÀ®"
  col_randchk "Set Random Color for Each Item" "¥¢¥¤¥Æ¥àËè¤Î¿§¤Î¥é¥ó¥À¥àÀßÄê"
  stipple_sel "Set Item Stipple" "¥¢¥¤¥Æ¥àÌÏÍÍ¤òÀßÄê"
} {
    balloon_for $c.$w $msg $msg_jp
}

#checkbutton $c.itemsnap -variable cur_itemsnap -onvalue 1 -offvalue 0

##################################################
set t .op
button $t.delete  -text "delete" -relief raised
button $t.copy    -text "copy" -relief raised
button $t.group   -text "group" -relief raised
button $t.ungroup   -text "ungroup" -relief raised
button $t.propdist -text "propDist" -relief raised
button $t.frame   -text "fram" -relief raised
button $t.shadow  -text "shad" -relief raised
button $t.brace   -text "brac" -relief raised
button $t.flipH   -text "flipH" -relief raised
button $t.flipV   -text "flipV" -relief raised
button $t.scaleI  -text "scale" -relief raised
button $t.rotateI -text "rotate" -relief raised
button $t.shearI  -text "shear" -relief raised
button $t.togGrid -text "togGrid" -relief raised
if {0} {
    button $t.setGrid -text "setGrid" -relief raised
} else {
    set m $t.setGrid
    menubutton $m -menu $m.menu -text "setGrid" -relief raised
    set m $m.menu
    menu $m -tearoff false
    foreach g {0 1 2 5 10 20} {
	$m add command -label $g -command [list setGrid $g] \
		-columnbreak [expr $g==5]
    }
    $m add command -label set -command {setGrid {}}
}
button $t.fileBrowser -text "fileBrowser" -relief raised
button $t.togor   -text "togOrient" -relief raised
checkbutton $t.togsm   -text "togSmooth" -relief raised -variable cur_smooth -onvalue 1 -offvalue 0
button $t.togar   -text "togArrow" -relief raised
button $t.togjus  -text "togTextJustify" -relief raised
button $t.toganc  -text "togTextAnchor" -relief raised
button $t.splittext  -text "splitText" -relief raised
button $t.jointext  -text "joinText" -relief raised
button $t.togpcl  -text "togClosePline" -relief raised
button $t.togitm  -text "togItem" -relief raised
button $t.blend   -text "blend" -relief raised
button $t.darken  -text "dark" -relief raised
button $t.lighten -text "light" -relief raised
radiobutton $t.bna -text "nAdd" -value "nodAdd" -variable cur_mode -indicatoron  false
radiobutton $t.bnd -text "nDel" -value "nodDel" -variable cur_mode -indicatoron  false
radiobutton $t.bnc -text "nCut" -value "nodCut" -variable cur_mode -indicatoron  false
set m $t.menulinc
menubutton $m -menu $m.menu -text "setLineCap" -relief raised
set m $m.menu
menu $m -tearoff false
$m add command -label "Butt"
$m add command -label "Projecting"
$m add command -label "Round"
foreach {w msg msg_jp} {
  delete "Delete Select Item" "ºï½ü"
  copy "Copy Select Item" "Ê£¼Ì"
  group "Group Select Item" "¥°¥ë¡¼¥Ô¥ó¥°"
  ungroup "Ungroup Select Item" "¥°¥ë¡¼¥Ô¥ó¥°¤ò²ò½ü"
  propdist "Proportional Distribute" "¶ÑÅùÇÛÃÖ"
  frame "Add Frame to Select Item" "ÏÈ¤òÄÉ²Ã"
  shadow "Add Shadow to Select Item" "±ÆÉÕ¤­ÏÈ¤òÄÉ²Ã"
  brace "Add Brace to Select Item" "¥«¥®³ç¸ÌÏÈ¤òÄÉ²Ã"
  flipH "Item Flip Horizontal" "¿åÊ¿Êý¸þ¤ËÈ¿Å¾"
  flipV "Item Flip Vertical" "¿âÄ¾Êý¸þ¤ËÈ¿Å¾"
  scaleI "Scale Select Item" "¥µ¥¤¥º¤òÊÑ¹¹"
  rotateI "Rotate Select Item" "²óÅ¾"
  shearI "Shear Select Item" "¤»¤óÃÇÊÑ·Á"
  togGrid "Set Grid Size" "¥°¥ê¥Ã¥ÉÉ½¼¨¤òÀÚÂØ¤¨"
  setGrid "Set Grid Size" "¥°¥ê¥Ã¥É¥µ¥¤¥º¤òÀßÄê"
  fileBrowser "Invoke File Browser" "¥Õ¥¡¥¤¥ë¥Ö¥é¥¦¥¶¤òµ¯Æ°"
  togor "Toggle Paper Orient" "»æÌÌÊý¸þ¤òÀÚÂØ¤¨"
  togsm "Toggle Poly/Line Smoothing" "Àþ¼ï¤Î¥¹¥à¡¼¥¸¥ó¥°¤òÀÚÂØ¤¨"
  togar "Toggle Line Arrow" "Àþ¤ÎÌð¤ÎÍ­Ìµ¤òÀÚÂØ¤¨"
  togjus "Toggle Text Justify" "Ê¸»úÎó¤Î´ó¤»Êý¸þ¤òÀÚÂØ¤¨"
  toganc "Toggle Text Anchor" "Ê¸»úÎó¤ÎÇÛÃÖ°ÌÃÖ¤òÀÚÂØ¤¨"
  splittext "Split Text Each Line" "Ê¸»úÎó¤ò¹ÔËè¤ËÊ¬²ò"
  jointext "Join Text to One Item" "¹ÔËè¤ÎÊ¸»úÎó¤òÃ±°ì²½"
  togpcl "Toggle Poly Line Closing" "Â¿³ÑÀþ¤ÎÃ¼ÅÀ¤ÎÊÄ¤¸¤òÀÚÂØ¤¨"
  togitm "Toggle Item Type" "¥¢¥¤¥Æ¥à¼ï¤òÀÚÂØ¤¨"
  blend "Blend Two Same Type Items" "£²¤Ä¤Î¥¢¥¤¥Æ¥à¤òÊ£¹ç"
  darken "Change Color Dark" "¥¢¥¤¥Æ¥à¿§¤ò°Å¤¯"
  lighten "Change Color Light" "¥¢¥¤¥Æ¥à¿§¤òÌÀ¤ë¤¯"
  bna "Line Node Add" "Àþ¤ÎÀ©¸æÅÀ¤òÄÉ²Ã"
  bnd "Line Node Delete" "Àþ¤ÎÀ©¸æÅÀ¤òºï½ü"
  bnc "Line Node Cut" "Àþ¤ÎÀ©¸æÅÀ¤«¤éÊ¬³ä"
  menulinc "Set Line Cap" "¥é¥¤¥ó¥­¥ã¥Ã¥×¤òÀßÄê"
} {
    balloon_for $t.$w $msg $msg_jp
}

set t .file
button $t.zoom_p -image lupe_plus -relief raised
button $t.zoom_m -image lupe_minus -relief raised
label $t.zoom_v -text [format "%4.1f" $cur_zoom]
bind $t.zoom_p <ButtonRelease-1> {changeZoom [expr $cur_zoom*sqrt(2)]}
bind $t.zoom_m <ButtonRelease-1> {changeZoom [expr $cur_zoom/sqrt(2)]}
balloon_for $t.zoom_p "Zoom +" "É½¼¨¤ò³ÈÂç +"
balloon_for $t.zoom_m "Zoom -" "É½¼¨¤ò½Ì¾® -"
balloon_for $t.zoom_v "Current Zoom Value" "¸½ºß¤ÎÉ½¼¨¥¹¥±¡¼¥ë"

label $t.llayer -text Layer -relief ridge
balloon_for $t.llayer "Change Layer" "ÊÔ½¸¥ì¥¤¥ä¤ÎÀÚÂØ¤¨"
foreach n {1 2 3 4} {
    radiobutton $t.layer$n -variable cur_layer -value $n -text $n \
	    -indicatoron  false
    balloon_for $t.layer$n "Change Layer $n" "ÊÔ½¸¥ì¥¤¥ä¤ÎÀÚÂØ¤¨ $n"
}

label $t.limptype -text ImportText -relief ridge
balloon_for $t.limptype \
	"Set Import Text Type" \
	"¥Æ¥­¥¹¥È¥Õ¥¡¥¤¥ë¤ÎÆÉ¤ß¹þ¤ß¥¿¥¤¥×¤òÀßÄê"
checkbutton $t.imptype -variable cur_importtext -indicatoron  false \
	-onvalue each -offvalue whole -text each
balloon_for $t.imptype \
	"Set Import Text Type to 'Each'" \
	"¥Æ¥­¥¹¥È¥Õ¥¡¥¤¥ë¤ÎÆÉ¤ß¹þ¤ß¥¿¥¤¥×¤ò¡Ö¸ÄÊÌ¹Ô¡×¤ËÀßÄê"

set sticky news
set t .file
if {$no_toolbutton==0} {
foreach {w r c} {
    quit 0 0
    newfile 0 1
    load 0 2
    reload 0 3
    save 0 4
    saveas 0 5
    import 0 6
    importtext 0 7
    imagel 0 8
    print  0 9
    info   0 10
    zoom_p 0 11
    zoom_m 0 12
    zoom_v 0 13
    llayer 0 14
    layer1 0 15
    layer2 0 16
    layer3 0 17
    layer4 0 18
    limptype 0 19
    imptype 0 20
} {
    grid $t.$w -row $r -column $c -sticky $sticky -padx 0 -pady 0 -ipadx 0 -ipady 0
}
}

update idletasks
wm geometry . [wm geometry .]

##################################################
set c .op.col
if {0} {
grid $c.cur_col $c.cole $c.col_plt -sticky news
grid $c.col_sel $c.col_rand $c.col_randchk -sticky news
grid $c.stipple_sel
} else {
grid $c.cur_col $c.col_sel $c.col_plt $c.col_rand $c.col_randchk $c.stipple_sel -sticky news
}

set t .tool
if {$no_toolbutton==0} {
set c 0
set r 0
foreach {w} {
    bs
    bt
    brct
    borct
    bb
    bob
    bx
    bc
    bo
    bsp
    ba
    bl
    bfl
    bpl
    bpo
    br
    bp
    spoit
} {
    grid $t.$w -row $r -column $c -sticky $sticky
    incr r
}
}

set t .op
if {$no_toolbutton==0} {
grid $t.fileBrowser -columnspan 6 -sticky news
grid $t.togor -columnspan 6 -sticky news
grid $t.togGrid $t.setGrid -columnspan 3 -sticky news
grid $t.delete $t.copy -columnspan 3 -sticky news
grid $t.group $t.ungroup -columnspan 3 -sticky news
grid $t.scaleI $t.shearI $t.rotateI -columnspan 2 -sticky news

grid $t.blend $t.darken $t.lighten -columnspan 2 -sticky news

grid $t.bnd $t.bnc $t.bna -columnspan 2 -sticky news

grid $t.frame $t.shadow $t.brace -columnspan 2 -sticky news

grid $t.flipH $t.flipV -columnspan 3 -sticky news
grid $t.propdist -columnspan 6 -sticky news

grid $t.togjus -columnspan 6 -sticky news
grid $t.toganc -columnspan 6 -sticky news
grid $t.splittext $t.jointext -columnspan 3 -sticky news
grid $t.togsm -columnspan 6 -sticky news
grid $t.togar -columnspan 6 -sticky news
grid $t.togpcl -columnspan 6 -sticky news
grid $t.menulinc -columnspan 6 -sticky news
grid $t.togitm -columnspan 6 -sticky news
grid $t.col -columnspan 6 -sticky news
}

set t .text
scale $t.fs -variable font_no -from 1 -to [llength $fontsize_list] -orient horizontal -showvalue 0
label $t.fs_l -text Font -relief ridge
label $t.fs_lv -text [$t.fs get]
label $t.fs_lf -text $fontface
scale $t.fw -variable cur_linewidth -from 0 -to 200 -orient horizontal -showvalue 0
label $t.fw_l -text Line -relief ridge
label $t.fw_lv -text [$t.fw get]
balloon_for $t.fs_l "Set Font" "»úÂ°À­¤ÎÀßÄê"
balloon_for $t.fs_lf "Toggle Font Face" "»úÂÎ¤òÀÚÂØ¤¨"
balloon_for $t.fs "Set Font Size" "»ú¥µ¥¤¥º¤òÀßÄê"
balloon_for $t.fw_l "Set Line" "Àþ¤ÎÀßÄê"
balloon_for $t.fw "Set Line Width" "ÀþÉý¤ÎÀßÄê"

if {$no_toolbutton==0} {
set t .text
grid $t.e_l $t.e $t.fs_l $t.fs_lf $t.fs $t.fs_lv $t.fw_l $t.fw $t.fw_lv -sticky news
}

############################################################
#
proc makeFloatMenuBase {{x} {y}} {
    global todo todo_c todo_open todo_num
    global cur_editedp cur_filename cur_printname cur_mode
    global tool_menu_teaoff
    foreach i {arrow box obox boxx circle fline line oval pixel pline poly rect orect rod select sphere text colSpoit quit load import importtext save saveas imagel print info} {
	global ${i}_icon
    }

    set m .tool_menu
    if {[winfo exists $m]} {
	tk_popup $m [expr $x-20] $y
	return
    }
    menu $m -tearoff 1 -cursor hand2 -title "tkduke: Toolbox"
    bind $m <Control-q> "destroy $m;break"
    bind $m <Control-c> "destroy $m;break"
    bind $m <Alt-w> "destroy $m;break"
    set clmn 5
    #set n 0
    set n 1
    foreach i {
	select
	text
	rect
	orect
	box
	obox
	boxx
	circle
	oval
	sphere
	arrow
	line
	fline
	pline
	poly
	rod
	pixel
	colSpoit} {
	$m add radiobutton -variable cur_mode \
		-indicatoron false \
		-value $i \
		-image ${i}_icon \
		-hidemargin 1 \
		-columnbreak [expr (fmod($n-1, $clmn)==0)]
	incr n
    }
    set n 1
    foreach f {
	{load {fileDialog loadFile "Load File"}}
	{reload {loadFile $cur_filename}}
	{save {saveItem $cur_filename}}
	{saveas {set cur_filename ""; fileDialog saveItem "Save As.." Save}}
	{import {set imp_id [fileDialog importFile "Import File"]; selectItem imp_id}}
	{imagel {imagefileDialog importImage "Import Image"}}
	{print {printfileDialog printCanvas "Print Out to File" Save}}
	{info {editCurrentInfo}}
	{newfile {fileDialog newFile "New File"}}
	{quit exitProgram}} {
	set i [lindex $f 0]
	set com  [lindex $f 1]
	$m add command -image ${i}_icon \
		-command $com \
		-hidemargin 1 \
		-columnbreak [expr (fmod($n-1, $clmn)==0)]
	incr n
    }

    tk_popup $m [expr $x-20] $y
}

bind .c <ButtonPress-1> {focus .c; ButtonPress-1 %x %y}
bind .c <ButtonPress-2> {focus .c; ButtonPress-2 %x %y}
bind .c <Enter> {focus .c}
bind .c <ButtonPress-3> {
    if {$cur_mode=="poly" || $cur_mode=="pline"} {
	ButtonPress-3 %x %y
    } else {
	set floatmenubase 0
	set floatmenubase_x %x
	set floatmenubase_y %y
	if {0} {
	unselectItem cur_id
	set cur_id "";
	set cur_bbox "";
	set cur_mode "select";
	}
    }
}
bind .c <Button3-Motion> {
    if {sqrt((%x-$floatmenubase_x)*(%x-$floatmenubase_x)+(%y-$floatmenubase_y)*(%y-$floatmenubase_y))>$floatmenubase_limit} {
	makeFloatMenuBase %X %Y
	set floatmenubase 1
    }
}
bind .c <ButtonRelease-3> {
    if {$floatmenubase==0} {
	unselectItem cur_id
	set cur_id "";
	set cur_bbox "";
	set cur_mode "select";
    }
    set floatmenubase 0
}
bind .c <Button1-Motion> {Button1-Motion %x %y}
bind .c <ButtonRelease-1> {ButtonRelease-1 %x %y}
bind .c <Shift-ButtonPress-1>  {Shift-ButtonPress-1 %x %y; break}
bind .c <Shift-ButtonPress-3>  {Shift-ButtonPress-3 %x %y; break}
bind .c <Shift-ButtonRelease-3> {break}
bind .c <Shift-Button1-Motion> {break}
bind .c <Motion> {ButtonMotion %x %y}

set floatmenubase 0
set t .text
bind $t.e <Alt-Return> {
    %W insert insert "\n"
    %W mark set current [%W index insert]+2chars
    %W see current
    break
}
bind $t.e <Control-o> {
    %W insert insert "\n"
    %W mark set current [%W index insert]+2chars
    %W see current
    break
}
bind $t.e <Control-Return> {
    %W insert insert "\n"
    %W mark set current [%W index insert]+2chars
    %W see current
    break
}
bind $t.e <Key-Return> {
    set x [expr ([rand]*.6+.2)*$width ]
    set y [expr ([rand]*.6+.2)*$height]
    if {$cur_id!={}} {
	foreach id $cur_id {
	    if {$itemType($id)=="text"} {
		set font_opt [.c itemcget $id -font]
		set tmp_fontface $fontface
		set tmp_fontsize $fontsize 
		if {[regexp "Mincho:Times-Roman-(\[0-9\]+)" $font_opt null tmp_fontsize]} {
		    set tmp_fontface "mt"
		} elseif {[regexp "Gothic:Helvetica-Bold-(\[0-9\]+)" $font_opt null tmp_fontsize]} {
		    set tmp_fontface "gh"
		}
		if {[info exists font($tmp_fontface:$tmp_fontsize)]==0} {loadFont $tmp_fontsize $tmp_fontface}
		.c itemconfigure $id -text [%W get 0.0 "end-1chars"] -font $font($tmp_fontface:$tmp_fontsize)
	    }
	}
    } else {
	makeItem "text" [list $x $y]
    }
    break
}
bind $t.e <Double-Button-3> {
    %W delete 0.0 end
    focus %W
    break
}
set c .op.col
bind $c.cole <Key-Return>      {setColor [%W get]}
bind $c.cole <Button-3>        {setColor [%W get]}
bind $c.cole <Double-Button-1> {%W delete 0 end}
set t .text
$t.fs configure -command [list $t.fs_lv configure -text]
bind $t.fs <ButtonRelease-1> {
    set x [expr ([rand]*.6+.2)*$width ]
    set y [expr ([rand]*.6+.2)*$height]
    if {$cur_id!={}} {
	foreach id $cur_id {
	    if {$itemType($id)=="text"} {
                regexp "(.+)-\[0-9\]+\$" [.c itemcget $id -font] null tmpface
		if {$tmpface=="Mincho:Times-Roman"} {
		    set face "mt"
		} elseif {$tmpface=="Gothic:Helvetica-Bold"} {
		    set face "gh"
		}
		if {0} {
		    set size $fontsize_array($font_no)
		} else {
		    set fontsizeId($id) $fontsize_array($font_no)
		    set size [expr int($fontsizeId($id)*$cur_zoom)]
		    if {$size==0} {set size 1}
		}
		if {[info exists font($face:$size)]==0} {
	            loadFont $size $face
	        }
		.c itemconfigure $id -font $font($face:$size)
	    }
	}
    }
}
$t.fw configure -command [list $t.fw_lv configure -text]
bind $t.fw <ButtonRelease-1> {
    set rodwidth $cur_linewidth
    if {$cur_id!={}} {
	foreach id $cur_id {
	    set type $itemType($id)
	    if {$type=="line" || $type=="arrow" || $type=="pline"} {
		.c itemconfigure $id -width $cur_linewidth
	    } elseif {$type=="rect" || $type=="orect"} {
		.c itemconfigure $id -width $cur_linewidth
	    } elseif {$type=="circle"} {
		.c itemconfigure $id -width $cur_linewidth
	    } elseif {$type=="rod"} {
		.c itemconfigure $id -width $rodwidth
		resizeItem id		
	    }
	}
    }
}

bind .c <Control-q>   exitProgram
bind .c <Key-Delete>  {deleteItem $cur_id}
bind .c <Control-x>   {deleteItem $cur_id; set cur_mode "select"}
bind .c <Control-a>   {selectItemAll; set cur_mode "move"}
bind .c <Control-d>   {copyItem $cur_id}
bind .c <Control-f>   {raiseItem $cur_id}
bind .c <Control-b>   {lowerItem $cur_id}
bind .c <Control-t>   {toggleSmoothItem $cur_id}
bind .c <Control-r>   {loadFile $cur_filename}
bind .c <Control-g>   {groupItem cur_id}
bind .c <Control-u>   {ungroupItem cur_id}
bind .c <Alt-p>       {printfileDialog printCanvas "Print Out to File" Save}
bind .c <Alt-parenright> {scaleSizeItem {} $cur_id}
bind .c <Alt-a>       {set cur_mode "nodAdd"}
bind .c <Alt-d>       {set cur_mode "nodDel"}
bind .c <Control-s>   {saveItem $cur_filename}
bind .c <Control-o>   {fileDialog loadFile "Load File"}
bind .c <Alt-i>       {set imp_id [fileDialog importFile "Import File"]; selectItem imp_id}
bind .c <Alt-less>    {changeZoom [expr $cur_zoom/sqrt(2)]}
bind .c <Alt-greater> {changeZoom [expr $cur_zoom*sqrt(2)]}

# wheel mouse binding
bind .c <Button-4> {.c yview scroll -5 units}
bind .c <Button-5> {.c yview scroll 5 units}
bind .c <Control-Button-4> {changeZoom [expr $cur_zoom/sqrt(2)]}
bind .c <Control-Button-5> {changeZoom [expr $cur_zoom*sqrt(2)]}
bind .c <MouseWheel> {if {%D>0} {.c yview scroll -5 units} else {.c yview scroll 5 units}}
bind .c <Control-MouseWheel> {if {%D>0} {changeZoom [expr $cur_zoom/sqrt(2)]} else {changeZoom [expr $cur_zoom*sqrt(2)]}}

update idletasks
if {$argc>0} {
    loadFile [lindex $argv 0]
}

##################################################
#
wm protocol . WM_DELETE_WINDOW exitProgram

set t .file
$t.quit configure -command exitProgram
$t.save   configure -command {saveItem $cur_filename}
$t.saveas configure -command {fileDialog saveItem "Save As.." Save}
$t.load   configure -command {fileDialog loadFile "Load File"}
$t.reload configure -command {loadFile $cur_filename}
$t.newfile configure -command {newFile}
$t.import configure -command {set imp_id [fileDialog importFile "Import File"]; selectItem imp_id}
$t.importtext configure -command {set imp_id [textfileDialog importTextFile "Import Text File"]; selectItem imp_id}
$t.imagel configure -command {imagefileDialog importImage "Import Image"}
#$t.print  configure -command {printfileDialog printCanvas "Print Out to File" Save}
$t.info   configure -command {editCurrentInfo}

set t .tool
$t.bfl configure -command unselectItemAll
$t.bpl configure -command unselectItemAll
$t.bpo configure -command unselectItemAll
set c .op.col
$c.col_rand configure -command randomColor
$c.cur_col configure -command {
    set col [lindex $cur_col 0] 
    set col [format "#%02x%02x%02x" \
	    [expr int($col*[lindex $cur_col 1])] \
	    [expr int($col*[lindex $cur_col 2])] \
	    [expr int($col*[lindex $cur_col 3])]]
    setColor $col}

set t .op
$t.delete configure -command {deleteItem $cur_id; set cur_mode "select"}
$t.copy   configure -command {copyItem $cur_id}
$t.group   configure -command {groupItem cur_id}
$t.ungroup configure -command {ungroupItem cur_id}
$t.propdist   configure -command {propdistItem cur_id}
$t.frame  configure -command {makeFrame $cur_id}
$t.shadow configure -command {makeShadow $cur_id}
$t.brace  configure -command {makeBrace $cur_id} 
$t.flipH  configure -command {flipHorizontalItem $cur_id}
$t.flipV  configure -command {flipVerticalItem $cur_id}
$t.scaleI configure -command {scaleSizeItem {} $cur_id}
$t.rotateI configure -command {rotateItem {} $cur_id}
$t.shearI configure -command {shearItem {} $cur_id}
$t.fileBrowser configure -command "$t.fileBrowser configure -state disabled; fileBrowser; tkwait window .fdw; $t.fileBrowser configure -state active"
$t.togGrid configure -command {set cur_gridshow [expr !$cur_gridshow]; makeGridLine}
#$t.setGrid configure -command {setGrid {}}
$t.togor  configure -command {toggleOrient}
$t.togsm  configure -command {toggleSmoothItem $cur_id}
$t.togar  configure -command {toggleArrowItem $cur_id}
$t.togjus configure -command {toggleTextJustify $cur_id}
$t.toganc configure -command {toggleTextAnchor $cur_id}
$t.splittext configure -command {splitTextEachLine $cur_id}
$t.jointext configure -command {joinTextEachLine $cur_id}
$t.togpcl configure -command {toggleClosePline $cur_id}
$t.togitm configure -command {toggleItem $cur_id}
$t.blend  configure -command {blendItem $cur_id}
$t.darken configure -command {darkenItem $cur_id}
$t.lighten configure -command {lightenItem $cur_id}

set m $t.menulinc.menu
$m entryconfigure Butt       -command {setLineCap "butt"       $cur_id}
$m entryconfigure Projecting -command {setLineCap "projecting" $cur_id}
$m entryconfigure Round      -command {setLineCap "round"      $cur_id}

bind .c <Alt-t>     {setItemAnchor $cur_id "l"}
bind .c <Alt-equal> {setItemAnchor $cur_id "c"}
bind .c <Alt-plus>  {setItemAnchor $cur_id "m"}
bind .c <Alt-bar>   {abutItem $cur_id "v"}
bind .c <Alt-underscore> {abutItem $cur_id "h"}

bind .c <Control-Alt-d> {darkenItem $cur_id; break}
bind .c <Control-Alt-l> {lightenItem $cur_id; break}
bind .c <Control-Alt-b> {blendItem $cur_id; break}

bind .text.fs_lf <Button-1> toggleFontFace
bind .c <Control-Alt-f> toggleFontFace

bind .c <Control-Alt-Key-1> {changeLayer 1}
bind .c <Control-Alt-Key-2> {changeLayer 2}
bind .c <Control-Alt-Key-3> {changeLayer 3}
bind .c <Control-Alt-Key-4> {changeLayer 4}

bind .c <Key-Right> {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem [expr  $grid*$cur_zoom] 0 cur_id}
bind .c <Key-Left>  {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem [expr -$grid*$cur_zoom] 0 cur_id}
bind .c <Key-Up>    {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem 0 [expr -$grid*$cur_zoom] cur_id}
bind .c <Key-Down>  {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem 0 [expr  $grid*$cur_zoom] cur_id}
bind .c <Shift-Key-Right> {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem [expr  5*$grid*$cur_zoom] 0 cur_id}
bind .c <Shift-Key-Left>  {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem [expr -5*$grid*$cur_zoom] 0 cur_id}
bind .c <Shift-Key-Up>    {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem 0 [expr -5*$grid*$cur_zoom] cur_id}
bind .c <Shift-Key-Down>  {set grid [expr $canvas_grid*$grid_unit]; if {$grid==0} {set grid 1}; moveItem 0 [expr  5*$grid*$cur_zoom] cur_id}

bind .c <Control-Alt-s> {getCanvasSnapshot .c}
bind .c <Alt-s> {splitTextEachLine $cur_id}
bind .c <Alt-j> {joinTextEachLine $cur_id}

bind .c <Alt-z> {fileBrowser}
