#!/bin/sh
# \
exec wish8.0 $0 ${1+"$@"} || exec wish $0 ${1+"$@"} || exit 1

source fontsel.tcl

option add *Menubutton.Font {Helvetica 11 bold}

wm title . "Tkpaint 1.0"
wm iconname . "tkpaint"
wm minsize . 300 150
wm protocol . WM_DELETE_WINDOW {File exit}

###### DEFAULT VALUSES OF GLOBAL VARIABLES

proc bgerror {trouble} {puts stdout "bgerror: $trouble"}

proc setDefaultGlobals {} {
   global Graphics Canv utagCounter
   global undoStack undoMode History histPtr

   array set Graphics {
     line,width      1
     line,color      black
     line,style      {}
     line,joinstyle  miter
     line,capstyle   butt
     line,arrow      none
     arrowshape      {8 10 3}
     splinesteps     20
     shape           none
     fill,color      {}
     fill,style      {}
     mode            start
     font,type       {Helvetica}
     font,size       10
     font,color      black
     font,normal     0
     font,bold       0
     font,italic     0
     font,roman      0
     font,underline  0
     font,overstrike 0
     font,style      {}
     font,stipple    {}
     text,anchor     c
     grid            0
     gridcell        0
     ticks           0
     gspacing        1
     progress        0
   }

#### CANVAS DEFAULTS
   array set Canv {
      W       500
      H       360
      coords  0,0
      bg      white
   }
   set undoStack   {}
   set undoMode    0
   set History     {}
   set histPtr     0
   set utagCounter 0
   catch {unset LastText}
}

#### DEFAULT BINDINGS

proc Bindings {mode} {
 switch $mode {
   enable {
      bind Canvas <Motion> {
         set Canv(pointerxy) %x,%y
      }

      bind .c <Leave> {
         set Canv(pointerxy) ""
      }

      bind .c <Configure> {
         set Canv(W)  %w
         set Canv(H)  %h
         Grid $Graphics(gridcell)
      }
      bind .c <Enter> {focus %W}
   }

   disable {
      foreach e [bind .c] {
          bind .c $e {}
      }
   }
 }
}

proc resetCanvas {} {
   global Canv File LastText
   Bindings disable
   setDefaultGlobals
   .c configure -width $Canv(W) -height $Canv(H) -bg $Canv(bg)
   wm geometry . ""
   set Canv(W) [winfo width .c]
   set Canv(H) [winfo height .c]
   .c delete obj
   .c delete graybox
   set File(progress) 0
   Bindings enable
}

canvas .c
resetCanvas


##### USER INTERFACE: BUTTONS, TOOL BARS, STATUS BARS, FRAMES, ETC ...

frame .mbar -bd 1 -relief raised

foreach {menub text menu under side} {
   .mbar.file    File   .mbar.file.menu    0   left
   .mbar.shape   Shape  .mbar.shape.menu   0   left
   .mbar.line    Line   .mbar.line.menu    0   left
   .mbar.fill    Fill   .mbar.fill.menu    1   left
   .mbar.edit    Edit   .mbar.edit.menu    0   left
   .mbar.group   Group  .mbar.group.menu   0   left
   .mbar.grid    Grid   .mbar.grid.menu    1   left
   .mbar.text    Text   .mbar.text.menu    0   left
   .mbar.font    Font   .mbar.font.menu    1   left
   .mbar.help    Help   .mbar.help.menu    1   right
} {
    menubutton $menub -text $text -underline $under -menu $menu
    pack $menub -side $side
}

# IN THE FOLLOWING LIST, THE ITEMS ARE GROUPED AS FOLLOWS:
# BUTTON TYPE; ROW; COLUMN; GIF; COMMAND
# R IS A RADIOBUTTON
# B IS A REGULAR BUTTON
# C IS A CHECKBUTTON
# THE ROW AND COLUMN NUMBERS ARE FOR THE GRID GEOMETRY MANAGER
# THE GIF IS DISPLAYED ON THE BUTTON
# THE COMMAND IS INVOKED WHEN THE BUTTON IS PRESSED

set Buttons { 
R  mode  0  0  rectangle.gif   {.mbar.shape.menu invoke Rectangle}
R  mode  0  1  roundrect.gif   {.mbar.shape.menu invoke "Round rectangle"}
R  mode  0  2  circle.gif      {.mbar.shape.menu invoke Circle}
R  mode  0  3  ellipse.gif     {.mbar.shape.menu invoke Ellipse}
R  mode  0  4  polygon.gif     {.mbar.shape.menu invoke Polygon}
R  mode  0  5  polyline.gif    {.mbar.shape.menu invoke Line}
R  mode  0  6  spline.gif      {.mbar.shape.menu invoke Spline}
R  mode  0  7  cspline.gif     {.mbar.shape.menu invoke "Closed Spline"}
R  mode  0  8  arc.gif         {.mbar.shape.menu invoke Arc}
R  mode  0  9  pieslice.gif    {.mbar.shape.menu invoke PieSlice}
R  mode  0 10  chord.gif       {.mbar.shape.menu invoke Chord}
R  mode  0 11  freehand.gif    {.mbar.shape.menu invoke "Free Hand"}
R  mode  1  0  text.gif        {.mbar.text.menu invoke "Draw text"}
R  mode  1  1  move.gif        {.mbar.edit.menu invoke "Move object"}
R  mode  1  2  copy.gif        {.mbar.edit.menu invoke "Copy object"}
R  mode  1  3  erase.gif       {.mbar.edit.menu invoke "Delete object"}
R  mode  1  4  raise.gif       {.mbar.edit.menu invoke "Raise object"}
R  mode  1  5  lower.gif       {.mbar.edit.menu invoke "Lower object"}
R  mode  1  6  arrows.gif      {.mbar.line.menu invoke Arrows}
C  gridcell 1  7  grid.gif     {set Graphics(gridcell) \
                                    [winfo pixels .c $Graphics(grid)c]}
R  mode  1 8  reconf.gif       {.mbar.group.menu invoke 0}
B  dumm  1 9 undo.gif         {.mbar.edit.menu invoke "Undo last change"}
B  dumm  1 10 unundo.gif       {.mbar.edit.menu invoke "Undo last undo"}
B  dumm  1 11  savefile.gif    {.mbar.file.menu invoke "Save"}
}

######## Text Tool buttons

set textButtons {
   C   0  12  bold.gif         {resetFontStyle}                 dummy
   C   0  13  underline.gif    {resetFontStyle}                 dummy
   C   0  14  italic.gif       {resetFontStyle}                 dummy
   R   1  12  lefta.gif        {.mbar.text.menu.anchor invoke West}    w
   R   1  13  centera.gif      {.mbar.text.menu.anchor invoke Center}  c
   R   1  14  righta.gif       {.mbar.text.menu.anchor invoke East}    e
}

frame .tools

foreach {btype var row col gif command} $Buttons {
    regexp {([^.]+)\.} $gif dummy b
    set im [image create photo -file gifs/$gif]
    set butt .tools.button${row}_${col}
    if {$btype=="R"} {
       set value [lindex $command end]
       radiobutton $butt -image $im -bd 1 \
             -indicatoron false \
             -selectcolor "" \
             -variable Graphics($var) \
             -value $value \
             -command $command
    }
    if {$btype=="B"} {
       button $butt -image $im -bd 1 \
             -command $command
    }
    if {$b=="grid"} {
       checkbutton $butt -image $im -bd 1 \
             -indicatoron false \
             -selectcolor "" \
             -variable Graphics(grid) \
             -command $command
    }
    grid config $butt -row $row -column $col\
                -columnspan 1 -rowspan 1 -sticky "snew"
}

foreach {btype row col gif command value} $textButtons {
   regexp {([^.]+)\.} $gif dummy b
   set im [image create photo -file gifs/$gif]
   set butt .tools.button${row}_${col}
   if {$btype=="C"} {
      checkbutton $butt -image $im -bd 1 \
             -indicatoron false \
             -selectcolor "" \
             -variable Graphics(font,$b) \
             -command $command
   }
   if {$btype=="R"} {
      radiobutton $butt -image $im -bd 1 \
             -indicatoron false \
             -selectcolor "" \
             -variable Graphics(text,anchor) \
             -value $value \
             -command $command
   }
   grid config $butt -row $row -column $col\
         -columnspan 1 -rowspan 1 -sticky "snew"
}

####### LINE WIDTH DEMO SCALE
frame .tools.width -relief raised -bd 1
canvas .tools.widthcanvas -relief flat -height 5m -width 4c
.tools.widthcanvas create text 1 1 \
       -anchor nw \
       -text "Line Width" \
       -font {Helvetica 8}
       
.tools.widthcanvas create line 1.8c .3c 4.25c .3c \
       -tags demoLine \
       -fill "$Graphics(line,color)" \
       -stipple "$Graphics(line,style)" \
       -arrow "$Graphics(line,arrow)" \
       -joinstyle "$Graphics(line,joinstyle)" \
       -width "$Graphics(line,width)"

scale .tools.widthscale -orient horiz \
       -resolution .2 -from 0 -to 20 \
       -length 2.5c \
       -variable Graphics(line,width) \
       -bd 1 \
       -relief flat \
       -highlightthickness 0 \
       -width 8 \
       -showvalue true \
       -font {"Helvetica" 8}

pack .tools.widthcanvas .tools.widthscale -in .tools.width \
     -side top  -fill both -expand true

grid config .tools.width -row 0 -column 15\
        -columnspan 1 -rowspan 2 -sticky "snew"

####### HERE WE BUILD THE FILL AND OUTLINE COLORS BUTTONS AND SAMPLES
button .tools.but_outline -text Outline: -anchor e \
      -command {chooseOutlineColor}
button .tools.but_fill -text Fill: -anchor e \
      -command {chooseFillColor}
frame  .tools.fr_outline -bg $Graphics(line,color)
frame  .tools.fr_fill
#frame  .tools.fr_fill -bg $Graphics(fill,color)

grid config .tools.but_outline -row 0 -column 16\
        -columnspan 1 -rowspan 1 -sticky "snew"
grid config .tools.but_fill -row 1 -column 16\
        -columnspan 1 -rowspan 1 -sticky "snew"

grid config .tools.fr_outline -row 0 -column 17\
        -columnspan 1 -rowspan 1 -sticky "snew"
grid config .tools.fr_fill -row 1 -column 17\
        -columnspan 1 -rowspan 1 -sticky "snew"

######### HERE WE START PACKING WITH THE GRID GEOMETRY MANAGER

grid config .mbar -column 0 -row 0 \
        -columnspan 1 -rowspan 1 -sticky "snew"
grid config .tools -column 0 -row 1 \
        -columnspan 1 -rowspan 1 -sticky "snew" 
grid config .c -column 0 -row 2 \
        -columnspan 1 -rowspan 1 -sticky "snew" 

#
# SET UP GRID FOR RESIZING.
# COLUMN 0 (THE ONLY ONE) GETS THE EXTRA SPACE.
grid columnconfigure . 0 -weight 1
# COL 17 (COLOR SAMPLES) GETS EXTRA SPACE IN RESIZING
grid columnconfigure .tools 17 -minsize 20
grid columnconfigure .tools 17 -weight 1
# COL 15 (LINE DEMO SAMPLES) GETS EXTRA SPACE IN RESIZING
grid columnconfigure .tools 15 -minsize 40
grid columnconfigure .tools 15 -weight 1
# Row 2 (the main area) gets the extra space.
grid rowconfigure . 2 -weight 1

for {set i 0} {$i<=14} {incr i} {
      grid columnconfigure .tools $i -minsize 25
}

######### MENUS ####################################

### FILE MENU:

menu .mbar.file.menu -tearoff 0

.mbar.file.menu add command -label New -command {File new}

.mbar.file.menu add command -label Open -command {File open}

.mbar.file.menu add command -label Close  -command {File close}

.mbar.file.menu add command -label Save -command {File save auto}

.mbar.file.menu add cascade -label "Save as" -menu .mbar.file.menu.save_as

menu .mbar.file.menu.save_as -tearoff 0

.mbar.file.menu.save_as add command \
         -label "Save as Encapsulated PostScript" \
         -command {File save eps}

.mbar.file.menu.save_as add command \
         -label "Save as Tcl script" \
         -command {File save pic}

.mbar.file.menu add command -label Print  -command {File print}
.mbar.file.menu add command -label Exit  -command {File exit}



####### SHAPE MENU:

menu .mbar.shape.menu -tearoff 0

.mbar.shape.menu add radiobutton \
     -label Rectangle \
     -variable Graphics(mode) \
     -value Rectangle \
     -command {startRectagle}
.mbar.shape.menu add radiobutton \
     -label "Round rectangle" \
     -variable Graphics(mode) \
     -value "Round rectangle" \
     -command {startRoundRect}
.mbar.shape.menu add radiobutton \
     -label Circle \
     -variable Graphics(mode) \
     -value Circle \
     -command {startCircle}
.mbar.shape.menu add radiobutton \
     -label Ellipse \
     -variable Graphics(mode) \
     -value Ellipse \
     -command {startEllipse}

.mbar.shape.menu add radiobutton \
     -label Polygon \
     -variable Graphics(mode) \
     -value Polygon \
     -command {startPolygon 0}

.mbar.shape.menu add radiobutton \
     -label "Closed Spline"  \
     -variable Graphics(mode) \
     -value "Closed Spline" \
     -command {startPolygon 1}

.mbar.shape.menu add radiobutton \
     -label Line \
     -variable Graphics(mode) \
     -value Line \
     -command {startLine 0}

.mbar.shape.menu add radiobutton \
     -label Spline \
     -variable Graphics(mode) \
     -value Spline \
     -command {startLine 1}

