#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/WBoard.tcl,v $
# $Date: 2001/07/10 15:36:13 $
# $Revision: 1.18.1.5 $
#
package provide zircon 1.18
#
#
proc WBoard {args} {
    set th [makeObj WBoard $args]
    return $th
}
#
proc zdraw {usr cmd} {
    switch nil [set chan [find [lindex $cmd 0]]] {
	[$usr net] inform "Bad draw command - \"$cmd\""
	return
    }
    if {[$chan draw]} { [$chan dwin] draw $usr $cmd }
}
#
proc wboard_configure {this args} { confObj $this $args }
#
proc wboard_delete {this} {
    $this unshow
    uplevel #0 unset $this
    rename $this {}
}
#
proc wboard_unshow {this} {
    switch {} [set wid [$this wid]] {} default { $wid deregister $this }
    $this configure -wid {}
}
#
proc wboard_draw {this usr cmd} {
    $this show
    set w [[$this wid] name].pic.canvas
    set lnm [$usr lname]
    switch [lindex $cmd 1] {
    delete {
	    switch -exact -- [set v [string tolower [lindex $cmd 2]]] {
	    *all* {	if {[[$this channel] isOp $usr]} { set v all } { set v $lnm } }
	    all -
	    current { set v ,$v }
	    }
	    if {![string compare $v all] || ![string compare $v $lnm]} { $w delete $v }
	}
    default {
	    regsub -all {[][$;]} [lrange $cmd 1 end] {} dc
	    if {![catch {set tid [eval $w $dc]} msg]} {
		$w itemconfigure $tid -tags $lnm
	    }
	}
    }
}
#
proc wboard_modeChange {this type} {
    upvar #0 $this zdata
    set win [$zdata(wid) name]
    if {[info exists zdata(mode)]} {
	$win.plt.$zdata(mode) configure -relief raised
    }
    set zdata(mode) $type
    foreach v {start last points} { set zdata($v) {} }
    $win.pic.canvas delete @r
    $win.pic.canvas delete @p
    $win.plt.$type configure -relief sunken
}
#
proc wboard_clButtons {this win} {
    global zircon DIms
    button $win.oln.none -image $DIms(none) \
      -command "$this colChange oln oln none" -relief raised \
      -height 24 -width 24
    button $win.fill.none -image $DIms(none) \
      -command "$this colChange fill fill none" -relief raised \
      -height 24 -width 24
    set col 1
    grid $win.oln.none -row 0 -column $col -sticky ew
    grid $win.fill.none -row 0 -column $col -sticky ew
    foreach cl {black white red orange yellow green blue violet} {
	button $win.oln.$cl -background $cl \
	  -command "$this colChange oln oln $cl" \
	  -relief raised
	button $win.fill.$cl \
	  -background $cl -command "$this colChange fill fill $cl" \
	  -relief raised 
	grid $win.oln.$cl -row 0 -column [incr col] -sticky ew
	grid $win.fill.$cl -row 0 -column $col -sticky ew
	grid columnconfigure $win.oln $col -weight 1
	grid columnconfigure $win.fill $col -weight 1
    }
}
#
proc wboard_colChange {this var frame cl} {
    upvar #0 $this zdata
    set win [$zdata(wid) name]
    if {[info exists zdata($var)]} {
	$win.$frame.$zdata($var) configure -relief raised
    }
    set zdata($var) $cl
    $win.$frame.$cl configure -relief sunken
}
#
proc wboard_clearAll {this} {
    if {[[$this channel] operator]} { $this do delete *ALL*  } { $this clear }
}
#
proc wboard_show {this} {
    global DIms
    switch {} [$this wid] {
        set wid [Window .$this -title "[[$this channel] name] Sketch Pad"]
	set win [$wid name]
	$wid register $this "$this unshow" {}
	$this configure -wid $wid
	wm group $win [[$this channel] window]
	grid columnconfigure $win 0 -weight 1
	grid rowconfigure $win 4 -weight 2
	set f0 [frame $win.btn -relief raised]
	button $f0.save -text [trans save] -command "$this save"
	button $f0.print -text [trans print] -command "$this print"
	button $f0.clear -text [trans clear] -command "$this clear"
	bind $f0.clear <Shift-ButtonRelease-1> "
	    set sc \[lindex \[%W configure -command\] 4\]
	    %W configure -command {}
	    tkButtonUp %W
	    uplevel #0 $this clearAll
	    %W configure -command \$sc
        "
	button $f0.quit -text [trans quit] -command "$this unshow"
	evenGrid $f0 column 0 3
	grid $f0.save $f0.print $f0.clear $f0.quit -sticky ew
	set fp [frame $win.plt -relief raised]
	global zircon
	set i -1
	foreach t {line arc polygon rectangle oval text} {
	    button $fp.$t -image $DIms($t) \
	      -command "$this modeChange $t" -height 48 -width 48 \
	      -relief raised
	    grid $fp.$t -row 0 -column [incr i] -sticky ew
	    grid columnconfigure $fp $i -weight 1
	}
	frame $win.oln -relief raised
	label $win.oln.label -text [trans outline] -width 10
	frame $win.fill -relief raised
	label $win.fill.label -text [trans fill] -width 10
	grid $win.oln.label

	grid $win.fill.label
	$this clButtons $win
	set f1 [frame $win.pic -relief raised]
	grid columnconfigure $f1 0 -weight 1
	grid rowconfigure $f1 0 -weight 1
	scrollbar $f1.vscroller -command "$f1.canvas yview" 
	canvas $f1.canvas -yscrollcommand "$f1.vscroller set" \
          -xscrollcommand "$f1.hscroller set" -background white
	grid $f1.canvas -row 0 -column 0 -sticky nsew
	grid $f1.vscroller -row 0 -column 1 -sticky ns
	scrollbar $f1.hscroller -command "$f1.canvas xview" -orient horizontal
	grid $f1.hscroller -row 1 -column 0 -sticky ew
	grid $win.btn -sticky ew
	grid $win.plt -sticky ew
	grid $win.oln -sticky ew
	grid $win.fill -sticky ew
	grid $win.pic -sticky nsew
	$this modeChange line
	$this colChange oln oln black
	$this colChange fill fill black
	bind $f1.canvas <1> " $this press %x %y "
	bind $f1.canvas <Double-1> "$this double %x %y "
	bind $f1.canvas <B1-Motion> "$this move %x %y"
	bind $f1.canvas <ButtonRelease-1> "$this up %x %y "
    } default { [$this wid] popup }
}

proc wboard_print {this} {
    [[$this wid] name].pic.canvas postscript -file /tmp/[$this name].ps
}

proc wboard_save {this} {
    set chan [[$this channel] name]
    mkFileBox .@zs$this .* ${this}(drawdir) "Save Sketch $chan" {}\
      "Save $chan sketch pad to:" \
      [list ok "[[$this wid] name].pic.canvas postscript -file"] \
      [list cancel {}]
}

proc wboard_do {this args} {
    set chn [$this channel]
    set myid [[$chn net] myid]
    set w [[$this wid] name].pic.canvas
    switch [lindex $args 0] {
    delete {
	    if {[set v [string tolower [lindex $args 1]]] == {*all*}} {
		set v all
	    }
	    $w delete $v
	}
    default {
	    set tid [eval $w [join $args]]
	    $w itemconfigure $tid -tags [$myid lname]
	}
    }
    set chan2 [expr {[$chn isa Channel] ? [$chn name] : [$myid name]}]
    [$chn net] CTCP ZIRCON [$chn name] "DRAW $chan2 [join $args]"
}
#
proc wboard_clear {this} {
    $this do delete [[[$this channel] net] nickname]
}
#
proc checkNone {val} { return [expr {$val == {none} ? {{}} : $val}] }
#
proc wboard_press {this x y} {
    upvar #0 $this zdata
    set w [$zdata(wid) name]
    set can $w.pic.canvas
    set x [$can canvasx $x]
    set y [$can canvasy $y]
    switch {} $zdata(start) {
	set zdata(last) [set zdata(start) [list $x $y]]
	return
    }
    set fill [checkNone $zdata(fill)]
    set oln [checkNone $zdata(oln)]
    switch -exact -- $zdata(mode) {
    arc -
    oval -
    rectangle {
	    $this do create $zdata(mode) $zdata(start) $x $y \
	    -fill $fill -outline $oln
	    set zdata(last) [set zdata(start) {}]
	}
    line {
	    $this do create $zdata(mode) $zdata(start) $x $y \
	      -fill $oln
	    set zdata(last) [set zdata(start) {}]
	}
    polygon {
	    eval $w.pic.canvas create line [join $zdata(last)] $x $y \
	      -tags @p -fill $oln
	    lappend zdata(points) $x $y
	    set zdata(last) [list $x $y]
	}
    text {
	    mkEntryBox .@[newName text] [trans text] {Enter your text:} \
	      [list [list text {}]] [list ok "$this addText $x $y"] \
	      [list cancel {}]
	}
    }
}
#
proc wboard_addText {this x y txt} {
    upvar #0 $this zdata
    set w [$zdata(wid) name]
    set can $w.pic.canvas
    set x [$can canvasx $x]
    set y [$can canvasy $y]
#    if [string match {none} [set oln $zdata(oln)]] {set oln {{}} }
    switch none [set fill $zdata(fill)] {} default {
	$this do create text $x $y -text "{$txt}" -fill $fill
    }
}
#
proc wboard_move {this x y} {
    upvar #0 $this zdata
    set w [$zdata(wid) name]
    set can $w.pic.canvas
    set x [$can canvasx $x]
    set y [$can canvasy $y]
    if {[string match {} $zdata(start)] || $zdata(start) == [list $x $y]} return
    set fill [checkNone $zdata(fill)]
    set oln [checkNone $zdata(oln)]
    $can delete @r
    switch -exact -- $zdata(mode) {
    arc -
    oval -
    rectangle {
	    eval $can create $zdata(mode) $zdata(start) $x $y \
	      -tags @r -fill $fill -outline $oln
	}
    line {
	    eval $can create line $zdata(start) $x $y \
	      -tags @r -fill $oln
	}
    polygon {
	    eval $can create line $zdata(last) $x $y -tags @r \
	      -fill $oln
	}
    text {
	}   
    }
}
#
proc wboard_up {this x y} {
    upvar #0 $this zdata
    set w [$zdata(wid) name]
    set can $w.pic.canvas
    set x [$can canvasx $x]
    set y [$can canvasy $y]
    if {![string match {} $zdata(start)] && $zdata(start) != [list $x $y]} {
	set fill [checkNone $zdata(fill)]
	set oln [checkNone $zdata(oln)]
	$can delete @r
	switch -exact -- $zdata(mode) {
	arc -
	oval -
	rectangle {
		$this do create $zdata(mode) $zdata(start) $x $y \
		  -fill $fill -outline $oln
		set zdata(last) [set zdata(start) {}]
	    }
	line {
		$this do create $zdata(mode) $zdata(start) $x $y \
		  -fill $oln
		set zdata(last) [set zdata(start) {}]
	    }
	polygon {
		eval $can create line [join $zdata(last)] $x $y -tags @r \
		  -fill $oln
		set zdata(last) [list $x $y]
	    }
	text {
	    }    
	}
    }
}