.mbar.shape.menu add radiobutton \
      -label Arc \
      -variable Graphics(mode) \
      -value Arc \
      -command {
         set Graphics(shape) arc
         arcMode
}

.mbar.shape.menu add radiobutton \
      -label PieSlice \
      -variable Graphics(mode) \
      -value PieSlice \
      -command {
         set Graphics(shape) pieslice
         arcMode
}

.mbar.shape.menu add radiobutton \
         -label Chord \
         -variable Graphics(mode) \
         -value Chord \
         -command {
             set Graphics(shape) chord
             arcMode
}

.mbar.shape.menu add radiobutton \
     -label "Free Hand" \
     -variable Graphics(mode) \
     -value "Free Hand" \
     -command {freeHand}

#### LINE MENU:

menu .mbar.line.menu

.mbar.line.menu add cascade -label Width -menu .mbar.line.menu.width

menu .mbar.line.menu.width -tearoff 0
foreach s {0 0.5 1 1.5 2 3 4 5 6 7 8 9 10 11 12 15 18 21 24 27 30 33 
           36 42 48 54 60} {
  .mbar.line.menu.width add radiobutton -label "${s} points" \
              -variable Graphics(line,width) \
              -value $s
}

.mbar.line.menu add cascade -label Style -menu .mbar.line.menu.style

menu .mbar.line.menu.style -tearoff 0

foreach s {solid gray12 gray25 gray50 gray75} {
   .mbar.line.menu.style add radiobutton -label $s \
         -variable Graphics(line,style) \
         -value $s
}

.mbar.line.menu add cascade -label "Join style" -menu .mbar.line.menu.join

menu .mbar.line.menu.join -tearoff 0
foreach s {bevel miter round} {
   .mbar.line.menu.join add radiobutton -label $s \
   -variable Graphics(line,joinstyle) \
   -value $s
}

.mbar.line.menu add cascade -label "Cap style" -menu .mbar.line.menu.cap

menu .mbar.line.menu.cap -tearoff 0
foreach s {butt projecting round} {
   .mbar.line.menu.cap add radiobutton -label $s \
   -variable Graphics(line,capstyle) \
   -value $s
}

.mbar.line.menu add command -label Color \
                -command {chooseOutlineColor}
.mbar.line.menu add command -label Arrows -command {arrowsMode}

# We need to source this file:
source arrowshape.tcl
.mbar.line.menu add command -label "Arrow shape" -command {arrowShapeTool}

#### FILL MENU:

menu .mbar.fill.menu -tearoff 0

.mbar.fill.menu add cascade -label Style -menu .mbar.fill.menu.style

menu .mbar.fill.menu.style -tearoff 0
foreach s {gray12 gray25 gray50 gray75} {
   .mbar.fill.menu.style add radiobutton -label $s \
         -variable Graphics(fill,style) \
         -value $s
}

.mbar.fill.menu.style add command -label "Solid" -command {
          .mbar.fill.menu.style activate none
          set Graphics(fill,style) {}
}

.mbar.fill.menu add command -label Color -command {chooseFillColor}

.mbar.fill.menu add command -label "No Color" -command {
          set Graphics(fill,color) {}
}

#### EDIT MENU:

menu .mbar.edit.menu

.mbar.edit.menu add command \
        -label "Undo last change" \
        -command {Undo exec}

.mbar.edit.menu add command \
        -label "Undo last undo" \
        -command {History repeat}

.mbar.edit.menu add radiobutton \
        -label "Move object" \
        -variable Graphics(mode) \
        -value "Move object" \
        -command {moveMode}

.mbar.edit.menu add radiobutton \
        -label "Copy object" \
        -variable Graphics(mode) \
        -value "Copy object" \
        -command {copyMode}

.mbar.edit.menu add radiobutton \
        -label "Raise object" \
        -variable Graphics(mode) \
        -value "Raise object" \
        -command {raiseMode}

.mbar.edit.menu add radiobutton \
        -label "Lower object"\
        -variable Graphics(mode) \
        -value "Lower object" \
        -command {lowerMode}

.mbar.edit.menu add radiobutton \
        -label "Delete object" \
        -variable Graphics(mode) \
        -value "Delete object" \
        -command {deleteMode}

.mbar.edit.menu add command \
        -label "Delete All" \
        -command {deleteAll}

.mbar.edit.menu add command \
        -label "Background color" \
        -command {chooseBackgroudColor}

#### GROUP MENU:

menu .mbar.group.menu

.mbar.group.menu add radiobutton \
        -label "Select group"\
        -variable Graphics(mode) \
        -value "Group Mode"\
        -command {selectGroupMode}

.mbar.group.menu add command \
        -label "Select all"\
        -command {selectAll}

.mbar.group.menu add command \
        -label "Copy group"\
        -command {createGroupCopy}

.mbar.group.menu add command \
        -label "Rotate group"\
        -command {rotateGroupMode}

.mbar.group.menu add command \
        -label "Horizontal reflection"\
        -command {reflect x}

.mbar.group.menu add command \
        -label "Vertical reflection"\
        -command {reflect y}

.mbar.group.menu add command \
        -label "Raise group"\
        -command {raiseGroup}

.mbar.group.menu add command \
        -label "Lower group"\
        -command {lowerGroup}

.mbar.group.menu add command \
        -label "Delete group"\
        -command {deleteGroup}

.mbar.group.menu add command \
        -label "Edit line width"\
        -command {editGroupLineWidth}

.mbar.group.menu add command \
        -label "Edit line color"\
        -command {editGroupLineColor}

.mbar.group.menu add command \
        -label "Edit fill color"\
        -command {editGroupFillColor}

.mbar.group.menu add command \
        -label "Edit font"\
        -command {editGroupFont}


#### GRID MENU:

menu .mbar.grid.menu -tearoff 0

.mbar.grid.menu add radiobutton -label "No grid" \
            -variable Graphics(gridcell) \
            -value 0 \
            -command "Grid 0"

foreach s {0.2 0.25 0.5 1 2} {
  set pxls [winfo pixels .c ${s}c]
  .mbar.grid.menu add radiobutton -label "$s cm" \
            -variable Graphics(gridcell) \
            -value $pxls \
            -command "Grid $pxls"
}

foreach s {10 20 30 40 50} {
  .mbar.grid.menu add radiobutton -label "$s pixels" \
            -variable Graphics(gridcell) \
            -value $s \
            -command "Grid $s"
}

.mbar.grid.menu add checkbutton -label "Ticks" \
            -variable Graphics(ticks)

.mbar.grid.menu add cascade -label "Grid spacing" -menu .mbar.grid.menu.gspacing

menu .mbar.grid.menu.gspacing -tearoff 0
foreach {gs label} {
   1     "1 pixel"
   2     "2 pixels"
   3     "3 pixels"
   4     "4 pixels"
   5     "5 pixels"
   6     "6 pixels"
   10    "10 pixels"
   20    "20 pixels"
   1m    "1 mm"
   2m    "2 mm"
   2.5m  "2.5 mm"
   3m    "3 mm"
   4m    "4 mm"
   5m    "5 mm"
} {
   .mbar.grid.menu.gspacing add radiobutton -label $label \
             -variable Graphics(gspacing) \
             -value $gs
}

#### TEXT MENU:

menu .mbar.text.menu -tearoff 0

.mbar.text.menu add radiobutton -label "Draw text" \
            -variable Graphics(mode) \
            -value "Draw text" \
            -command {TextMode}

.mbar.text.menu add cascade -label "Anchor" -menu .mbar.text.menu.anchor

menu .mbar.text.menu.anchor -tearoff 0
foreach {anchor label} {
   w   West
   e   East
   c   Center
   n   North
   s   South
   nw  NW
   ne  NE
   sw  SW
   se  SE
} {
   .mbar.text.menu.anchor add radiobutton -label $label \
             -variable Graphics(text,anchor) \
             -value $anchor
}


# FONT MENU

menu .mbar.font.menu -tearoff 0

.mbar.font.menu add command -label "Choose font" \
           -command {chooseFont}

.mbar.font.menu add cascade -label "Font stipple" \
                            -menu .mbar.font.menu.stipple
menu .mbar.font.menu.stipple -tearoff 0
foreach {lbl val} {
    Gray12 gray12
    Gray25 gray25
    Gray50 gray50
    Gray75 gray75
    Solid  solid
} {
   .mbar.font.menu.stipple add radiobutton -label $lbl \
         -variable fontStipple \
         -value $val \
         -command {
             if {$fontStipple == "solid"} {
               set Graphics(font,stipple) {}
             } else {
               set Graphics(font,stipple) $fontStipple
             }
         }
}

set fontStipple solid

# HELP MENU

menu .mbar.help.menu -tearoff 0

.mbar.help.menu add command -label "Help" -command {
      if {[info exists HelpVar]==0} {
          source help.tcl
      }
      Help
      set HelpVar 1
}

.mbar.help.menu add command -label "About" -command {About}


############## END OF GUI  .....   %>|(~



############################# PROCEDURES ###############################

# WE START WITH A PROCEDURE THAT ASSIGNS A UNIQUE TAG TO EACH
# OBJECT THAT WE CREATE ON THE CANVAS. THIS KIND OF TAG IS USEFUL,
# FOR EXAMPLE, FOR THE UNDO ACTION, WHERE AN OBJECT MAY BE CREATED AND DELETED
# SEVERAL TIMES (HENCE ITS NORMAL ID MAY CHANGE) RETAINING ITS UTAG.
# THE PROCEDURE ALSO FINDS OF THE UTAG OF A GIVEN ID.

proc Utag {mode id} {
  global utagCounter
  if ![regexp {^[1-9][0-9]*$} $id] {
    return ""
  }
  switch $mode {
     assign {
        incr utagCounter
        set utag utag$utagCounter
        .c addtag $utag withtag $id
        return $utag
     }
     find {
        set tags [.c gettags $id]
        set n [lsearch -regexp $tags {utag[0-9]+}]
        if {-1==$n} {error "utag trouble!"}
        return [lindex $tags $n]
     }
  }
}

###### RECTANGLE SECTION
proc startRectagle {} {
  global Rectangle Graphics

  set Graphics(shape) Rectangle

  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       set Rectangle(coords) "$x $y $x $y"
       set Rectangle(options)  [list \
           -width   $Graphics(line,width) \
           -outline $Graphics(line,color) \
           -fill    $Graphics(fill,color) \
           -stipple $Graphics(fill,style) \
           -tags    {Rectangle obj}       \
       ]
  }
  bind .c <B1-Motion> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       makeRectagle $x $y
  }
  bind .c <B1-ButtonRelease> {
      if ![info exists Rectangle(id)] {return}
      set utag [Utag assign $Rectangle(id)]
      History add [getObjectCommand $utag 1]
      Undo add ".c delete $utag"
      unset Rectangle
  }
}

proc makeRectagle {x y} {
  global Rectangle
  set Rectangle(coords) [lreplace $Rectangle(coords) 2 3 $x $y]
  catch {.c delete $Rectangle(id)}
  set Rectangle(id) \
      [eval .c create rectangle $Rectangle(coords) $Rectangle(options)]
}

###### ROUND RECTANGLE SECTION
proc startRoundRect {} {
  global RoundRect Graphics

  set Graphics(shape) "Round rectangle"

  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       set RoundRect(tmp,coords) "$x $y $x $y"
       set RoundRect(tmp,options)  [list  \
           -width   $Graphics(line,width) \
           -outline $Graphics(line,color) \
           -fill    $Graphics(fill,color) \
           -stipple $Graphics(fill,style) \
           -tags    {tmpRoundRect obj}    \
       ]

       set RoundRect(options)  [list \
           -width   $Graphics(line,width) \
           -outline $Graphics(line,color) \
           -fill    $Graphics(fill,color) \
           -stipple $Graphics(fill,style) \
           -smooth  1                     \
           -tags    {RoundRect obj}       \
       ]

  }
  bind .c <B1-Motion> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       makeRoundRect $x $y
  }
  bind .c <B1-ButtonRelease> {finishRoundRect}
}

proc makeRoundRect {x y} {
  global RoundRect
  set RoundRect(tmp,coords) [lreplace $RoundRect(tmp,coords) 2 3 $x $y]
  catch {.c delete $RoundRect(tmp,id)}
  set RoundRect(tmp,id) \
      [eval .c create rectangle $RoundRect(tmp,coords) $RoundRect(tmp,options)]
}

proc finishRoundRect {} {
  global RoundRect
  if ![info exists RoundRect(tmp,id)] {return}

  set x1 [lindex $RoundRect(tmp,coords) 0]
  set y1 [lindex $RoundRect(tmp,coords) 1]
  set x2 [lindex $RoundRect(tmp,coords) 2]
  set y2 [lindex $RoundRect(tmp,coords) 3]

  if {abs($x2-$x1)<=2 || abs($y2-$y1)<=2} {
      .c delete $RoundRect(tmp,id)
      catch {unset RoundRect}
      return
  }
  if {$x2<$x1} {
       set tmp $x1
       set x1 $x2
       set x2 $tmp
  }
  if {$y2<$y1} {
       set tmp $y1
       set y1 $y2
       set y2 $tmp
  }
  set a [expr $x2-$x1]
  set b [expr $y2-$y1]
  if {$a<=$b} {set min $a} else {set min $b}
  if {$min>=100} {set r 25} else {set r [expr int(0.4*$min)+1]}

  set points {
      $x1+$r   $y1
      $x1+$r   $y1
      $x2-$r   $y1
      $x2-$r   $y1
      $x2      $y1
      $x2      $y1+$r
      $x2      $y1+$r
      $x2      $y2-$r
      $x2      $y2-$r
      $x2      $y2
      $x2-$r   $y2
      $x2-$r   $y2
      $x1+$r   $y2
      $x1+$r   $y2
      $x1      $y2
      $x1      $y2-$r
      $x1      $y2-$r
      $x1      $y1+$r
      $x1      $y1+$r
      $x1      $y1
  }

  foreach {a b} $points {
    lappend coords [eval expr $a] [eval expr $b]
  }
  
  .c delete $RoundRect(tmp,id)
  set id [eval .c create polygon $coords $RoundRect(options)]
  set utag [Utag assign $id]
  History add [getObjectCommand $utag 1]
  Undo add ".c delete $utag"
  catch {unset RoundRect}
}