proc wboard_double {this x y} {
    upvar #0 $this zdata
    set w [$zdata(wid) name]
    set can $w.pic.canvas
    set x [$can canvasx $x]
    set y [$can canvasy $y]
    switch {} $zdata(start) {
	set zdata(last) [set zdata(start) [list $x $y]]
	return
    }
    set fill [checkNone $zdata(fill)]
    set oln [checkNone $zdata(oln)]
    switch -exact -- $zdata(mode) {
    arc -
    oval -
    rectangle {
	    $this do create $zdata(mode) $zdata(start) $x $y \
	      -fill $fill -outline $oln
	    set zdata(last) [set zdata(start) {}]
	}
    line {
	    $this do create $zdata(mode) $zdata(start) $x $y -fill $oln
	    set zdata(last) [set zdata(start) {}]
	}
    polygon {
	    if {[llength $zdata(points)] < 4} {
		bell
	    } {
		$this do create polygon $zdata(start) \
	          $zdata(points) $x $y -fill $fill
		$can delete @p
		if {$oln != {{}}} {
		    $this do create line $zdata(start) \
		      $zdata(points) $x $y $zdata(start) \
		      -fill $oln
	        }
	        set zdata(points) {}
	        set zdata(last) [set zdata(start) {}]
	    }
	}
    text {
	}
    }
}