######## CIRCLE SECTION

proc startCircle {} {
  global Circle Graphics
  set Graphics(shape) circle
  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       set Circle(center) "$x $y"
       set Circle(options)  [list \
            -width    $Graphics(line,width) \
            -outline  $Graphics(line,color) \
            -stipple  $Graphics(fill,style) \
            -fill     $Graphics(fill,color) \
            -tags     {Circle obj}        \
       ]
  }
  bind .c <B1-Motion> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       makeCircle $x $y
  }
  bind .c <B1-ButtonRelease> {
      if ![info exists Circle(id)] {return}
      set utag [Utag assign $Circle(id)]
      History add [getObjectCommand $utag 1]
      Undo add ".c delete $utag"
      catch {unset Circle}
  }
}

proc makeCircle {x y} {
  global Circle Graphics
  set x0 [lindex $Circle(center) 0]
  set y0 [lindex $Circle(center) 1]
  set tmp  [expr sqrt(pow($x-$x0,2)+pow($y-$y0,2))]
  set r  [expr (int($tmp)/$Graphics(gspacing))*$Graphics(gspacing)]

  set coords [list [expr $x0-$r] [expr $y0-$r] [expr $x0+$r] [expr $y0+$r] ]

  catch {.c delete $Circle(id)}
  set Circle(id) [eval .c create oval $coords $Circle(options)]
}

######### ELLIPSE SECTION

proc startEllipse {} {
  global Ellipse Graphics
  set Graphics(shape) ellipse
  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       set Ellipse(center) "$x $y"
       set Ellipse(options)  [list \
          -width   $Graphics(line,width) \
          -outline $Graphics(line,color) \
          -fill    $Graphics(fill,color) \
          -stipple $Graphics(fill,style) \
          -tags    {ellipse obj}         \
       ]
  }
  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      makeEllipse $x $y
  }
  bind .c <B1-ButtonRelease> {
      if ![info exists Ellipse(id)] {return}
      set utag [Utag assign $Ellipse(id)]
      History add [getObjectCommand $utag 1]
      Undo add ".c delete $utag"
      catch {unset Ellipse}
  }
}

proc makeEllipse {x y} {
  global Graphics Ellipse
  set x0 [lindex $Ellipse(center) 0]
  set y0 [lindex $Ellipse(center) 1]
  set a [expr abs($x-$x0)]
  set b [expr abs($y-$y0)]
  set coords [list [expr $x0-$a] [expr $y0-$b] [expr $x0+$a] [expr $y0+$b] ]
  catch {.c delete $Ellipse(id)}
  set Ellipse(id) [eval .c create oval $coords $Ellipse(options)]
}

################ LINE SECTION

proc startLine {type} {
  catch {unset Line}
  global Line Graphics

  if {$type==0} {
    set Graphics(shape) line
  } else {
    set Graphics(shape) spline
  }
  set Graphics(line,smooth) $type

  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       if [info exists Line(coords)] {
         newLinePoint create $x $y
         continue
       }
       set Line(options)  [list     \
           -width     $Graphics(line,width)     \
           -capstyle  $Graphics(line,capstyle)  \
           -joinstyle $Graphics(line,joinstyle) \
           -fill      $Graphics(line,color)     \
           -stipple   $Graphics(line,style)     \
           -smooth    $Graphics(line,smooth)    \
           -tags      {Line obj}             \
       ]
       set Line(coords) "$x $y"
       newLinePoint create $x $y
  }

  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      newLinePoint drag $x $y
  }
  bind .c <Button-3> {makeLine}
#  bind .c <Double-Button-1> {makeLine}
}

proc newLinePoint {mode x y} {
  global Line Graphics

  set n [llength $Line(coords)]

  if {$mode=="create"} {
    lappend Line(coords) $x $y
  } else {
    set Line(coords) [lreplace $Line(coords) [expr $n-2] end $x $y]
  }

  catch {.c delete $Line(tempLine)}
  if {$Graphics(line,style)=="solid"} {
    set Graphics(line,style) {}
  }
  set Line(tempLine) [eval .c create line $Line(coords) $Line(options)]
}

proc distance {x1 y1 x2 y2} {
  return [expr abs($x1-$x2) + abs($y1-$y2)]
}

proc groomLine {coords} {
  if {[llength $coords]<=3} {
     error "grromLine trouble!"
     return
  }

  set x1 [lindex $coords 0]
  set y1 [lindex $coords 1]
  set x2 [lindex $coords 2]
  set y2 [lindex $coords 3]
  
  if {[distance $x1 $y1 $x2 $y2]<=3} {
    set coords [lreplace $coords 2 3]
  }

  set n [llength $coords]

  set x1 [lindex $coords [expr $n-4]]
  set y1 [lindex $coords [expr $n-3]]
  set x2 [lindex $coords [expr $n-2]]
  set y2 [lindex $coords [expr $n-1]]
  
  if {[distance $x1 $y1 $x2 $y2]<=3} {
    set coords [lreplace $coords [expr $n-4] [expr $n-3]]
  }

  lappend new_coords [lindex $coords 0] [lindex $coords 1]

  foreach {x y} [lrange $coords 2 end] {
     set m [llength $new_coords]
     set x_top [lindex $new_coords [expr $m-2]]
     set y_top [lindex $new_coords [expr $m-1]]
     set d [distance $x $x_top $y $y_top]
     if {$d==0 || $d>3} {
       lappend new_coords $x $y
     }
  }
  return $new_coords
}

proc makeLine {} {
  global Line Graphics
  catch {.c delete $Line(tempLine)}
 
  if {![info exists Line] || [llength $Line(coords)]<4} {
    catch {unset Line}
    return
  }

   set Line(coords) [groomLine $Line(coords)]

  if {$Graphics(line,style)=="solid"} {
    set Graphics(line,style) {}
  }

  set id [eval .c create line $Line(coords) $Line(options)]
  set utag [Utag assign $id]
  History add [getObjectCommand $utag 1]
  Undo add ".c delete $utag"
  unset Line
}

################ POLYGON SECTION

proc startPolygon {type} {
  catch {unset Polygon}
  global Polygon Graphics
  if {$type==0} {
    set Graphics(shape) polygon
  } else {
    set Graphics(shape) "closed spline"
  }
  set Graphics(line,smooth) $type

  bind .c <Button-1> {
       set x [.c canvasx %x $Graphics(gspacing)]
       set y [.c canvasx %y $Graphics(gspacing)]
       if [info exists Polygon(coords)] {
         newPolygonPoint create $x $y
         continue
       }
       set Polygon(tempLine,options)  [list     \
           -width     $Graphics(line,width)     \
           -capstyle  $Graphics(line,capstyle)  \
           -joinstyle $Graphics(line,joinstyle) \
           -fill      $Graphics(line,color)     \
           -stipple   $Graphics(line,style)     \
           -smooth    $Graphics(line,smooth)    \
           -tags      {Polygon obj}             \
       ]
       set Polygon(options)  [list \
           -width   $Graphics(line,width) \
           -outline $Graphics(line,color) \
           -fill    $Graphics(fill,color) \
           -stipple $Graphics(fill,style) \
           -smooth  $Graphics(line,smooth)\
           -tags    {Polygon obj}         \
       ]
       set Polygon(coords) "$x $y"
       newPolygonPoint create $x $y
  }

  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      newPolygonPoint drag $x $y
  }
#  bind .c <B1-ButtonRelease> {catch {unset Polygon(tempLine)}}
  bind .c <Button-3> {makePolygon}
#  bind .c <Double-Button-1> {makePolygon}
}

proc newPolygonPoint {mode x y} {
  global Polygon Graphics

  set n [llength $Polygon(coords)]

  if {$mode=="create"} {
    lappend Polygon(coords) $x $y
  } else {
    set Polygon(coords) [lreplace $Polygon(coords) [expr $n-2] end $x $y]
  }

  catch {.c delete $Polygon(tempLine)}
  if {$Graphics(line,style)=="solid"} {
    set Graphics(line,style) {}
  }
  set Polygon(tempLine) [eval .c create line $Polygon(coords) \
                               $Polygon(tempLine,options) ]
}

proc makePolygon {} {
  global Polygon Graphics
  catch {.c delete $Polygon(tempLine)}
 
  if {![info exists Polygon] || [llength $Polygon(coords)]<6} {
    catch {unset Polygon}
    return
  }

#  if {$Graphics(line,smooth)==0} {
#    set Polygon(coords) [removeDuplicates $Polygon(coords)]
#  }

  if {$Graphics(line,style)=="solid"} {
    set Graphics(line,style) {}
  }

  set id [eval .c create polygon $Polygon(coords) $Polygon(options)]
  set utag [Utag assign $id]
  History add [getObjectCommand $utag 1]
  Undo add ".c delete $utag"
  unset Polygon
}

################ SECTION:  ARC
proc arcMode {} {
  global Arc Graphics
  bind .c <Button-1> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      startArc $x $y
  }
  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      makeArc $x $y
  }
  bind .c <B1-ButtonRelease> {finishArc}
}

proc finishArc {} {
  global Arc
  if {![info exists Arc(p3)]} {return}
  .c delete arcMark
  set utag [Utag assign $Arc(id)]
  History add [getObjectCommand $utag 1]
  Undo add ".c delete $utag"
  unset Arc
}

proc startArc {x y} {
  global Arc
  if {![info exists Arc(p1)]}  {
    set Arc(p1) "$x $y"
    .c create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
                   -fill red -tags {arcMark obj}
  } elseif {![info exists Arc(p2)]} {
    set Arc(p2) "$x $y"
    if {"$Arc(p2)"=="$Arc(p1)"} {
      unset Arc(p2)
      return
    }
    .c create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
                   -fill red -tags {arcMark obj}
  } else {
    set Arc(p3) "$x $y"
    if {"$Arc(p3)"=="$Arc(p1)" || "$Arc(p3)"=="$Arc(p2)"} {
      unset Arc(p3)
      return
    }
    makeArc $x $y
  }
}

proc getArcConfig {} {
   global Arc Graphics
   set PI 3.14159265359
   
   set x1 [lindex $Arc(p1) 0]
   set y1 [lindex $Arc(p1) 1]
   set x2 [lindex $Arc(p2) 0]
   set y2 [lindex $Arc(p2) 1]
   set x3 [lindex $Arc(p3) 0]
   set y3 [lindex $Arc(p3) 1]
   
     if {$x1*($y2-$y3) + $x2*($y3-$y1) + $x3*($y1-$y2) == 0} {
         set Arc(radius) infinity
         return
     }
   # (u1,v1) is the midpoint of (x1,y1) (x2,y2)
   # (u2,v2) is the midpoint of (x2,y2) (x3,y3)
   set u1 [expr ($x1+$x2)/2.0]
   set u2 [expr ($x2+$x3)/2.0]
   set v1 [expr ($y1+$y2)/2.0]
   set v2 [expr ($y2+$y3)/2.0]
   set b1 [expr ($y2-$y1)*$v1 + ($x2-$x1)*$u1]
   set b2 [expr ($y3-$y2)*$v2 + ($x3-$x2)*$u2]
   
   set delta [expr ($x2-$x1)*($y3-$y2) - ($x3-$x2)*($y2-$y1)]
   set x0 [expr ($b1*($y3-$y2) - $b2*($y2-$y1))/$delta]
   set y0 [expr (($x2-$x1)*$b2 - ($x3-$x2)*$b1)/$delta]
   #set Arc(center) "$x0 $y0"
   
#   set tmp    [expr sqrt(pow($x1-$x0,2)+pow($y1-$y0,2))]
#   set radius  [expr (int($tmp)/$Graphics(gspacing))*$Graphics(gspacing)]
   set radius [expr sqrt(pow($x1-$x0,2)+pow($y1-$y0,2))]
   set Arc(box) [list [expr $x0-$radius] [expr $y0-$radius] \
                      [expr $x0+$radius] [expr $y0+$radius]]
   
   set ang1 [expr -atan2($y1-$y0,$x1-$x0)*(180/$PI)]
   set ang2 [expr -atan2($y2-$y0,$x2-$x0)*(180/$PI)]
   set ang3 [expr -atan2($y3-$y0,$x3-$x0)*(180/$PI)]
   # we add minus to atan2 to convert to the strange coordinate system
   # of X!!!!
   # Now we compute the start and the extent of the arc
   foreach a {ang1 ang2 ang3} {
     if {[subst $$a]<0} {set $a [expr 360+[subst $$a]]}
   }
   
   if {$ang1<$ang2} {
     set Arc(start) $ang1
     set Arc(end) $ang2
   } else {
     set Arc(start) $ang2
     set Arc(end) $ang1
   }
   
   if {$Arc(start) < $ang3 && $ang3 < $Arc(end)} {
     set Arc(extent) [expr $Arc(end)-$Arc(start)]
   } else {
     set Arc(extent) [expr $Arc(end) - $Arc(start) - 360]
   }
}

proc makeArc {x y} {
  global Graphics
  global Arc

  if ![info exists Arc(p3)] {
    return
  }

  set Arc(p3) "$x $y"
  
  getArcConfig

  catch {.c delete $Arc(id)}
  set Arc(id) [eval .c create arc $Arc(box) \
                  { -start   $Arc(start) \
                    -extent  $Arc(extent) \
                    -style   $Graphics(shape) \
                    -width   $Graphics(line,width) \
                    -outline $Graphics(line,color) \
                    -outlinestipple $Graphics(line,style) \
                    -fill    $Graphics(fill,color) \
                    -stipple $Graphics(fill,style) \
                    -tags "arc $Graphics(shape) obj"\
                   }
     ]
}

###### FREE HAND SECTION
proc freeHand {} {
  global freeHand Graphics
  set Graphics(shape) "Free Hand"
  bind .c <Button-1> {
      lappend freeHand(coords) %x %y
      set freeHand(tmp_options)  [list \
             -width $Graphics(line,width) \
             -fill  $Graphics(line,color) \
             -stipple $Graphics(line,style) \
             -joinstyle $Graphics(line,joinstyle) \
             -capstyle $Graphics(line,capstyle) \
             -tags {freeHandTemp}\
      ]
      set freeHand(options)  [list \
             -width $Graphics(line,width) \
             -fill  $Graphics(line,color) \
             -stipple $Graphics(line,style) \
             -joinstyle $Graphics(line,joinstyle) \
             -capstyle $Graphics(line,capstyle) \
             -tags {freeHand obj}\
      ]
  }

  bind .c <B1-Motion> {
        set n [llength $freeHand(coords)]
        set lastPoint [lrange $freeHand(coords) [expr $n-2] end]
        eval .c create line $lastPoint %x %y $freeHand(tmp_options)
        lappend freeHand(coords) %x %y
  }

  bind .c <B1-ButtonRelease> {
     .c delete freeHandTemp
      set id [eval .c create line $freeHand(coords) $freeHand(options)]
      set utag [Utag assign $id]
      History add [getObjectCommand $utag 1]
      Undo add ".c delete $utag"
      catch {unset freeHand}
  }
}


########## FILL COLOR AND OUTLINE COLOR

proc chooseFillColor {} {
   global Graphics
   if {$Graphics(fill,color)==""} {
     set initColor grey75
   } else {
     set initColor $Graphics(fill,color)
   }
   set color [tk_chooseColor -initialcolor $initColor \
                             -title "Choose Fill Color"]
   if {$color==""} {return}
   set Graphics(fill,color) $color
}

proc chooseOutlineColor {} {
   global Graphics
   if {$Graphics(line,color)==""} {
     set initColor white
   } else {
     set initColor $Graphics(line,color)
   }
   set color [tk_chooseColor -initialcolor $initColor \
                             -title "Choose Outline Color"]
   if {$color==""} {return}
   set Graphics(line,color) $color
}

############## EDIT SECTION:  DELETE, MOVE, COPY, RAISE, LOWER, 

# UTILITY PROCEDURES TO HELP US DO MOVE, DELETE, RAISE, LOWER, AND COPY
# OPERATIONS MORE NEAT.
#
# THE FOLLOWING PROCEDURE RETURNS THE UTAG of THE CLOSEST ITEM WITH TAG "tag"
# THAT OVERLAP WITH THE AREA (x-r,y-r) (x+r,y+r) IN THE CANVAS .c.
# (CLOSEST ALSO MEANS AS HIGH AS POSSIBLE IN THE DISPLAY LIST)
# THE PROCEDURE RETURNS AN EMPTY STRING IF IT FINDS NO ITEM WITH THE
# SPECIFIED REQUIREMNETS.

proc getNearestUtag {x y r tag} {
  set nearObjects [.c find overlapping [expr $x-$r] [expr $y-$r] \
                                       [expr $x+$r] [expr $y+$r]]
  if {[llength $nearObjects]==0} {
    return ""
  }
  set n [expr [llength $nearObjects]-1]
  for {set i $n} {$i>=0} {incr i -1} {
     set id [lindex $nearObjects $i]
     if {[lsearch [.c gettags $id] $tag]>=0} {
       return [Utag find $id]
     }
  }
}

# THE NEXT PROC ACCEPTS AN OBJECT UTAG AND RETURNS A COMMAND TO CREATE AN
# IDENTICAL COPY OF THIS OBJECT.
# THE bool ARGUMENT IS A BOOLEAN VALUE THAT INDICATES IF WE WANT TO KEEP
# THE ORIGINAL UTAG (1) OR DELETE IT (0).

proc getObjectOptions {utagORid bool} {
  foreach conf [.c itemconfigure $utagORid] {
    if {[lindex $conf 0]=="-tags"} {continue}
    set default [lindex $conf 3]
    set value [lindex $conf 4]
    if {[string compare $default $value] != 0} {
      lappend options [lindex $conf 0] $value
    }
  }
  set tags [.c gettags $utagORid]
  if {[lsearch $tags current]>=0} {
    regsub current $tags "" tags
  }
  if {[lsearch $tags Selected]>=0} {
    regsub Selected $tags "" tags
  }
  # next, we strip out the utag (if exists) if bool=0
  if {$bool==0} {
    regsub {utag[0-9]+} $tags "" tags
  }
  lappend options -tags $tags
  return $options
}

proc getObjectCommand {utagORid bool} {
  lappend command .c create
  lappend command [.c type $utagORid]
  eval lappend command [.c coords $utagORid]
  eval lappend command [getObjectOptions $utagORid $bool]
  return $command
}

proc getObjectAbove {utag} {
   set i $utag
   while { $i != "" } {
     set i [.c find above $i]
     if {$i==""} {return ""}
     set tags [.c gettags $i]
     if {[lsearch $tags obj] >= 0} {
       return [Utag find $i]
     }
   }
   return ""
}

proc getObjectBelow {utag} {
   set i $utag
   while { $i != "" } {
     set i [.c find below $i]
     if {$i==""} {return ""}
     set tags [.c gettags $i]
     if {[lsearch $tags obj] >= 0} {
       return [Utag find $i]
     }
   }
   return ""
}

proc deleteMode {} {
  bind .c <Button-1>  "itemDelete %x %y"
#  bind .c <B1-Motion> "itemDelete %x %y"
}

proc itemDelete {x y} {
  set x [.c canvasx $x]
  set y [.c canvasy $y]
  set utag [getNearestUtag $x $y 2 obj]
  if {$utag==""} {return}
  set below [getObjectBelow $utag]
  set above [getObjectAbove $utag]
  set undo [getObjectCommand $utag 1]\;
  if { $below != "" } {
    append undo ".c raise $utag $below\;"
  } elseif { $above != "" } {
    append undo ".c lower $utag $above\;"
  }
  set cmd ".c delete $utag"
  History add $cmd
  Undo add $undo
  eval $cmd
}

proc raiseMode {} {
  bind .c <Button-1> "itemRaise %x %y"
#  bind .c <B1-Motion> "itemRaise %x %y"
}

proc itemRaise {x y} {
  set utag [getNearestUtag $x $y 2 obj]
  if {$utag==""} {return}
  set above [getObjectAbove $utag]
  if {$above != ""} {
    History add ".c raise $utag"
    Undo add ".c lower $utag $above"
  }
  .c raise $utag
}

proc lowerMode {} {
  bind .c <Button-1> "itemLower %x %y"
#  bind .c <B1-Motion> "itemLower %x %y"
}

proc itemLower {x y} {
  set utag [getNearestUtag $x $y 2 obj]
  if {$utag==""} {return}
  set below [getObjectBelow $utag]
  if {$below != ""} {
    History add ".c lower $utag"
    Undo add ".c raise $utag $below"
  }
  .c lower $utag
}

proc moveMode {} {
  bind .c <Button-1> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      Move begin $x $y
  }
  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      Move drag $x $y
  }
  bind .c <B1-ButtonRelease> {
      if {$Move(utag) != ""} {
        set a [expr $Move(lastX)-$Move(firstX)]
        set b [expr $Move(lastY)-$Move(firstY)]
        set cmd  ".c move $Move(utag) $a $b"
        set undo ".c move $Move(utag) [expr -$a] [expr -$b]"
        History add $cmd
        Undo add $undo
      }
      unset Move
  }
}

proc Move {mode x y} {
    global Move
    switch -exact -- $mode {
       begin {
          set Move(utag) [getNearestUtag $x $y 2 obj]
          if {$Move(utag)==""} {return}
          set Move(firstX) $x
          set Move(firstY) $y
          set Move(lastX) $x
          set Move(lastY) $y
       }
       drag  {
          if {$Move(utag)==""} {return}
          .c move $Move(utag) [expr $x-$Move(lastX)] [expr $y-$Move(lastY)]
          set Move(lastX) $x
          set Move(lastY) $y
        }
    }
}

# copying of items.

proc copyMode {} {
  bind .c <Button-1> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      itemStartCopy $x $y
  }
  bind .c <B1-Motion> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      itemCopy $x $y
  }
  bind .c <B1-ButtonRelease> {
      if {$Copy(utag) != ""} {
        set cmd "[getObjectCommand $Copy(utag) 1] \;"
        append cmd ".c raise $Copy(utag) $Copy(origUtag) \;"
        History add $cmd
        Undo add ".c delete $Copy(utag)"
      }
      unset Copy
  }
}

proc itemStartCopy {x y} {
  global Copy

  set utag [getNearestUtag $x $y 2 obj]
  if {$utag==""} {set Copy(utag) "" ; return}
  set Copy(lastX) $x
  set Copy(lastY) $y
  set Copy(origUtag) $utag

  set Copy(utag) [Utag assign [eval [getObjectCommand $utag 0]]]
  .c raise $Copy(utag) $utag
}

proc itemCopy {x y} {
    global Copy
    if {$Copy(utag)==""} {return}
    .c move $Copy(utag) [expr $x-$Copy(lastX)] [expr $y-$Copy(lastY)]
    set Copy(lastX) $x
    set Copy(lastY) $y
}

proc deleteAll {} {
  .c delete graybox
  set objects [.c find withtag obj]
  if {[llength $objects]==0} {return}
  foreach id $objects {
     append undo [getObjectCommand [Utag find $id] 1]\;
  }
  set cmd ".c delete graybox obj"
  History add $cmd
  Undo add $undo
  .c delete obj
}


# TAKING CARE OF CANVAS BACKGROUND COLOR AND STIPPLE:

proc chooseBackgroudColor {} {
   global Canv
   set undo ".c config -bg $Canv(bg)"
   set color [tk_chooseColor -initialcolor $Canv(bg) \
                             -title "Choose Canvas Background Color"]
   if {$color==""} {return}
   set Canv(bg) $color
   .c config -bg $Canv(bg)
   set cmd ".c config -bg $Canv(bg)"
   History add $cmd
   Undo add $undo
}

## UNDO AND HISTORY PROCS

proc Undo {mode {cmd ""}} {
  global undoStack undoMode histPtr File

  switch -exact -- $mode {
     exec {
        set undoMode 1
        if {[llength $undoStack]==0 || $histPtr==0} {
          return
        }
        incr histPtr -1
        set cmd [lindex $undoStack $histPtr]
        eval $cmd
        if {$File(progress)!="dead"} {
          incr File(progress) -1
        }
        if {$File(progress)<0} {
          set File(progress) dead
          set File(saved) 0
        }
        if {$File(progress)==0} {
          set File(saved) 1
        }
     }
     add {
        lappend undoStack $cmd
     }
  }
}

proc History {mode {cmd ""}} {
  global History histPtr undoStack File
  switch -exact -- $mode {
     add {
        if {$File(progress)!="dead"} {
          incr File(progress)
        }
        set File(saved) 0
        set File(new) 0

        if {$histPtr < [llength $History]} {
             set History [lrange $History 0 [expr $histPtr-1]]
             set undoStack [lrange $undoStack 0 [expr $histPtr-1]]
        } elseif {[llength $History]==50} {
             set History [lreplace $History 0 0]
             set undoStack [lreplace $undoStack 0 0]
        }
        lappend History $cmd
        set histPtr [llength $History]
     }
     repeat {
        if {$histPtr==[llength $History]} {return}
        set cmd [lindex $History $histPtr]
        incr histPtr
        if {$File(progress)!="dead"} {
          incr File(progress)
        }
        set File(saved) 0
        set File(new) 0
        eval $cmd
     }
  }
}

############## GROUP SECTION:
# DELETE, MOVE, COPY, RAISE, LOWER, ...
# OPERATIONS ON GROUPS OF OBJECTS
# HERE WE DEFINE PROCEDURES FOR SELECTING A GROUP OF OBJECTS,
# DELETING, COPYING, RESIZING, ... A GROUP OF OBJECTS


proc selectGroupMode {} {
  global selectBox
  .c delete graybox
  .c dtag obj Selected
  bind .c <Button-1> {
        catch {unset selectBox}
        .c delete graybox
        .c dtag obj Selected
        set selectBox(x1) %x
        set selectBox(y1) %y
        set selectBox(x2) %x
        set selectBox(y2) %y
  }
  bind .c <B1-Motion> {drawSelectionBox %x %y}
  bind .c <B1-ButtonRelease> {
      setBoundingBox
      setEditGroupMode
  }
}

proc selectAll {} {
  global Graphics selectBox
  set Graphics(mode) "Group Mode"
  selectGroupMode

  .c addtag Selected withtag obj
  set bbox [.c bbox Selcetd]
  set selectBox(x1) [lindex $bbox 0]
  set selectBox(y1) [lindex $bbox 1]
  set selectBox(x2) [lindex $bbox 2]
  set selectBox(y2) [lindex $bbox 3]

  if {[llength [.c find withtag Selected]]==0} {
    .c delete selectBox
    unset selectBox
    return
  }
  .c delete selectBox
  unset selectBox
  drawBoundingBox
  setEditGroupMode
}

proc drawSelectionBox {x y} {
  global selectBox
  set selectBox(x2) $x
  set selectBox(y2) $y
  catch {.c delete $selectBox(id)}
  set selectBox(id) [.c create rectangle $selectBox(x1) $selectBox(y1) \
                                        $selectBox(x2) $selectBox(y2) \
                -width 1 \
                -tags selectBox ]
}

proc drawGrayBox {x1 y1 x2 y2 col stip tag} {
  return [.c create rectangle $x1 $y1 $x2 $y2 \
                -outline {} \
                -fill $col \
                -stipple $stip \
                -tags "graybox $tag"]
#  .c raise gridObject
}

proc setBoundingBox {} {
  global selectBox

  .c addtag Selected enclosed \
       $selectBox(x1) $selectBox(y1) $selectBox(x2) $selectBox(y2)

  if {[llength [.c find withtag Selected]]==0} {
    .c delete selectBox
    return
  }
  .c delete selectBox
  unset selectBox
  drawBoundingBox
}

proc drawBoundingBox {} {
  global BBox

  .c delete graybox
  set bbox [.c bbox Selected]
  set BBox(x1) [lindex $bbox 0]
  set BBox(y1) [lindex $bbox 1]
  set BBox(x2) [lindex $bbox 2]
  set BBox(y2) [lindex $bbox 3]

  set x1 $BBox(x1)
  set y1 $BBox(y1)
  set x2 $BBox(x2)
  set y2 $BBox(y2)
  drawGrayBox $x1 $y1 $x2 $y2 gray60 gray12 mainBBox
  
# Now we create the 8 small rectangles (handles) around the main BBox.
# Naming the boxes is based on:
#    NW   North NE
#    West ***** East
#    SW   South SE
  set a 14
  set midx [expr ($x1+$x2-$a)/2]
  set midy [expr ($y1+$y2-$a)/2]
  foreach {X1 Y1 X2 Y2 tag} "
      [expr $x1-$a] [expr $y1-$a] $x1 $y1       nwHandle
      $x2 $y2 [expr $x2+$a] [expr $y2+$a]       seHandle
      $x2 $y1 [expr $x2+$a] [expr $y1-$a]       neHandle
      [expr $x1-$a] [expr $y2+$a] $x1 $y2       swHandle
      $midx $y1 [expr $midx+$a] [expr $y1-$a]   nHandle
      $midx [expr $y2+$a] [expr $midx+$a] $y2   sHandle
      [expr $x1-$a] $midy $x1 [expr $midy+$a]   wHandle
      $x2 $midy [expr $x2+$a] [expr $midy+$a]   eHandle
  " {
     drawGrayBox $X1 $Y1 $X2 $Y2 black gray50 $tag
  }
  .c raise graybox
  .c raise mainBBox
#  .c raise gridObject
}

proc getGroupCommand {bool} {
   set group [.c find withtag Selected]
   foreach id $group {
      set utag [Utag find $id]
      append cmd ".c delete $utag\;"
      append cmd [getObjectCommand $utag $bool]\;
   }
   set below [getObjectBelow Selected]
   set above [getObjectAbove Selected]
   set n [llength $group]

   if { $below != "" } {
     set first [Utag find [lindex $group 0]]
     append cmd ".c raise $first $below\;"
     for {set i 0} {$i<[expr $n-1]} {incr i} {
        set current [Utag find [lindex $group $i]]
        set next [Utag find [lindex $group [expr $i+1]]]
        append cmd ".c raise $next $current\;"
     }
   } 

   if { $above != "" } {
     set last [Utag find [lindex $group [expr $n-1]]]
     append cmd ".c lower $last $above\;"
     for {set i [expr $n-1]} {$i>0} {incr i -1} {
        set current [Utag find [lindex $group $i]]
        set previous [Utag find [lindex $group [expr $i-1]]]
        append cmd ".c lower $previous $current\;"
     }
   }

   append cmd ".c delete graybox\;"
   append cmd ".c delete rotateLine rotateBox rotateText rotateTextBox\;"
   return $cmd
}

proc setEditGroupMode {} {
   global BBox Graphics lastX lastY
   set BBox(action) none

   foreach {tag curs side} {
      nHandle   top_side             n
      sHandle   bottom_side          s
      wHandle   left_side            w
      eHandle   right_side           e
      nwHandle  top_left_corner      nw
      neHandle  top_right_corner     ne
      swHandle  bottom_left_corner   sw
      seHandle  bottom_right_corner  se
   } {
       .c bind $tag <Enter> "%W configure -cursor $curs"

       .c bind $tag <Leave> {
            %W configure -cursor ""
        }

       .c bind $tag <Button-1> "set BBox(action) $side
            %W configure -cursor $curs
            set BBox(undo) \[getGroupCommand 1\]"
   }

   .c bind mainBBox <Enter> {%W configure -cursor fleur}
   .c bind mainBBox <Leave> {%W configure -cursor ""}
   .c bind mainBBox <Button-1> {
           set BBox(action) move
           %W configure -cursor fleur
           set BBox(undo) [getGroupCommand 1]
   }
   .c bind mainBBox <B1-ButtonRelease> {catch {unset lastX lastY}}

   bind .c <Button-1> {
      set lastX %x
      set lastY %y
   }

   bind .c <B1-Motion> {
      switch -exact -- $BBox(action) {
         move    { moveGroup %x %y }
         none    { set selectBox(x1) %x
                   set selectBox(y1) %y
                   set selectBox(x2) %x
                   set selectBox(y2) %y
                   selectGroupMode}
         default { scaleGroup %x %y }
      }
   }

   bind .c <B1-ButtonRelease> {
       set BBox(action) none
       catch {unset lastX lastY}
       %W configure -cursor ""
       History add [getGroupCommand 1]
       Undo add $BBox(undo)
   }
}

proc scaleGroup {x y} {
   global BBox lastX1 lastY1 lastX2 lastY2
   switch -exact -- $BBox(action) {
      none  { return }
      n    { if {abs($y-$BBox(y1))<2} {return} }
      s    { if {abs($y-$BBox(y2))<2} {return} }
      w    { if {abs($x-$BBox(x1))<2} {return} }
      e    { if {abs($x-$BBox(x2))<2} {return} }
      ne   { if {abs($x-$BBox(x2))<2 || abs($y-$BBox(y1))<2} {return} }
      nw   { if {abs($x-$BBox(x1))<2 || abs($y-$BBox(y1))<2} {return} }
      se   { if {abs($x-$BBox(x2))<2 || abs($y-$BBox(y2))<2} {return} }
      sw   { if {abs($x-$BBox(x1))<2 || abs($y-$BBox(y2))<2} {return} }
   }

   set lastX1 $BBox(x1)
   set lastY1 $BBox(y1)
   set lastX2 $BBox(x2)
   set lastY2 $BBox(y2)

   switch -exact -- $BBox(action) {
      none  { return }
      n    { set BBox(y1) $y
             set xOrigin $BBox(x1)
             set yOrigin $BBox(y2)
             set xScale  1.0
             set yScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
      }

      s    { set BBox(y2) $y
             set xOrigin $BBox(x1)
             set yOrigin $BBox(y1)
             set xScale  1.0
             set yScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
      }

      w    { set BBox(x1) $x
             set xOrigin $BBox(x2)
             set yOrigin $BBox(y1)
             set xScale  [getRatio $lastX2 $lastX1 $BBox(x2) $BBox(x1)]
             set yScale  1.0
      }

      e    { set BBox(x2) $x
             set xOrigin $BBox(x1)
             set yOrigin $BBox(y1)
             set xScale  [getRatio $lastX2 $lastX1 $BBox(x2) $BBox(x1)]
             set yScale  1.0
      }

      ne   { set BBox(y1) $y
             set xOrigin $BBox(x1)
             set yOrigin $BBox(y2)
             set xScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
             set yScale  $xScale
             set BBox(x2) [expr $lastX1+($lastX2-$lastX1)*$xScale]
      }

      nw   { set BBox(y1) $y
             set xOrigin $BBox(x2)
             set yOrigin $BBox(y2)
             set xScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
             set yScale  $xScale
             set BBox(x1) [expr $lastX2-($lastX2-$lastX1)*$xScale]
      }

      se   { set BBox(y2) $y
             set xOrigin $BBox(x1)
             set yOrigin $BBox(y1)
             set xScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
             set yScale  $xScale
             set BBox(x2) [expr $lastX1+($lastX2-$lastX1)*$xScale]
      }

      sw   { set BBox(y2) $y
             set xOrigin $BBox(x2)
             set yOrigin $BBox(y1)
             set xScale  [getRatio $lastY2 $lastY1 $BBox(y2) $BBox(y1)]
             set yScale  $xScale
             set BBox(x1) [expr $lastX2-($lastX2-$lastX1)*$xScale]
      }
   }

   .c scale Selected $xOrigin $yOrigin $xScale $yScale
   drawBoundingBox
}

proc getRatio {a b c d} {
  set ratio [expr ($c-$d+0.0)/($a-$b+0.0)]
  if {$ratio==0} {
    return 0.01
  }
  return $ratio
}


proc deleteGroup {} {
   set undo [getGroupCommand 1]
   foreach id [.c find withtag Selected] {
       set utag [Utag find $id]
       append cmd ".c delete $utag \; "
   }
   .c delete Selected graybox
   History add $cmd
   Undo add $undo
   selectGroupMode
}

proc raiseGroup {} {
   set undo [getGroupCommand 1]
   foreach id [.c find withtag Selected] {
       set utag [Utag find $id]
       append cmd ".c raise $utag \; "
   }
   .c raise Selected
   .c raise graybox
#   .c raise gridObject
   History add $cmd
   Undo add $undo
}

proc lowerGroup {} {
   set group [.c find withtag Selected]
   set n [llength $group]
   for {set i $n} {$i>=0} {incr i -1} {
       set id [lindex $group $i]
       set utag [Utag find $id]
       append cmd ".c lower $utag \; "
   }
   Undo add [getGroupCommand 1]
   .c lower Selected
}

proc moveGroup {x y} {
    global lastX lastY BBox
    set dx [expr $x-$lastX]
    set dy [expr $y-$lastY]
    .c move Selected $dx $dy
    drawBoundingBox
    set lastX $x
    set lastY $y
}

# COPY A GROUP:

proc createGroupCopy {} {
  foreach id [.c find withtag Selected] {
      set id_utag [Utag find $id]
      set cp_utag [Utag assign [eval [getObjectCommand $id_utag 0]]]
      .c addtag tmpSelected withtag $cp_utag
      append undo ".c delete $cp_utag \; "
   }
   .c dtag Selected
   .c addtag Selected withtag tmpSelected
   .c dtag tmpSelected
   .c move Selected 15 15
   drawBoundingBox
   History add [getGroupCommand 1]
   Undo add $undo
#   .c raise gridObject
}

##### ROTATE A GROUP

proc rotateObj {xo yo ang id} {
   set type [.c type $id]
   set coords  [.c coords $id]
   foreach conf [.c itemconfigure $id] {
      set opt [lindex $conf 0]
      set val [lindex $conf 4]
      set Options($opt) $val
   }
   set new_coords {}
   set sin [expr sin($ang)]
   set cos [expr cos($ang)]
   foreach {x y} $coords {
      lappend new_coords [expr ($x-$xo)*$cos + ($y-$yo)*$sin + $xo] \
                         [expr -($x-$xo)*$sin + ($y-$yo)*$cos + $yo]
   }
   .c delete $id
   eval .c create $type $new_coords [array get Options]
}

proc shape2spline {id} {
   if {[lsearch [.c gettags $id] spline] >= 0} {return $id}
   set pi [expr 2*asin(1)]
   set Options(-width)    [.c itemcget $id -width]
   set Options(-stipple)  [.c itemcget $id -stipple]
   set Options(-tags)     [.c itemcget $id -tags]
   lappend Options(-tags) spline
   set coords  [.c coords $id]
   set type [.c type $id]

   switch -exact -- $type {
      text      -
      line      -
      polygon   { .c addtag spline withtag $id
         return $id
      }
      oval {
         set Options(-outline) [.c itemcget $id -outline]
         set Options(-fill)    [.c itemcget $id -fill]
         set Options(-smooth) 1
         set type polygon
         set x1 [lindex $coords 0]
         set y1 [lindex $coords 1]
         set x2 [lindex $coords 2]
         set y2 [lindex $coords 3]
         set a [expr ($x2-$x1)/2.0]
         set b [expr ($y2-$y1)/2.0]
         set coords {}
         for {set i 0} {$i<36} {incr i} {
           set t [expr $i*(2*$pi/36)]
           lappend coords [expr $x1+$a+$a*cos($t)]
           lappend coords [expr $y1+$b-$b*sin($t)]
         }
      }
      rectangle {
         set Options(-outline)  [.c itemcget $id -outline]
         set Options(-fill)     [.c itemcget $id -fill]
         set Options(-smooth) 0
         set type polygon
         set x1 [lindex $coords 0]
         set y1 [lindex $coords 1]
         set x2 [lindex $coords 2]
         set y2 [lindex $coords 3]
         set coords [list $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2]
      }
      arc {
         set Options(-smooth) 1
         set start  [expr ($pi*[.c itemcget $id -start])/180]
         set extent [expr ($pi*[.c itemcget $id -extent])/180]
         set style  [.c itemcget $id -style]
         set x1 [lindex $coords 0]
         set y1 [lindex $coords 1]
         set x2 [lindex $coords 2]
         set y2 [lindex $coords 3]
         set a [expr ($x2-$x1)/2.0]
         set b [expr ($y2-$y1)/2.0]
         set coords {}
         set divnum 48.0
         for {set i 0} {$i<=$divnum} {incr i} {
           set t [expr $start+$i*($extent/$divnum)]
           lappend coords [expr $x1+$a+$a*cos($t)]
           lappend coords [expr $y1+$b-$b*sin($t)]
         }
         switch -exact -- $style {
             arc  {
                set type line
                set Options(-fill) [.c itemcget $id -outline]
             }
             chord {
                set type polygon
                set Options(-outline) [.c itemcget $id -outline]
                set Options(-fill)    [.c itemcget $id -fill]
                set n [expr [llength $coords]-2]
                set x0 [lindex $coords 0]
                set y0 [lindex $coords 1]
                set xn [lindex $coords $n]
                set yn [lindex $coords [expr $n+1]]
                set coords [lreplace $coords 0 1]
                lappend coords $xn $yn $x0 $y0 $x0 $y0
             }
             pieslice {
                set type polygon
                set Options(-outline) [.c itemcget $id -outline]
                set Options(-fill)    [.c itemcget $id -fill]
                set n [expr [llength $coords]-2]
                set x0 [lindex $coords 0]
                set y0 [lindex $coords 1]
                set xn [lindex $coords $n]
                set yn [lindex $coords [expr $n+1]]
                set xc [expr ($x1+$x2)/2]
                set yc [expr ($y1+$y2)/2]
                set coords [lreplace $coords 0 1]
                lappend coords $xn $yn $xc $yc $xc $yc $x0 $y0 $x0 $y0
            }
          }
             
      }
   }
   .c addtag aboutToDie withtag $id
   set new_id [eval .c create $type $coords [array get Options]]
   .c raise $new_id aboutToDie
   .c delete aboutToDie
   return $new_id
}


proc rotateGroupMode {} {
   global Rotate pi
   set pi [expr 2*asin(1)]
   
   .c delete graybox

   set bbox [.c bbox Selected]
   set x1 [lindex $bbox 0]
   set y1 [lindex $bbox 1]
   set x2 [lindex $bbox 2]
   set y2 [lindex $bbox 3]
   .c create polygon $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2\
                -outline {} \
                -fill gray50 \
                -stipple gray12 \
                -tags {graybox rotateBox}

   set Rotate(x1) $x1
   set Rotate(x2) $x2
   set Rotate(y1) $y1
   set Rotate(y2) $y2
   set Rotate(xc) [expr ($x1+$x2)/2]
   set Rotate(yc) [expr ($y1+$y2)/2]

   .c bind rotateBox <Enter> {%W configure -cursor dot}
   .c bind rotateBox <Leave> {
        %W configure -cursor ""
        %W delete rotateText
   }

   .c bind rotateBox <Motion> {
        .c delete rotateText
        .c create text $Rotate(xc) [expr $Rotate(y1)-3] \
              -anchor s \
              -text [format "%%.1f" [expr $Rotate(yc)-%y]] \
              -tags rotateText
        .c create text [expr $Rotate(x2)+3]  $Rotate(yc) \
              -anchor w \
              -text [format "%%.1f" [expr %x-$Rotate(xc)]] \
              -tags rotateText
   }

   bind .c <Button-1> {
      set Rotate(x_orig) %x
      set Rotate(y_orig) %y
      set Rotate(last) 0
      set Rotate(ang) 0
      set Rotate(delta) 0
      set Rotate(undo) [getGroupCommand 1]
      foreach id [.c find withtag Selected] {
         shape2spline $id
      }
   }

   bind .c <B1-Motion> {
     .c delete rotateLine rotateText rotateTextBox
     .c create line $Rotate(x_orig) $Rotate(y_orig) %x %y \
           -width 2 \
           -arrow last \
           -tags rotateLine
     if {abs($Rotate(x_orig) - %x) < 15 && abs($Rotate(y_orig) - %y) < 15} {
       return
     }
     .c create rectangle [expr %x+5] [expr %y-32] [expr %x+55] [expr %y-8] \
                -width 2 \
                -fill cyan \
                -tags rotateTextBox
     set Rotate(ang) [expr -atan2(%y-$Rotate(y_orig),%x-$Rotate(x_orig))]
     .c create text [expr %x+30] [expr %y-20] \
           -anchor c \
           -fill red \
           -text [format "%%.1f" [expr $Rotate(ang)*180.0/$pi]] \
           -font {Helvetica 12 bold} \
           -tags rotateText
     set Rotate(delta) [expr $Rotate(ang) - $Rotate(last)]
     set Rotate(last) $Rotate(ang)
     rotateGroup
   }

   bind .c <B1-ButtonRelease> {
       .c delete rotateLine rotateBox rotateText rotateTextBox
       %W configure -cursor ""
       foreach id [.c find withtag Selected] {
          set utag [Utag find $id]
          append Rotate(cmd) "shape2spline $utag \; "
          append Rotate(cmd) "rotateObj $Rotate(x_orig) $Rotate(y_orig) \
                      $Rotate(last) $utag \; "
       }
       History add $Rotate(cmd)
       Undo add $Rotate(undo)
       catch {unset Rotate}
       selectGroupMode
   }
}

proc rotateGroup {} {
  global Rotate

  rotateObj $Rotate(x_orig) $Rotate(y_orig) $Rotate(delta) graybox

  foreach id [.c find withtag Selected] {
     rotateObj $Rotate(x_orig) $Rotate(y_orig) $Rotate(delta) $id
  }
  .c raise rotateTextBox
  .c raise rotateText
}


# GROUP LINE COLOR:
proc editGroupLineColor {} {
   set undo [getGroupCommand 1]
   set group [.c find withtag Selected]
   if {[llength $group]==0} { return }
   set color [tk_chooseColor -title "Choose Group Outline Color"]
   if {$color==""} {return}
   foreach id [.c find withtag Selected] {
       set type [.c type $id]
       set utag [Utag find $id]
       switch -exact -- $type {
          text      {set step ""}
          line      {set step ".c itemconfigure $utag -fill $color\;"}
          default   {set step ".c itemconfigure $utag -outline $color\;"}
       }
       if {$step==""} {continue}
       eval $step
       append cmd $step
   }
   History add $cmd
   Undo add $undo
}

# GROUP FILL COLOR:
proc editGroupFillColor {} {
   set undo [getGroupCommand 1]
   set group [.c find withtag Selected]
   if {[llength $group]==0} { return }
   set color [tk_chooseColor -title "Choose Group Fill Color"]
   if {$color==""} {return}
   foreach id $group {
       set type [.c type $id]
       switch -exact -- $type {
          line      {set step ""}
          text      {set step ""}
          default   {
             set utag [Utag find $id]
             set step ".c itemconfigure $utag -fill $color\;"
          }
       }
       if {$step==""} {continue}
       eval $step
       append cmd $step
   }
   History add $cmd
   Undo add $undo
}


# GROUP LINE WIDTH:
proc editGroupLineWidth {} {
   global glwidth glw_undo
   set have_line 0

   set glw_undo [getGroupCommand 1]

   foreach id [.c find withtag Selected] {
      set type [.c type $id]
      switch -exact -- $type {
         text     {}
         default  {set glwidth [.c itemcget $id -width]
                   set have_line 1
                   break
                  }
      }
   }

   if {$have_line==0} {return}

   toplevel .grouplw
   wm transient .grouplw .
   wm resizable .grouplw 0 0
#   wm geometry .grouplw +250+150
   focus -force .grouplw
   wm title .grouplw "Pick line width"
   frame .grouplw.width -relief raised -bd 1
   canvas .grouplw.widthcanvas -relief flat -height 2c -width 7.5c
   .grouplw.widthcanvas create text 5 5 \
          -anchor nw \
          -text "Group Line Width" \
          -font {Helvetica 12 bold}
       
   .grouplw.widthcanvas create line 1.2c 1.5c 6.3c 1.5c \
          -tags demoGroupLine \
          -width $glwidth

   scale .grouplw.widthscale -orient horiz \
          -resolution .1 -from 1 -to 30 \
          -length 4c \
          -variable glwidth \
          -command updateGroupLineWidth \
          -bd 2 \
          -relief flat \
          -highlightthickness 0 \
          -width 10 \
          -showvalue true \
          -font {Helvetica 12 bold}
   pack .grouplw.widthcanvas .grouplw.widthscale -in .grouplw.width \
           -side top  -fill both -expand true
   pack .grouplw.width

   wm protocol .grouplw WM_DELETE_WINDOW {
             foreach id [.c find withtag Selected] {
                 if {[.c type $id] != "text"} {
                       set utag [Utag find $id]
                       set lw [.c itemcget $id -width]
                       append cmd ".c itemconfigure $utag -width $lw\;"
                 }
             }
             History add $cmd
             Undo add $glw_undo
             unset glwidth glw_undo cmd
             destroy .grouplw
   }
}

proc updateGroupLineWidth {glw} {
   .grouplw.widthcanvas itemconfigure demoGroupLine -width $glw
   foreach id [.c find withtag Selected] {
       set type [.c type $id]
       switch -exact -- $type {
          text      {}
          default   {.c itemconfigure $id -width $glw}
       }
   }
}

proc editGroupFont {} {
   set have_text 0

   set undo [getGroupCommand 1]

   foreach id [.c find withtag Selected] {
       set type [.c type $id]
       if {$type=="text"} {
         set initfont  [.c itemcget $id -font]
         set initcolor [.c itemcget $id -fill]
         set have_text 1
         break
       }
   }

   if {$have_text==0} {return}

   set newData [dkf_chooseFont -initialfont  $initfont \
                               -initialColor $initcolor]
   if {$newData==""} {return}

   set newFont [lindex $newData 0]
   set newColor [lindex $newData 1]

   foreach id [.c find withtag Selected] {
       set type [.c type $id]
       set utag [Utag find $id]
       if {$type=="text"} {
         .c itemconfigure $id -font $newFont -fill $newColor
         append cmd [list .c itemconfigure $utag -font $newFont \
                          -fill $newColor] \;
       }
   }
   History add $cmd
   Undo add $undo
}

# X-REFLECT GROUP:
proc reflect {mode} {
   global BBox
   set group [.c find withtag Selected]
   if {[llength $group]==0} { return }
   set undo2 [getGroupCommand 1]
   set x0 [expr ($BBox(x1)+$BBox(x2))/2.0]
   set y0 [expr ($BBox(y1)+$BBox(y2))/2.0]
   foreach id $group {
       set id [shape2spline $id]
       set utag [Utag find $id]
       lappend utags $utag
       append cmd ".c delete $utag \; "
       set type [.c type $id]
       append cmd ".c create $type "
       set coords [.c coords $id]
       set new_coords {}
       if {$mode=="x"} {
           foreach {x y} $coords {
              lappend new_coords $x [expr (2*$y0)-$y]
           }
       } else {
           foreach {x y} $coords {
              lappend new_coords [expr (2*$x0)-$x] $y
           }
       }
       append cmd $new_coords " "
       set options [getObjectOptions $utag 1]
       if {$type=="text"} {
            set a [.c itemcget $id -anchor]
            if {$mode=="x"} {
                if {[string first "n" $a]>=0} {
                     regsub n $a s b
                } else {
                     regsub s $a n b
                }
            } else {
                if {[string first "w" $a]>=0} {
                     regsub w $a e b
                } else {
                     regsub e $a w b
                }
            }
            regsub -- "-anchor $a" $options "-anchor $b" options
       }
       append cmd "$options \; "
   }
   eval $cmd
   foreach u $utags {
       .c addtag Selected withtag $u
   }
   drawBoundingBox
   History add $cmd
   Undo add [append undo1 $undo2]
}

###################### SECTION:  ARROWS

proc drawArrowHandle {x y} {
  set r 7
  set coords [list [expr $x-$r] [expr $y-$r] \
                   [expr $x-$r] [expr $y+$r] \
                   [expr $x+$r] [expr $y+$r] \
                   [expr $x+$r] [expr $y-$r] ]
  set options [list -outline black -width 1 -fill {} -smooth 1 \
                    -tags arrowHandle]
  return [eval .c create polygon $coords $options]
}

proc arrowsMode {} {
  global arrowsInfo Graphics
  set Graphics(mode) Arrows

  catch {unset arrowsInfo}

  set lines [concat [.c find withtag Line] [.c find withtag freeHand] ]

  foreach line $lines {
     set line [Utag find $line]
     set coords [.c coords $line]
     set n [llength $coords]
     set x1 [lindex $coords 0]
     set y1 [lindex $coords 1]
     set x2 [lindex $coords [expr $n-2]]
     set y2 [lindex $coords [expr $n-1]]
     
     set arrowsConfig [.c itemcget $line -arrow]

     set id1 [drawArrowHandle $x1 $y1]
     set arrowsInfo($id1,point) first
     set arrowsInfo($id1,line) $line
     set arrowsInfo($id1,option) $arrowsConfig
     .c bind $id1 <Button-1> "toggleArrow $id1"

     set id2 [drawArrowHandle $x2 $y2]
     set arrowsInfo($id2,point) last
     set arrowsInfo($id2,line) $line
     set arrowsInfo($id2,option) $arrowsConfig
     .c bind $id2 <Button-1> "toggleArrow $id2"

     set arrowsInfo($id1,friend) $id2
     set arrowsInfo($id2,friend) $id1
   }
   set arrowsInfo(map) {
      first  none    first
      first  first   none
      first  last    both
      first  both    last
      last   none    last
      last   first   both
      last   last    none
      last   both    first
   }
}

proc toggleArrow {id} {
   global arrowsInfo Graphics
  
   foreach {a b c} $arrowsInfo(map) {
     if {$arrowsInfo($id,point)==$a && $arrowsInfo($id,option)==$b} {
       set cmd [list .c itemconfigure $arrowsInfo($id,line) \
                     -arrow $c -arrowshape $Graphics(arrowshape)]
       set undo [list .c itemconfigure $arrowsInfo($id,line) \
                 -arrow $arrowsInfo($id,option) \
                 -arrowshape $Graphics(arrowshape)]
       eval $cmd
       set arrowsInfo($id,option) $c
       set friend $arrowsInfo($id,friend)
       set arrowsInfo($friend,option) $c
       History add $cmd
       Undo add $undo
       return
     }
   }
}

### SECTION: TEXT IN CANVAS

#
# Stolen code:
# Example 31-12 of Welch's great book "Practical Programming in Tcl/Tk".
# (must flatter ;-)).
# Simple edit bindings for canvas text items.
#

proc TextMode {} {
   global Graphics

   bind .c <Button-1> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      TextFocus $x $y
   }
   bind .c <Button-3> {
      set x [.c canvasx %x $Graphics(gspacing)]
      set y [.c canvasx %y $Graphics(gspacing)]
      TextPaste [.c canvasx $x] [.c canvasy $y]
   }
   bind .c <<Cut>> {TextCopy ; TextDelete}
   bind .c <<Copy>> {TextCopy}
   bind .c <<Paste>> {TextPaste}
   .c bind text <B1-Motion> {
      TextDrag [%W canvasx %x] [%W canvasy %y]
   }
   .c bind text <Delete> {TextDelete}
   .c bind text <Control-d> {TextDelChar}
   .c bind text <Control-h> {TextBackSpace}
   .c bind text <BackSpace> {TextBackSpace}
   .c bind text <Control-Delete> {TextErase}
   .c bind text <Return> {TextNewline}
   .c bind text <Any-Key> {TextInsert %A}
   .c bind text <Key-Right> {TextMoveRight}
   .c bind text <Control-f> {TextMoveRight}
   .c bind text <Key-Left> {TextMoveLeft}
   .c bind text <Control-b> {TextMoveLeft}
}

proc TextFocus {x y} {
   global Text Graphics LastText
   focus .c
   if [info exists Text] {TextHist}

   set Text(utag) [getNearestUtag $x $y 2 text]

   if {$Text(utag) != ""} {
        foreach opt {font fill stipple anchor tags} {
            set Text($opt)  [.c itemcget $Text(utag) -$opt]
        }
        .c focus $Text(utag)
        .c icursor $Text(utag) @$x,$y
        .c select clear
        .c select from $Text(utag) @$x,$y
   } else {
         set Text(font)    [list $Graphics(font,type) $Graphics(font,size)\
                                 $Graphics(font,style)]
         set Text(color)   $Graphics(font,color)
         set Text(stipple) $Graphics(font,stipple)
         set Text(anchor)  $Graphics(text,anchor)
         set id [.c create text $x $y -text "" \
                         -font    $Text(font) \
                         -fill    $Text(color) \
                         -stipple $Text(stipple) \
                         -anchor  $Text(anchor) \
                         -tags {text obj} \
                         -anchor $Graphics(text,anchor)]
         set Text(utag) [Utag assign $id]
         set LastText($Text(utag)) {}
         .c focus $Text(utag)
         .c select clear
         .c icursor $Text(utag) 0
   }
}

proc TextHist {} {
     global LastText Text
     set u $Text(utag)
     set text [.c itemcget $u -text]
     if {$text==""} {
          .c delete $u
          unset Text
          return
     } elseif {$LastText($u)==""} {
          set cmd [getObjectCommand $u 1]
          set undo ".c delete $u"
          set LastText($u) $text
     } elseif {$text==$LastText($u)} {
          unset Text
          return
     } else {
          set cmd  [list .c itemconfig $u -text $text]
          set undo [list .c itemconfig $u -text $LastText($u)]
          set LastText($u) $text
     }

     History add $cmd
     Undo add $undo
     unset Text
}

proc TextDrag {x y} {
   .c select to current @$x,$y
}

proc TextDelete {} {
   if {[.c select item] != {}} {
      .c dchars [.c select item] sel.first sel.last
   } elseif {[.c focus] != {}} {
      .c dchars [.c focus] insert
   }
}

proc TextCopy {} {
   if {[.c select item] != {}} {
      clipboard clear
      set t [.c select item]
      set text [.c itemcget $t -text]
      set start [.c index $t sel.first]
      set end [.c index $t sel.last]
      clipboard append [string range $text $start $end]
   } elseif {[.c focus] != {}} {
      clipboard clear
      set t [.c focus]
      set text [.c itemcget $t -text]
      clipboard append $text
   }
}

proc TextDelChar {} {
   if {[.c focus] != {}} {
      .c dchars [.c focus] insert
   }
}

proc TextBackSpace {} {
   if {[.c select item] != {}} {
      .c dchars [.c select item] sel.first sel.last
   } elseif {[.c focus] != {}} {
      set _t [.c focus]
      .c icursor $_t [expr [.c index $_t insert]-1]
      .c dchars $_t insert
   }
}

proc TextErase {} {
   global Text LastText

   if ![info exists Text] {return}

   .c focus {}
   .c select clear

   set u $Text(utag)

   set text [.c itemcget $u -text]

   set cmd ".c delete $u"
   set undo "[getObjectCommand $u 1]\;"

   if {$text==""} {
       if {$LastText($u) != ""} {
         append undo [list .c itemconfig $u -text $LastText($u)]
       } else {
        .c delete $u
        catch {unset Text}
        return
       }
   } elseif {$LastText($u)!="" && $text!=$LastText($u)} {
#        History add [getObjectCommand $u 1]
        History add [list .c itemconfig $u -text $text]
        Undo add [list .c itemconfig $u -text $LastText($u)]
        set LastText($u) $text
   }

   History add $cmd
   Undo add $undo
   catch {unset Text}
   .c delete $u
}

proc TextNewline {} {
   .c insert [.c focus] insert \n
}

proc TextInsert {char} {
   if {$char=="" || $char=="" || $char==""} {return}
   .c insert [.c focus] insert $char
}

proc TextPaste {{x {}} {y {}}} {
   if {[catch {selection get} _s] &&
       [catch {selection get -selection CLIPBOARD} _s]} {
      return      ;# No selection
   }
   set id [.c focus]
   if {[string length $id] == 0 } {
      set id [.c find withtag current]
   }
   if {[string length $id] == 0 } {
      # No object under the mouse
      if {[string length $x] == 0} {
         # Keyboard paste
         set x [expr [winfo pointerx .c] - [winfo rootx .c]]
         set y [expr [winfo pointery .c] - [winfo rooty .c]]
      }
      TextFocus $x $y
   } else {
      .c focus $id
   }
   .c insert [.c focus] insert $_s
}

proc TextMoveRight {} {
   .c icursor [.c focus] [expr [.c index current insert]+1]
}

proc TextMoveLeft {} {
   .c icursor [.c focus] [expr [.c index current insert]-1]
}



#### FONT CHOOSING
proc chooseFont {} {
   global Graphics
   set initFont [list $Graphics(font,type) \
                      $Graphics(font,size) \
                      $Graphics(font,style)]
   set initColor $Graphics(font,color)
   set newData [dkf_chooseFont -initialfont $initFont\
                               -initialColor $initColor]
   if {$newData==""} {return}
   set newFont [lindex $newData 0]
   set newFontColor [lindex $newData 1]
   set Graphics(font,type)  [lindex $newFont 0]
   set Graphics(font,size)  [lindex $newFont 1]
   set Graphics(font,style) [lindex $newFont 2]
   set Graphics(font,color) $newFontColor
}

proc resetFontStyle {} {
   global Graphics
   foreach s {bold italic underline overstrike} {
      if {$Graphics(font,$s)==1 && [lsearch $Graphics(font,style) $s]<0} {
        lappend Graphics(font,style) $s
      }
      if {$Graphics(font,$s)==0 && [lsearch $Graphics(font,style) $s]>=0} {
        set i [lsearch $Graphics(font,style) $s]
        set Graphics(font,style) [lreplace $Graphics(font,style) $i $i]
      }
   }
}

###### GRID SECTION
proc Grid {cellSize} {
  global Graphics Canv
  .c delete gridObject
  if {$cellSize==0} {
    return
  }
  set Graphics(gridcell) $cellSize
  set m [expr int($Canv(W)/$cellSize)]
  set n [expr int($Canv(H)/$cellSize)]
  
  for {set i 1} {$i<=$m} {incr i} {
    set Xi [expr $i*$cellSize]
    .c create line $Xi 0 $Xi $Canv(H) \
        -width 1.5 \
        -stipple gray12 \
        -tags {gridLine gridObject}
  }
  
  for {set i 1} {$i<=$n} {incr i} {
    set Yi [expr $i*$cellSize]
    .c create line 0 $Yi $Canv(W) $Yi \
        -stipple gray12 \
        -width 1.5 \
        -tags {gridLine gridObject}
  }
  if {$Graphics(ticks)} {
    Ticks $cellSize
  }
}

proc Ticks {cellSize} {
  global Graphics Canv

  .c delete gridText gridTick
  if {$cellSize==0} {
    return
  }

  set m [expr int($Canv(W)/$cellSize)]
  set n [expr int($Canv(H)/$cellSize)]
  
  for {set i 1} {$i<=$m} {incr i} {
    set Xnum [expr $i*$cellSize+3]
    set Xtick [expr $i*$cellSize]
    .c create text $Xnum 3 \
        -font {Helvetica 7} \
        -text $i \
        -fill red \
        -anchor nw \
        -tags {gridText gridObject}
    .c create line $Xtick 0 $Xtick 4 \
        -width 2 \
        -fill red \
        -tags {gridTick gridObject}
  }
  
  for {set i 1} {$i<=$n} {incr i} {
    set Ynum [expr $i*$cellSize+3]
    set Ytick [expr $i*$cellSize]
    .c create text 3 $Ynum\
        -font {Helvetica 7} \
        -text $i \
        -fill red \
        -anchor nw \
        -tags {gridText gridObject}
    .c create line 0 $Ytick 4 $Ytick \
        -width 2 \
        -fill red \
        -tags {gridTick gridObject}
  }
}


####### FILE SECTION: NEW, OPEN, SAVE, EXIT, ...

set File(pic,name) ""
set File(eps,name) ""
set File(new) 1
set File(saved) 1
#set File(progress) 0
set File(pic,types) {
   {{tcl pic} {.pic} }
   {{All files} * }
}
set File(eps,types) {
   {{EPS file} {.eps} }
   {{All files} * }
}
set File(wd) [pwd]

proc File {cmnd args} {
global File Graphics Canv utagCounter LastText

groomCanvas
cd $File(wd)

switch -exact -- $cmnd {
   getname {
       set mode        [lindex $args 0]
       set type        [lindex $args 1]
       set title       [lindex $args 2]
       set defaultName [lindex $args 3]
       if {$mode=="save"} { set command tk_getSaveFile }
       if {$mode=="open"} { set command tk_getOpenFile }
       set filename [$command \
                -title "$title" \
                -filetypes $File($type,types) \
                -initialfile $defaultName \
                -defaultextension ".$type" ]
       if {$filename==""} {return 0}
       set File($type,name) $filename
       set File(wd) [file dirname $File(pic,name)]
       return 1
   }

   new {
       if {$File(saved)==0} {
         File close
         return
       }
       resetCanvas
       set File(pic,name) ""
       set File(eps,name) ""
       set File(new) 1
       set File(saved) 1
       set Graphics(mode) ""
   }

   open {
       if {$File(saved)==0  &&  [File close]==0} {
         return
       }
       if ![File getname open pic "Open a Tcl pic file" ""] {
         return
       }
       resetCanvas
       source $File(pic,name)
       set File(eps,name) ""
       set File(saved) 1
       set File(new) 0
   }

   close {
       if {$File(new)==1} {
         return
       }
       if {$File(saved)==1} {
         File new
         return 1
       }

       switch [tk_messageBox -type yesnocancel \
                -message "Current work was not saved !\nSave now ?" \
                -icon question \
                -title "TkPaint: save file?" \
                -default yes] {
          yes {
                if {$File(pic,name)==""
                       && ![File getname save pic "Save as a Tcl pic file" \
                       untitled.pic] } {
                   return 0
                }
                File write pic
                set File(saved) 1
                File new
                return 1
          }

          no {
                set File(saved) 1
                File new
                return 1
          }

          cancel {
            return 0
          }
       }
   }

   save {
       set type [lindex $args 0]

       switch -exact -- $type {

            pic {
              if ![File getname save pic "Save a Tcl pic file" $File(pic,name)] {
                 return
              }
              File write pic
              set File(progress) 0
              set File(saved) 1
            }

            eps {
              if {$File(pic,name)==""} {
                set File(eps,name) "untitled.eps"
              } else {
                set File(eps,name) [file rootname $File(pic,name)].eps
              }
              if ![File getname save eps "Save as Encapsulated PostScript File" $File(eps,name)] {
                return
              }
              File write eps
            }

            auto {
              if {$File(pic,name)=="" &&
                  ![File getname save pic "Save a Tcl pic file" untitled.pic]} {
                return
              }
              File write pic
              set File(progress) 0
              set File(saved) 1
            }
       }
   }

   write {
       set type [lindex $args 0]

       if {$type=="eps"} {
         set dimens [eval .c bbox [.c find withtag obj]]
         set x1 [lindex $dimens 0]
         set x2 [lindex $dimens 2]
         set y1 [lindex $dimens 1]
         set y2 [lindex $dimens 3]
         set h [expr $y2-$y1]
         set w [expr $x2-$x1]
         .c postscript -file $File(eps,name) \
                       -x $x1 \
                       -y $y1 \
                       -width $w \
                       -height $h \
                       -pagewidth 19c
         return
       }

       if {$type=="pic"} {
         set File(pic,fd) [open $File(pic,name) w]
         foreach name [array names Graphics] {
            puts $File(pic,fd) [list set Graphics($name) $Graphics($name)]
         }
         puts $File(pic,fd) {set Graphics(mode) ""}
         puts $File(pic,fd) "### End of Graphics parameters\n\n"
         puts $File(pic,fd) "set utagCounter $utagCounter\n\n"
         puts $File(pic,fd) "global Canv"
         puts $File(pic,fd) "set Canv(H) $Canv(H)"
         puts $File(pic,fd) "set Canv(W) $Canv(W)"
         puts $File(pic,fd) "set Canv(bg) $Canv(bg)"
         puts $File(pic,fd) {.c config -width $Canv(W) -height $Canv(H) \
              -bg $Canv(bg)}
         puts $File(pic,fd) {wm geometry . ""}

         foreach name [array names LastText] {
            puts $File(pic,fd) [list set LastText($name) $LastText($name)]
         }

         foreach id [.c find all] {
            puts $File(pic,fd) [getObjectCommand $id 1]
         }

         close $File(pic,fd)
         return
      }
      set Graphics(mode) $save_mode
   }

   exit  {
       if {$File(saved)==1} {exit}
       if [File close] {exit}
   }

   print  {
       if {$File(new)==1} {return}
       if {$File(pic,name) != ""} {
         set File(eps,name) [file rootname $File(pic,name)].eps
       } else {
         set File(eps,name) printout.eps
       }
       File write eps
       if [catch {exec ghostview $File(eps,name)} err] {
         tk_messageBox -type ok \
                -message "$err\n You need gsview program to print!\
                          It looks like you don't have it. Sorry." \
                -icon warning \
                -title "TkPaint: can't print" \
                -default ok
       }
#       exec e:/texps/gsview/gsview32.exe $File(eps,name)
   }
}
} ;# end of File proc

proc groomCanvas {} {
  global Polygon Line Text undoMode Arc

  .c delete arrowHandle
  .c delete arcMark
  if [info exists Arc] {unset Arc}

  if {[info exists Polygon(coords)] && [llength $Polygon(coords)]>=6} {
    makePolygon
  }

  if [info exists Polygon] {
     catch {.c delete $Polygon(tempLine)}
     unset Polygon
  }

  if [info exists Line] {
    makeLine
  }

  .c raise gridObject

  if [info exists Text] {
    foreach event [.c bind text] {
       .c bind text $event {}
    }
    .c focus {}
    .c select clear
    TextHist
  }

  .c delete graybox
  .c configure -cursor ""
}


###### HELP SECTION

proc About { } {
   toplevel .about
   wm protocol .about WM_DELETE_WINDOW {.about.dismiss invoke}
   wm transient .about .
   wm resizable .about 0 0
   wm iconify .
   wm geometry .about +250+150
   focus -force .about
   wm title .about "About Tkpaint 1.0"
   label .about.l -image [image create photo -file gifs/TclTk.gif] \
                  -relief raised \
                  -bd 2 \
                  -bg white
   pack .about.l -padx 10 -pady 5

   set text "Copyright (c) 1998 Samy Zafrany.\n\
Version 1.0\n\
Netanya Academic College\n\
samy@netanya.ac.il\n\
lots of help from\n\
Michel Zohar & Yaniv Katan & Amit Noph"

   label .about.msg -width 45 -justify center \
               -font {"Times New Roman" 12 bold} \
               -text $text
   pack .about.msg -pady 5
   button .about.dismiss -text Dismiss \
               -bd 2 \
               -command {destroy .about;wm deiconify .}
   pack .about.dismiss -ipadx 3
   grab .about.dismiss
   tkwait window .about.dismiss
}

proc balloon { w text } {
   global Balloon
   set x [expr [winfo rootx $w] + int(0.8*[winfo width $w])]
   set y [expr [winfo rooty $w] + int(0.8*[winfo height $w])]
   regsub -all {\.} $w _ temp 
   set Balloon($w,name) .balloon$temp
   set b $Balloon($w,name)
   set job1  "toplevel $b -bg black
        wm geometry $b +$x+$y 
        wm overrideredirect $b 1
        label $b.label -text \"$text\" \
                   -relief flat \
                   -bg #ffffaa \
                   -fg black \
                   -padx 2 \
                   -pady 0 \
                   -anchor w
         pack $b.label  -side left \
                   -padx 1 \
                   -pady 1
         set Balloon($w,job2) [after 5000 [list catch [list destroy $b]]]
   "
   set Balloon($w,job1) [after 1500 "$job1"]
}

set ButtonsHelp { 
  0  0  rectangle.gif   "Draw a rectangle"
  0  1  roundrect.gif   "Draw a rounded rectangle"
  0  2  circle.gif      "Draw a circle"
  0  3  ellipse.gif     "Draw an ellipse"
  0  4  polygon.gif     "Draw a polygon"
  0  5  polyline.gif    "Draw lines"
  0  6  spline.gif      "Draw a spline"
  0  7  cspline.gif     "Draw a closed spline"
  0  8  arc.gif         "Draw an arc (of a circle)"
  0  9  pieslice.gif    "Draw a pie slice (of a circle)"
  0 10  chord.gif       "Draw a chord (of a circle)"
  0 11  freehand.gif    "Draw a free hand line"
  1  0  text.gif        "Insert text"
  1  1  move.gif        "Move an object"
  1  2  copy.gif        "Copy an object"
  1  3  erase.gif       "Erase an object"
  1  4  raise.gif       "Raise an object"
  1  5  lower.gif       "Lower an object"
  1  6  arrows.gif      "Put arrows on lines"
  1  7  grid.gif        "Toggle a 1cm grid"
  1  8  reconf.gif      "Edit a group of objects"
  1  9  undo.gif        "Undo last change"
  1 10  unundo.gif      "Undo last undo"
  1 11  savefile.gif    "Save file to disk"
  0 12  bold.gif        "Bold style text"
  0 13  underline.gif   "Undeline style text"
  0 14  italic.gif      "Italic style text"
  1 12  lefta.gif       "Left justified text"
  1 13  centera.gif     "Center text"
  1 14  righta.gif      "Right justified text"
}

foreach {row col dummy text} $ButtonsHelp {
   set w .tools.button${row}_$col
   bind $w <Enter> [list balloon %W $text]
   bind $w  <Leave>  {catch {
       after cancel $Balloon(%W,job1)
       after cancel $Balloon(%W,job2)
       destroy $Balloon(%W,name)
      }
   }
}

bind  .tools.but_outline  <Enter> {
     balloon %W  "Choose line color"
}

bind  .tools.but_outline  <Leave> {catch {
       after cancel $Balloon(%W,job1)
       after cancel $Balloon(%W,job2)
       destroy $Balloon(%W,name)
   }
}

bind  .tools.but_fill  <Enter> {
     balloon %W  "Choose fill color"
}

bind  .tools.but_fill  <Leave> {catch {
       after cancel $Balloon(%W,job1)
       after cancel $Balloon(%W,job2)
       destroy $Balloon(%W,name)
   }
}

########### Status Bar:
frame .statbar
grid config .statbar -column 0 -row 3 \
        -columnspan 1 -rowspan 1 -sticky "snew" -ipadx 1 -ipady 1

label .statbar.coords -textvariable Canv(pointerxy) \
      -bd 1 \
      -width 7 \
      -anchor w \
      -relief sunken
pack .statbar.coords -side left -padx 1 -pady 1

label .statbar.mode -textvariable Graphics(mode) \
      -bd 1 \
      -width 13 \
      -anchor w \
      -relief sunken
pack .statbar.mode -side left -padx 1 -pady 0.5

label .statbar.font -textvariable Graphics(font,type) \
      -bd 1 \
      -width 15 \
      -anchor w \
      -relief sunken
pack .statbar.font -side left -padx 1 -pady 0.5

label .statbar.fontsize -textvariable Graphics(font,size) \
      -bd 1 \
      -width 2 \
      -anchor e \
      -relief sunken
pack .statbar.fontsize -side left -padx 1 -pady 0.5

label .statbar.fontstyle -textvariable Graphics(font,style) \
      -bd 1 \
      -width 18 \
      -anchor w \
      -relief sunken
pack .statbar.fontstyle -side left -padx 1 -pady 0.5

label .statbar.file -textvariable File(pic,name) \
      -bd 1 \
      -width 50 \
      -anchor w \
      -relief sunken
pack .statbar.file -side left -padx 1 -pady 0.5 -fill x -expand 1

################ End of Status bar

#source debug.tcl

#########  VARIABLE TRACING

proc Traces {mode} {
   global Graphics undoMode
   set traceList {
     Graphics(line,width)    w   traceProc1
     Graphics(line,width)    w   traceProc1.1
     Graphics(line,capstyle) w   traceProc1.1
     Graphics(line,color)    w   traceProc1.1
     Graphics(fill,color)    w   traceProc2
     Graphics(line,color)    w   traceProc3
     Graphics(mode)          w   traceProc4
     Graphics(font,style)    w   traceProc5
     Graphics(gridcell)      w   traceProc6
     Graphics(ticks)         w   traceProc6.1
     Graphics(font,color)    w   traceProc7
     undoMode                w   traceProc9
   }

   switch $mode {
      enable {
         foreach {var op proc} $traceList {
            trace variable $var $op $proc
         }
      }
      disable {
         foreach {var op proc} $traceList {
            trace vdelete $var $op $proc
         }
      }
   }
}

Traces enable

proc traceProc1 {v index op} {
  global Graphics
  if {$Graphics(line,width)==0} {
    set Graphics(line,color,save) $Graphics(line,color)
    set Graphics(line,color) {}
  }
  if {$Graphics(line,width)!=0 && [info exists Graphics(line,color,save)]} {
    set Graphics(line,color) $Graphics(line,color,save)
    unset Graphics(line,color,save)
  }
}

proc traceProc1.1 {v index op} {
  global Graphics
  .tools.widthcanvas itemconfig demoLine -width $Graphics(line,width) \
               -fill $Graphics(line,color) \
               -stipple $Graphics(line,style) \
               -capstyle $Graphics(line,capstyle)
}

proc traceProc2 {v index op} {
  global Graphics
  if {$Graphics(fill,color)==""} {
    set color grey75
  } else {
    set color $Graphics(fill,color)
  }
  .tools.fr_fill configure -bg $color
  update
}

proc traceProc3 {v index op} {
  global Graphics
  .tools.fr_outline configure -bg $Graphics(line,color)
  update
}

proc traceProc4 {v index op} {
  global Graphics Polygon Line Text

  .c delete arrowHandle

  if {[info exists Polygon(coords)] && [llength $Polygon(coords)]>=6} {
    makePolygon
  }

  if [info exists Polygon] {
     catch {.c delete $Polygon(tempLine)}
     unset Polygon
  }

  if [info exists Line] {
    makeLine
  }

  .c raise gridObject

  if [info exists Text] {
    foreach event [.c bind text] {
       .c bind text $event {}
    }
    TextHist
    .c focus {}
    .c select clear
  }

  .c delete graybox
  .c configure -cursor ""
  
  foreach b [bind .c] {
     bind .c $b {}
  }
  Bindings enable
}

proc traceProc5 {v index op} {
  global Graphics
  foreach s {normal bold italic underline overstrike roman} {
     if {[lsearch $Graphics(font,style) $s] >= 0} {
       set Graphics(font,$s) 1
     } else {
       set Graphics(font,$s) 0
     }
  }
}

proc traceProc6 {v index op} {
  global Graphics
  if {$Graphics(gridcell) > 0} {
    Grid $Graphics(gridcell)
    set Graphics(grid) 1
  } else {
    set Graphics(grid) 0
    Grid 0
  }
}

proc traceProc6.1 {v index op} {
  global Graphics
  if {$Graphics(grid)==0} {
    return
  }
  if {$Graphics(ticks)==0} {
    .c delete gridText gridTick
  } else {
    Ticks $Graphics(gridcell)
  }
}

proc traceProc7 {v index op} {
  global Graphics
  .statbar.font config -fg $Graphics(font,color)
}

# Caused havoc!
#proc traceProc8 {v index op} {
#  global Canv
#  .c configure -width $Canv(W) -height $Canv(H)
#}

#proc traceProc8 {v index op} {
#  setBackgroudStipple
#}

proc traceProc9 {v index op} {
  global Polygon Line Text undoMode Graphics

  if {$Graphics(mode)=="Arrows"} {
    set Graphics(mode) ""
   .c delete arrowHandle
    catch {unset arrowsInfo}
  }

  .c delete arcMark

  if {[info exists Polygon(coords)] && [llength $Polygon(coords)]>=6} {
    makePolygon
  }

  if [info exists Polygon] {
     catch {.c delete $Polygon(tempLine)}
     unset Polygon
  }

  if [info exists Line] {
    makeLine
  }

  .c raise gridObject

  if [info exists Text] {
    .c focus {}
    .c select clear
    TextHist
  }

  .c delete graybox
  .c configure -cursor ""

  set undoMode 0
}

########## MENU BAR KEY BINDINGS:
bind all <Alt-Key-f> { tkMbPost .mbar.file }
bind all <Alt-Key-s> { tkMbPost .mbar.shape }
bind all <Alt-Key-e> { tkMbPost .mbar.edit }
bind all <Alt-Key-l> { tkMbPost .mbar.line }
bind all <Alt-Key-i> { tkMbPost .mbar.fill }
bind all <Alt-Key-e> { tkMbPost .mbar.edit}
bind all <Alt-Key-g> { tkMbPost .mbar.group}
bind all <Alt-Key-r> { tkMbPost .mbar.grid}
bind all <Alt-Key-t> { tkMbPost .mbar.text}
bind all <Alt-Key-o> { tkMbPost .mbar.font}
bind all <Alt-Key-h> { tkMbPost .mbar.help}
bind all <Alt-Key-u> {.mbar.edit.menu invoke "Undo last change"}
