path: root/desiredata/src/desire.tk

#!/usr/bin/env wish
set svnid {$Id$}
#-----------------------------------------------------------------------------------#
# 
# DesireData
#   Copyright (c) 2004 by Mathieu Bouchard
#   Copyright (c) 2005,2006,2007 by Mathieu Bouchard and Chun Lee
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# See file ../COPYING.desire-client.txt for further informations on licensing terms.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# Note that this is not under the same license as the rest of PureData.
# Even the DesireData server-side modifications stay on the same license
# as the rest of PureData.
#
#-----------------------------------------------------------------------------------#

# this command rebuilds the package index: echo pkg_mkIndex . | tclsh

set debug 0 ;# DON'T TOUCH THIS, make yourself a debug.tcl instead!

if {$tcl_version < 8.5} {puts "Please upgrade to Tcl/Tk 8.5... Thank You.\n(your version is $tcl_version)"; exit 84}

if {[catch {winfo children .}]} {set tk 0} {set tk 1}

set argh0 [file normalize [file join [pwd] $argv0]]
set auto_path [concat . \
	[list [file join [file dirname [file dirname $argh0]] lib/pd/bin]] \
	/usr/lib/tcllib1.7 \
	/usr/lib/tclx8.4 \
	$auto_path]

package require poe
if {$tk} {package require bgerror}

catch {package require Tclx}
#if {[catch {source /home/matju/src/svn-pd/desiredata/src/profile_dd.tcl}]} {error_dump}
if {[file exists debug.tcl]} {source debug.tcl}

proc which {file} {
	global env
	foreach dir [split $::env(PATH) ":"] {
		if {[file exists $dir/$file]} {return $dir/$file}
	}
	return ""
}

#-----------------------------------------------------------------------------------#
# some list processing functions and some math too
# these could become another library like objective.tcl
# if they become substantial enough

# min finds the smallest of two values
# max finds the biggest of two values
# [clip $v $min $max] does [max $min [min $max $v]]
proc min {x y} {expr {$x<$y?$x:$y}}
proc max {x y} {expr {$x>$y?$x:$y}}
proc clip {x min max} {
	if {$x<$min} {return $min}
	if {$x>$max} {return $max}
	return $x
}

# set several variables from elements of a list
# WARNING: for @-variables, use [list @a @b @c] instead of {@a @b @c}
proc mset {vars list} {
	uplevel 1 "foreach {$vars} {$list} {break}"
}

# add or subtract two lists
proc l+   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a+$b}]}; return $r}
proc l-   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a-$b}]}; return $r}
# halve a list
proc l/2  {   al   } {set r {}; foreach a $al       {lappend r [expr {$a/2 }]}; return $r}

# like l+ or l- but for any infix supported by expr
proc lzip {op al bl} {
	set r {}
	set e "\$a $op \$b"
	foreach a $al b $bl {lappend r [expr $e]}
	return $r
}

# do an operation between all elements of a list and a second argument
proc lmap {op al b } {
	set r {}
	set e "\$a $op \$b"
	foreach a $al       {lappend r [expr $e]}
	return $r
}

# sum and product of a list, like math's capital Sigma and capital Pi.
proc lsum  {al} {set r 0; foreach a $al {set r [expr {$r+$a}]}; return $r}
proc lprod {al} {set r 1; foreach a $al {set r [expr {$r*$a}]}; return $r}

# all elements from end to beginning
proc lreverse {list} {
	set r {}
	for {set i [expr {[llength $list]-1}]} {$i>=0} {incr i -1} {lappend r [lindex $list $i]}
	return $r
}

# list substraction is like set substraction but order-preserving
# this is the same algorithm as Ruby's - operation on Arrays
proc lwithout {a b} {
	set r {}
	foreach x $b {set c($x) {}}
	foreach x $a {if {![info exists c($x)]} {lappend r $x}}
	return $r
}

proc lintersection {a b} {
	set r {}
	foreach x $b {set c($x) {}}
	foreach x $a {if {[info exists c($x)]} {lappend r $x}}
	return $r
}

# removes duplicates from a list, but it must be already sorted.
proc luniq {a} {
	set last [lindex $a 0]
	set r [list $last]
	set i 0
	foreach x $a {
		if {$i && [string compare $last $x]} {lappend r $x}
		incr i; set last $x
	}
	return $r
}

# one-dimensional intervals (left-closed, right-open); not much in use at the moment, not that they wouldn't deserve to!
# (slightly buggy)
proc inside      {x x0 x1} {return [expr $x>=$x0 && $x<$x1]}
proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}

proc distance {point1 point2} {
	set off [l- $point1 $point2]
	return [expr {sqrt([lsum [lzip * $off $off]])}]
}

proc rect_centre {rect} {
	mset {x1 y1 x2 y2} $rect
	return [list [expr {($x1+$x2)/2}] [expr {($y1+$y2)/2}]]
}

proc lmake {start end} {for {set i $start} {$i<=$end} {incr i} {lappend l $i}; return $l}
#-----------------------------------------------------------------------------------#
set callback_list {}

proc append_callback {mode when def} {
	global callback_list
	dict set callback_list $mode $when $def
}

proc remove_callback {mode} {
	global callback_list
	set callback_list [dict remove $callback_list $mode]
}

proc modes_callback {self def {args}} {
	global callback_list
	set i 0
	dict for {mode callbacks} $callback_list {
		foreach {when call} $callbacks {
			if {$def == $when} {eval $self $call $args; incr i}
		}
	}
	if {!$i} {return 0} else {return 1}
}

#-----------------------------------------------------------------------------------#
# Observer pattern
# there's no class for "observer".
# it's anything that has def $myclass notice {args} {...} in which args indicate
# attributes that have changed, or is an empty list if an unspecified number of
# attributes (maybe all) have changed.

class_new Observable {}
def Observable init {args} {
	eval [concat [list super] $args]
	set @subscribers {}
}
def Observable subscribe {observer} {
	set i [lsearch $@subscribers $observer]
	if {$i<0} {lappend @subscribers $observer}
}
def Observable unsubscribe {observer} {
	set i [lsearch $@subscribers $observer]
	if {$i>=0} {set @subscribers [lreplace $@subscribers $i $i]}
}

if {$have_expand} {
  #def Observable changed              {args} {
  #  puts "Observable changed $self called from [info level [expr [info level]-2]]"
  #  foreach x $@subscribers {$x notice   $self {expand}$args]}
  #}
  def Observable changed              {args} {foreach x $@subscribers {$x notice   $self {expand}$args}}
  def Observable child_changed {origin args} {foreach x $@subscribers {$x notice $origin {expand}$args}}
} else {
  def Observable changed              {args} {foreach x $@subscribers {$x notice   $self {*}$args}}
  def Observable child_changed {origin args} {foreach x $@subscribers {$x notice $origin {*}$args}}
}
def Observable subscribers {} {return $@subscribers}

#-----------------------------------------------------------------------------------#
set poolset(foo) bar
array unset poolset foo

class_new Manager {Thing}

def Manager init {} {
	set @q {}
	$self call
}

def Manager call {} {
	global poolset
	#if {[llength $@q]} {post "client queue %d" [llength $@q]}

	for {set i 0} {$i < [llength $@q]} {incr i} {
		set o [lindex $@q $i]
		unset poolset($o)
		if {[info exists _($o:_class)]} {
			if {[catch {$o draw_maybe}]} {puts [error_dump]}
		} else {
			puts "  tries to draw ZOMBIE $o"
		}
		if {$i == [expr [llength $@q] - 1]} {set @q {}}
	}
	after 50 "$self call"
}

def Manager notice {origin args} {
	global poolset
	if {[info exists poolset($origin)]} {
		# post %s "def Manager notice: double dirty"
		# nothing for now
	} {
		set poolset($origin) {-1}
		lappend @q $origin
	}
	#post "Manager notice: queue length is now %d" [llength $@q]
}

set serial 0
proc serial {n obj} {
	if {$n >= $::serial} {error "object creation serial number is in the future"}
	eval [concat $::replyset($n) [list $obj]]
	array unset ::replyset $n
}

proc philtre {atoms} {
	set r {}
	foreach atom $atoms {lappend r [regsub -all {([;,\\ ])} $atom {\\\1}]}
	return [join $r]
}

# you pass the 2nd argument if and only if the message creates an object (or pretends to).
# this happens with #N canvas, and those methods of #X:
#   obj, msg, floatatom, symbolatom, text, connect, text_setto, array.
# this does NOT happen with #X coords/restore/pop.
proc netsend {message {callback ""}} {
	#if {$message == ""} {error "empty message... surely a mistake"}
	if {$::sock == ""} {error "connection to server needed for doing this"}
	if {$callback != ""} {
		set ::replyset($::serial) $callback
		set message [concat [lrange $message 0 0] [list with_reply $::serial] [lrange $message 1 end]]
		incr ::serial
	}
	set text "[philtre $message];"
	if {$::debug} {puts "[VTcyan]<- $text[VTgrey]"}
	puts $::sock $text
}

#-----------------------------------------------------------------------------------#
# This is not a real Hash, just the same interface as a Ruby/Python/Perl Hash... or quite like Tcl arrays themselves
class_new Hash {Thing}

def Hash   init {args} {      super; foreach {k v} $args {$self set $k $v}}
def Hash reinit {args} {$self clear; foreach {k v} $args {$self set $k $v}}
def Hash set {k v} {set ::hash($self:$k) $v}
def Hash exists {k} {info exists ::hash($self:$k)}
def Hash get {k}   {set ::hash($self:$k)}
def Hash size {} {llength [$self keys]}
def Hash unset {k} {unset ::hash($self:$k)}
def Hash list {} {set r {}; foreach k [$self keys] {lappend r $k [$self get $k]}; return $r}
def Hash keys {} {
	set r {}
	set n [string length $self:]
	foreach k [array names ::hash $self:*] {lappend r [string range $k $n end]}
	return $r
}
def Hash values {} {
	set r {}
	foreach k [array names ::hash $self:*] {lappend r $::hash($k)}
	return $r
}
def Hash clear {} {foreach k [$self keys] {$self unset $k}}
def Hash delete {} {$self clear; super}

def Hash search {v} {
	foreach k [$self keys] {if {[$self get $k] == $v} {return $k}}
	return -1 ;# this is not correct as -1 could be a Hash key, though not in its current context of use...
}

if 0 {
	set h [Hash new foo bar 1 2 3 4]
	$h set hello world
	puts keys=[$h keys]
	puts values=[$h values]
	puts list=[$h list]
	$h unset foo
	puts list=[$h list]
	$h clear
	puts list=[$h list]
	foreach i {1 2 3 4} {puts "exists $i : [$h exists $i]"}
}

class_new Selection {Hash}
def Selection set {k v} {super $k $v; $v selected?= 1}
def Selection unset {k} {
	#set v [$self get $k]; puts "$v ::: [$v class]"
	if {[$self exists $k]} {[$self get $k] selected?= 0}
	super $k
}
#-----------------------------------------------------------------------------------#
# abstract class: subclass must def {value value= <<}
class_new Clipboard {Observable Thing}
def Clipboard init   {{value ""}} {super; $self value= $value; set @copy_count 0}

# uses system clipboard
class_new Clipboard1 {Clipboard}
def Clipboard1 value= {value} {clipboard clear; clipboard append $value; $self changed}
def Clipboard1 << {value}     {                 clipboard append $value; $self changed}
def Clipboard1 value {} {clipboard get}

# uses string buffer (not system clipboard)
class_new Clipboard2 {Clipboard}
def Clipboard2 value= {value} {set    @value $value; $self changed}
def Clipboard2 << {value}     {append @value $value; $self changed}
def Clipboard2 value {} {return $@value}

if {$tk} {
  set clipboard [Clipboard1 new]
} else {
  set clipboard [Clipboard2 new]
}

#-----------------------------------------------------------------------------------#
class_new EventHistory {Observable Thing}

def EventHistory init {} {super; set @list {}}
def EventHistory add {e} {lappend @list $e; $self changed add $e}
def EventHistory list {{formatted 1}} {
	if {!$formatted} {return $@list}
	set r {}
	foreach event $@list {
		mset {type W x y mod K k} $event
		lappend r [format "%-13s %9s %4d %4d %4d %4d %s" $type $K $k $x $y $mod $W]
	}
	return $r
}
set ::event_history [EventHistory new]

#-----------------------------------------------------------------------------------#
class_new CommandHistory {Observable Thing}

def CommandHistory init {} {
	super
	set @undo_stack {}
	set @redo_stack {}
}

def CommandHistory can_undo? {} {return [expr [llength @undo_stack] > 0]}
def CommandHistory can_redo? {} {return [expr [llength @redo_stack] > 0]}
def CommandHistory next_undo_name {} {return stuff}
def CommandHistory next_redo_name {} {return stuff}
def CommandHistory undo_stack {} {return $@undo_stack}
def CommandHistory redo_stack {} {return $@redo_stack}

# overload this if you want to control how many levels
# of undo may be kept.
# keep in mind that undo information is kept hierarchically.
def CommandHistory add {message} {
	lappend @undo_stack [list do $message [lrange [info level -3] 1 end]]
	set @redo_stack {}
	$self changed
}

def CommandHistory can't {} {
	lappend @undo_stack [list can't {} [lrange [info level -3] 1 end]]
	set @redo_stack {}
	$self changed
}

# runs the restore procedure for the last item in the root undo queue.
def CommandHistory undo {} {
	if {![$self can_perform? [lindex $@undo_stack end]]} {error "Can't undo this!"}
	set backup $@undo_stack
	set @undo_stack $@redo_stack
	set @redo_stack {}
	#set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $::errorInfo}
	$self atomically [list atomic_undo] {
		$self perform [lindex $backup end]
	}
	set @redo_stack $@undo_stack
	set @undo_stack [lrange $backup 0 end-1]
	$self changed
	#if {$err} {post %s $err; error "undo: $err"}
}

def CommandHistory redo {} {
	if {![$self can_perform? [lindex $@undo_stack end]]} {error "Can't redo this!"}
	set backup $@redo_stack
	set @redo_stack {}
	set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $::errorInfo}
	$self atomically [list atomic_redo] {
		$self perform [lindex $backup end]
	}
	set @redo_stack [lrange $backup 0 end-1]
	$self changed
	#if {$err} {post %s $err; error "redo: $err"}
}

def CommandHistory can_perform? {action} {
	switch -- [lindex $action 0] {
	  do      {return 1}
	  can't   {return 0}
	  default {
	    foreach x [lrange $action 1 end] {
	      if {![$self can_perform? $x]} {return 0}
	    }
	    return 1
	  }
	}
}

def CommandHistory perform {action} {
	switch -- [lindex $action 0] {
	  do      {eval [lindex $action 1]}
	  can't   {error "can't undo this!"}
	  default {foreach x [lreverse [lindex $action 1]] {$self perform $x}}
	}
}

def CommandHistory atomically {what code} {
	set ubackup @undo_stack; set @undo_stack {}
	set rbackup @redo_stack; set @redo_stack {}
	uplevel 2 $code
	set atom $@undo_stack
	set @undo_stack $ubackup
	set @redo_stack $rbackup
	lappend @undo_stack [list $what $atom [lrange [info level -3] 1 end]]
	$self changed
}

def CommandHistory list {} {
	set r {}
	set hist [concat [$self undo_stack] [list "You Are Here"] [lreverse [$self redo_stack]]]
	set i 0
	foreach e $hist {lappend r "$i: $e"; incr i}
	return $r
}

set command_history [CommandHistory new]

#-----------------------------------------------------------------------------------#
class_new History {Thing}

def History init {size} {
	set @size $size
	set @hist {{}}
	set @histi -1
}

def History histi= {val} {set @histi $val}
def History histi {} {return $@histi}

def History set_hist {idx stuff} {set @hist [lreplace $@hist $idx $idx $stuff]}

def History prepend {stuff} {
	set @hist [linsert $@hist 1 $stuff]
	if {[llength $@hist] >= $@size} {set @hist [lrange $@hist 0 [expr $@size-1]]}
}

def History traverse {incr} {
	set @histi [expr $@histi + $incr]
	set mod [expr ([llength $@hist]<[expr $@size+1]) ?[llength $@hist]:[expr $@size+1]]
	if {$@histi >=$mod} {set @histi [expr $@histi%$mod]}
	if {$@histi < 0} {set @histi [expr ($@histi+$mod)%$mod]}
	return [lindex $@hist $@histi]
}

History new_as obj_hist 5
#-----------------------------------------------------------------------------------#
# this is the beginning of the more application-dependent part.

switch $tcl_platform(os) {
  Darwin {set OS osx}
  default {set OS $tcl_platform(platform)}
}

if {$tk} {
	option add *foreground #000000
	option add *font {Helvetica -12}
	foreach tkclass {Menu Button Checkbutton Radiobutton Entry Text Spinbox Scrollbar Canvas} {
		option add *$tkclass*borderWidth 1
		option add *$tkclass*activeBorderWidth 1
	}
	foreach tkclass {CheckButton RadioButton} {
		option add *$tkclass*selectColor #dd3000
	}
	foreach tkclass {Entry Text} {
		option add *$tkclass*background #b0c4d8
		option add *$tkclass*selectBackground #6088b0
	}
	option add *__tk__messagebox*Canvas*borderWidth 0
	foreach tkclass {Listbox} {
		option add *$tkclass*background #c4d8b0
		option add *$tkclass*selectBackground #88b060
	}
	foreach tkclass {Label} {
		#option add *$tkclass*background #909090
	}
	# very small icons:
	foreach {name w h values} {
		icon_empty      7 7 "0,0,0,0,0,0,0"
		icon_plus       7 7 "8,8,8,127,8,8,8"
		icon_minus      7 7 "0,0,0,127,0,0,0"
		icon_close      7 7 "99,119,62,28,62,119,99"
		icon_wedge_up   7 5 "8,28,62,127,0"
		icon_wedge_down 7 5 "0,127,62,28,8"
		icon_up         7 7 "8,28,62,127,28,28,28"
		icon_down       7 7 "28,28,28,127,62,28,8"
		icon_right      7 7 "8,24,63,127,63,24,8"
		icon_left       7 7 "8,12,126,127,126,12,8"
	} {
		image create bitmap $name -data "#define z_width $w\n#define z_height $h
			static unsigned char z_bits[] = { $values };"
	}


	set main [string toupper [info script] 0 0]
	set ::current_window .
	bind $main    <FocusIn> {set ::current_window %W}
	bind Toplevel <FocusIn> {set ::current_window %W}
	proc tk_messageBox2 {args} {tk_messageBox -parent $::current_window {*}$args}

	# it's unfortunate but we seem to have to turn off global bindings
	# for Text objects to get control-s and control-t to do what we want for
	# "text" dialogs below. Also we have to get rid of tab's changing the focus.
	bind all <Key-Tab> ""
	#bind all <Key-Shift-Tab> ""
	bind all <<PrevWindow>> ""
	bind Text <Control-t> {}
	bind Text <Control-s> {}
	set mods {{} 0 Shift- 1 Control- 4 Shift-Control- 5 Alt- 8 Shift-Alt- 9 Control-Alt- 12 Shift-Control-Alt- 13}
	foreach type {KeyPress KeyRelease} {
	    foreach {subtype mod} $mods {
		bind all <$subtype$type> "$::event_history add \[list $type %W %x %y $mod %K %k\]"
	    }
	}
	foreach type {ButtonPress ButtonRelease} {
	    foreach {subtype mod} $mods {
		bind all <$subtype$type> "$::event_history add \[list $type %W %x %y $mod %b %b\]"
	    }
	}
}

proc modekey {k mode} {
  set s ""
  if {$mode&1} {append s Shift-}
  if {$mode&4} {append s Control-}
  if {$mode&8} {append s Alt-}
	if {[regexp {[0-9]} $k]} {set k Key-$k}
  return $s$k
}

proc modeclick {k mode event} {
  set s ""
  if {$mode&1} {append s Shift-}
  if {$mode&4} {append s Control-}
  if {$mode&8} {append s Alt-}
	if {[regexp {[0-9]} $k]} {set k $event-$k}
  return $s$k
}


# there are two palettes of 30 colours used in Pd
# when placed in a 3*10 grid, the difference is that
# the left corner of 3*3 (the greys) are transposed (matrixwise)
# here is the one used in the swatch color selector:
set preset_colors {
	fcfcfc e0e0e0 bcbcbc fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
	a0a0a0 7c7c7c 606060 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
	404040 202020 000000 8c0808 583000 782814 285014 004450 001488 580050
}

set preset_colors2 {
	fcfcfc a0a0a0 404040 fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
	e0e0e0 7c7c7c 202020 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
	bcbcbc 606060 000000 8c0808 583000 782814 285014 004450 001488 580050
}

switch $::OS {
  osx     {set pd_tearoff 0}
  default {set pd_tearoff 1}
}

proc guess_lang {} {
  set lang C
  if {[info exist ::env(LC_ALL)]} {set lang $::env(LC_ALL)}
  if {[info exist ::env(LANG)]}   {set lang $::env(LANG)}
  set lang [lindex [split $lang {[_.]}] 0]
  return $lang
}

#temporary
set leet 0

proc say {k args} {
  global text
  if {[llength $args]} {
    set text($k) [lindex $args 0]
  } else {
    if {[info exist text($k)]} {
        if {$::leet} {
		return [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $text($k)]
	} else {
		return $text($k)
	}
    } else {return "{{$k}}"}
  }
}

proc can_say {k args} {
  return [info exist ::text($k)]
}

proc say_namespace {k code} {uplevel 1 $code}
proc say_category  {text} {}

switch -- [lindex [file split $argh0] end] {
  desire.tk {set cmdline(server) [file join [file dirname $argh0] pd]}
  default {set cmdline(server) [file join [file dirname [file dirname $argh0]] bin/pd]}
}

set cmdline(rcfilename) ~/.pdrc
set cmdline(ddrcfilename) ~/.ddrc
set cmdline(console) 1000
if {[file exists ../icons/mode_edit.gif]} {
	set cmdline(icons) ../icons
} else {
	set cmdline(icons) [file join [file dirname [file dirname $argh0]] lib/pd/icons]
}

#-----------------------------------------------------------------------------------#
set accels {}
proc read_client_prefs_from {filename} {
	global cmdline look key accels
	set ::accels {}
	puts "reading from $filename"
	set fd [open $filename]
	set contents [read $fd]
	close $fd
	foreach {category category_data} $contents {
		foreach {class class_data} $category_data {
			foreach {var val} $class_data {set ${category}($class:$var) $val}
		}
	}
	foreach k [array names key] {
	    if {[llength $key($k)]} {
		if {![dict exists $accels $key($k)]} {
			dict set accels $key($k) $k
		} else {
			dict lappend accels $key($k) $k
		}
	    }
	}
}
proc read_ddrc {} { ;# load defaults then load .ddrc
	if {[file exists "defaults.ddrc"]} {
		read_client_prefs_from "defaults.ddrc"
	} else {
		read_client_prefs_from [file join [file dirname [file dirname $::argh0]] "lib/pd/bin/defaults.ddrc"]
	}
	if {[file exists $::cmdline(ddrcfilename)]} {
		read_client_prefs_from $::cmdline(ddrcfilename)
	}
}
read_ddrc

#-----------------------------------------------------------------------------------#

set cmdline(port) 0
set cmdline(gdb) 0
set cmdline(gdbconsole) 1
set cmdline(valgrind) 0
if {$look(View:language) eq "auto"} {
	set language [guess_lang]
} else {
	set language $look(View:language)
}

set files_to_open {}

proc cmdline_help {} {
  puts "DesireData commandline options:
  -serverargs (for future use)
      -server   select the executable for the pd server
         -gdb   run pd server through gdb
   -manualgdb   run gdb in the terminal
    -valgrind   run pd server through valgrind
  -novalgrind   ... or don't
  -safemode     run desiredata with all default settings
  -dzinc        use zinc emulation"
}

for {set i 0} {$i < $argc} {incr i} {
  global cmdline files_to_open
  set o [lindex $argv $i]
  switch -regexp -- $o {
          ^-port\$ {incr i; set cmdline(port) [lindex $argv $i]}
    ^-serverargs\$ {error "not supported yet"}
    ^-server\$  {incr i; set cmdline(server)  [lindex $argv $i]}
           ^-gdb\$ {set cmdline(gdb) 1}
     ^-manualgdb\$ {set cmdline(gdbconsole) 0}
      ^-valgrind\$ {set cmdline(valgrind) 1}
    ^-novalgrind\$ {set cmdline(valgrind) 0}
    ^-safemode\$ {set cmdline(safemode) 1}
    ^-dzinc\$ {set cmdline(dzinc) 1}
    ^(-h|-help|--help)\$ {cmdline_help; exit 1}
    ^- {puts "ERROR: command line argument: unknown $o"}
    default {lappend files_to_open [lindex $argv $i]}
  }
}

#set cmdline(server) \"$cmdline(server)\"
set encoding ""
if {$language == "C"} {set language en}
proc localedir {x} {file join [file dirname [file dirname $::argh0]] lib/pd/bin/$x}
if {[regexp {desire\.tk$} $argh0]} {source locale/index.tcl} {source [localedir locale/index.tcl]}
set langentry [figure_out_language $language]
set encoding [lindex $langentry 0]
set langfile locale/[lindex $langentry 1].tcl
if {[regexp {desire\.tk$} $argh0]} {
	if {$encoding != ""} {source -encoding $encoding $langfile} else {source $langfile}
} else {
	if {$encoding != ""} {source -encoding $encoding [localedir $langfile]} else {source [localedir $langfile]}
}

if {[info exists ::cmdline(safemode)]} {read_client_prefs_from "defaults.ddrc"}
if {[info exists ::cmdline(dzinc)]} {package require dzinc}

#-----------------------------------------------------------------------------------#

#!@#$ is this still valid?
set look(Box:extrapix) [switch $::OS {
        osx     {concat 2}
        default {concat 1}}]

#font is defined as Thing for now, as the completion needs to get to these ones.

#!@#$ View->???
#set look(View:tooltip) 1

#!@#$ View->TextBox ?
#set look(View:minobjwidth) 21

#!@#$ View->ObjectBox
#set look(View:fg) #000000
#set look(View:bg) #ffffff
#set look(View:frame1) #99cccc
#set look(View:frame2) #668888
#set look(View:frame3) #000000

#!@#$ this is supposed to be BlueBox!
#set look(Slider:bg) #ccebff

set zoom(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
set scale_amount 1.1
################## set up main window #########################

class_new Console {View}

def Console init {c} {
	set @c $c
	frame $c
	text $c.1 -width 72 -height 20 -yscrollcommand "$c.2 set" -font [$self look font]
	scrollbar $c.2 -command "$c.1 yview"
	pack $c.1 -side left -fill both -expand yes
	pack $c.2 -side left -fill    y -expand no
	pack $c -fill both -expand yes
	$c.2 set 0.0 1.0
	switch $::OS { osx {
		bind $c.1 <MouseWheel> [list $c.1 yview scroll [expr {-2-abs(%D)/%D}] units]
	}}
	set @lines 0
}

def Console widget {} {return $@c}

def Console post_string {x} {
	set oldpos [lindex [$@c.2 get] 1]
	$@c.1 insert end $x
	regsub -all "\n" $x "" y
	set n [expr [string length $x]-[string length $y]]
	incr @lines $n
	while {$@lines >= $::cmdline(console)} {
		$@c.1 delete 1.0 2.0
		incr @lines -1
	}
	if {$oldpos > 0.9999} {$@c.1 see end}
}

#class_new Client {Menuable View}
class_new Client {Menuable Thing}

set ctrls_audio_on 0
set ctrls_meter_on 0

def Client window {} {return .}

def Client init_binds {} {
    bind . <Control-Key>       {$main ctrlkey %x %y %K %A 0}
    bind . <Control-Shift-Key> {$main ctrlkey %x %y %K %A 1}
    switch $::OS {
      osx {
        bind . <Mod1-Key>       {$main ctrlkey %x %y %K %A 0}
        bind . <Mod1-Shift-Key> {$main ctrlkey %x %y %K %A 1}
      }
    }
#    bind . <Motion> {.debug.1 configure -text "widget = %W"}
}

# miller uses this nowadays (matju fished it in pd-cvs for 0.40). we don't use it for now.
# remember to fix all quoting problems, which in the end may or may not involve the following proc.
proc pdtk_unspace {x} {
  set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
  if {$y == ""} {set y "empty"}
  concat $y
}

proc pdtk_pd_meters {indb outdb inclip outclip} {
    foreach {z clip db} [list in $inclip $indb out $outclip $outdb] {
	.controls.$z.1.mtr coords m 0 0 $db 0
	.controls.$z.1.clip configure -background [if {$clip==1} {concat red} {concat black}]
    }
}

proc pd_startup {version apilist midiapilist args} {
	set ::pd_version $version
	set ::pd_apilist $apilist
	set ::pd_midiapilist $midiapilist
	foreach api $apilist {
		lappend ::pd_apilist2 "-[string tolower [lindex $api 0]]"
	}
	set version [regsub "^DesireData " $::pd_version ""]
	post "DesireData server version $version"
}

def Client init_controls {} {
    menu .mbar
    pack [frame .controls] -side top -fill x
    foreach t {file window help} {
	.mbar add cascade -label [say $t] -menu [menu .mbar.$t -tearoff $::pd_tearoff]
    }
    .mbar.window configure -postcommand "$self fix_window_menu"
    foreach {z fill} {in #0060ff out #00ff60} {
	set f .controls.$z
	frame $f
	frame $f.1 -borderwidth 2 -relief groove
	canvas $f.1.mtr -width 100 -height 10 -bg #222222
	    $f.1.mtr create line [list 0 0 0 0] -width 24 -fill $fill -tags m
	canvas $f.1.clip -width 5 -height 10 -bg #222222
	pack $f.1.mtr $f.1.clip -side left
	pack [label $f.2 -text [say $z]:] $f.1 -side left
	pack $f -side left -pady 0 -padx 0
    }
    foreach {w x y z} {
	    audiobutton audio  ctrls_audio_on {netsend [list pd dsp    $ctrls_audio_on]}
	    meterbutton meters ctrls_meter_on {netsend [list pd meters $ctrls_meter_on]}
    } {
	pack [checkbutton .controls.$w -text [say $x] -variable $y -anchor w -command $z] -side left
    }
    button .controls.clear -text [say console_clear] -command {.log.1 delete 0.0 end}         -padx 2 -pady 0
    button .controls.dio   -text [say io_errors]     -command {netsend [list pd audiostatus]} -padx 2 -pady 0
    pack .controls.clear .controls.dio -side right
    if {$::debug} {
	    frame .debug
	    pack [label .debug.1 -anchor w -text ""] -side left
	    pack [entry .debug.3 -textvariable ::serial -width 5] -side right
	    pack [label .debug.2 -text "obj.serial: " -justify right] -side right
	    pack .debug -side bottom -fill x
    }
    if {$::cmdline(console)} {set ::console [Console new .log]}
    . configure -menu .mbar
    wm title . "DesireData"
    catch {wm iconphoto . icon_pd_32}
    regexp {\d\d\d\d-\d\d-\d\d} $::svnid date
    regsub -all "/" $date "." date
    regexp {desire.tk (\d+)} $::svnid blah revision
    set version "svn#$revision ($date)"
    set ::pd_version_client $version
    post "DesireData client version $version"
    post "Using Tcl %s and Tk %s" $::tcl_patchLevel $::tk_patchLevel
}

proc pdtk_pd_dsp {value} {
    global ctrls_audio_on
    set ctrls_audio_on $value
}

proc pdtk_pd_dio {red} {
    .controls.dio configure -background red -activebackground [if {$red==1} {list red} {list lightgrey}]
}

############### set up global variables ################################

set pd_opendir [pwd]

############### set up socket ##########################################
set sock {}
set sock_lobby {}

proc poll_sock {} {
	global sock sock_lobby cmdline
	if {[llength $sock]==0} {return}
	while {1} {
		set cmd [gets $sock]
		if {[eof $sock]} {
			if {!$cmdline(gdb)} {
				tk_messageBox2 -message "connection ended by server.\n(crash? try: desire -gdb)" -type ok
			}
			set sock {}
			return
		}
		if {[fblocked $sock]} {break}
		if {$::debug} {if {[string first pdtk_post $cmd]!=0} {puts "[VTmagenta]-> $cmd[VTgrey]"}}
		append sock_lobby "\n$cmd"
		if {[catch {eval $sock_lobby}]} {
			switch -regexp -- $::errorInfo { "^missing close-brace" {
				#puts "waiting for the end of: [string range $sock_lobby 0 40]"
				continue
			}}
			error_dump
		}
		set sock_lobby {}
	}
	flush $sock
	after 50 poll_sock
}

set server_pid 0
proc poll_gdb {} {
	global gdb
	while {1} {
		set line [gets $gdb]
		if {$line=="" || [fblocked $gdb]} {break} ;# which way should i check for no input?
		if {[eof $gdb]} {return}
		regsub {^\(gdb\) ?} $line {} line
		if {[regexp {^\[Thread debug} $line]} {continue}
		if {[regexp {^\[New Thread.*LWP (\d+)} $line dummy pid]} {
			if {!$::server_pid} {
				set ::server_pid $pid
				post "server pid=$pid"
				continue
			}
		}
		if {[regexp {^Reading symbols from} $line]} {continue}
		if {[regexp {^Using host libthread_db} $line]} {continue}
		if {[regexp {^Starting program:} $line]} {continue}
		if {[regexp {^Program received signal (\w+), (.*)\.} $line bogus sig1 sig2]} {
			set where ""
			# can anyone figure out why a long backtrace won't be slurped in this case?
			set timeout [expr [clock seconds]+2]
			#fconfigure $gdb -blocking 1 -buffering none
			while {![eof $gdb] && [clock seconds] < $timeout} {
				set line [gets $gdb]
				if {$line eq ""} {continue} ;# busy-wait
				regsub {^\(gdb\) ?} $line {} line
				append where "$line\n"
				#puts "where size = [string length $where]"
			}
			OopsDialog new $sig1 $sig2 $where
		}
		post "\[gdb\] %s" $line
	}
	after 100 poll_gdb
}

proc pd_connect {} {
	global sock
	if {[catch {set sock [socket 127.0.0.1 13666]}]} {
		post "can't connect... wait a second"
		after 1000 pd_connect
		return
	}
	post "Connected to server"
	fconfigure $sock -blocking 0 -buffering line
	netsend [list pd init]
	poll_sock
	foreach f $::files_to_open {
		set ff [file split [file normalize $f]]
		set ffl [llength $ff]
		set file [lindex $ff [expr $ffl-1]]
		set dir [join [lrange $ff 0 [expr $ffl-2]] [file separator]]
		netsend [join [list pd open $file $dir]]
	}
}

set server_port 13666
after 1000 pd_connect

after 0 {
  if {$cmdline(port)} {
	set server_port $cmdline(port)
	# and then do nothing...
  } elseif {$cmdline(valgrind)} {
	#exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
	exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
  } else {
    if {$cmdline(gdb)} {
	if {$cmdline(console) && $cmdline(gdbconsole)} {
	    set gdb [open "| gdb --quiet 2&>1" w+]
	    fconfigure $gdb -blocking 0 -buffering none
	    puts $gdb "file \"$cmdline(server)\"" ;# bad quoting, sorry
	    puts $gdb "run -guiport $server_port"
	    puts $gdb "where"
	    puts $gdb "quit"
	    flush $gdb
	    after 0 poll_gdb
	} else {
	    exec gdb --args $cmdline(server) -guiport $server_port &
	    #exec gdb --tui --args $cmdline(server) -guiport $server_port &
	}
    } else {
	exec $cmdline(server) -guiport $server_port &
    }
  }
}

################ utility functions #########################

proc enquote {x} {
    set foo [string map {"," "" ";" "" "\"" ""} $x]
    return [string map {" " "\\ " "{" "" "}" ""} $foo]
}

proc pdtk_watchdog {} {netsend [list pd ping]; after 2000 {pdtk_watchdog}}

proc accel_munge {acc} {
    switch $::OS {
      osx {
        set tmp [string toupper [string map {Ctrl Meta} $acc] end]
	if [string is upper [string index $acc end]] {
	    return Shift+$tmp
	} else {
	    return $tmp
	}
      }
      default {return $acc}
    }
}

# a menuable must be a View
# and it must have a window so that the Menuable methods work
# it could be renamed to Windowed
class_new Menuable {}
def Menuable init {args} {
	eval [concat [list super] $args]
	set @accel {}
	set @menubar .$self.m
}

# this doesn't have to do with menus, only with toplevel windows.
def Menuable raise {} {
	set w [$self window]
	set w $w.c
	raise $w
	focus -force $w
}

set untitled_number 1
set untitled_folder [pwd]

# just a dummy proc
proc none {args} {}

def Client new_file {} {
	global untitled_number untitled_folder
	netsend [list pd filename Untitled-$untitled_number $untitled_folder]
	netsend [list #N canvas]
	netsend [list #X pop 1]
	incr untitled_number
}


set patch_filetypes {
	{"pd files"  ".pd"}
	{"max files" ".pat"}
	{"all files" "*"}
}

set image_filetypes {
	{"image files" ".gif .png"}
	{"gif files"  ".gif"}
	{"png files" ".png"}
	{"all files" "*"}
}

catch {tk_getOpenFile -load-once} ;#only works with tcltk 8.5
catch {
	set ::tk::dialog::file::showHiddenBtn 1
	set ::tk::dialog::file::showHiddenVar 0
}

def Client open_file {} {
    global pd_opendir patch_filetypes
    set filename [tk_getOpenFile -parent $::current_window -defaultextension .pd -filetypes $patch_filetypes -initialdir $pd_opendir]
    if {$filename != ""} {$self open_file_really $filename}
}

def Client open_file_really {filename} {
    set i [string last / $filename]
    set folder [string range $filename 0 [expr $i-1]]
    set ::pd_opendir $folder
    set basename [string range $filename [expr $i+1] end]
    if {[string last .pd $filename] >= 0} {
	    netsend [list pd open [enquote $basename] [enquote $folder]]
    }
}

def Client send_message {} {
    toplevel .sendpanel
    set e .sendpanel.entry
    pack [entry $e -textvariable send_textvar] -side bottom -fill both -ipadx 100
    $e select from 0
    $e select adjust end
    bind $e <KeyPress-Return> {netsend $send_textvar; after 50 {destroy .sendpanel}}
    focus $e
}

def Client quit {} {
	set answer [tk_messageBox2 -message "Do you really wish to quit?" -type yesno -icon question]
	switch -- $answer {yes {netsend [list pd quit]; exit}}
}

def Client abort_server {} {
	set answer [tk_messageBox2 -message "Do you really wish to abort?" -type yesno -icon question]
	switch -- $answer {yes {exec kill -ABRT $::server_pid}}
}

def Client server_prefs {} {ServerPrefsDialog new_as pdrc}
def Client client_prefs {} {ClientPrefsDialog new_as ddrc}

proc menu_pop_pd {} {raise .}

def Menuable populate_menu {menu list} {
	global key
	if {[string index $menu 0] != "."} {set menu $@menubar.$menu}
	foreach name $list {
		if {$name == ""} {$menu add separator; continue}
		set k ""
		if {[info exists key($@_class:$name)]} {
			if {[string length $key($@_class:$name)]} {set k $key($@_class:$name)}
		}
		$menu add command -label [say $name] -command "$self $name" -accelerator [accel_munge $k]
	}
}

def Client init_menus {} {
    #removed paths after send_message
    $self populate_menu file {
        new_file open_file {}
	server_prefs client_prefs send_message {}
	audio_on audio_off {}
	abort_server quit}
    $self populate_menu help {
	about documentation class_browser do_what_i_mean {}
	test_audio_and_midi load_meter latency_meter {}
	clipboard_view command_history_view event_history_view keyboard_view client_class_tree}
}

def Client init {} {
  super
  set @menubar .mbar
  $self init_controls
  $self init_binds
  $self init_menus
  # it's necessary to raise the window on OSX
  switch $::OS { osx {raise .; wm iconify .; after 100 {wm deiconify .}}}
  after 0 {
	  Listener new .tcl [say "tcl_console"] tcl_eval
	  Listener new .pd  [say "pd_console"]  pd_eval
  }
  #wm geometry .[$self keyboard_view] -0+0
  #wm geometry .[$self event_history_view] -0-0
}

proc post {args} {
	set s "[eval [linsert $args 0 format]]\n"
	#	set s "[info level -1]: $s"
	if {$::cmdline(console)} {$::console post_string $s} else {puts stderr $s}
}
proc pdtk_post {s} {
	if {$::cmdline(console)} {$::console post_string $s} else {puts stderr $s}
}

def Menuable eval% {code} {
	regsub -all %W $code $self code
	uplevel [info level] $code
}

def Menuable getkey {k} {
	global accels
	if {[dict exists $accels $k]} {
		set vars [dict get $accels $k]
		foreach var $vars {
			#mset {class key} [split [dict get $accels $k] ":"]
			mset {class key} [split $var ":"]
			#if {$class != $@_class} {return ""} else {return $key}
			if {$class == $@_class} {return $key}
		}
	}
}

def Menuable ctrlkey {x y key iso shift} {
	set key [if {$shift} {string toupper $key} {string tolower $key}]
	set key "Ctrl+$key"
	set cmd [$self getkey $key]
	if {![string length $cmd]} {
		switch [$self class]:$key {
			#explicitly listed here to do nothing
			Client:Ctrl+c {}
			Client:Ctrl+v {}
			default {post "unknown key $key"}
		}
	} else {$self eval% "%W $cmd"}
}

def Menuable altkey {x y key iso shift} {
    set key [if {$shift} {string toupper $key} {string tolower $key}]
    set key "Alt+$key"
    set cmd [$self getkey $key]
    if {[string length $cmd]} {$self eval% "%W $cmd"} else {post "unknown key $key"}
}

#-----------------------------------------------------------------------------------#
set pd_apilist "{ALSA 1}"
set pd_apilist2 "default"

#-----------------------------------------------------------------------------------#
#fixme: actually, is it ok that View<Menuable ? --matju
class_new View {Menuable Observable Thing}

# normally ninlets/noutlets should be in class "Box", but server-side isn't smart enough
def View  pdclass= {v}    {set @pdclass $v}
def View  pdclass  {} {return $@pdclass}
def View  ninlets= {v}    {set  @ninlets $v}
def View  ninlets  {} {return  $@ninlets}
def View noutlets= {v}    {set @noutlets $v}
def View noutlets  {} {return $@noutlets}
def View   click {x y f target} {}
def View unclick {x y f target} {}
def View  motion {x y f target} {}

def View subpatch {} {if {[info exists @subpatch]} {return 1} else {return 0}}

def View look_cache {k} {
	global look look_cache
	foreach super [$@_class ancestors] {
		if {[info exists look($super:$k)]} {
			set look_cache($@_class:$k) $super
			return $super
		}
	}
}
def View look {k} {
	if {![info exists ::look_cache($@_class:$k)]} {$self look_cache $k}
	return   $::look($::look_cache($@_class:$k):$k)
}

def View init {} {
	super
	set @selected? 0
	set @index 0xDEADBEEF
	set @ninlets 1  ;# should be in Box init
	set @noutlets 0 ;# should be in Box init
	set @canvas ""
#	set @inside_box 42 ;# temporary fix
	set @ioselect {}
}

def View classtags {} {return {foo}}

set item {
	set canvas [$self get_canvas] 
	if {$canvas == ""} {return}
	set c [$self cwidget]
	set zoom [$canvas zoom]
	set coords [lmap * $coords $zoom]
	set find [lsearch $args "-width"]
	if {$find >= 0} {
		incr find
		set w [lindex $args $find]
		lset args $find [format %.0f [expr {$w*$zoom}]]
	}
	set find [lsearch $args "-font"]
	if {$find >= 0} {
		incr find
		set fs [lindex [lindex $args $find] 1]
		lset args $find 1 [format %.0f [expr {$fs*$zoom}]]
	}
	set tags {}
	foreach s $suffixes {lappend tags "$self$s"}
	set ss [lindex $tags 0]
	lappend tags $self
	set tags [concat $tags [$self classtags]]
}
append item [correct_splat {
	if {![llength [$c gettags $ss]]} {
		$c create $type $coords -tags $tags {*}$args
	} {
		$c itemconfigure $ss {*}$args
		$c coords        $ss {*}$coords
	}
}]
def View item {suffixes type coords args} $item

def View item_delete {{suffix all}} {
	if {$@canvas == ""} {return}
	set c [$@canvas widget]
	if {![winfo exists $c]} {
		set canvas [$@canvas get_canvas]
		if {$canvas == ""} {return}
		set c [[$@canvas get_canvas] widget]
		if {![winfo exists $c]} {return}
	}
	switch -- $suffix {
		all     {$c delete $self}
		default {$c delete $self$suffix}}
}

def View draw {} {}

def View delete {} {$self erase; super}
def View erase {} {$self item_delete}
def View selected?  {}  {return $@selected?}
def View selected?= {x} {set @selected? $x; $self changed} ;# this is for use by the Selection class only
def View edit? {} {if {[info exists @edit]} {return $@edit} else {return 0}}
def View select {state} {
	set ostate [$self selected?]
	set @selected? $state
	if {$state!=$ostate} {$self changed}
}

# give topleft point of an object in the canvas it's rendered in.
# this includes GOP and excludes zoom.
# inheritance problem: this doesn't work for Wire, which doesn't store its positions
def View xy {} {
	if {$@canvas == ""} {return [list $@x1 $@y1]}
	set type [$@canvas type]
	if {$type == "gopabs" || $type == "gopsub"} {
		mset {xmargin ymargin} [$@canvas margin]
		mset {x y} [$@canvas xy]
		set x1 [expr {($@x1-$xmargin)+$x}]
		set y1 [expr {($@y1-$ymargin)+$y}]
		#if $self's gop is opened
		if {[regexp {^.x[0-9a-f]{6,8}.c} [focus] f]} {
			if {$f == ".$@canvas.c"} {set x1 $@x1; set y1 $@y1}
		}
		#if {[focus] != "." && [focus] == ".$@canvas.c"} {set x1 $@x1; set y1 $@y1}
		return [list $x1 $y1]
	}
	return [list $@x1 $@y1]
}

def View canvas  {}  {return $@canvas}
def View canvas= {c} {
	set @canvas $c
	# should "subscribe" call "changed"? (or pretend to?)
	$self subscribe $c
	$self changed
	$self outside_of_the_box
}

def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}}

# this returns the canvas actually exists/drawn
# see also def Canvas get_canvas
def View get_canvas {} {
	set canvas $@canvas
	if {$canvas == ""} {return ""}
	#while {![$canvas havewindow]} {set canvas [$canvas canvas]}
	while {![winfo exists [$canvas widget]]} {set canvas [$canvas canvas]}
	return $canvas
}
# this will return the top level gop if gop is nested
def View get_parent_gop {canvas} {
	set obj $self
	while {$canvas != [$obj canvas]} {set obj [$obj canvas]}
	return $obj
}

def View outside_of_the_box {} {
	if {$@canvas eq ""} {return}
	# always hide these things
	if {[$self class] == "Wire"}       {set @inside_box 0; return}
	if {[$self class] == "ObjectBox"}  {set @inside_box 0; return}
	if {[$self class] == "MessageBox"} {set @inside_box 0; return}
	if {[$self class] == "Comment"}    {set @inside_box 0; return}
	if {[$self class] == "Array"} {$@canvas visibles+= $self; set @inside_box 1; return}
	set x1 $@x1; set y1 $@y1
	if {[$@canvas gop]} {
		set mess [$@canvas get_mess]
		set pixwidth [lindex $mess 4]
		set pixheight [lindex $mess 5]
		if {[llength $mess] == 6} {
			set xmargin 0; set ymargin 0
		} else {
			set xmargin [lindex $mess 6]; set ymargin [lindex $mess 7]
		}
		if {$x1 < $pixwidth +$xmargin && $x1 > $xmargin && \
		    $y1 < $pixheight+$ymargin && $y1 > $ymargin} {
			set @inside_box 1
			$@canvas visibles+= $self
		} else {
			set @inside_box 0
			$@canvas visibles-= $self
		}
	} else {set @inside_box 1}
}

def View draw_maybe {} {
	if {$@canvas == "" && [winfo exists .$self.c]} {$self draw; return}
	if {[$self class] == "Canvas" && $@canvas == ""} {return}
	if {$@inside_box} {
		#if {[$@canvas mapped] && ![$@canvas abs] && [$self gop_check]} {$self draw}
		if {[$@canvas mapped] && [$self gop_check]} {$self draw}
	} else {
		# for drawing opened gop
		if {[winfo exists .$@canvas.c]} {$self draw}
	}
}
#this checks if $self can be seen, ie nested gop.
def View gop_check {} {
	set canvases $@canvas
	while {[lindex $canvases end] != ""} {lappend canvases [[lindex $canvases end] canvas]}
	set canvases [lreplace $canvases end-1 end]; # all canvases
	foreach canvas $canvases {
		# if a canvas is not a gop and its window does not exists
		if {![$canvas gop] && ![winfo exists [$canvas widget]]} {return 0; break}
	}
	return 1
}

#-----------------------------------------------------------------------------------#

class_new Canvas {Menuable ObjectBox}

def Canvas close {} {
	after cancel $@motion_after_id
	if {$@subpatch} {
		#can't wait till @mapped get updated thru proc change
		if {$@gop} {foreach x [$@objects values] {$x outside_of_the_box}}
		$self save_geometry
		$self copy_times= 0
		netsend [list .$self vis 0]
		#netsend [list .$self close]
		return
	}
	if {$@gop} {
		foreach x [$@objects values] {$x outside_of_the_box}
		netsend [list .$self close]
		return
	}
	switch [tk_messageBox2 -message [say save_changes?] -icon question -type yesnocancel -default cancel] {
		yes    {$self save; netsend [list .$self close]}
		no     {            netsend [list .$self close]}
		cancel {}
	}
}

def Canvas save_geometry {} {
	set geometry [wm geometry .$self]
	set cw [winfo width [$self widget]]; set ch [winfo height [$self widget]]
	foreach {size x y} [split $geometry "+"] {mset {w h} [split $size "x"]; set x1 $x; set y1 $y}
	set x2 [expr $x1+$cw]; set y2 [expr $y1+$ch]
	netsend [list .$self bounds $x1 $y1 $x2 $y2]
}

def Canvas save {} {
	if {$@subpatch} {return [$@canvas save]}
	$self checkgeometry
	set c [$self widget]
	if {![regexp {^Untitled-[0-9]} $@name]} {
		$self save_geometry
		netsend [list .$self savetofile $@name $@folder]
	} else {
		$self save_as
	}
}

def Canvas save_as {} {
	$self checkgeometry
	set filename [tk_getSaveFile -parent $::current_window -filetypes $::patch_filetypes]
	if {$filename != ""} {
		set @file   [string range $filename [expr [string last / $filename]+1] end]
		set @folder [string range $filename 0 [expr [string last / $filename]-1]]
		$self save_geometry
		puts "save $@file dir to $@folder"
		netsend [list .$self savetofile $@file $@folder]
	}
}

def Canvas print {} {
    set filename [tk_getSaveFile -parent $::current_window -initialfile pd.ps -defaultextension .ps -filetypes { {{postscript} {.ps}} }]
    if {$filename != ""} {[$self widget] postscript -file $filename}
}
def Canvas quit {}         {$::main quit}
def Canvas abort_server {} {$::main abort_server}

proc wonder {} {tk_messageBox2 -message [say ask_cool] -type yesno -icon question}

def Canvas eval% {code} {
	mset {x y} $@curpos
	regsub -all %X $code $x code
	regsub -all %Y $code $y code
	super $code
}

def Client documentation {} {
    set filename [tk_getOpenFile -parent $::current_window -defaultextension .pd -filetypes { {{documentation} {.pd .txt .htm}} } -initialdir $::docdir]
    if {$filename != ""} {
        if {[string first .txt $filename] >= 0} {
            menu_opentext $filename
        } elseif {[string first .htm $filename] >= 0} {
            menu_openhtml $filename
        } else {
            set i [string last / $filename]
            set help_directory [string range $filename 0 [expr $i-1]]
            set basename       [string range $filename   [expr $i+1] end]
            netsend [list pd open [enquote $basename] [enquote $help_directory]]
        }
    }
}

def Canvas     new_file {} {$::main  new_file}
def Canvas    open_file {} {$::main open_file}
def Canvas send_message {} {$::main send_message}
def Client test_audio_and_midi {} {menu_doc_open doc/7.stuff/tools testtone.pd  }
def Client          load_meter {} {menu_doc_open doc/7.stuff/tools load-meter.pd}
def Client       latency_meter {} {menu_doc_open doc/7.stuff/tools latency.pd   }
def Client about {} {AboutDialog new}
def Client class_browser {} {Browser new_as browser browser 0 0 ""}
def Client audio_on  {} {netsend [list pd dsp 1]}
def Client audio_off {} {netsend [list pd dsp 0]}
def Client        keyboard_view {} {    KeyboardDialog new $::event_history}
def Client       clipboard_view {} {   ClipboardDialog new $::clipboard}
def Client command_history_view {} {        ListDialog new $::command_history [say command_history_view]}
def Client   event_history_view {} {EventHistoryDialog new $::event_history}
def Client do_what_i_mean {} {wonder}

set pd_prefix [file dirname [file dirname [which pd]]]
set pd_guidir ${pd_prefix}/lib/pd
set doc_number 1
set updir [file dirname [file dirname $argh0]]
if {[file exists $updir/lib/pd/doc]} {
	set docdir $updir/lib/pd/doc
} else {
	set docdir $updir/doc
}

proc menu_opentext {filename} {
    set w [format ".help%d" $::doc_number]
    toplevel $w
    wm title $w $filename
    frame $w.1
    frame $w.2
    pack [text $w.1.text -relief raised -bd 2 -yscrollcommand "$w.1.scroll set"] -side left -fill both -expand 1
    pack [scrollbar $w.1.scroll -command "$w.1.text yview"] -side right -fill y
    pack [button $w.2.close -text [say close] -command "destroy $w"] -side right
    pack $w.2 -side bottom -fill    x -expand 0
    pack $w.1 -side bottom -fill both -expand 1
    set f [open $filename]
    while {![eof $f]} {
    	set bigstring [read $f 1000]
	regsub -all PD_BASEDIR $bigstring $::pd_guidir bigstring
    	regsub -all PD_VERSION $bigstring $::pd_version bigstring
    	$w.1.text insert end $bigstring
    }
    $w.1.text configure -state disabled
    close $f
    incr ::doc_number
    return $w
}

proc menu_doc_open {subdir basename} {
    set dirname $::pd_guidir/$subdir
    if {[string first .txt $basename] >= 0} {
    	return [menu_opentext $dirname/$basename]
    } else {
    	netsend [list pd open $basename $dirname]
    }
}

#-----------------------------------------------------------------------------------#
def Canvas editmode {} {return $@editmode}
def Canvas editmode= {mode} {
    if {$mode == $@editmode} {return}
    if {!$mode} {$self deselect_all}
    $self redraw ;# why this???
    set @editmode $mode; $self changed editmode
#    catch {.$self.bbar.edit configure -image icon_mode_$mode}
    if {$@mapped} {
      if {$mode} {set im icon_mode_edit} else {set im icon_mode_run}
      [$self window].bbar.edit configure -image $im
      if {[$self look hairstate] && !$@editmode} {$@crosshair erase}
	    if {[$self look gridstate]} {
		    if {$@editmode} {$@grid draw} else {$@grid erase}
	    }
    }
    # comment's look depends on the value of @editmode
    foreach child [$@objects values] {if {[[$child class] <= Comment]} {$child changed}}
    #!@#$ should update the checkbox in the editmenu
}

def Canvas editmodeswitch {} {$self editmode= [expr !$@editmode]}

def Canvas window {} {
	#if {$@gop && $@canvas != ""} {return [$@canvas window]}
	return .$self
}
def Canvas widget {} {return .$self.c}
def View  cwidget {} {return .[$self get_canvas].c}

#-----------------------------------------------------------------------------------#

def Canvas atomically {proc} {$@history atomically $proc}
def Canvas undo {} {$@history undo}
def Canvas redo {} {$@history redo}

def Canvas init {mess} {
    set @mapped 0
    set @gop 0
    set @goprect ""
    set @abs 0
    set @name ""
    set @folder "???"
    set @file ""
    super {#X obj 666 666 pd} ;# bogus
    $self reinit $mess
    set @zoom 1.0 ;# must be a float, not int
    set @action none
    set @objects [Hash new]; set @objectsel [Selection new]; set @visibles {}
    set   @wires [Hash new]; set   @wiresel [Selection new]

    set @focus ""
    set @curpos {30 30}
    set @bbox {0 0 100 100}
    set @dehighlight {}
#    if {$@mapped} {$self init_window} ;#!@#$ @mapped can't possibly be 1 at this point
    set @history $::command_history
    $self subscribe $::manager
    $self changed
    #$self canvas= $self ;#!@#$ EEVIL
    set @coords 0
    set @jump 0
    set @keynav_iocount 0  ;# the io select count
    set @keynav_port 0     ;# which in/outlet is selected
    set @keynav 0          ;# the list of objects that has io selected
    set @keynav_iosel 0    ;# last object that is io selected
    set @keynav_iosel_o {} ;# list of objects that has outlet selected
    set @keynav_iosel_i {} ;# list of objects that has inlet selected
    set @iosel_deselect 0  ;# if selected should be deselected by clicking at empty space
    set @keynav_current 0
    set @keynav_last_obj 0
    set @keynav_last_wire 0
    set @keynav_tab_sel "wire"
    set @keynav_shift 0
    set @copy_count 0
    set @findbar ""
    set @find_string ""
    set @iohilite {-1 0 0 0 0}
    set @keyprefix 0
    set @coords {0 0 1 1} ;# default #X coords line
    set @pixsize {0 0}
    set @margin {0 0}
    set @macro_q {}
    set @macro_delay 200
    set @blinky ""
    set @editmode 0
    set @show_id 0
    set @motion_queue {}
}

def Canvas reinit {mess} {
  switch -- [lindex $mess 0] {
    "#N" {
	# those four are not to be confused with other @variables of similar names.
	set @canvas_pos [lrange $mess 2 3]
	set @canvas_size [lrange $mess 4 5]
	set args [lrange $mess 6 end]
	switch [llength $args] {
	  1 {
		set @subpatch 0
		mset [list @fontsize] $args
		set @name ""
		set @mapped 1
	  }
	  2 {
		  set @subpatch 1
		  mset [list @name @mapped] $args
		  set @fontsize "what?"
	  }
	  default {error "wrong number of arguments (expecting 5 or 6, got [expr 4+[llength $args]])"}
        }
    }
    "#X" {
      switch -- [lindex $mess 1] {
        obj {}
	restore {
	  set @x1 [lindex $mess 2]
	  set @y1 [lindex $mess 3]
	  set args [lrange $mess 4 end]
	  $self text= [lrange $mess 4 end]
		if {!$@subpatch && [llength $args] != 0} {set @abs 1}
		if {$@mapped && !$@gop} {
			#if {!$@subpatch && $@text != ""} {set @abs 1; return}
			#if {![winfo exists .$self.c]} {$self init_window}
		}
	}
	coords {
	  set @coords  [lrange $mess 2 5]
	  set @pixsize [lrange $mess 6 7]
	  switch [llength $mess] {
	    8  {set @gop 0}
	    9  {set @gop [lindex $mess 8]}
	    11 {
		set @gop [lindex $mess 8]
		set @margin [lrange $mess 9 10]
	    }
	    default {error "what???"}
          }
	  if {$@gop} {set @mapped 1}
	}
      }
    }
    "" {return}
    default {error "huh? mess=$mess"}
  }
}

# doesn't this look like Canvas deconstruct ?
def Canvas get_mess {} {
	return [concat $@coords $@pixsize $@margin]
}


def Canvas margin {} {return $@margin}
def Canvas gop {} {return $@gop}
def Canvas hidtext {} {return $@hidetext}
def Canvas abs {} {return $@abs}
#def Canvas abs {} {if {!$@subpatch} {return 1} else {return 0}}
def Canvas subpatch {} {return $@subpatch}
def Canvas get_dimen {} {return $@canvas_size}

def Canvas gop_rect {} {
	mset {pxs pys} $@pixsize
	mset {mx my} $@margin
	set rect [list $mx $my [expr $mx+$pxs] [expr $my+$pys]]
	if {$@goprect == ""} {
		set @goprect [GopRect new $self $rect]
	} elseif {!$@editmode} {$@goprect delete; set @goprect ""; return}
	$@goprect draw

}

# should be called once and only from init
def Canvas init_window {} {
    lappend ::window_list $self
    set win .$self
    set c [$self widget]
    if {$::tcl_platform(platform) == "macintosh"} {
	    toplevel $win -menu $win.m
    } else {
	    if {[$self look menubar]} {toplevel $win -menu $win.m} else {toplevel $win -menu ""}

    }
    catch {wm iconphoto $win icon_pd}
    set @menubar $win.m
    $self init_menus
    # turn buttonbar on/off
    set @buttonbar [ButtonBar new $self]
    if {[$self look buttonbar]} {pack [$@buttonbar widget] -side top -fill x -expand no}
    set @statusbar [StatusBar new $self]
    # turn statusbar on/off
    if {[$self look statusbar]} {pack [$@statusbar widget] -side bottom -fill x}
    set w [expr [lindex $@canvas_size 0]-4];# dd canvas is 4 pixel out with pd canvas? 
    set h [expr [lindex $@canvas_size 1]-4]   
    pack [canvas $c -width $w -height $h -background white] -side left -expand 1 -fill both
    set @yscroll $win.yscroll; set @xscroll $win.xscroll
    $self init_scrollbars
    wm minsize $win 1 1
    wm geometry $win +[lindex $@canvas_pos 0]+[lindex $@canvas_pos 1]
    wm protocol $win WM_DELETE_WINDOW "$self close"
    focus $c
    $self new_binds
    $self update_title
    $self motion_update
    set @runcommand [Runcommand new .$self "command" canvas_eval]
    set @crosshair [Crosshair new $self]
    set @active [Active new $self]
    set @sense [Sense new $self]
    set @grid [Grid new $self]
}

def Canvas activate_menubar= {val} {if {$val} {.$self configure -menu $@menubar} {.$self configure -menu ""}}

def Canvas activate_buttonbar= {val} {
	if {$val} {
		pack [$@buttonbar widget] -side top -fill x -expand no -before [$self widget]
	} else {pack forget [$@buttonbar widget]}
}

def Canvas activate_statusbar= {val} {
	if {$val} {
		if {[winfo exists $@yscroll]} {set w .$self.yscroll} else {set w .$self.c}
		pack [$@statusbar widget] -side bottom -fill x -before $w
	} else {pack forget [$@statusbar widget]}
}

def Canvas activate_scrollbars= {val} {if {!$val} {$self init_scrollbars} {$self remove_scrollbars}}

def Canvas activate_grid= {val} {if {$val} {$@grid draw} {$@grid erase}}

def Canvas init_scrollbars {} {
	set win .$self
	set c [$self widget]
	if {[winfo exists $win.yscroll]} {return}
	set size [$c bbox foo]
	mset {xs ys} $@canvas_size
	pack [scrollbar $win.yscroll -command "$c yview"                   ] -side  right -fill y -before $c
	pack [scrollbar $win.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x -before $c
	set xw $win.xscroll; set yw $win.yscroll
	$c configure -yscrollcommand "$self scroll_set $yw" -xscrollcommand "$self scroll_set $xw"
	after 0 [list $self adjust_scrollbars]
}

def Canvas remove_scrollbars {} {
	set win .$self
	set c [$self widget]
	if {![winfo exists $win.yscroll]} {return}
	#use destroy instead of pack forget so that it can be tested with winfo exists
	destroy $win.yscroll
	destroy $win.xscroll
	$c configure -yscrollcommand "" -xscrollcommand "" -scrollregion ""
}

def Canvas adjust_scrollbars {} {
	set c [$self widget]
	set size [$c bbox foo]
	if {[$self look scrollbar]} {$self auto_scrollbars}
	if {$size != ""} {
		mset {xmin ymin xmax ymax} {0 0 100 100}
		mset {x1 y1 x2 y2} $size
		if {$x2 > 100} {set xmax $x2}
		if {$y2 > 100} {set ymax $y2}
		set bbox [list $xmin $ymin $xmax $ymax]
		set oldbbox [$c cget -scrollregion]
		# it is very inefficient to call "configure" here
		if {"$oldbbox" != "$bbox"} {$c configure -scrollregion $bbox}
		set @bbox $bbox
	}
}

def Canvas auto_scrollbars {} {
	set c [$self widget]
	if {[$c bbox foo] != ""} {
		mset {cx1 cy1 cx2 cy2} [$c bbox foo]
	}  else {
		set cx2 [lindex $@canvas_size 0]; set cy2 [lindex $@canvas_size 1]
	}
	set x2 [$c canvasx [winfo width $c]]
	set y2 [$c canvasy [winfo height $c]]
	if {$x2 == 1} {set x2 $cx2; set y2 $cy2}
	if {$cx2 <= $x2 && $cy2 <= $y2} {$self remove_scrollbars} {$self init_scrollbars}
}

def Canvas delete_window {} {
	set wl {}
	foreach w $::window_list {if {$w != $self} {lappend wl $w}}
	set ::window_list $wl
	destroy .$self
}

def Canvas delete {} {
	$self delete_window
	super
}

def Canvas focus {} {return $@focus}
def Canvas focus= {o} {set @focus $o}
def Canvas history {} {return $@history}

#-----------------------------------------------------------------------------------#
def Canvas find {} {
	if {[info exists ::_(findmodel:_class)]} {
		focus .$self.find.find
		findmodel reinit
	} else {
		FindModel new_as findmodel $self
		FindView new $self
		focus .$self.find.find
	}
}
def Canvas find_again {} {
	if {[info exists ::_(findmodel:_class)]} {findmodel remove_info;findmodel search_recursive}
}

def Canvas find_last_error {} {netsend [list pd finderror]}

def Canvas bind {eventtype selector args} {
    set c [$self widget]
    #bind $c $eventtype [concat [list $self $selector] $args \; $self statusbar_draw %x %y]
    #bind $c $eventtype "puts \[time {[concat [list $self $selector] $args \; $self statusbar_draw %x %y]}\]"
    #bind $c $eventtype "puts \[time {[concat [list $self $selector] $args]}\]"
	if {[$self look statusbar]} {
		bind $c $eventtype [concat [list $self $selector] $args \; $self statusbar_draw %x %y]
	} else {
		bind $c $eventtype [concat [list $self $selector] $args]
	}
}

# apparently, this method is useless
def Canvas osx_scroll {axis diff} {$self scroll $axis [expr -abs($diff)/$diff]}

def Canvas new_binds {} {
    # mouse buttons
    $self bind <Button>                   click_wrap %x %y %b 0
    $self bind <Shift-Button>             click_wrap %x %y %b 1
    $self bind <Control-Button>           click_wrap %x %y %b 2
    $self bind <Control-Shift-Button>     click_wrap %x %y %b 3
    $self bind <Alt-Button>               click_wrap %x %y %b 4
    $self bind <Alt-Shift-Button>         click_wrap %x %y %b 5
    $self bind <Alt-Control-Button>       click_wrap %x %y %b 6
    $self bind <Alt-Control-Shift-Button> click_wrap %x %y %b 7
    switch $::OS {
      osx {
        $self bind <Button-2>       click_wrap %x %y %b 8
        $self bind <Control-Button> click_wrap %x %y 3 8
      }
      default {
        $self bind <Button-3>       click_wrap %x %y %b 8
      }
    }
    switch $::OS { unix {
	$self bind <Button-4>       scroll y -1
    	$self bind <Button-5>       scroll y +1
	$self bind <Shift-Button-4> scroll x -1
    	$self bind <Shift-Button-5> scroll x +1
    } default {
	$self bind <MouseWheel>       scroll y %D
	$self bind <Shift-MouseWheel> scroll x %D
    }}
    $self bind <ButtonRelease>     	 unclick_wrap %x %y %b 0
    $self bind <Shift-ButtonRelease>     unclick_wrap %x %y %b 1

    # keyboard
    $self bind <Control-Key>       ctrlkey %x %y %K %A 0
    $self bind <Control-Shift-Key> ctrlkey %x %y %K %A 1
    $self bind <Alt-Key>           altkey  %x %y %K %A 0
    $self bind <Alt-Shift-Key>     altkey  %x %y %K %A 1
    switch $::OS {
      unix {
	$self bind <Mod1-Key>       altkey %x %y %K %A 0
	$self bind <Mod1-Shift-Key> altkey %x %y %K %A 1
	$self bind <Mod4-Key>       altkey %x %y %K %A 0
	$self bind <Mod4-Shift-Key> altkey %x %y %K %A 1
      }
      osx {
	$self bind <Mod1-Key>       ctrlkey %x %y %K %A 0
	$self bind <Mod1-Shift-Key> ctrlkey %x %y %K %A 1
      }
    }
    $self bind <Key>               key_wrap   %x %y %K %A 0
    $self bind <Shift-Key>         key_wrap   %x %y %K %A 1
    $self bind <KeyRelease>        keyup_wrap %x %y %K %A 0
    $self bind <Shift-KeyRelease>  keyup_wrap %x %y %K %A 1
    $self bind <Control-KeyRelease>  keyup_wrap %x %y %K %A 0
    $self bind <Motion>     motion_wrap %x %y 0
    $self bind <Alt-Motion> motion_wrap %x %y 4
    $self bind <Control-Motion> motion_wrap %x %y 9
    #$self bind <Map>        map
    #$self bind <Unmap>      unmap
    $self bind <Leave>      leave
    $self bind <Configure>  configure %h %w
}

def Canvas configure {h w} {
	if {[$self look gridstate]} {
		$@grid update $h $w
		if {[winfo exists .$self.yscroll]} {return}; # scrollbar will update grid already
		$@grid draw
	}
}

#def Canvas   map {} {}
#def Canvas unmap {} {}
def Canvas leave {} {$@crosshair erase}

def Canvas scroll {axis diff} {
	set c [$self widget]
	$c [list $axis]view scroll $diff units
	if {[$self look hairstate] && $@editmode} {
		# this should be changed so that we don't need to recompute x,y here.
		set x [expr [$c canvasx [expr [winfo pointerx $c] - [winfo rootx $c]]]/$@zoom]
		set y [expr [$c canvasy [expr [winfo pointery $c] - [winfo rooty $c]]]/$@zoom]
		set target [$self identify_target $x $y 0]
		$@crosshair data= $x $y $target
		$@crosshair draw
	} else {
		$@crosshair erase
	}
}

# this allows the grid to update when scroll
def Canvas scroll_set {w v1 v2} {if {[$self look gridstate] && $@editmode} {$@grid draw}; $w set $v1 $v2}

def Canvas reload {} {netsend [list .$self reupload]}
def Canvas redraw {} {
    $self changed
    foreach x [$@objects values] {$x changed}
    foreach x [  $@wires values] {$x changed}
}

#patch editing commandline shortcuts
def Canvas o {x y {name ""}} {
	set c [$self widget]
	if {[$self snap_grid]} {set off [expr [$self look grid_size]/2]} {set off 0}
	set @curpos [list [expr [$c canvasx $x]+$off] [expr [$c canvasy $y]+$off]]
	$self new_object obj $name
}

def Canvas c {from outlet to inlet} {
	set out_objs [$self parse_idx $from]
	set in_objs [$self parse_idx $to]
	foreach out $out_objs {
		foreach in $in_objs {
			$self connect [list $out $outlet $in $inlet]
		}
	}
}

def Canvas pc {from outlet to inlet} {
	set out_objs [$self parse_idx $from]
	set in_objs [$self parse_idx $to]
	if {[llength $out_objs] != [llength $in_objs]} {return "No can do :("}
	for {set i 0} {$i < [llength $out_objs]} {incr i} {
		$self connect [list [lindex $out_objs $i] $outlet [lindex $in_objs $i] $inlet]
	}
}

def Canvas s {selection} {
	set objs [$self parse_idx $selection]
	foreach obj $objs {$self selection+= [$@objects get $obj]}
}

def Canvas s+ {selection} {
	set objs [$self parse_idx $selection]; set ids {}
	foreach obj $objs {
		set v [$@objects get $obj]; lappend ids $v
		$self selection+= $v
	}
	$self selection_wire= [$self implicit_wires $ids]
}

def Canvas sw {from outlet to inlet} {
	set out_objs [$self parse_idx $from]
	set in_objs [$self parse_idx $to]
	foreach out $out_objs {
		foreach in $in_objs {
			set id [$self wire_idx [list $out $outlet $in $inlet]]
			if {$id>=0} {$self selection_wire+= [$@wires get $id]}
		}
	}
}

def Canvas parse_idx {val} {
	set objs {}
	foreach obj [split $val ","] {
		if {[regexp {\d+-\d+} $obj range]} {
			set l [split $range "-"]
			set objs [concat $objs [lmake [lindex $l 0] [lindex $l 1]]]
			continue
		}
		lappend objs $obj
	}
	return $objs
}

def Canvas xy_snap {x y} {
	if {[$self look snap_grid]} {
		set grid [$self look grid_size]
		set x [expr floor($x/$grid)*$grid]
		set y [expr floor($y/$grid)*$grid]
	}
	return [list $x $y]

}

def Canvas new_object {sel args} {
	$self editmode= 1
	$self deselect_all
	mset {x y} $@curpos
	if {[$self look snap_grid]} {
		set grid [$self look grid_size]
		set x [expr floor($x/$grid)*$grid]
		set y [expr floor($y/$grid)*$grid]
	}
	switch -- $sel {
		obj {    set goto [list $self new_object_edit]}
		msg {    set goto [list $self new_object_edit]}
		text {   set goto [list $self new_object_edit]}
		default {set goto [list $self new_object_callback]}
	}
	netsend [concat [list .$self $sel $x $y] $args] $goto
}

def Canvas new_wire_callback {wire} {}

def Canvas new_object_callback {obj} {
	$self add_to_obj_history $obj
	set @keynav_last_obj $obj
	$self selection+= $obj
	if {$@keynav} {$self update_Active $obj}
}

def Canvas new_object_copyselect {obj} {
	$self selection+= $obj
	#set @action "move"
	#$self click_on_object $obj 0
}

def Canvas new_wire_select {wire} {$self selection_wire+= $wire}

def Canvas new_object_edit     {obj} {
	if {[$obj class] == "NumBox"} {return}
	$obj edit
}

def Canvas add_to_obj_history {obj} {
	if {![[$obj class] <= ObjectBox]} {return}
	obj_hist prepend [$obj text]
}


def Canvas insertxy {} {return [list $@insert_x $@insert_y]}

def Canvas insert_object {} {$self do_insert_obj "none" "none"}

def Canvas get_canvas {} {
	if {![info exists @gop]} {
		if {[info exists @subpatch]} {if {$@subpatch} {return [$self canvas]}}
		if {[info exists @abs]} {if {$@abs} {return [$self canvas]}}
		if {[winfo exists .$self.c]} {return $self}
	}
	#if {[info exists @subpatch]} {if {$@subpatch} {return [$self canvas]}}
	return [super]
}

def Canvas get_topcanvas {} {
	set canvas $@canvas
	if {$@canvas == ""} {return $self}
	while {[$canvas canvas] != ""} {set canvas [$canvas canvas]}
	return $canvas
}

def Canvas do_insert_obj {x y} {
	if {$x == "none" && $y == "none"} {
		if {[$@wiresel size] != 1} {return}
		set wire [$@wiresel values]
		puts "insert object for wire $wire"
		mset {from outlet to inlet} [$wire report]
		set c [$self widget]
		set iowidth [$self look iowidth]
		mset {ox1 oy1 ox2 oy2} [lmap / [$c bbox ${from}o${outlet}] [$self zoom]]
		mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox   ${to}i${inlet} ] [$self zoom]]
		set x1 [expr $ox1 + $iowidth/2]; set y1 [expr ($oy1+$oy2)/2]
		set x2 [expr $ix1 + $iowidth/2]; set y2 [expr ($iy1+$iy2)/2]
		set x [expr $x1 + ($x2-$x1)/2]
		set y [expr $y1 + ($y2-$y1)/2]
	}
	netsend [list .$self obj $x $y] [list $self new_object_edit]
	set @action insert
}

def Canvas new_object_insert_wire {obj} {
	set wire [$self selection_wire]
	$self selection_wire-= $wire
	mset {from outlet to inlet} [$wire report]
	$self disconnect [$wire connects]
	set @keynav 0; $@active hide; set @keynav_tab_sel "object"
	set from_idx [$@objects search $from]
	set   to_idx [$@objects search $to]
	set obj3_idx [$@objects search $obj]
	$self connect [list $from_idx $outlet $obj3_idx 0] [list $self keynav_current=]
	$self connect [list $obj3_idx 0 $to_idx $inlet]
	$self action= none
}

def Canvas chain_object {} {
	if {[$@objectsel size] != 1} {return}
	set o [$@objectsel values]
	mset {x1 y1 x2 y2} [$o bbox]
	set grid [$self look grid_size]
	if {[$self look snap_grid]} {set y [expr floor(($y2+$grid)/$grid)*$grid]} {set y [expr $y2+10]}
	netsend [list .$self obj $x1 $y] [list $self new_object_edit]
	set @action chain_obj
}
def Canvas new_object_chain_wire {obj} {
	obj_hist prepend [$obj text]
	set from_idx [$@objects search [lindex [$self selection] 0]]
	$self deselect_all
	set to_idx [$@objects search $obj]
	$self connect [list $from_idx 0 $to_idx 0]
	$self action= none
	$self selection= $obj
}

def Canvas objects {} {return $@objects}
#def Canvas wires {} {return $@wires}
def Canvas selection        {} {$@objectsel values}
def Canvas selection=       {objs} {$@objectsel clear; $self selection+= $objs}
def Canvas selection+=      {objs} {foreach obj $objs {$@objectsel set [$obj index] $obj}}
def Canvas selection-=      {objs} {foreach obj $objs {set k [$obj index]; if {[$@objectsel exists $k]} {$@objectsel unset $k}}}
def Canvas selection_wire   {} {$@wiresel values}
def Canvas selection_wire=  {objs} {$@wiresel clear; $self selection_wire+= $objs}
def Canvas selection_wire+= {objs} {foreach obj $objs {$@wiresel set [$obj index] $obj}}
def Canvas selection_wire-= {objs} {foreach obj $objs {set k [$obj index]; if {[  $@wiresel exists $k]} {  $@wiresel unset $k}}}

def Canvas Object  {} {$self new_object obj}
def Canvas Message {} {$self new_object msg}
def Canvas Number  {} {$self new_object floatatom}
def Canvas Symbol  {} {$self new_object symbolatom}
def Canvas Comment {} {$self new_object text}

#!@#$ these 9 should be harmonised with the class list instead of having special names
def Canvas bng     {} {$self new_object obj bng}
def Canvas tgl     {} {$self new_object obj tgl}
def Canvas nbx     {} {$self new_object obj nbx}
def Canvas vsl     {} {$self new_object obj vsl}
def Canvas hsl     {} {$self new_object obj hsl}
def Canvas vradio  {} {$self new_object obj vradio}
def Canvas hradio  {} {$self new_object obj hradio}
def Canvas vu      {} {$self new_object obj vu}
def Canvas cnv     {} {$self new_object obj cnv}

def Canvas Graph   {} {$self editmode= 1; netsend [list .x$self graph    ]}
def Canvas Array   {} {$self editmode= 1; netsend [list .x$self menuarray]}

def Canvas init_menus {} {
    set name .$self
    set m $name.m
    menu $m
    #removed Paths after send_message
    foreach x {file edit find view put window help} {menu $m.$x -tearoff $::pd_tearoff}
    $self populate_menu file {new_file open_file {} send_message {} close save save_as print {} abort_server quit}
    $self populate_menu edit {undo redo {} cut copy paste duplicate select_all subpatcherize {} tidy_up {}}
    $self populate_menu find {find find_again find_last_error}
    $m.view add checkbutton -label [say visual_diff] -selectcolor grey0 -command [list $self visual_diff] \
    	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1
    $self populate_menu view {get_elapsed {} reload redraw}
    $self populate_menu put {Object Message Number Symbol Comment {} bng tgl nbx vsl hsl vradio hradio vu cnv {} Graph Array}
    $self populate_menu window {{}}
    $m.edit add checkbutton -label [say edit_mode] -selectcolor grey0 -command [list $self editmodeswitch] \
    	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1
    $m.edit   configure -postcommand "$self fix_edit_menu"
    $m.window configure -postcommand "$self fix_window_menu"
    foreach x {file edit view find put window help} {
      if {$x=="help"} {
	# help menu is in the wrong place in patch windows because it's taken from .mbar ???
	$m add cascade -label [say $x] -menu .mbar.$x
      } {
	$m add cascade -label [say $x] -menu $m.$x
      }
    }
}

# corrects edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
def Canvas fix_edit_menu {} {
    set e .$self.m.edit
    switch $::OS {osx {set i 0} default {set i 1}}
    set t [say undo]
    if {[$@history can_undo?]} {
	$e entryconfigure $i -state normal   -label "$t [$@history next_undo_name]"
    } else {
	$e entryconfigure $i -state disabled -label "[say cannot] $t"
    }
    incr i
    set t [say redo]
    if {[$@history can_redo?]} {
	$e entryconfigure $i -state normal   -label "$t [$@history next_redo_name]"
    } else {
	$e entryconfigure $i -state disabled -label "[say cannot] $t"
    }
}

def Menuable fix_window_menu {} {
    set menu $@menubar.window
    $menu delete 0 end
    foreach w $::window_list {$menu add command -label [wm title [$w window]] -command "$w raise"}
#   {"parentwindow" {menu_windowparent} ""}
}

#-----------------------------------------------------------------------------------#
#this just tells whether an object is part of the selection, that is, what usually makes objects turn blue.
def Canvas selection_include? {member} {expr [$@objectsel search $member]>=0}

def Canvas type {} {
	if {$@subpatch && !$@gop} {return "sub"}
	if {$@subpatch && $@gop} {return "gopsub"}
	if {$@abs && !$@gop} {return "abs"}
	if {$@abs && $@gop} {return "gopabs"}
	if {!$@subpatch && !$@abs && !$@gop} {return "toplevel"}
}

def Canvas draw {} {
	if {$@gop} {
		if {[$self gop_check]} {$self all_changed}
		#if the focus is not in the opened gop
		if {[regexp {^.x[0-9a-f]{6,8}.c} [focus] f]} {
			if {$@canvas != ""&& $f != [$self widget]} {super;return}
		} elseif {$@canvas != "" && [focus] != [$self widget]} {super;return}
	} elseif {$@subpatch || $@abs} {super}
	if {!$@mapped} {return} else {if {![winfo exists [$self widget]]} {return}}
	$self check_findbar
	if {$@editmode} {set bg [$self look bgedit]} else {set bg [$self look bgrun]}
	[$self widget] configure -background $bg
	$self adjust_scrollbars
	if {$@gop} {$self gop_rect}
}

def Canvas popup_properties {} {CanvasPropertiesDialog new $self}

def Canvas gop_target {id} {
	while {[$id canvas] != $self} {set id [$id canvas]}; return $id
}

#-----------------------------------------------------------------------------------#
class_new Macro_Rect {View}

def Macro_Rect init {} {super; $self data= 0 0 0 0 blue}

def Macro_Rect data= {x1 y1 x2 y2 col} {
	set @x1 $x1; set @y1 $y1
	set @x2 $x2; set @y2 $y2
	set @col $col
}

def Macro_Rect flash {x1 y1 x2 y2 col} {
	$self data= $x1 $y1 $x2 $y2 $col
	$self draw
	after 500 $self erase
}

def Macro_Rect draw {} {
	set @canvas [string range [focus] 1 [string first . [focus] 1]-1]
	$self item MACRO rect [list $@x1 $@y1 $@x2 $@y2] -outline $@col
}

class_new Macro {EventHistory}
def Macro init {} {
	$::event_history subscribe $self
	set @idx 0
	set @state 0
	set @list {}
	set @ref_list {}
	set @delay 200
	set @offset_x 0
	set @offset_y 0
	set @rect [Macro_Rect new]
}
def Macro state= {val} {
	set @state $val
	if {$val} {
		set @ref_list {}
		set @list {}
		post %s "start recording macro..."
	} else {
		post %s "end..."
	}
}
def Macro state {} {return $@state}
def Macro dump {} {set i 0; foreach step $@list {post %s "step $i -> $step"; incr i}}
def Macro idx= {val} {set @idx $val}
def Macro idx {} {return $@idx}
def Macro delay {} {return $@delay}
def Macro append_ref {mess} {lappend @ref_list $mess}
def Macro ref_list {} {puts "$@ref_list";return $@ref_list}
def Canvas ref_list {} {$::macro ref_list}


def Macro notice {args} {
	if {$@state} {
		set mess [lindex $args 2]
		switch [lindex $args 1] {
			add {$self add $mess}
			default {}
		}
	}
}

def Macro add {mess} {
	mset {event widget x y mode k kval} $mess
	if {[regexp {^Control_} $k]} {return}
	if {[regexp {^Alt_} $k]} {return}
	if {[regexp {^Shift_} $k]} {return}
	if {$event == "KeyRelease"} {return}
	if {$event == "ButtonRelease"} {lappend @list [lreplace $mess 0 0 "Motion"]}
	if {$event == "KeyPress"} {lappend @list [lreplace $mess 0 0 "Motion"]}
	if {$event == "ButtonPress"} {lappend @list [lreplace $mess 0 0 "Motion"]}
	lappend @list $mess
}

def Macro test_playable {x y} {
	mset {macro_width macro_height} [$self calc_size]
	set c [string range [focus] 0 [string first . [focus] 1]+1]
	set cwidth [winfo width $c]; set cheight [winfo height $c]
	set cx1 [$c canvasx 0]; set cy1 [$c canvasy 0]
	set cx2 [$c canvasx $cwidth]; set cy2 [$c canvasy $cheight]
	set new_x [expr $x+$macro_width]; set new_y [expr $y+$macro_height]
	$@rect flash $x $y $new_x $new_y blue
	if {$new_x > $cx2 || $new_x < $cx1 || $new_y > $cy2 || $new_y < $cy1} {
		puts "Can't playback Macro:: outside of canvas area"
		return
	} else {$self idx= 0; $self offset $x $y; $self play [$self delay]}

}

def Macro offset {new_x new_y} {
	mset {event widget x y mode k kval} [lindex $@list 0]
	set @offset_x [expr $new_x-$x]
	set @offset_y [expr $new_y-$y]
}

def Macro play {delay} {
	if {$@idx == [llength $@list]} {return}
	#$self test_canvas_size
	set i 0
	set focus [string range [focus] 1 [string first . [focus] 2]-1]
	set step [lindex $@list $@idx]
	#puts "\t $step"
	mset {event widget x y mode k kval} $step
	switch $event {
		#KeyRelease {set name [modekey $k $mode]}
		KeyPress {set name [modekey $k $mode]}
		ButtonPress {set name $event-$k}
		ButtonRelease {set name $event-$k}
		Motion {set name $event}
		default {puts "Error: event $event should not have been here.."}
	}
	if {$@idx < [llength $@list]} {
		#after $delay [list $self run $event $name $k [expr $X+$@offset_x] [expr $Y+$@offset_y] \
		#		  [expr $x+$@offset_x] [expr $y+$@offset_y]]
		after $delay [list $self run $event $name $k $x $y]
	}
}

#this don't make sense when multiple window, and should be re implemeneted somehow
def Macro calc_size {} {
	set x1 66666; set x2 0
	set y1 66666; set y2 0
	foreach step $@list {
		mset {event widget x y mode k kval} $step
		set x1 [min $X $x1]; set x2 [max $x2 $X]
		set y1 [min $Y $y1]; set y2 [max $y2 $Y]
		
	}
	return [list [expr $x2-$x1] [expr $y2-$y1]]
}

def Macro test_canvas_size {} {
	set c [string range [focus] 0 [string first . [focus] 1]+1]
	set cwidth [winfo width $c]; set cheight [winfo height $c]
	set cx1 [$c canvasx 0]; set cy1 [$c canvasy 0]
	set cx2 [$c canvasx $cwidth]; set cy2 [$c canvasy $cheight]
	mset {x1 y1 x2 y2} [$self calc_size]
}

def Macro run {event name k x y} {
	set w [focus]
	incr @idx
	event generate $w <$name> -x $x -y $y
	if {$event=="KeyPress"} {event generate $w <KeyRelease-$k> -x $x -y $y}
	$self play $@delay
}

def Macro copy {} {
	clipboard clear
	selection clear
	set i 0
	foreach step $@list {
		if {$i == [expr [llength $@list]-1]} {set comma ""} else {set comma ","}
		mset {event widget x y mode k kval} $step
		set mess [list $event $x $y $mode $k]
		set t ${mess}$comma
		switch $event {
			KeyPress {clipboard append [lreplace $t 0 0 "key"]}
			ButtonPress {clipboard append [lreplace $t 0 0 "click"]}
			ButtonRelease {clipboard append [lreplace $t 0 0 "unclick"]}
		}
		incr i
	}
	selection handle -selection PRIMARY [focus] "$self getdata"
	selection own -command lost -selection PRIMARY
}

def Macro getdata {offset maxchar} {
	puts "clipboard ::: [clipboard get]"
	return [string range [format %s [clipboard get]] $offset [expr {$offset+$maxChars}]]
}

def Macro reset {} {set @idx 0}

set ::macro [Macro new]
set ::macro_state 0

def Canvas macro_toggle {} {if {![$::macro state]} {set ::macro_state 1} {$::macro state= 0; $::macro dump}}
#def Canvas macro_play {} {puts ">> $@click_at <<"; $::macro idx= 0; $::macro play [$::macro delay]}
def Canvas macro_play {} {
	mset {x y} $@click_at
	$::macro reset 
	$::macro play [$::macro delay]
	#$::macro test_playable $x $y
}
def Canvas keyevent {} {
	focus [$self widget]
	event generate [$self widget] <Control-Key-1>
}

def Canvas macro_copy {} {$::macro copy}

#-----------------------------------------------------------------------------------#
class_new TextBox {Box}

def TextBox init {mess} {
	super $mess
	set @edit 0
	set @x1 [lindex $mess 2]
	set @y1 [lindex $mess 3]
	set @text [$self remove_braces [join [lrange $mess 4 end]]]
	set @multi 0
	set @max_width 40
	# @textoffset is for offseting the text item/widget, ie, ObjectBox vs NumBox
	switch [$self class] {
		NumBox {set @textoffset [list 10 2]}
		default {set @textoffset [list 2 2]}
	}
}

def TextBox text= {text} {set @text [$self remove_braces [join $text]]}
def TextBox text {} {return $@text}
def TextBox filter_text {{for_edit 0}} {return $@text}

def TextBox draw {} {
	if {[$self class] == "Canvas"} {if {$@text == "graph"} {$self update_size; super; return}}
	# "TEXT" is the text label while "text" is the the input text field tk widget.
	# the text should be drawn before, so that update_size works at the right time.
	mset {x1 y1} [$self xy]
	set z [$@canvas zoom]
	if {$@edit} {
		$self draw_edit
	} else {
		set fw [font measure [$self look font] 0]
		set text [$self filter_text]
		if {$::leet} {set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $text]}
		$self item TEXT text [l+ $@textoffset [$self xy]] \
		    -font [$self look  font] -text $text \
		    -fill [$self look fg] -anchor nw -width [expr ($fw*$@max_width)-1]
		# set width with -1 because text item seem to be inclusive at wrap point
		# where as the text widget is exclusive
	}
	$self update_size
	super
}

def TextBox edit {} {
	if {$@edit} {return}; set @edit 1; $self changed edit
	if {[[$self class] <= AtomBox]} {set @clear 1}
}

def TextBox new_bind {} {
	set t [$self cwidget].${self}text
	bind $t <Key>            "$self key_input %W %x %y %K %A 0"
	bind $t <Control-Return> "$self key_input %W %x %y 10 %A 0"
	bind $t <Control-v>      "$self paste_resize"
	bind $t <Return>         "$self unedit"
	bind $t <Escape>         "$self unedit 0"
	bind $t <Up> "$self scroll_history +1"
	bind $t <Down> "$self scroll_history -1"
	bind $t <Control-p> "$self scroll_history +1"
	bind $t <Control-n> "$self scroll_history -1"	
	bind $t <Alt-BackSpace> "$self clear"
}

def TextBox draw_edit {} {
	set c [$self cwidget]
	switch $::tcl_platform(os) {
		Linux {$c configure -cursor crosshair}
		#need to find equivalent names for other os
	}
	if {[lsearch [$@canvas selection] $self] < 0} {$@canvas selection+= $self}
	set t $c.${self}text
	if {[winfo exists $t]} {return}
	set @edit 1
	set @tab_repeats 0
	obj_hist histi= 0
	set @selected? 1
	set z [$@canvas zoom]
	set font_height [font metrics [$self look font] -linespace]
	if {[$c bbox ${self}TEXT] != ""} {
		mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox ${self}TEXT] $z]
		if {($iy2-$iy1)/$z > $font_height} {set @multi 1}
	} else {
		set ix1 0; set iy1 0
		set ix2 [font measure [$self look font] 0]
		set iy2 [font metrics [$self look font] -linespace]
	}
	$c delete ${self}TEXT
	set font_str [$self look font]
	set new_size [format %.0f [expr [lindex $font_str 1]*$z]]
	set font_str [lreplace $font_str 1 1 $new_size]
	foreach char [split $@text ""] {lappend l [scan $char %c]}
	mset {width height} [$self get_size [expr $ix2-$ix1] [expr $iy2-$iy1]]
	set insertbg [$self look fg]; set fg [$self look fg]
	if {[[$self class] <= AtomBox]} {set fg "red"; set insertbg [$self look bgedit]}
	text $t -width $width -height $height -relief flat -bg [$self look bgedit] -borderwidth 0 \
		-highlightthickness 0 -font $font_str -fg $fg -insertbackground $insertbg -wrap word
	$self new_bind
	$@canvas focus= $self
	$self item text window [l+ [lmap / $@textoffset $z] [$self xy]] -window $t -anchor nw -tags "${self}text $self text"
	$t insert 1.0 $@text
	$t configure -pady 0 -padx 0
	# dnd bindtarget $c.${self}text text/uri-list <Drop> {}
	# tkdnd::drop_target register $c.${self}text
	#set w .[$self get_canvas]
	#tkdnd::drop_target register $w *
	#bind $w <<Drop>>           {post %s "Drop           %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D"}
	#bind $w <<Drop:DND_Files>> {post %s "Drop:DND_Files %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D"}
	#bind $w <<DropEnter>>      {post %s "DropEnter      %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D"}
	#bind $w <<DropPosition>>   {post %s "DropPosition   %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D"}
	#bind $w <<DropLeave>>      {post %s "DropLeave      %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D"}

	# "pd \"x[list ${self}] symbol \[ enquote %D \] ;\""
	$self resize
	focus $t
}

def TextBox resize {} {
	if {[[$self class] <= AtomBox]} {return}
	set c [$self cwidget]
	set t $c.${self}text
	#set z [$@canvas zoom]
	set pix_height [$t count -update -ypixels 1.0 end]
	set pix_width [font measure [$self look font] [$t get 1.0 end]]
	mset {width height} [$self get_size $pix_width $pix_height]
	$t configure -width [min $width $@max_width] -height $height -wrap word
}

def TextBox get_size {w h} {
	set c [$self cwidget]
	set t $c.${self}text
	set pix_height $h
	set pix_width $w
	set char_width [font measure [$self look font] 0]
	set line_height [font metrics [$self look font] -linespace]
	set round_chars [expr int(ceil($pix_width/$char_width.0))]
	if {$round_chars < $@max_width && !$@multi} {
		set round_lines 1
	} else {
		set @multi 1
		set round_chars $@max_width
		set round_lines [expr int(ceil($pix_height/$line_height))]
	}
	return [list $round_chars $round_lines]
}

def TextBox key_input {widget x y key iso shift} {
	after 0 "$self after_key $widget"
	set c [$@canvas widget]
	set t $c.${self}text
	if {[[$self class] <= AtomBox]} {if {$@clear} {$t delete 1.0 1.end; set @clear 0}}
	switch -- $key {
		Tab {
			if {[$self class] == "ObjectBox"} {
				$self propose_completions; $widget configure -state disabled
			}
		}
		10 {$t configure -height [expr [lindex [$t configure -height] 4] + 1]}
	}
}

def TextBox after_key {widget} {
	$widget configure -state normal; # for in case there is completion box
	$self resize
	$self changed
}

def TextBox paste_resize {} {
	if {[[$self class] <= AtomBox]} {return}
	set c [$self cwidget]
	set t $c.${self}text
	set fixed [font metrics [$self look font] -fixed]
	set text [clipboard get]
	if {$fixed} {
		set width [string length $text]
	} else {
		set textpix [font measure [$self look font] $text]
		set fwidth [font measure [$self look font] 0]
		set width [expr (($textpix+$fwidth-1)/$fwidth)+1]
	}
	set maxwidth 40
        mset {y1 y2} [$t yview]
        if {$width < $maxwidth} {set height 1} {set height [expr ceil($width/$maxwidth.0)]}
	$t configure -width [min $width $maxwidth] -height $height -wrap word
	after 0 [list $t mark set insert 1.end]
	$t mark set insert 1.0
	$self update_size
	$self changed
}

def TextBox scroll_history {incr} {
	if {[[$self class] <= MessageBox]} {return}
	set c [$self cwidget]
	set t $c.${self}text
	if {![obj_hist histi]} {obj_hist set_hist 0 [$t get 1.0 1.end]}
	$t delete 1.0 1.end
	set text [obj_hist traverse $incr]
	$t insert 1.0 $text
	$t configure -width [string length $text]
	$self update_size
	after 0 $self changed
	
}

def TextBox clear {} {
	set c [$self cwidget]
	set t $c.${self}text
	$t delete 1.0 1.end
}

def TextBox text {} {return $@text}

def TextBox update_size {} {
	if {[info exists @gop]} {if {$@gop} {mset [list @xs @ys] $@pixsize; return}}
	if {$@canvas == ""} {puts "update_size: this textbox has no canvas, try again later"; return}
	set c [$self cwidget]
	set t_widget $c.${self}text
	set t_item $c.${self}TEXT
	set w2 0; set h2 0
	set xpad 2; set ypad 3
	set z [$@canvas zoom]
	if {[winfo exists $t_widget]} {
		set textwidth [expr ([winfo reqwidth $t_widget]+$xpad)/$z]
		set height [expr ([winfo reqheight $t_widget]+$ypad)/$z]
	} else {
		mset {x1 y1 x2 y2} [[[$self canvas] widget] bbox ${self}TEXT]
		set textwidth [expr ($x2-$x1+$xpad)/$z]
		set height [expr ($y2-$y1+$ypad)/$z]
	}
	set iowidth [$self look iowidth]
	set topwidth    [expr {(2* $@ninlets-1)*$iowidth}]
	set bottomwidth [expr {(2*$@noutlets-1)*$iowidth}]
	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
	set @ys $height
}

#-----------------------------------------------------------------------------------

class_new ObjectBox {TextBox}

def ObjectBox init {mess} {
	super $mess
	set @valid 0 ;# only ObjectBox needs a @valid. (removed all others)
	set @ninlets 0
	set @noutlets 0
	set @pdclass ""
}

def ObjectBox valid= {v}    {set @valid $v}
def ObjectBox valid  {} {return $@valid}
def Canvas objectsel {} {return $@objectsel}
def Canvas   wiresel {} {return   $@wiresel}

def ObjectBox draw_box {} {
	super
	set xya [$self bbox]
	mset {x1 y1 x2 y2} $xya
	#set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
	#set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
        if {[$self selected?]} {set fg [$self look selectframe]} {set fg [$self look frame3]}
	if {$@valid} {
		$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1
	} else {
		$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1 -dash {3 3}
	}
	#$self item BASE1 line      $xyb -fill [$self look frame1] -width 1
	#$self item BASE2 line      $xyc -fill [$self look frame2] -width 1
	#[$@canvas widget] lower ${self}BASE ${self}TEXT
	[[$self get_canvas] widget] lower ${self}BASE ${self}TEXT
	#[[$self get_canvas] widget] lower ${self}BASE
}

def ObjectBox draw {} {super; $self draw_io}

# this is called from the GUI; text= is reserved for server.
def TextBox setto {text} {
	[$@canvas history] add [list $self setto $@text]
	[$@canvas widget] configure -cursor {}
	set @text $text
	set l {}
	foreach char [split $@text ""] {lappend l [scan $char %c]}
	$@canvas selection-= [list $self]
	switch [$@canvas action] {
		insert        {set goto [list $@canvas new_object_insert_wire]}
		chain_obj     {set goto [list $@canvas new_object_chain_wire]}
		subpatcherize {set goto [list $@canvas new_object_subpatcherize_redraw]}
		default       {set goto [list $@canvas new_object_callback]}
	}
	netsend [concat [list .$@canvas text_setto $self] $l] $goto
}

def TextBox unedit {{accept 1}} {
	if {!$@edit} {return}
	set @edit 0
	$self changed edit
	set c [[$self get_canvas] widget]
	set t $c.${self}text
	if {$accept} {$self setto [$t get 1.0 "end - 1 chars"]}
	after 1 "destroy $t"
	if {[winfo exists .completion]} {$@action cancel}
	focus $c
	$@canvas focus= ""
}

#-----------------------------------------------------------------------------------#
def Canvas name {} {return $@name}
def Canvas folder {} {return $@folder}
def Canvas name=   {name}    {if {!$@mapped} {return}; set @name   $name  ; $self update_title}
def Canvas folder= {folder}  {if {!$@mapped} {return}; set @folder $folder; $self update_title}

def Canvas make_title {} {
	if {!$@mapped} {return}
	if {$@subpatch} {
		if {$@canvas == "" || 0==[string compare $@canvas $self]} {
			set t "(uh)"
		} else {
			set t [$@canvas make_title]
		}
		set t "subpatch '$@name' of $t"
	} else {
		#set t "$@name in $@folder"
		set t "$@name"
	}
	if {[$self modified?]} {append t "(*)"}
	return $t
}

def Canvas update_title {} {
	if {[winfo exists .$self]} {wm title .$self [$self make_title]}
}

# UNIMPLEMENTED: this should indicate whether the patch in pd is different from the last saved patch
def Canvas modified? {} {return 1}

def Canvas mapped {} {return $@mapped}
def Canvas mapped= {v} {set @mapped $v}

def Canvas havewindow= {flag} {
	set was [winfo exists .$self]
	if {$flag && !$was} {$self init_window; $self redraw}
	#if {$flag && $was && [$self gop]} {$self redraw}
	if {$flag && $was} {$self raise}
	if {!$flag && $was} {$self delete_window}
}

def Canvas visibles+= {child} {
	if {[lsearch $@visibles $child]  < 0} {lappend @visibles $child; $self changed visibles}
}
def Canvas visibles-= {child} {
	if {[lsearch $@visibles $child] >= 0} {set @visibles [lwithout $@visibles $child]; $self changed visibles}
}

def Canvas visibles {} {return $@visibles}

def Canvas all_changed {} {
	foreach x $@visibles {
		if {[$x class] == "Canvas"} {
			if {$@gop} {$x all_changed}
		}
		$x changed
	}
}

# this is a shim between the client's new-style indices and the server's remaining old-style indices
proc dex {h k} {lsearch [lsort -integer [$h keys]] $k}

# for undo; calls the server
def Canvas ins {i constructor} {
	set parts [pd_mess_split $constructor]
	set last [lindex $parts end]
	set parts [lrange $parts 0 end-1]
	foreach part $parts {netsend $part}
	netsend [concat [list .$self object_insert $i] $last]
	$@history add [list $self del $i]
}

def Canvas del {i} {
	set o [$@objects get $i]
	#this keynav should be better sorted out
	if {$o == $@keynav_current || $o == $@keynav_last_obj} {
		set @keynav_current 0
		set @keynav_last_obj 0
	}
	# this "if" might not be necessary... try deconstruct_to for everything.
	if {[$o class] != "Canvas"} {
		$@history add [list $self ins $i [$o deconstruct]]
	} else {
		set meuh [Clipboard2 new]
		$o deconstruct_to $meuh
		$@history add [list $self ins $i [$meuh value]]
		$meuh delete
	}
	netsend [list .$self object_delete $o]
}

def Canvas wires {} {return $@wires}

def Canvas delete_selection {} {
    $@history atomically [list delete_selection] {
	if {![$@objectsel size] && ![$@wiresel size]} {return}
	#this keynav should be better sorted out
	if {$@keynav} {
		set @keynav 0
		switch [$@keynav_current class] {
			Wire    {set @keynav_last_wire 0}
			default {set @keynav_last_obj  0}
		}
		set @keynav_current 0
		$@active hide
	}
	set del_wire {}
	foreach obj [$@objectsel values] {
		foreach wire [$obj wires2] {
			if {[$@wires search $wire] != -1 && [lsearch $del_wire $wire] < 0} {
				$self disconnect [$wire connects]
				lappend del_wire $wire
			}
		}
		$self del [$@objects search $obj]
	}
	foreach x [$@wiresel values] {
		if {[$@wires search $x] != -1 && [lsearch $del_wire $x] < 0} {
			$self disconnect [$x connects]
		}
	}
	$@objectsel clear
	$@wiresel   clear
    }
}

def View position= {xy1} {mset [list @x1 @y1] $xy1; $self changed x1 y1}
def View set_orig_xy {x y} {set @orig_x $x; set @orig_y $y}

def Canvas motion_wrap {x y f} {
	set c [$self widget]
	set x [expr [$c canvasx $x]/$@zoom]
	set y [expr [$c canvasy $y]/$@zoom]
	lappend @motion_queue [list $x $y $f]
	#$self motion $x $y $f [$self identify_target $x $y $f]
}

def Canvas motion_update {} {
	if {[llength $@motion_queue]} {
		mset {x y f} [lindex $@motion_queue end]; set @motion_queue {}
		$self motion $x $y $f [$self identify_target $x $y $f]
	}
	set @motion_after_id [after 50 "$self motion_update"]
}

def Canvas click_wrap {x y b f} {
	set c [$self widget]
	set x [expr [$c canvasx $x]/$@zoom]
	set y [expr [$c canvasy $y]/$@zoom]
	set f [expr 1<<($b+7)|$f]
	$self click $x $y $f [$self identify_target $x $y $f]
}
def Canvas unclick_wrap {x y b f} {
	set c [$self widget]
	set x [expr [$c canvasx $x]/$@zoom]
	set y [expr [$c canvasy $y]/$@zoom]
	set f [expr 1<<($b+7)|$f]
	$self unclick $x $y $f [$self identify_target $x $y $f]
}
def Canvas key_wrap {x y key iso shift} {
	set c [$self widget]
	$self key [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
}
def Canvas keyup_wrap {x y key iso shift} {
	set c [$self widget]
	$self keyup [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
}

proc lsearch_minimum {l} {
	set i 0
	set j 0
	set min [lindex $l 0]
	foreach o $l {
		if {$o < $min} {set i $j; set min $o}
		incr j
	}
	return $i
}

def Canvas quadrant {du dv array} {
	if {$@keynav_current == 0} {set @keynav_current [$@objects get [lindex [$@objects keys] 0]]}
	set foo {}
	set bar {}
	set pos [$@keynav_current xy]
	foreach o $array {
		mset {x y} [l- $pos [$o xy]]
		set u [expr $x+$y]
		set v [expr $x-$y]
		if {$u*$du>0 && $v*$dv>0} {lappend foo $o; lappend bar [distance $pos [$o xy]]}
	}
	if {![llength $bar]} {return $@keynav_current}
	set best [lindex $foo [lsearch_minimum $bar]]
	return $best
}

def Canvas motion {x y f target} {
	#modes_callback $self "motion" $x $y $f $target
	set c [$self widget]
	$self motion_checkhairtip $target $x $y
	eval $@dehighlight
	set @dehighlight {}
	set oldpos $@curpos
	set @curpos [list $x $y]
	# detects if the focus is not on the canvas itself in run mode, ie. numbox
	if {!$@editmode & [$self focus] != $self & [$self focus] != ""} {
		[$self focus] motion $x $y $f $target
	}
	mset {type id detail} $target
	switch $@action {
		edit {$self motion_edit $x $y $f}
		insert {}
		chain_obj {}
		imove      {$self motion_imove $oldpos $x $y; return}
		mouse_copy {$self motion_move  $oldpos $x $y; return}
		move       {$self motion_move  $oldpos $x $y; return}
		none {}
		default {$@action motion $x $y $f $target}
	}
	if {$@editmode} {$self motion_iohilite2 $x $y $f}
	if {$id == ""} {return}
}

proc remainder {val val2} {
	if {[expr {abs($val)}]} {return [expr {(abs($val)%$val2)*($val/abs($val))}]} else {return 0}
}

def Canvas motion_move {oldpos x y} {
	mset {ox oy} $oldpos
	if {$@keynav} {$@active draw}
	foreach obj [$@objectsel values] {
		#if {[[$obj class] <= Box]} {
			if {[$self look snap_grid]} {
				set grid [$self look grid_size]
				set ax  [expr {(int($x)/$grid)*$grid}]
				set ay  [expr {(int($y)/$grid)*$grid}]
				set oax [expr {(int($ox)/$grid)*$grid}]
				set oay [expr {(int($oy)/$grid)*$grid}]
				mset {x1 y1} [$obj xy]
				if {![expr {($ax-$oax)%$grid}]} {
					set xoff [remainder [expr {int($x1-$ax)}] $grid]
				} else {set xoff 0}
				if {![expr {($ay-$oay)%$grid}]} {
					set yoff [remainder [expr {int($y1-$ay)}] $grid]
				} else {set yoff 0}
				$obj move [expr ($ax-$oax)-$xoff] [expr ($ay-$oay)-$yoff]
			} else {
				$obj move [expr {$x-$ox}] [expr {$y-$oy}]
			}
		#} else {
		#	puts "Canvas motion warning: trying to move non-Box explicitly"
		#}
	}
}

def Canvas motion_imove {oldpos x y} {
	mset {ox oy} $oldpos
	if {$@keynav} {$@active draw}
	if {[$@objectsel size] == 1} {
		set obj [$@objectsel values]
		set  in_objs $obj
		set out_objs $obj
	} else {
		if {![llength $@keynav_iosel_i] || ![llength $@keynav_iosel_o]} {
			return
		} else {
			set obj [lindex $@keynav_iosel_i 0]
			set  in_objs $@keynav_iosel_i
			set out_objs $@keynav_iosel_o
		}
	}
	if {[[$obj class] <= Box]} {
		if {[$obj class] == "Canvas"} {
			if {[$obj gop]} {[$self widget] raise [list $obj [$obj visibles]]}
		} else {
			[$self widget] raise $obj
		}
		mset {type id detail} [$self identify_target $x $y 0]
		if {$type == "wire"} {
			mset {from outlet to inlet} [$id report]
			$self disconnect [$id connects]
			set from_idx [$@objects search $from]
			set   to_idx [$@objects search $to]
			foreach obj $in_objs {
				set obj3_idx [$@objects search $obj]
				if {![llength [$obj ioselect]]} {set port 0} else {set port [lindex [$obj ioselect] 0]}
				set w1 [list $from_idx $outlet $obj3_idx $port]
				if {[$@wires search $w1]<0} {$self connect $w1}
			}
			foreach obj $out_objs {
				set obj3_idx [$@objects search $obj]
				if {![llength [$obj ioselect]]} {set port 0} else {set port [lindex [$obj ioselect] 0]}
				set w2 [list $obj3_idx $port $to_idx $inlet]
				if {[$@wires search $w2]<0} {$self connect $w2}
			}
			set @action move
		}
		foreach obj [$@objectsel values] {$obj move [expr $x-$ox] [expr $y-$oy]}
	} else {
		puts "Canvas motion warning: trying to move non-Box explicitly"
	}
}

def Canvas motion_edit {x y f} {
	if {[distance [list $x $y] $@click_at] > 5} {
		foreach obj [$@objectsel values] {
			if {[[$obj class] <= Box]} {
				$obj backupxy= [$obj xy]
			} else {
				puts "Canvas motion warning: trying to backup coordinates of non-Box"
			}
		}
		if {$f == 9} {set @action imove} else {set @action move; $self motion_move $@click_at $x $y}
		mset {ox oy} $@click_at
	}
}

def Canvas motion_checkhairtip {target x y} {
	global tooltip
	if {[$self look hairstate] && $@editmode} {
		$@crosshair data= $x $y $target
		$@crosshair draw
	} else {
		$@crosshair erase
	}
	if {[$self look tooltip]} {
		if {$tooltip ne "" && ![$tooltip iserror] && [expr [distance [$tooltip curpos] [list $x $y]] > 10]} {
			$tooltip delete
			set tooltip ""
		}
	}
}

def Canvas motion_iohilite2 {x y f} {
	set c [$self widget]
	set io [$self identify_closestio $x $y $f]
	if {$io<0} {set @iohilite [list -1 0 0 0 0]; return}
	foreach item {i o} {
		set type_idx [string first $item $io]
		set type [string index $io $type_idx]
		set port [string range $io [expr $type_idx+1] end]
		set object [string range $io 0 [expr $type_idx-1]]
		if {$type_idx >= 0} {break}
	}
	mset {iox ioy} [lmap / [rect_centre [$c bbox $io]] $@zoom]
	set @iohilite [list $object $iox $ioy $type $port]
	$object hilite_io $type $iox $ioy
	set @dehighlight [list $c delete ${io}b]
}

def Canvas iohilite {} {return $@iohilite}

def Canvas motion_iohilite {target x y} {
	set c [$self widget]
	mset {type id detail} $target
	if {[llength $@keynav_iosel_i] || [llength $@keynav_iosel_o]} {return}
	if {$@editmode && [$id canvas] == $self} {
		switch $type {
			inlet  {set io i}
			outlet {set io o}
			default {return}
		}
		set port [$id hilite_io $io $x $y]
		set @dehighlight [list $c delete ${id}$io${port}b]
	}
}

#-----------------------------------------------------------------------------------#
# returns one of those five things:
#   object $id         : the  body of an object
#    inlet $id  $inlet : an  inlet of an object
#   outlet $id $outlet : an outlet of an object
#     wire $id         : a wire
#    label $id         : a label
#  nothing             : nothing
def Canvas identify_target {x y f} {
	set c [$self widget]
	set cx [expr $x*$@zoom]
	set cy [expr $y*$@zoom]
	set stack [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
	# reversing the stack is necessary for some things
	# not reversing the stack is also necessary for some other things
	# we have to figure out something.
	set stack [lreverse $stack]
	set target ""
	foreach tag $stack {set target [$self target $x $y $f $tag]; if {[llength $target] > 1} {break}}
	if {[llength $target] > 1} {return $target} {return [list "nothing"]}
}

def Canvas target {x y f tag} {
	set c [$self widget]
	set cx [expr $x*$@zoom]
	set cy [expr $y*$@zoom]
	set tags [$c gettags $tag]
	if {[regexp {^[xo][0-9a-f]{6,8}} $tags id]} {
		# prior to Aug 15th, Wires had lower priority as all objects together
		# now it's same priority, so just stacking order (and it's prolly wrong)
		if {[$id classtags] == ""} {return [list "nothing"]}
		set class [$id class]
		if {[$self == $id]} {continue}
		if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
		if {[$class <= Box]} {
			if {$@action == "imove"} {
				foreach tag [$self item_stack $x $y] {
					set tags2 [$c gettags $tag]
					if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id2]} {
						set class [$id2 class]
						if {[$class == Wire]} {return [list "wire" $id2]}
					}
				}
			}
			mset {x1 y1 x2 y2} [$id bbox]
			if {[regexp {^x[0-9a-f]{6,8}LABEL} $tags label]} {
				if {$x>$x1 && $x<$x2 && $y>$y1 && $y<$y2} {
					return [list "object" $id]
				} else {
					return [list "label" $id]
				}
			}
			set outs [$id noutlets]
			set  ins [$id  ninlets]
			if {$y>=$y2-6 && $outs} {
				set val [expr int(($x-$x1)*$outs/($x2-$x1))]
				if {$val == $outs} {set val [expr $val-1]}
				return [list "outlet" $id $val]
			}
			if {$y< $y1+2 &&  $ins} {
				set val [expr int(($x-$x1)* $ins/($x2-$x1))]
				if {$val == $ins} {set val [expr $val-1]}
				return [list  "inlet" $id $val]
			}
			return [list "object" $id]
		}
		#puts "skipped a $class"
	}
}

def Canvas item_stack {x y} {
	set c [$self widget]
	set cx [expr {$x*$@zoom}]
	set cy [expr {$y*$@zoom}]
	set sense [$self pointer_sense]
	set stack [$c find overlapping [expr {$cx-$sense}] [expr {$cy-$sense}]\
		                       [expr {$cx+$sense}] [expr {$cy+$sense}]]
	set stack [lreverse $stack]
	return $stack
}

def Canvas identify_closestio {x y f} {
	set c [$self widget]
	set ios {}
	set objs {}
	foreach tag [$self item_stack $x $y] {
		set tags [$c gettags $tag]
		if {[regexp {^[x][0-9a-f]{6,8}[oi][0-9]{1,3}} $tags io]} {
			foreach item {i o} {
				set type_idx [string first $item $io]
				set object [string range $io 0 [expr $type_idx-1]]
				if {$type_idx >= 0} {break}
			}
			if {[$object canvas] == $self} {lappend ios $io}
		}
	}
	if {![llength $ios]} {return -1}
	set mindist 66666
	set idx 0; set i 0
	foreach io $ios {
		set point2 [rect_centre [$c bbox $io]]
		set point1 [list $x $y]
		set dist [distance $point2 $point1]
		if {$dist < $mindist} {set mindist $dist; set idx $i}
		incr i
	}
	return [lindex $ios $idx]
}
def Canvas pointer_sense {} {return [$self look pointer_sense]}
def Canvas pointer_sense= {sense} {
	set ::look(Canvas:pointer_sense) $sense
	mset {x y} $@curpos
	$@sense flash $x $y $sense "red"
}

#-----------------------------------------------------------------------------------#
class_new StatusBar {View} ;# no, using View is wrong here. View is for tk canvas item collections.

def StatusBar widget {} {return .$@canvas.stat}

def StatusBar addw {a b text args} {
	set f [$self widget]
	if {$text!=""} {
		eval [concat [list pack [label $f.${a}_l -text $text -font {helvetica -10} -pady 0] -side left] $args]
	}
	label $f.$a -width $b -font {helvetica -10} -background #cccccc -foreground black -anchor w -pady 0
	pack $f.$a -side left
}

def StatusBar init {canvas} {
	super
	set @canvas $canvas
	set f [$self widget]
	frame $f -border 1 -relief ridge
	$self addw px     4 ""
	$self addw py     4 ""
	$self addw what   28 " " -fill x -expand yes
	$self addw action 12  " Action: "
	$self addw sel    3  " Sel: "
	$self addw focus  10 " Focus: "
}

def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
def Canvas action {} {return $@action}
def Canvas action= {action} {set @action $action}
def Canvas zoom {} {return $@zoom}

def StatusBar draw {x y} {
    if {$x == "??"} {return}
    set c [$@canvas widget]
    set f [$self widget]
    set zoom [$@canvas zoom]
    set x [expr [$c canvasx $x]/$zoom]
    set y [expr [$c canvasy $y]/$zoom]
    set target [$@canvas identify_target $x $y -1]
    mset {type id detail} $target
    set t $target
    switch -- $type {
      object {
	if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
	append t " \[$class\]"
      }
    }
    set action [$@canvas action]
    if {[regexp ^o $action]} {set action [$action class]}
    if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
    $f.px     configure -text [format "%4d" [expr round($x)]]
    $f.py     configure -text [format "%4d" [expr round($y)]]
    if {$::debug} {
      $f.what   configure -text [$c gettags [lindex [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
    } {
      $f.what   configure -text $t
    }
    $f.action configure -text $action
    $f.sel    configure -text [llength [$@canvas selection]]
    $f.focus  configure -text [$@canvas focus]
}

#-----------------------------------------------------------------------------------#
class_new FindModel {Thing}

def FindModel init {canvas} {
	set @orig_canvas $canvas
	set @find_string ""
	set @next_canvases $canvas
	set @last_canvas 0
	set @result ""
	set @results {}
	set @views {}
	set @recursive 1
	set @info ""
}

def FindModel reinit {} {
	set @next_canvases $@orig_canvas
	set @last_canvas 0
	set @result ""
	set @results {}
	$self remove_info
}
def FindModel remove_info {} {
	foreach view $@views {
		set f [$view widget]
		destroy $f.info_l; destroy $f.info
	}
}
def FindModel delete {} {foreach view $@views {destroy [$view widget]}; super}

def FindModel find_string= {s} {set @find_string $s}
def FindModel find_string {} {return $@find_string}
def FindModel result= {s} {
	$@orig_canvas deselect_all
	$@orig_canvas selection= $s
	set @result $s
}
def FindModel result {} {return $@result}
def FindModel views+ {view} {lappend @views $view}
def FindModel views {} {return $@views}
def FindModel end? {} {return $@end}
def FindModel end= {v} {set @end 0}

def FindModel search_recursive {} {
	if {![llength $@next_canvases]} {$self end; return}
        if {[llength $@results]} {$self result= [lindex $@results 0]; set @results [lreplace $@results 0 0];return}
	while {$@last_canvas < [llength $@next_canvases]} {
		set canvas [lindex $@next_canvases $@last_canvas]
		if {[$self cache_results $canvas]} {
			if {![winfo exists [$canvas widget]]} {$canvas popup_open} else {focus [$canvas widget]}
			$self result= [lindex $@results 0]
			set @results [lreplace $@results 0 0]
			incr @last_canvas
			return
		} else {
			incr @last_canvas
			$self search_recursive
			return
		}
	}
	set old_canvases $@next_canvases
	set @next_canvases {}
	if {$@recursive} {
		foreach canvas $old_canvases {foreach x [$canvas get_childcanvas] {lappend @next_canvases $x}}
	} else {
		set @next_canvases {}
	}
	set @last_canvas 0
	$self search_recursive
}

def FindModel end {} {
	$self reinit
	$@orig_canvas deselect_all
	set @info " \"$@find_string\" not found"
	foreach view $@views {
		$view addw label "info" "info"
	}
}

def FindModel cache_results {canvas} {
	set @results {}
	foreach child [$@objects values] {
		if {[string first $@find_string [$child text] 0] >= 0} {
			lappend @results $child
		}
	}
	if {[llength $@results]} {return 1} else {return 0}
}

class_new FindView {FindModel} ;# no, using View is wrong here. View is for tk canvas item collections.
def FindView widget {} {return .$@canvas.find}
def FindView init {canvas} {
	findmodel views+ $self
	set @canvas $canvas
	set @break 0
	set f [$self widget]
	frame $f -border 1 -relief ridge
	$self addw button "close" ""
	$self addw text "find" "find"
	$self addw checkbutton "recursive" "recursive"
	if {[winfo exists .$@canvas.yscroll]} {set w .$@canvas.yscroll} else {set w .$@canvas.c}
	pack $f -side bottom -fill x -before $w
	set string [findmodel find_string]
	if {$string != ""} {$f.find insert 0 $string}
}

def FindView addw {type name label} {
	set f [$self widget]
	if {$label!=""} {
		eval [concat [list pack [label $f.${label}_l -text ${label}: -font {helvetica -10} -pady 0] -side left]]
	}
	switch $type {
		text {
			entry $f.$name -width 10 -relief flat -bg white -borderwidth 0 -highlightthickness 0
			bind $f.$name <Escape> "findmodel delete"
			bind $f.$name <Return> "$self find"
		}
		checkbutton {
			checkbutton $f.$name
			if {$name == "recursive"} {$f.$name configure -variable _(findmodel:recursive)}
		}
		button {
			button $f.$name -border 1 -command "findmodel delete" -image icon_close -width 9 -height 9
			if {$name == "close"} {bind $f.$name <Return> "findmodel delete"}
		}
		label {label $f.$name -textvariable _(findmodel:info) -font {helvetica -10} -pady 0}
	}
	pack $f.$name -side left
	bind $f.$name <Tab> "$self traversal %K %W forward"
}

def FindView find {} {
	set f [$self widget]
	findmodel find_string= [$f.find get]
	findmodel search_recursive
	focus .$@canvas.c
}

def FindView traversal {k w direction} {
	set f [$self widget]
	if {$w == "$f.recursive"} {set next $f.close} else {set next [tk_focusNext $w]}
	focus $next
}

def Canvas check_findbar {} {
	if {[info exists ::_(findmodel:_class)] && ![winfo exists .$self.find.find]} {FindView new $self}
}

def Canvas get_childcanvas {} {
	set canvases {}
	foreach child [$@objects values] {if {[$child class] == "Canvas"} {lappend canvases $child}}
	return $canvases
}

def Canvas runcommand {} {$@runcommand pack_prompt}

class_new Runcommand {Listener}
def Runcommand canvas {} {return $@canvas}

def Runcommand init {serf name command} {
	set @history [History new 20]
	set @serf ${serf}.run
	set @command $command
	set @expanded 0
	set @canvas [string trimleft $serf "."]
	set @defs {}
	set @completions {}
	set @comp_i 0
	set @comp_s "666"
	set @show_id 0
	$self defs
	set f $@serf
	frame $f -border 1 -relief ridge
	button $f.close -border 1 -command "$self unpack_prompt" -image icon_close -width 9 -height 9
	bind $f.close <Return> "$self unpack_prompt"
	pack $f.close -side left
	bind $f.close <Tab> "$self traversal %K %W forward"
	label $f.cmd_l -text Command: -font {helvetica -10} -pady 0
	pack $f.cmd_l -side left
	entry $f.entry -width 30 -relief flat -bg white -borderwidth 0 -highlightthickness 0
	bind $f.entry <Escape> "$self unpack_prompt"
	bind $f.entry <Control-g> "$self unpack_prompt"
	bind $f.entry <Return> "$self eval"
	bind $f.entry <Up>     "$self scroll_history +1"
	bind $f.entry <Down>   "$self scroll_history -1"
	bind $f.entry <Control-p>     "$self scroll_history +1"
	bind $f.entry <Control-n>     "$self scroll_history -1"
	bind $f.entry <Tab>    "$self completion +"
	switch $::tcl_platform(os) {
		Linux   {bind $f.entry <ISO_Left_Tab> "$self completion -"}
		default {bind $f.entry    <Shift-Tab> "$self completion -"}
	}
	pack $f.entry -side left -fill x -expand yes
	bind $f.entry <Control-Tab> "$self traversal %K %W forward"
}

def Runcommand pack_prompt {} {
	set f $@serf
	set @show_id [$@canvas show_id]
	if {!$@show_id} {$@canvas show_id= 1}
	if {[winfo exists .$@canvas.yscroll]} {set w .$@canvas.yscroll} else {set w .$@canvas.c}
	pack $f -side bottom -fill x -before $w
	focus $f.entry
}

def Runcommand unpack_prompt {} {
	if {!$@show_id} {$@canvas show_id= 0}
	pack forget $@serf
	focus [$@canvas widget]
}

def Runcommand traversal {k w direction} {
	set f $@serf
	if {$w == "$f.entry"} {set next $f.close} else {set next [tk_focusNext $w]}
	focus $next
}

def Runcommand eval {} {
	set f $@serf
	if {[winfo exists $f.completion]} {
		set l [string range $@comp 0 [expr [string first ":" $@comp 0]-1]]
		$self replace $l
		destroy $f.completion
		return
	}
	#$self unpack_prompt
	super
	$self unpack_prompt
}

def Runcommand defs {} {
	set name [$@canvas class]
	set len [string length ${name}_]
	foreach def [$name methods] {lappend @defs $def}
}

def Runcommand completion {which} {
	set f $@serf
	set text [$f.entry get]
	if {$text != $@comp_s} {
		set @comp_s $text
		set @completions {}
		set @comp_i 0
		foreach def $@defs {if {[regexp ^$@comp_s $def]} {lappend @completions $def}}
	}
	if {![llength $@completions]} return
	set def [lindex $@completions $@comp_i]
	set args [$@canvas args $def]
	if {[lindex $args 0] == "self"} {
		set args2 [lreplace $args 0 0]
	} else {
		set args2 $args
	}
	if {![llength $args2]} {set args2 "none"}
	set @comp [join [list $def ":" $args2]]
	if {$which == "+"} {
		set @comp_i [expr ($@comp_i+1)%[llength $@completions]]
	} else {
		set @comp_i [expr $@comp_i-1]
		if {$@comp_i<0} {set @comp_i [expr [llength $@completions]-1]}
	}
	if {![winfo exists $f.completion]} {
		label $f.completion -textvariable _($self:comp) -pady 0
		pack $f.completion -side right
	}
}

def Thing args {def} {
	set class [$self class]
	set ancestors [$class ancestors]
	set name ${class}_$def
	set n 0
	foreach class $ancestors {
		set name ${class}_$def
		if {[info exists ::__args($name)]} {break}
	}
	return $::__args($name)
}

def Canvas visible_rect {} {
	set c [$self widget]
	set height [winfo height $c]
	set width [winfo width $c]
	if {$width == 1 && $height == 1} {set height 300; set width 450}
	mset {l r} [$c xview]
	mset {t b} [$c yview]
	if {$l == $r} {set l 0; set r 1}
	if {$t == $b} {set t 0; set b 1}
	set w [expr  $width / ($r - $l)]
	set h [expr $height / ($b - $t)]
	mset {l2 r2} [lmap * [list $l $r] $w]
	mset {t2 b2} [lmap * [list $t $b] $h]
	return [list $l2 $t2 $r2 $b2]
}

def Canvas clipboard_coords {offset} {
	set in 0
	foreach mess [pd_mess_split [$::clipboard value]] {
		set type [lindex $mess 1]
		switch $type {
			canvas {set in 1} "" {} connect {}
			default {
				if {$type == "restore"} {set in 0}
				mset {x y} [lmap + [lrange $mess 2 3] $offset]
				if {!$in} {lappend xcoords $x; lappend ycoords $y}
			}
		}
	}
	return [list $xcoords $ycoords]
}

def Canvas paste_visible? {x1 y1 x2 y2 offset} {
	set in 0
	foreach mess [pd_mess_split [$::clipboard value]] {
		set type [lindex $mess 1]
		switch $type {
			canvas {set in 1} "" {} connect {}
			default {
				if {$type == "restore"} {set in 0}
				mset {x y} [lmap + [lrange $mess 2 3] $offset]
				if {!$in} {
					if {$x > $x2 || $x < $x1} {return 0}
					if {$y > $y2 || $y < $y1} {return 0}
				}
			}
		}
	}
	return 1
}

def Canvas copy_times= {c} {set @copy_count $c}
def Canvas copy_times {} {return $@copy_count}

def Canvas copy {} {
	global clipboard obj_index_sel
	if {![$@objectsel size]} {return}
	$clipboard value= ""
	$self copy_times= 1
	array unset obj_index_sel $self:*
	set j 0
	foreach i [lsort -integer [$@objectsel keys]] {
		set child [$@objectsel get $i]
		#set obj_index_sel($self:$child) [$@objectsel search $child]
		set obj_index_sel($self:$child) $j; incr j
		$child deconstruct_to $clipboard
	}
	foreach wire [$@wiresel values] {
		if {[array names obj_index_sel $self:[$wire from]] == ""} {continue}
		if {[array names obj_index_sel $self:[$wire to  ]] == ""} {continue}
		$wire deconstruct_to $clipboard $self
	}
}

def Canvas paste {} {
	if {[$self look snap_grid]} {set offset [$self look grid_size]} {set offset 15}
	$self do_paste [expr [$self copy_times] * $offset]
	$self copy_times= [expr [$self copy_times] + 1]
}

def Canvas do_paste {offset} {
	set in 0
	$self deselect_all
	netsend [list .$self "push"]
	foreach mess [pd_mess_split [$::clipboard value]] {
		set type [lindex $mess 1]
		if {$type == "restore"} {incr in -1}
		if {!$in} {set with [list $self new_object_copyselect]} else {set with ""}
		switch $type {
			"" {}
			canvas {incr in; netsend $mess}
			connect {
				if {$with != ""} {set with [list $self new_wire_select]}
				netsend $mess $with}
			default {netsend [$self paste_coords $mess $offset] $with}
		}
	}
	netsend [list #X pop 1]
}

def Canvas paste_coords {mess offset} {
	set x [lindex $mess 2]; set y [lindex $mess 3]
	mset {vx1 vy1 vx2 vy2} [$self visible_rect]
	mset {xcoords ycoords} [$self clipboard_coords $offset]
	set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset]
	set ref [lsearch $ycoords [lindex [lsort -real -increasing $ycoords] 0]]
	if {!$visible} {
		set xoff [expr ($vx2 - $vx1) * 0.25]
		set yoff [expr ($vy2 - $vy1) * 0.25]
		set x2 [expr [lindex $mess 2] - [lindex $xcoords $ref] + $vx1 + $xoff]
		set y2 [expr [lindex $mess 3] - [lindex $ycoords $ref] + $vy1 + $yoff]
		return [lreplace $mess 2 3 $x2 $y2]
	} else {
		puts "\t \t [expr $x+$offset] [expr $y+$offset] <<<<<"
		return [lreplace $mess 2 3 [expr $x+$offset] [expr $y+$offset]]
	}
}

def Canvas cut {} {
	$@history atomically [list cut] {
		$self copy
		$self delete_selection
	}
}

def Canvas duplicate {} {
	if {[$self look snap_grid]} {set off [$self look grid_size]} {set off 15}
	$self do_duplicate $off
}

def Canvas do_duplicate {offset} {
	global clipboard
	set backup $clipboard
	set clipboard [Clipboard2 new]
	$self copy
	$self do_paste $offset
	$clipboard delete
	set clipboard $backup
}

def Canvas mouse_copy {} {
	$self do_duplicate 0
}

def Canvas   select_all {} {
	$self editmode= 1
	eval [concat [list $@objectsel reinit] [$@objects list]]
	eval [concat [list   $@wiresel reinit] [  $@wires list]]
}
def Canvas deselect_all {} {
	#$self editmode= 1
	$@objectsel clear
	$@wiresel clear
}

def Canvas popup_help {} {$::main class_browser}

def Canvas popup_open {} {
	#$self init_window
	#set @mapped 1
	if {[winfo exists [$self widget]]} {raise .$self; return}
	netsend [list .$self vis 1]
	#$self init_window
	#$self redraw
}

def Canvas popup {id x y} {
	set p .$self.popup
	catch {destroy $p}
	menu $p -tearoff false
	if {$id == $self} {
		$self populate_menu $p {popup_properties popup_help}
	} elseif {[$id class] == "Wire"} {
		$id populate_menu $p {popup_insert}
	} else {
		$id populate_menu $p {popup_properties popup_open popup_help
			popup_clear_wires popup_remove_from_path popup_delete_from_path popup_copy_id}
	}
	tk_popup $p [expr $x-5] [expr $y-5]
}

def View popup_copy_id {} {
	clipboard clear
	clipboard append $self
}

def Canvas disconnect {wire} {
	set @keynav_tab_sel "wire"
	set id [$@wires get [$self wire_idx $wire]]
	if {$id == $@keynav_current || $id == $@keynav_last_wire} {
		set @keynav_current 0
		set @keynav_last_wire 0
	}
	mset {from outlet to inlet} $wire
	netsend [list .$self disconnect $from $outlet $to $inlet]
	$@history add [list $self    connect $wire]
}
def Canvas connect {wire {callback ""}} {
	mset {from outlet to inlet} $wire
	netsend [list .$self connect $from $outlet $to $inlet] $callback
	$@history add [list $self disconnect $wire]
}

def Canvas clear_wires_of {obj} {
    if {![llength [$obj ioselect]]} {
	set port 0; set type "none"
    } else {
	set port [lindex [$obj ioselect] 0]
	set type [lindex [$obj ioselect] 1]
    }
    foreach wire [$obj wires2] {
	mset {from outlet to inlet} [$wire report]
	switch $type {
	    i {if {  $to==$obj &&  $inlet==$port} {$self disconnect [$wire connects]; if { !$inlet} {lappend @auto_wire_from $from}}}
	    o {if {$from==$obj && $outlet==$port} {$self disconnect [$wire connects]; if {!$outlet} {lappend @auto_wire_to   $to  }}}
	    none {
		$self disconnect [$wire connects]
		if {$from==$obj && !$outlet} {lappend @auto_wire_to   $to  }
		if {  $to==$obj && ! $inlet} {lappend @auto_wire_from $from}
	    }
	}
    }
}

def Canvas clear_wires {} {
	set @auto_wire_to {}; set @auto_wire_from {}
	if {[$@objectsel size] == 1} {
		set objs [$@objectsel values]
	} else {
		if {![llength $@keynav_iosel_i] && ![llength $@keynav_iosel_o]} {return}
		set objs [list $@keynav_iosel_i $@keynav_iosel_o]
	}
	foreach obj $objs {$self clear_wires_of $obj}
}

def Canvas reconnect {} {
	foreach from $@auto_wire_from {
		set idx1 [$@objects search $from]
		foreach to $@auto_wire_to {
			set idx2 [$@objects search $to]
			set wire [list $idx1 0 $idx2 0]
			if {[$self wire_idx $wire] < 0} {$self connect $wire}
		}
	}
}

def Canvas delete_obj_from_path {} {$self clear_wires; $self reconnect;	$self delete_selection}
def Canvas remove_obj_from_path {} {$self clear_wires; $self reconnect}

def Canvas wire_idx {connects} {
	foreach {idx x} [$@wires list] {
		if {[string compare [join $connects] [join [$x connects]]] == 0} {return $idx}
	}
	return -1
}

def Canvas reconnect_brkwires {type brk_quads obj} {
	set k [$@objects search $obj]
	foreach quad $brk_quads {
		mset {from outlet to inlet} $quad
		set orig_outlet $outlet; set orig_inlet $inlet
		switch $type {
			i {set orig_obj $to; set to $k; set inlet 0}
			o {set orig_obj $from; set from $k; set outlet 0}
		}
		netsend [list .$self connect $from $outlet $to $inlet] 
	}
	if {$type == "i"} {
		netsend [list .$self connect $k 0 $orig_obj $orig_inlet]
	} else {
		netsend [list .$self connect $orig_obj $orig_outlet $k 0]
	}
	$self new_object_callback $obj
	
}

def Canvas expand_port {type idx port} {
	set obj [$@objects get $idx]
	mset {bx1 by1 bx2 by2} [$obj io_bbox $type $port]
	mset {ox1 oy1 ox2 oy2} [$obj bbox]
	mset ys [expr $oy2-$oy1]
	mset {brk_wires brk_quads} [$self broken_wires $type $idx $port $self]
	switch $type {
		i {mset {nx ny} [$self xy_snap $bx1 [expr $by1-25]]}
		o {mset {nx ny} [$self xy_snap $bx1 [expr $by1+$ys+25]]}
	}
	foreach quad $brk_quads {$self disconnect $quad}
	set reply [list $self reconnect_brkwires $type $brk_quads]
	netsend [concat [list .$self obj $nx $ny] t a] $reply
	
}

def Canvas outlet_expand {k outlet} {set reconnect [$self broken_wires o $k $inlet]}

def Canvas implicit_wires {objs} {
	set l {}; set h $@objects
	foreach obj $objs {
		set k [$h search $obj]
		for {set i 0} {$i < [$obj ninlets]} {incr i} {
			set ws [$self com_wires i $k $i]; if {[llength $ws]} {foreach w $ws {lappend l $w}}
		}
		for {set o 0} {$o < [$obj noutlets]} {incr o} {
			set ws [$self com_wires o $k $o]; if {[llength $ws]} {foreach w $ws {lappend l $w}}
		}
	}
	#return [lsort -integer -unique $l]
	return [lsort -unique $l]
}

def Canvas com_wires {type k port} {
	set h $@objectsel; set obj [$@objects get $k]; set wires [$obj wires2]; set l {}
	foreach wire $wires {
		mset {f2 o2 t2 i2} [$wire connects]
		if {$t2==$k && $i2==$port && $type=="i" && [$h exists $f2]} {lappend l $wire}
		if {$f2==$k && $o2==$port && $type=="o" && [$h exists $t2]} {lappend l $wire}
	}
	return $l
}

def Canvas broken_wires {type k port canvas} {
	set shash [$canvas objectsel]
	set obj [[$canvas objects] get $k]
	set wires [$obj wires2]; set brk_wires {}; set quads {}
	foreach wire $wires {
		mset {f2 o2 t2 i2} [$wire connects]
		if {$t2==$k && $i2==$port && $type=="i" && ![$shash exists $f2]} {
			lappend brk_wires $wire; lappend quads [$wire connects]
		}
		if {$f2==$k && $o2==$port && $type=="o" && ![$shash exists $t2]} {
			lappend brk_wires $wire; lappend quads [$wire connects]
		}
	}
	return [list $brk_wires $quads]
}


def Canvas selection_center {} {
	set x 0; set y 0
	foreach obj [$@objectsel values] {
		mset {x1 y1} [$obj xy]
		incr x $x1
		incr y $y1
	}
	set n [$@objectsel size]
	set x [expr $x / $n]
	set y [expr $y / $n]
	return [list $x $y]
}

# translate the key/idx in $@objects to key/idx in $@objectsel
def Canvas idx_map {idx} {
	set i 0; set obj [$@objects get $idx]
	foreach sobj [$@objectsel values] {if {$obj == $sobj} {return $i}; incr i}
	return -1
}

def Canvas subpatcherize_mkio {center iolist offset} {
	mset {x y} $center; set inx 0; set outx 0
	for {set i 0} {$i < [llength $iolist]} {incr i} {
		mset {type io port dsp} [lindex $iolist $i]
		if {$type == "i"} {
			if {$dsp} {set inlet "inlet~"} {set inlet "inlet"}
			netsend [list #X obj [expr ($inx+1)*100] 0 $inlet]
			netsend [list #X connect $offset 0 $io $port]
			incr inx
		} else {
			if {$dsp} {set outlet "outlet~"} {set outlet "outlet"}
			netsend [list #X obj [expr ($outx+1)*100] [expr $y*2] $outlet]
			netsend [list #X connect $io $port $offset 0]
			incr outx
		}
		incr offset
	}
}

def Canvas subpatcherize_iopos {orig io} {
	set tab {}; set result {}
	for {set x 0} {$x < [llength $orig]} {incr x} {
		mset {from k1 io1 dsp} [lindex $orig $x]; mset {k2 io2} [lindex $io $x]
		set obj1 [$@objects get $k1]
		mset {x1 y1 x2 y2} [$obj1 io_bbox $from $io1]; set x1 [expr int($x1)]
		lappend pos $x1; lappend tab [list $k1 $x1 [list $k2 $io2 $dsp]]
		#lappend pos $x1; lappend tab [list $k1 $x1 [list $k2 $io2]]
	}
	set tab [lsort -index 1 -real $tab]; set foo ""
	foreach item $tab {mset {k1 val foo2} $item; if {$foo2 != $foo} {lappend result $foo2}; set foo $foo2}
	return $result
}

def Canvas subpatcherize {} {
	set center [$self selection_center]
	set rewire_off [llength [$@objectsel values]]
	set ins {}; set outs {}; set toins {}; set fromouts {}; set broken {}; set iolist {}
	foreach obj [$@objectsel values] {
		for {set i 0} {$i < [$obj ninlets]} {incr i} {
			mset {brk_wires brk_quads} [$self broken_wires i [$@objects search $obj] $i $self]
			if {[llength $brk_wires]} {
				foreach wire $brk_quads {
					set out_obj_name [[$@objects get [lindex $wire 0]] text]
					if {[regexp {~} $out_obj_name]} {set dsp 1} {set dsp 0}
					lappend broken [concat i $wire $dsp]
				}
			}
		}
		for {set o 0} {$o < [$obj noutlets]} {incr o} {
			mset {brk_wires brk_quads} [$self broken_wires o [$@objects search $obj] $o $self]
			if {[llength $brk_wires]} {
				foreach wire $brk_quads {
					set out_obj_name [[$@objects get [lindex $wire 0]] text]
					if {[regexp {~} $out_obj_name]} {set dsp 1} {set dsp 0}
					lappend broken [concat o $wire $dsp]
				}
			}
		}
	}
	# $broken stores totall number of broken connections, i= need [inlet] o = need [outlet]
	foreach c $broken {
		mset {type f o t i dsp} $c
		if {$type == "i"} {
			lappend ins [list $t $i];lappend toins [list o $f $o $dsp]
		} else {
			lappend outs [list $f $o]; lappend fromouts [list i $t $i $dsp]
		}
	}
	# figures out the inlet/outlet positioning and num of in/outlet to create
	set ins [$self subpatcherize_iopos $toins $ins]
	set outs [$self subpatcherize_iopos $fromouts $outs]
	# iolist stores in/outlets to be conected inside the subpatch
	foreach in   $ins {mset {idx p dsp}  $in; lappend iolist [list i [$self idx_map $idx] $p $dsp]}
	foreach out $outs {mset {idx p dsp} $out; lappend iolist [list o [$self idx_map $idx] $p $dsp]}
	puts "\t \t Cutting..............."
	$self cut
	puts "\t \t Push.................."
	netsend [list .$self "push"]
	netsend [list #N canvas 0 0 450 300 sub 0] [list $self subpatcherize_id]
	puts "\t \t Push clipboard........"
	foreach mess [pd_mess_split [$::clipboard value]] {netsend $mess}

	#creating in/outlets
	$self subpatcherize_mkio $center $iolist $rewire_off
	#netsend [list [concat #X restore $center pd sub]]
	netsend [concat #X restore $center pd sub]
	puts "\t \t Pop..................."
	netsend [list .$self "pop"] [list $self subpatcherize_rewire $broken $ins $outs]
}

def Canvas subpatcherize_id {id} {set @subpatcherize_id $id} 

def Canvas subpatcherize_rewire {wires inlist outlist bogus} {
	set obj $@subpatcherize_id
	foreach wire $wires {
		mset {type f o t i dsp} $wire
		if {$type == "i"} {
			set idx [lsearch $inlist [list $t $i $dsp]]
			$self connect [list $f $o [$@objects search $obj] $idx]
		} else {
			set idx [lsearch $outlist [list $f $o $dsp]]
			$self connect [list [$@objects search $obj] $idx $t $i]
		}
	}
}

def Canvas end_action {} {
	switch -- $@action {
	  none    {post "ending action 'none' makes no sense"}
	  default {$@action delete; set @action "none"}
	}
}

proc shift?    {f} {return [expr $f&1]}
proc ctrl?     {f} {return [expr $f&2]}
proc alt?      {f} {return [expr $f&4]}
proc button_of {f} {
#	set f [expr $f>>8]
#	set b 1
#	while {[expr $f&1==0} {set f [expr $f>>1]}
#	return $f
	return [expr $f>>8]
}

class_new FutureWire {View}
def FutureWire init {canvas x y f target} {
	super
	set @canvas $canvas
	mset {type from port} $target
	switch $type {
	    outlet {
		set @from $from; set @outlet $port
		set   @to ""   ; set @inlet ""
		set port_name ${from}o${port}
	    }
	    inlet {
		set @from ""   ; set @outlet ""
		set   @to $from; set @inlet $port
		set port_name ${from}i${port}
	    }
	}
	mset {x y} [lmap / [rect_centre [[$@canvas widget] bbox $port_name]] [$@canvas zoom]]
	set @x1 $x
	set @y1 $y
	$self motion $@x1 $@y1 $f $target
}
def FutureWire motion {x y f target} {
	set @x2 $x
	set @y2 $y
	mset [list type foo bar] $target
	$self draw
}
def FutureWire unclick {x y f target} {
	mset [list type foo bar] $target
	mset {obj iox ioy io idx} [$@canvas iohilite]
	if {$obj != -1} {
		switch $io {i {set type "inlet"} o {set type "outlet"}}
		set target [list $type $obj $idx]
	}
	switch $type {
		outlet {mset [list type @from @outlet] $target}
		inlet  {mset [list type   @to  @inlet] $target}
		default {}
	}
	set from_idx [[$@canvas objects] search $@from]
	set   to_idx [[$@canvas objects] search $@to]
	if {$from_idx >= 0 && $to_idx >= 0 && $@from != $@to} {
		$@canvas connect [list $from_idx $@outlet $to_idx $@inlet]
	}
	if {![shift? $f]} {$@canvas end_action}
}
def FutureWire draw {} {
	$self item WIRE line [xys $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes 
}

class_new GopRect {View}

def GopRect init {canvas rect} {
	set @canvas $canvas
	set @rect $rect
}

def GopRect draw {} {
	$self item GOPRECT rectangle $@rect -outline [$self look fg]
}

class_new SelRect {View}
def SelRect init {canvas x y bf target} {
	super
	set @x1 $x
	set @y1 $y
	set @canvas $canvas
	$self motion $x $y 0 $target
}
def SelRect motion {x y f target} {
	set @x2 $x
	set @y2 $y
	$self draw
}
def SelRect unclick {x y f target} {
	$self motion $x $y 0 $target
	set sel {}
	set c [$@canvas widget]
	mset {x1 y1 x2 y2} [lmap * [list $@x1 $@y1 $@x2 $@y2] [$@canvas zoom]]
	set sel [$c find overlapping $x1 $y1 $x2 $y2]
	set selrect_index [lsearch $sel [$c find withtag selrect]]
	set sel [lreplace $sel $selrect_index $selrect_index]
	if {[llength $sel]} {
		set objects {}
		#set wires {}
		foreach tag $sel {
			if {[regexp {^[xo]?[0-9a-f]{6,8}} [$c gettags $tag] id]} {
				if {[$@canvas == $id]} {continue}
				if {[[$id class] <=  Box]} {lappend objects $id}
				#elseif {[[$id class] <= Wire]} {lappend wires   $id}
			}
		}
		set objects [lsort -unique $objects]
		#set wires   [lsort -unique $wires]
		set objects2 {}
		#so that objects in gop won't get selected...
		foreach obj $objects {if {[$obj canvas] == $@canvas} {lappend objects2 $obj}}
		$@canvas selection+= $objects2
		#$@canvas selection_wire+= $wires
	}
	$@canvas selection_wire+= [$@canvas implicit_wires $objects]
	set _($@canvas:keynav_tab_sel) "wire"
	$@canvas end_action
	
}
def SelRect draw {} {
	$self item RECT line [list $@x1 $@y1 $@x2 $@y1 $@x2 $@y2 $@x1 $@y2 $@x1 $@y1] \
	    -fill [$self look rect] -dash {3 3 3 3} -dashoffset 3 
}

def Canvas click {x y f target} {
	if {[winfo exists .completion]} {
		raise .completion
		focus .completion.comp
		return
	}
	mset {type id detail} $target
	set c [$self widget]
	focus $c
	set @click_at [list $x $y]
	if {$f&8} {if {$id == ""} {set id $self}; $self right_click $id $x $y; return}
	if {!$@editmode} {$self click_runmode $id $x $y $f $target; return}
	set in_selection [expr [$@objectsel search $id]>=0]
	switch $@action {
		mouse_copy {$self move_selection}
	}
	switch $type {
		outlet {}
		inlet {}
		object {$self click_on_object $id $f}
		wire {$self click_on_wire $id $f $x $y}
		nothing {
			#$self deselect_all
			if {[lindex $@iohilite 0] == -1} {
				$self click_on_nothing $f $target $x $y
				return
			}
		}
		label {$self click_on_object $id $f}
		default {error "BORK: $type"}
	}
	if {$@iohilite != "" && $type != "wire"} {
		mset {obj iox ioy io idx} $@iohilite
		if {$obj < 0} {return}
		switch $io {
			i {set type "inlet"}
			o {set type "outlet"}
		}
		if {$@action == "none" && [$obj canvas] == $self} {
			set @action [FutureWire new $self $iox $ioy $f [list $type $obj $idx]]
		}
		return
	}
}

def Canvas click_runmode {id x y f target} {
	foreach obj [$self selection] {if {[[$obj class] <= AtomBox]} {$obj unedit}}
	$self deselect_all
	#if {$@focus != ""} {if {[[$@focus class] <= TextBox]} {$self selection-= $@focus;$@focus unedit}}
	if {[llength $id]} {
		if {[$id class] != "Canvas"} {
			$id click $x $y $f $target
		} else {
			if {[$id subpatch]} {
				if {![$id mapped]} {$id popup_open} else {if {![$id gop]} {raise .$id}}
			}
		}
	}
}

def Canvas click_on_object {id f} {
	set c [$self widget]; set text $c.${id}text
	# so that if one clicks on the objectbox when editing the objectname, the focus won't get lost
	if {[winfo exists $text]} {focus $text; return}
	switch [expr $f&255] {
		0 {
			if {[$self action] == "mouse_copy"} {$self action= "none"; return}
			# if $id is the content of GOP
			if {[$id canvas] != $self} {
				set obj [$id get_parent_gop $self]
			} else {set obj $id}
			if {[$@objectsel search $obj] < 0 || [$@objectsel size] == 0} {
				$self deselect_all
				$self selection+= $obj
				set @action edit
			} else {set @action edit}
		}
		1 {
			if {[$@objectsel search $id] < 0} {
				$self selection+= $id
			} else {
				$self selection-= $id
			}
		}
		2 {
			if {![llength [$id wires2]]} {return}
			$self deselect_all
			$self selection+= $id
			$self remove_obj_from_path
		}
		3 {
			if {[$id canvas] != $self} {
				set obj [$id get_parent_gop $self]
			} else {set obj $id}
			if {![$@objectsel size]} {$self selection+= $obj}
			if {[$@objectsel search $obj] < 0} {
				$self deselect_all
				$self selection+= $obj
			}
			$self action= "mouse_copy"
		}
	}
}
def Canvas click_on_wire {id f x y} {
	set obj_selection [$self selection]
	if {[llength $obj_selection]} {$self selection-= $obj_selection}
	set @keynav_tab_sel "object"
	switch [expr $f&255] {
		0 {$self selection_wire= $id}
		1 {$self selection_wire+= $id}
		2 {
			set c [$self widget]
			set wire [$id connects]
			$self disconnect $wire
			set from [$@objects get [lindex $wire 0]]; set outlet [lindex $wire 1]
			set to   [$@objects get [lindex $wire 2]]; set  inlet [lindex $wire 3]
			set opos [lmap / [rect_centre [$c bbox ${from}o${outlet}]] [$self zoom]]
			set ipos [lmap / [rect_centre [$c bbox   ${to}i${inlet}]]  [$self zoom]]
			set  pos [list $x $y]
			if {[distance $pos $opos] > [distance $pos $ipos]} {
				mset {x1 y1} $ipos
				set target [list outlet $from $outlet]
			} else {
				mset {x1 y1} $opos
				set target [list inlet $to $inlet]
			}
			set @action [FutureWire new $self $x1 $y1 $f $target]
		}
	}
}

def Canvas click_on_nothing {f target x y} {
	# this cget check actually saves a full tk redraw
	if {[[$self widget] cget -cursor] != {}} {[$self widget] configure -cursor {}}
	if {$@focus != ""} {if {[[$@focus class] <= TextBox]} {$@focus unedit}}
	if {$@action == "insert"} {return}
	if {![expr $f&255]} {
		$self deselect_all
		#$self click_deselect_io
	}
	switch $@action {
		edit {}
		move {}
		none {}
		insert {}
		chain_obj {}
		imove {}
		mouse_copy {}
		default {$@action unclick $x $y $f $target}
	}
	set @action [SelRect new $self $x $y $f $target]
}

def Canvas right_click {id x y} {
	set c [$self widget]
	set @insert_x $x; set @insert_y $y
	if {$id != $self} {set id [$self gop_target $id]}
	$self popup $id [winfo pointerx $c] [winfo pointery $c]
}

def Canvas unclick {x y f target} {
	set c [$self widget]
	mset {type id detail} $target
	if {$@editmode} {
		switch $@action {
			edit {
				if {[$id canvas] != $self} {
					set obj [$id get_parent_gop $self]
				} else {set obj $id}
				if {[$id class] == "Canvas"} {if {[$id text] == "graph"} {set @action none; return}}
				set focus [$self focus]
				if {$focus != ""} {if {[[$focus class] <= TextBox]} {$focus unedit}}
				$obj edit; set @action none; $obj changed action
			}
			move {$self unclick_move}
			none {}
			insert {}
			chain_obj {}
			mouse_copy {$self mouse_copy}
			imove {$self unclick_move}
			default {$@action unclick $x $y $f $target}
		}
	} else {$self unclick_runmode $target $f $x $y}
	$self adjust_scrollbars
	#$self checkgeometry
}

def Canvas unclick_move {} {
	$self move_selection
	set @action none
}

def Canvas move_selection {} {
	foreach obj [$@objectsel values] {
		if {![[$obj class] <= Box]} {
			puts "Canvas unclick warning: trying to move non-Box explicitly"
			continue
		}
		mset {x1 y1} [$obj xy]
		switch $@action {
			mouse_copy {}
			default {$obj position= [$obj backupxy]}
		}
		$obj moveto $x1 $y1
		if {[$obj edit?]} {focus [[$obj canvas] widget].${obj}text}
	}
	set objs [$@objectsel values]
}

def Canvas unclick_runmode {target f x y} {
	if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
	mset {type id detail} $target
	if {$id != ""} {
		if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}
	}
}

def Canvas get_bbox {} {return $@bbox}

if {$have_expand} {
	def Canvas notice {origin args} {$self child_changed $origin {expand}$args}
} else {
	def Canvas notice {origin args} {eval [concat [list $self child_changed $origin] $args]}
}

def Canvas tab_jump {} {
	if {![$@objects size]} {return}
	set @keynav 1
	set olength [$@objectsel size]
	set wlength [  $@wiresel size]
	if {$@keynav_tab_sel == "object"} {
		if {[$@wires size]} {set @keynav_tab_sel "wire"}
	} else {
		set @keynav_tab_sel "object"
	}
	switch $@keynav_tab_sel {
		object {$self tab_jump_object}
		wire {$self tab_jump_wire}
	}
}

def Canvas tab_jump_wire {} {
	# if no selection done by the mouse
	if {![$@wiresel size]} {
		# see if the selected object has wire, if yes, use it
		# if keynav_current is already a wire, do nothing
		if {[$@keynav_current class] != "Wire"} {
			#use the last key selected wire as start if there is one
			if {$@keynav_last_wire != 0} {
				$self deselect_all
				set @keynav_current $@keynav_last_wire
			} else {
				if {[llength [$@keynav_current wires2]]} {
					$self deselect_all
					set @keynav_current [lindex [$@keynav_current wires2] 0]
					set @keynav_last_wire $@keynav_current
				} else {
					# check if the canvas has wires, if yes, use it
					if {[$@wires size]} {
						$self deselect_all
						set @keynav_current [lindex [$@wires values] 0]
						set @keynav_last_wire $@keynav_current
					} else {return}

				}
			}
		}
	}
	$self selection_wire= $@keynav_current
}

def Canvas tab_jump_object {} {
	set olength [$@objectsel size]
	# if there is no selection done by mouse
	if {!$olength} {
		# if keynav_current is 0, aka the start of key navigation
		if {$@keynav_current == 0} {
			if {[$@objects size]} {set @keynav_current [lindex [$@objects values] 0]} else {return}
		} else {
			# if the keynav_current is a wire, set keynav_current to a object
			if {[$@keynav_current class] == "Wire"} {
				set @keynav_last $@keynav_current
				$self deselect_all
				# use the last key selected obj as the start if there is one
				if {$@keynav_last_obj != 0} {
					set @keynav_current $@keynav_last_obj
				} else {
					set @keynav_current [lindex [$@keynav_current report] 0]
					set @keynav_last_obj $@keynav_current
				}
			}
		}
	} elseif {$olength == 1}  {
		set @keynav_current [lindex [$@objectsel values] 0]
		$self deselect_all
	} else {
		$self deselect_all
		set @keynav_current [$@objects get 0]
		set @keynav_last_obj $@keynav_current
	}
	$self selection= $@keynav_current
}

def Canvas key_nav_up          {} {$self key_nav +1 -1 0}
def Canvas key_nav_down        {} {$self key_nav -1 +1 0}
def Canvas key_nav_right       {} {$self key_nav -1 -1 0}
def Canvas key_nav_left        {} {$self key_nav +1 +1 0}
def Canvas key_nav_up_shift    {} {$self key_nav +1 -1 1}
def Canvas key_nav_down_shift  {} {$self key_nav -1 +1 1}
def Canvas key_nav_right_shift {} {$self key_nav -1 -1 1}
def Canvas key_nav_left_shift  {} {$self key_nav +1 +1 1}

def Canvas key_nav {du dv shift} {
	if {$@keynav_shift && !$shift} {}
	set @keynav_shift $shift
	if {[$@objectsel size] > 1} {
		if {[llength $@keynav_iosel_i] > 0 || [llength $@keynav_iosel_o] > 0} {
			#$self deselect_all
		}
	}
	if {!$@keynav} {$self tab_jump}
	switch $@keynav_tab_sel {
	    object {
		set @keynav_next [$self quadrant $du $dv [$@objects values]]
		if {!$shift} {
			$self selection-= $@keynav_current
			$@keynav_current selected?= 0
			set @keynav_last_obj $@keynav_next
		}
		if {[$@objectsel search $@keynav_next] < 0} {$self selection+= $@keynav_next}
	    }
	    wire {
		#$@keynav_current selected?= 0
		set @keynav_next [$self quadrant $du $dv [$@wires values]]
		if {!$shift} {
			$self selection_wire-= $@keynav_current
			$@keynav_current selected?= 0
			set @keynav_last_wire $@keynav_next
		}
		if {[$@wiresel search $@keynav_next] < 0} {$self selection_wire+= $@keynav_next}
	    }
	}
	#$self selection+= $@keynav_next
	set @keynav_current $@keynav_next
}

def Canvas victim {} {
	if {[$@objectsel size]} {return [$@objectsel values]}
	if {[string compare $@keynav_current 0]} {return {}}
	return $@keynav_current
}

def Canvas key_nav_ioselect {} {
	if {![$@objectsel size]} {return}
	set var [lindex [$@objectsel values] end]
	if {$@keynav_iosel != $var} {set @keynav_iocount 0}
	if {$@keynav_port != 0 && $@keynav_iosel == $var} {
		#set hilitebox $@keynav_port
		foreach io $@keynav_port2 {[$self widget] delete ${io}b}
	}
	set obj [lindex [$@objectsel values] 0]
	set ins  [$obj ninlets]
	set outs [$obj noutlets]
	set ports {}; set ports2 {}; set ports3 {}
	for {set i 0} {$i < $ins}  {incr i} {lappend ports ${obj}i${i}; lappend ports2 "i"; lappend ports3 $i}
	for {set i 0} {$i < $outs} {incr i} {lappend ports ${obj}o${i}; lappend ports2 "o"; lappend ports3 $i}
	#incr @keynav_iocount
	if {$@keynav_iocount >= [llength $ports]} {set @keynav_iocount 0}
	set port [lindex $ports3 $@keynav_iocount]
	set type [lindex $ports2 $@keynav_iocount]
	set @keynav_port ${obj}${type}${port}
	set @keynav_port2 {}
	# @keynav_port stores the current hilited in/outlets
	# @keynav_ports stores the current hilited in/outlets if there are multiple objects
	# @keynav_iosel_i stores the selected inlets
	# @keynav_iosel_o stores the selected outlets
	foreach object [$@objectsel values] {
		if {$@keynav_iosel != $var} {set @keynav_iosel $var}
		switch $type {
			i {
				if {[lsearch $@keynav_iosel_i $object] == -1} {
					lappend @keynav_iosel_i $object
					set find [lsearch $@keynav_iosel_o $object]
					if {$find >= 0} {set @keynav_iosel_o [lreplace $@keynav_iosel_o $find $find]}
				}
			}
			o {
				if {[lsearch $@keynav_iosel_o $object] == -1} {
					lappend @keynav_iosel_o $object
					set find [lsearch $@keynav_iosel_i $object]
					if {$find >= 0} {set @keynav_iosel_i [lreplace $@keynav_iosel_i $find $find]}
				}
			}
		}
		mset {x y x1 y1} [[$self widget] bbox ${object}${type}${port}]
		lappend @keynav_port2 ${object}${type}${port}
		set _($object:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
		#set _($object:ioselect) [lindex $ports3 $@keynav_iocount]
		$object hilite_io [lindex $ports2 $@keynav_iocount] [expr $x/$@zoom] [expr $y/$@zoom]
	}
	incr @keynav_iocount
	
}

def Canvas keyboard_mode {} {
	post "loading keyboard-mode...."
	if {[file exists kb-mode.tcl]} {
		package require kb-mode
		$@runcommand defs
		if {![info exists @kbcursor]} {set @kbcursor [kb-mode_init $self]}
		puts "cursor::: $@kbcursor"
	}
}

def Canvas keyboard_mode_exit {} {
	post "exiting keyboard-mode...."
	package forget kb-mode
	remove_callback kb-mode
	$@runcommand defs
	$@kbcursor delete
	read_ddrc
	remove_callback "kb-mode"
	unset @kbcursor
}

def Canvas keyprefix {} {
	if {!$@keyprefix} {set @keyprefix 1} else {set @keyprefix 0}
}

def Canvas click_deselect_io {} {
	if {[llength $@keynav_iosel_i] || [llength $@keynav_iosel_o]} {
		if {!$@iosel_deselect} {set @iosel_deselect 1} else {$self dehilite_io; set @iosel_deselect 0}
	} else {
		$self dehilite_io
	}
}

def Canvas dehilite_io {} {
	foreach io [concat $@keynav_iosel_i $@keynav_iosel_o] {
		puts "$io is a [$io class]"
		set box $_($io:ioselect)
		set type [lindex $_($io:ioselect) 1]
		set port [lindex $_($io:ioselect) 0]
		set tag ${io}${type}${port}
		[$self widget] delete ${tag}b
		set _($io:ioselect) {}
	}
	set @keynav_iosel_i {}
	set @keynav_iosel_o {}
	set @keynav_port 0
	set @keynav_iocount 0
}

def Canvas incr_scale {} {$self scale out}
def Canvas decr_scale {} {$self scale in}

def Canvas scale {mode} {
	set s $::scale_amount
	switch $mode { in { set s [expr 1/$s] }}
	set sel [$@objectsel values]
	if {![llength $sel]} {set sel [$@objects values]}
	foreach child $sel {
		mset {x y} [$child xy]
		set x1 [expr $x*$s]
		set y1 [expr $y*$s]
		$child position= [list $x1 $y1]
		netsend [list .$self object_moveto $child $x1 $y1]
	}
	foreach child $sel {$child changed_wires}
}

def Canvas incr_zoom {} {$self zooming in}
def Canvas decr_zoom {} {$self zooming out}
def Canvas zooming {mode} {
	global zoom bar
	set spinbox .$self.bbar.scale
	set val [string trimright [$spinbox get] %]
	set i [lsearch $zoom(canned) $val]
	set end [expr [llength $zoom(canned)] - 1]
	switch -regexp $mode {
	   in|up   {if {$i<$end} {incr i +1}}
	  out|down {if {$i>0}    {incr i -1}}
	}
	set per [lindex $zoom(canned) $i]
	$spinbox set $per%
	set @zoom [expr $per/100.0] ;# @zoom must be float, not int
	#$self propagate_zoom $@zoom
	$self redraw
	if {[$self look gridstate]} {if {$@editmode} {$@grid erase}}
	foreach child [$@objects values] {if {[$child class] == "Canvas" && [$child gop]} {$child all_changed}}
}

def Canvas propagate_zoom {zoom} {
	foreach child [$@objects values] {
		if {[$child class] == "Canvas"} {
			set @zoom $zoom
			$child propagate_zoom $zoom
		}
	}
}

#-----------------------------------------------------------------------------------#
set lastcanvasconfigured ""
set lastcanvasconfiguration ""

def Canvas checkgeometry {} {
    set topname .$self
    set boo [winfo geometry $topname.c]
    set boo2 [wm geometry $topname]
    global lastcanvasconfigured lastcanvasconfiguration
    if {$topname != $lastcanvasconfigured || $boo != $lastcanvasconfiguration} {
    	    set lastcanvasconfigured $topname
    	    set lastcanvasconfiguration $boo
    }
}
#-----------------------------------------------------------------------------------#
def Canvas selection_move {dx dy} {
	$@history atomically [list move] {
		$self selection_move2 $dx $dy
	}
}
def Canvas selection_move2 {dx dy} {
	if {![$self editmode]} {return}
	foreach o [$@objectsel values] {
		mset {x1 y1} [$o xy]
		if {[[$o class] <= Box]} {
			$o moveto [expr $x1+$dx] [expr $y1+$dy]
		} else {
			puts "selection_move: $o is not a Box, it's a [$o class]"
		}
	}
}

def Canvas key {x y key iso shift} {
	global tooltip; if {$tooltip ne ""} {$tooltip delete; set tooltip ""}
	#if {[modes_callback $self "key" $x $y $key $iso $shift]} {return}
	#if {[$self focus] != ""} {[$self focus] key $key $shift}
	#if {$iso != ""} {scan $iso %c key}
	#set focus [$self focus]
	if {!$@editmode && [llength [$self selection]] == 1} {
		set obj [$self selection]
		if {[[$obj class] <= AtomBox]} {
			if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {$obj text= $key} {return}
			$obj edit
			$obj clear 0
			return
		}
	}
	if {$shift} {
		if {[$self look snap_grid]} {set motion [expr [$self look grid_size]*2]} {set motion 10}
	} else {
		if {[$self look snap_grid]} {set motion [$self look grid_size]} {set motion 1}
	}
	set n [$@objectsel size]
	switch -regexp -- $key {
		BackSpace|Delete|KP_Delete {$self delete_selection}
		Up    {if {$n} {$self arrow_key 0 -$motion} else {$self scroll y -$motion}}
		Down  {if {$n} {$self arrow_key 0 +$motion} else {$self scroll y +$motion}}
		Left  {if {$n} {$self arrow_key -$motion 0} else {$self scroll x -$motion}}
		Right {if {$n} {$self arrow_key +$motion 0} else {$self scroll x +$motion}}
		Tab   {$self tab_jump}
		Return {$self return_key $x $y $key $iso $shift}
		F1 {$self deselect_all}
		F2 {set @keynav 0; $@active hide}
		default {}
	}
}

def Canvas return_key {x y key iso f} {
	mset {type id detail} [$self identify_target $x $y $f]
	if {![llength $@keynav_iosel_i] && ![llength $@keynav_iosel_o]} {
		if {[$@objectsel size] == 1} {
			mset {bx1 by1 bx2 by2} [[$self selection] bbox]
			set x1 [expr ($bx1+$bx2)/2]; set y1 [expr ($by1+$by2)/2]
			$self click_wrap $x1 $y1 1 $f
			$self unclick_wrap $x1 $y1 1 $f
		}
	} else {
		foreach out_obj $@keynav_iosel_o {
			set from [$@objects search $out_obj]
			set outlet [lindex $_($out_obj:ioselect) 0]
			foreach in_obj $@keynav_iosel_i {
				set to [$@objects search $in_obj]
				set inlet [lindex $_($in_obj:ioselect) 0]
				$self connect [list $from $outlet $to $inlet]
			}
		}
		$self dehilite_io
	}

}

def Canvas arrow_key {val1 val2} {
	if {![$self editmode]} {
		if {[$@objectsel size] == 1} {
			set o [$@selection values]
			if {[[$o class] <= IEMGUI] || [[$o class] == FloatBox]} {$o key_incr $val1 $val2}
		}
	} else {
		$self selection_move $val1 $val2
	}
}

def Canvas clear_selection {} {
	if {[$@objectsel size] > 0 || [$@wiresel size] > 0} {
		$self deselect_all
		$self dehilite_io
	}
	if {$@keynav} {
		set @keynav 0
		#bogus switch so that keynav remains the same next time..
		if {$@keynav_tab_sel == "object"} {set @keynav_tab_sel "wire"} {set @keynav_tab_sel "object"}
	}
}

#-----------------------------------------------------------------------------------#
def Canvas keynav_current {} {return $@keynav_current}
def Canvas keynav_current= {current} {
	set @keynav_current $current
	switch [$current class] {
		Wire {set @keynav_last_wire $current}
		default {set @keynav_last_obj $current}
	}
}
def Canvas keynav {} {return $@keynav}
def Canvas keyup {x y key iso shift} {
	if {$iso != ""} {scan $iso %c key}
	if {$::macro_state} {$::macro state= 1; set ::macro_state 0 }
	$@active draw
}

class_new Active {View}
def Active init {canvas} {
	super
	set @canvas $canvas
	set @length 3
	set @length2 10
}
def Active draw {} {
	set current [$@canvas keynav_current]
	if {$current == ""} {return}
	if {![string compare $current 0]} {return}
	set col [$self look selectframe]
	if {[$@canvas keynav]} {
		if {[$current class] == "Wire"} {
			$self item_delete
			set i 0
			foreach side {1.6 -1.6} {
				mset {ax1 ay1 ax2 ay2} [$current bbox]
				set t [expr atan2($ay2-$ay1, $ax2-$ax1)]
				set cx1 [expr $ax1 + (($ax2-$ax1)* 0.15)]
				set cy1 [expr $ay1 + (($ay2-$ay1)* 0.15)]
				set cx2 [expr ($@length * cos($t+$side)) + $cx1]
				set cy2 [expr ($@length * sin($t+$side)) + $cy1]

				for {set n 0} {$n < 2} {incr n} {
					set angle [lindex {45 90 -45 -90} [expr $n+$i]]
					mset {ax1 ay1 ax2 ay2} [$current bbox]
					set t [expr atan2($ay2-$ay1, $ax2-$ax1)]
					set bx1 [expr $ax1 + (($ax2-$ax1)* 0.15)]
					set by1 [expr $ay1 + (($ay2-$ay1)* 0.15)]
					set bx2 [expr ($@length2 * cos($t+$angle)) + $bx1]
					set by2 [expr ($@length2 * sin($t+$angle)) + $by1]
					set line [list $cx2 $cy2 $bx2 $by2]
					$self item LINE$angle line $line -fill $col -width 2
				}
 				set i [expr $i+2]
			}
		} else {
			$self item_delete
			mset {x y} [lmap - [$current xy] 5]
			set line1 [list $x $y $x [expr $y + $@length2]]
			set line2 [list $x $y [expr $x + $@length2] $y]
			$self item LINE1 line $line1 -fill $col -width 2
			$self item LINE2 line $line2 -fill $col -width 2

		}
	} else {$self hide}
}
def Active hide {} {$self item_delete}
def Active bbox {} {
	set current [$@canvas keynav_current]
	set l [$current xy]
	concat $l $l ;# happy now??
}

def Canvas update_Active {item} {$self keynav_current= $item}

#-----------------------------------------------------------------------------------#
class_new Box {View}

def Box init {{mess {}}} {
	super
	# @wires2 stores the connections to and from a object
	set @wires2 {}
	$self reinit $mess
}

def Box delete {} {if {$@canvas != ""} {[$@canvas objects] unset $@index}; super}

def Box remove_braces {str} {
	# this hack is to remove the "\" in the text
	regsub -all {\\} $str "" text
	return $text
}

def Box reinit {mess} {
    global classinfo fields
	if {[$::macro state] && [llength $mess] > 4} {$::macro append_ref $mess}
    if {![llength $mess]} {return} ;# what?
    if {[lindex $mess 1] == "obj"} {set i 4} else {set i 1}
    set @pdclass [lindex $mess $i]
    if {[info exists fields($@pdclass)]} {
	    set i 0
	    foreach f $fields($@pdclass) {set _($self:$f) [lindex $mess $i]; incr i}
    } else {
	    set @text [$self remove_braces [join [lrange $mess 4 end]]]
    }
    $self outside_of_the_box
}

def Box update_size {} {}

# will be so that @wires are updated correctly without breaking encapsulation
def Box connect_out {} {}
def Box connect_in {} {}

def Box draw {} {
	$self draw_box
	if {[$@canvas show_id]} {$self draw_id} {$self item_delete ID}
	[[$self get_canvas] widget] raise $self
	$self update_hilite_io
#	if {[$self class] == "Canvas"} {$self restack}
	if {[info exists @elapsed]} {
		mset {x1 y1 x2 y2} [$self bbox]
		$self item ELAPSED text [l+ {10 1} [list $x1 $y2]] -anchor nw -fill "#008800" \
			-text $@elapsed -font {{DejaVu Sans Mono} -8}
	}
}

def Box elapsed {f} {
	set @elapsed $f
	$self changed
}

def Canvas get_elapsed {} {netsend [list .$self get_elapsed]}

def Canvas show_id {} {return $@show_id}
def Canvas show_id= {val} {set @show_id $val; $self redraw}
def Canvas id_toggle {} {if {$@show_id} {set @show_id 0} {set @show_id 1}; $self redraw}

def Box draw_id {} {
	set id [$self index]:
	mset {x y} [$self xy]
	set fw [font measure [$self look font] 0]
	if {[$@canvas editmode]} {
		set col [complement [$@canvas look bgedit]]
	} else {set col [complement [$@canvas look bgrun]]}
	$self item ID text [list [expr $x-([string length $id]*$fw)] [expr $y+2]] \
	    -font [$self look  font] -text $id \
	    -fill $col -anchor nw
}

def Box draw_box {} {}
def Box edit {} {}
def Box unedit {} {}

def Box bbox {} {
	mset {x y} [$self xy]
	set xs $@xs
	set ys $@ys
	list $x $y [expr {$x+$xs}] [expr {$y+$ys}]
}

def Box io_bbox {type port} {
	mset {x1 y1 x2 y2} [$self bbox]
	set xs [expr {$x2-$x1}]
	# method calls aren't as fast as we'd want them to be.
	#set iowidth [$self look iowidth]
	#set fy [$self look iopos]
	set iowidth 7
	set fy -1
	switch $type {
		o {set n $@noutlets; set y [expr {$y2+$fy  }]}
		i {set n  $@ninlets; set y [expr {$y1-$fy-1}]}
	}
	set nplus [expr {$n==1 ? 1 : $n-1}]
	set onset [expr {$x1+($xs-$iowidth)*$port/$nplus}]
	set points [list $onset $y [expr {$onset+$iowidth}] $y]
	return $points
}


def Box ioselect= {type port} {set @ioselect [list $type $port]}
def Box ioselect {} {return $@ioselect}

def Box wires2 {} {return $@wires2}
def Box wires2+= {val} {if {[lsearch $@wires2 $val] < 0} {lappend @wires2 $val}}

def Box changed_wires {} {foreach wire $@wires2 {$wire changed}}

def Box delete_wire {wire} {
  set find [lsearch $@wires2 $wire]
  if {$find != -1} {set @wires2 [lreplace $@wires2 $find $find]}
}

def Box move {dx dy} {
	set @x1 [expr {$@x1+$dx}]; set @y1 [expr {$@y1+$dy}]
	set zoom [$@canvas zoom]
	$self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move.
	$self changed_wires
}

# temporary hack... only used during the moving of objects.
def Box backupxy= {xy} {set @backupxy $xy}
def Box backupxy    {} {return $@backupxy}

# the only one sending to the server.
# View position= is when getting position from server.
# View xy is virtual (for GOP)
def Box moveto {x1 y1} {
	netsend [list .$@canvas object_moveto $self $x1 $y1]
	[$@canvas history] add [list $self moveto $@x1 $@y1]
	if {[$self class] == "Canvas"} {
		if {[$self gop] && ![winfo exists .$self.c]} {foreach x $@visibles {$x changed}}
	}
	set @x1 $x1
	set @y1 $y1
	$self changed
	$self draw_wires
}

def Box draw_io2 {which n color} {
	for {set i 0} {$i<$n} {incr i} {
		set points [$self io_bbox $which $i]
		$self item [list $which$i $which] rectangle $points -outline $color -fill $color -width 1
		[[$self get_canvas] widget] raise $self$which$i
	}
}

def Box draw_io {} {
    $self draw_io2 i $@ninlets  [$self look inletfg]
    $self draw_io2 o $@noutlets [$self look outletfg]
}

def Box tips= {tips} {set @tips $tips}

def Box tip {type port} {
	if {[info exists @tips]} {
		set tips $@tips
	} else {
		netsend [list .$@canvas object_get_tips $self]
		#after 500 $self tip $type $port
		set tips ""
	}
	switch $type {
		i {return "inlet $port: [lindex $tips $port]"}
		o {return "outlet $port"}
	}
}

# type is i or o
def Box hilite_io {type x y} {
	mset {x1 y1 x2 y2} [$self bbox]
	set xs [expr $x2-$x1]
	set c [$@canvas widget]
	switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}
	set port -1
	set iowidth [$self look iowidth]

	for {set n 0} {$n<$ports} {incr n} {
		set tag $self$type$n
		set area [lmap / [$c bbox $self$type$n] [$@canvas zoom]]
		set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
		set dist [expr abs($x - $center)]
		if {$dist < [expr ($iowidth/2)+5] && $dist > 0} {set port $n}
	}

	if {$ports==0 | $port==-1} return
	if {$port >= $ports} {set port [expr $ports-1]}
	$self hilite_io_2 $type $port
	if {[$self look tooltip]} {$@canvas show_tooltip $x $y [$self tip $type $port] $type}
	return $port
}

def Box update_hilite_io {} {
	if {![llength $@ioselect]} {return}
	set type [lindex $@ioselect 1]
	set zoom [$@canvas zoom]
	set port [lindex $@ioselect 0]
	set p $type$port
	$self hilite_io_2 $type $port
}

def Box hilite_io_2 {type port} {
	set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}]
	set box [l+ [$self io_bbox $type $port] [list -3 -3 +3 +3]]
	$self item $type${port}b rectangle $box -outline $outline -width 1
}

#def Box popup_help {} {netsend [list pd help $@pdclass]}
def Box popup_help {} {netsend [list .$@canvas object_help $self]}

def Box show_error {text} {
	regsub "\n" $text "" text
	#mset {x1 y1 x2 y2} [$self bbox]
	#[$self get_canvas] show_tooltip [expr $x2+4] [expr ($y1+$y2)/2] $text object 1
	mset {x1 y1 x2 y2} [$self bbox]
	mset {x y} [rect_centre [$self io_bbox i 0]]
	[$self get_canvas] show_tooltip $x $y $text i 1
}

def Canvas macro_event_append {e obj} {
	if {![llength $@macro_q]} {after $@macro_delay [list $self macro_schedule $@macro_delay] $obj}
	lappend @macro_q $e
}

def Canvas get_clipboard {obj} {
	puts "get clipboard"
	set content [clipboard get]
	set l {}; set s ""; set space " ";
	set last_newline [string last ";" $content]
	#foreach char [split $content ""] {lappend l [scan $char %c]}
	set i 0
	foreach char [split $content ""] {
		if {$i == $last_newline} {break}
		#if {$char == ";"} {set s ${s}${space}list} {set s ${s}$char}
		if {$char != ";"} {
			if {$char == "\n"} {
				set s ${s}${space}$char
			} else {
				set s ${s}$char
			}
		}
		incr i
	}
	netsend [concat [list .$obj clipboard_set] $s]
}


def Canvas macro_schedule {delay obj} {
	if {[llength $@macro_q]} {
		set w [focus]
		set m [lindex $@macro_q 0]
		set fudge 0
		mset {event x y mode k} $m
		switch $event {
			key {set name [modekey $k $mode]; set fudge 1}
			click {set name [modeclick $k $mode ButtonPress]; set fudge 1}
			unclick {set name [modeclick $k $mode ButtonRelease]; set fudge 1}
			bang {
				after $delay [list $self macro_schedule $@macro_delay] $obj
				netsend [list .$obj mbang]
				set @macro_q [lreplace $@macro_q 0 0]
				return
			}
			default {puts "Error: this event $event should not have been here.."}
		}
		if {$fudge} {event generate $w <Motion> -x $x -y $y}
		event generate $w <$name> -x $x -y $y
		#puts "event generate $w <$name> -x $x -y $y"
		if {$event=="key"} {event generate $w <KeyRelease-$k> -x $x -y $y}
		set @macro_q [lreplace $@macro_q 0 0]
		after $delay [list $self macro_schedule $@macro_delay] $obj
	}
}

def Canvas foobar {} {$self macro_schedule 1000}

def Canvas macro_q {} {puts "$@macro_q"}
#-----------------------------------------------------------------------------------#
class_new Wire {View}

def Wire canvas= {c} {
	super $c
	mset {from outlet to inlet} $@connects
	set children [$c objects]
	set @from [$children get $from]
	set   @to [$children get $to]
	$@from wires2+= $self; $@to wires2+= $self
}

def  Box index= {i} {super $i; if {$@canvas != ""} {[$@canvas objects] set $i $self}}
def Wire index= {i} {super $i;                      [$@canvas   wires] set $i $self }

def Wire init {mess} {
	super
	$self reinit $mess
}

def Wire reinit {mess} {
	if {[$::macro state]} {$::macro append_ref $mess}
	mset {x msg from outlet to inlet canvas} $mess
	set @connects [list $from $outlet $to $inlet]
	set @outlet $outlet
	set @inlet $inlet
	$self outside_of_the_box
}

def Wire   from {} {return $@from}
def Wire outlet {} {return $@outlet}
def Wire     to {} {return $@to}
def Wire  inlet {} {return $@inlet}
def Wire move {dx dy} {$self changed}

# DON'T do the former, it's so horribly slow
#def View draw_wires {} {foreach wire $_($@canvas:wires) {$wire changed}}
def View draw_wires {} {foreach wire $@wires2 {$wire changed}}

def Wire bbox {} {
	set from $@from; set outlet $@outlet
	set   to $@to;   set  inlet  $@inlet
	set zoom [$@canvas zoom]
	set c [$@canvas widget]
	mset {x1 y1} [lmap / [rect_centre [$c bbox ${from}o${outlet}]] $zoom]
	mset {x2 y2} [lmap / [rect_centre [$c bbox   ${to}i${inlet} ]] $zoom]
	list $x1 $y1 $x2 $y2
}

def Wire xy {} {
	mset {x1 y1 x2 y2} [$self bbox]
	list [expr $x1 + (($x2-$x1)*0.05)] [expr $y1 + (($y2-$y1)*0.05)]
}

def Wire report {} {list $@from $@outlet $@to $@inlet}
def Wire connects {} {return $@connects}
proc xys {x1 y1 x2 y2} {
	return [list $x1 $y1 $x2 $y2] ;# just a straight line, no frills
	set r {}
	lappend r $x1 $y1
	set dx [expr $x2-$x1]
	set dy [expr $y2-$y1]
	set d [expr sqrt($dx*$dx+$dy*$dy)]
	set n [expr 1+$d/10]
	for {set i 1} {$i<$n} {incr i} {
		set w $i*($n-$i)/(0.0+$n*$n)
		lappend r [expr $x1 + $dx*$i/$n + $dy*(rand()-0.5)*$w]
		lappend r [expr $y1 + $dy*$i/$n - $dx*(rand()-0.5)*$w]
	}
	lappend r $x2 $y2
	return $r
}

def Wire draw {} {
	set zoom [$@canvas zoom]
	set c [$@canvas widget]
	set iowidth [$@from look iowidth]
	mset {ox1 oy1 ox2 oy2} [$@from io_bbox o $@outlet]
	mset {ix1 iy1 ix2 iy2} [  $@to io_bbox i $@inlet]
	set x1 [expr ($ox1+$ox2)/2.0]; set y1 $oy2
	set x2 [expr ($ix1+$ix2)/2.0]; set y2 $iy1
	set xys [xys $x1 $y1 $x2 $y2]
	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
	# how to customise the arrow size/shape?
	set arrowsize [expr $length<100 ? $length/10 : 10]
	if {$arrowsize < 5} {set arrow none} {set arrow last}
	set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]]
	set wire_width [$self look thick]
	set wire_color [$self look fg]
	if {[$self selected?]} {
	    set wire_color [$self look fg2] ;# fg2 should be renamed
	} else {
	    if {[info exists _($@from:text)] && [info exists _($@to:text)]} {
		if {[regexp -nocase {~$} [lindex $_($@from:text) 0]] && \
		    [regexp -nocase {~$} [lindex   $_($@to:text) 0]]} {
			set wire_width [expr $wire_width*2]
		}
	    }
	}
	set options {}
	if {[$self look wirearrow]} {lappend options -arrow $arrow -arrowshape $arrowshape}
	eval [concat [list $self item WIRE line $xys -width $wire_width -smooth yes -fill $wire_color] $options]
}

def Wire delete {} {
	$self unsubscribe $@canvas
	$@from delete_wire $self
	$@to   delete_wire $self
	[$@canvas wires] unset $@index
	super
}

def Wire popup_insert {} {
	if {![llength [$@canvas selection_wire]]} {$@canvas selection_wire= $self}
	mset {x y} [$@canvas insertxy]
	$@canvas do_insert_obj $x $y
}

#-----------------------------------------------------------------------------------#
############ colouring

proc color_* {c1 c2} {
	scan $c1 #%02x%02x%02x r g b
	scan $c2 #%02x%02x%02x R G B
	return [format #%02x%02x%02x [expr ($r*$R)>>8] [expr ($g*$G)>>8] [expr ($b*$B)>>8]]
}

# equivalent to color* #c0c0c0 $c
proc darker {c} {
	scan $c #%02x%02x%02x r g b
	set r [expr $r*3/4]
	set g [expr $g*3/4]
	set b [expr $b*3/4]
	return [format #%02x%02x%02x $r $g $b]
}

proc brighter {c} {
	scan $c #%02x%02x%02x r g b
	set r [min 255 [expr $r*4/3]]
	set g [min 255 [expr $g*4/3]]
	set b [min 255 [expr $b*4/3]]
	return [format #%02x%02x%02x $r $g $b]
}


proc parse_color {c} {
	regsub {;$} $c {} c
	if {$c<0} {
		set c [expr ~$c]
		set r [expr round((($c>>12)&63)*255/63)]
		set g [expr round((($c>> 6)&63)*255/63)]
		set b [expr round((($c>> 0)&63)*255/63)]
		return [format #%02x%02x%02x $r $g $b]
	} {
		global preset_colors2
		return #[lindex $preset_colors2 $c]
	}
}

proc unparse_color {c} {
	if {[string index $c 0]=="#"} {set c [string replace $c 0 0 0x]}
	set r [expr round((($c>>16)&255)*63/255)]
	set g [expr round((($c>> 8)&255)*63/255)]
	set b [expr round((($c>> 0)&255)*63/255)]
	return [expr ~0[format %02o%02o%02o $r $g $b]]
}

############ data transfer
# note: @pdclass is the server-side class name
#  and   @_class is the client-side class name

# abstract classes
set fields1 {foo bar x1 y1 class}
set fields2 {snd rcv lab ldx ldy fstyle fs bcol fcol lcol}

# real classes
set fields(tgl)    [eval list $fields1    w                  isa   $fields2 on nonzero]
set fields(bng)    [eval list $fields1    w hold break       isa   $fields2]
set fields(nbx)    [eval list $fields1    w h min max is_log isa   $fields2 val log_height]
set fields(hsl)    [eval list $fields1    w h min max is_log isa   $fields2 val steady]
set fields(hradio) [eval list $fields1    w change           isa n $fields2 on]
set fields(vu)     [eval list $fields1    w h        rcv lab ldx ldy fstyle fs bcol lcol scale isa]
set fields(cnv)    [eval list $fields1 hh w h    snd rcv lab ldx ldy fstyle fs bcol lcol       isa]
set fields(vsl)    $fields(hsl)
set fields(vradio) $fields(hradio)
set fields(hdl)    $fields(hradio)
set fields(vdl)    $fields(hradio)
set fields(coords)     {foo bar xfrom yfrom xto yto w h gop x1 y1} ;# goes with #N canvas
set fields(floatatom)  {foo bar x1 y1 w min max pos lab rcv snd}
set fields(symbolatom) {foo bar x1 y1 w min max pos lab rcv snd}
set fields(array)      {name n elemtype flags}

proc classinfo {pdclass _class} {
	global classinfo classinfo2
	set classinfo($pdclass) $_class
	set classinfo2($_class) $pdclass
}

# basic patchables
classinfo obj        ObjectBox
classinfo message    MessageBox
classinfo floatatom  FloatBox
classinfo symbolatom SymbolBox
classinfo text       Comment

# non-patchables (scalars, arrays, ...)
classinfo array    Array

# GUI patchables
classinfo bng      Bang
classinfo tgl      Toggle
classinfo nbx      NumBox
classinfo hsl      Slider
classinfo vsl      Slider
classinfo vu       Vu
classinfo hradio   Radio
classinfo vradio   Radio
classinfo hdl      Radio
classinfo vdl      Radio
classinfo canvas   Canvas
classinfo cnv      Cnv
classinfo display    Display

# remember, _($foo:$bar) notation should die
# because objects ought to be autonomous.

# in array objects, number of inlets is bogus?
#X array array1 1 float 3;
#A 0 0;

def View index= {i} {set @index $i}
def View index {} {return $@index}

proc change {self canvas index e {ninlets 0} {noutlets 0} {valid 1}} {
	foreach mess [pd_mess_split $e] {change_2 $self $mess}
	#the server ought to take care of this:
	#if {[lindex $e 1] == "array"} {set ninlets 0; set noutlets 0}
	if {$canvas != "x0"} {$self   canvas= $canvas}
	$self    index= $index
	$self  ninlets= $ninlets
	$self noutlets= $noutlets
	if {[$self class] == "ObjectBox"} {$self valid= $valid}
	if {[$self class] == "Canvas"} {
		if {[$self subpatch]} {$self valid= $valid}
		if {[$self gop]} {$self valid= $valid}
		if {[$self abs]} {$self valid= $valid}
	}
	$self changed
}

proc change_2 {self mess} {
	set isnew [expr ![info exists ::_($self:_class)]]
	switch -- [lindex $mess 0] {
		"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
		"#X" {
			set i 1
			# would it be possible to merge floatatom,symbolatom as gatom ?
			switch -- [lindex $mess 1] {
				obj        {set class [lindex $mess 4]}
				msg        {set class message}
				default    {set class [lindex $mess 1]}}
			if {[info exists ::classinfo($class)]} {
				set _class [lindex $::classinfo($class) 0]
			} else {
				if {[lindex $mess 1] == "connect"} {
					set _class Wire
				} else {
					set _class ObjectBox
				}
			}
			if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
			switch -- $class {
				floatatom  {set class gatom}
				symbolatom {set class gatom}
				array {$self length= [lindex $mess 3]; $self name= [lindex $mess 2]}
				default {$self position= [lrange $mess 2 3]}}
			$self pdclass= $class
		}
		"#A" {
			#post "#A: $mess"
			$self array_set [lrange $mess 2 end]
		}
		"#V" {
			#post "#V: $mess"
		}
		default {if {$mess != ""} {error "what you say? «[lindex $mess 0]» in «$mess»"}}
	}
}

#proc pasting_count {self} {
#	global paste _
#	if {$paste(count2) != $paste(count)} {incr paste(count2)}
#}

# split at message boundaries and atom boundaries, returning a list of lists of atoms.
# spaces    get  temporary value \x01
# A_SEMI    gets temporary value \x02
# backslash gets temporary value \x03
# A_COMMA is not handled yet
proc pd_mess_split {s} {
	set s [regsub -all {\\\\} $s "\x03"]
	set s [regsub -all {(^|[^\\]);}          $s "\\1\x02"]
	set s [regsub -all {(^|[^\\])[\s\n]+}    $s "\\1\x01"]
	set s [regsub -all {^\n}                 $s "\x01"] ;# oops
	set s [regsub -all {\\([\\; \{\}])} $s "\\1\\2"]
	set s [regsub -all \x03 $s \\]
	set r {}
	foreach m [split $s \x02] {
		set m [regsub -all "\x01+" $m "\x01"]
		set m [regsub -all "^\x01" $m ""]
		set t [split $m \x01]
		lappend r $t
	}
	return $r
}

proc canonical_list {list} {
	set r {}
	foreach e $list {lappend r $e}
	return $r
}

proc pd_mess_split_want== {a b} {
	set b [canonical_list $b]
	set c [pd_mess_split $a]
	if {[string compare $c $b]} {
		puts "[VTred]string     «$a»\nparses to  «$c»\ninstead of «$b»[VTgrey]"
	} else {
		puts "[VTgreen]string     «$a» OK[VTgrey]"
	}
}

if 0 {
	pd_mess_split_want== {foo;bar;baz;a\;;b\\;c\\\;;d\\\\;e} {foo bar baz {{a;}} {b\\} {{c\;}} {{d\\}} e}
	pd_mess_split_want== {foo\ bar} {{{foo bar}}}
	pd_mess_split_want== {foo \  bar\ foo\ bar foo} {{foo { } {bar foo bar} foo}}
	pd_mess_split_want== {\\ \\\\ \\\\\\ \ \\\ \\\\\ one} [list [list "\\" "\\\\" "\\\\\\" "\ \\\ \\\\\ one"]]
	pd_mess_split_want== "\n  \n   \n  foo" foo
	pd_mess_split_want== "\\\x7b\\\x7b\\\x7b\\\x7b" [list [list "\x7b\x7b\x7b\x7b"]]
	pd_mess_split_want== "\\\x7d\\\x7d\\\x7d\\\x7d" [list [list "\x7d\x7d\x7d\x7d"]]
	exit
}

############ rendering

class_new MessageBox {TextBox}

def MessageBox init {mess} {
	super $mess
	set @w 15 ;# this is useless?
	set @xs $@w
	set @ys $@w ;# this is a bug
}

def MessageBox draw_box {} {
	mset {x1 y1} [$self xy]
	set x2 [expr $x1+$@xs]
	set y2 [expr $y1+$@ys]
	set points [list $x1 $y1 [expr $x2+4] $y1 $x2 [expr $y1+4] $x2 [expr $y2-4] [expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
	$self item BASE polygon $points -fill [$self look bg] -outline $frcol -width 1
	[$@canvas widget] lower ${self}BASE ${self}TEXT
	[$@canvas widget] raise $self
}

def MessageBox draw {} {
	super
	$self draw_io
}

def MessageBox click {x y f target} {
	$self bang 1
	netsend [list .$self bang]
	after 150 $self bang 0
}

def MessageBox bang {flag} {
	if {$flag} {set color #ffff00} {set color [$self look bg]}
	[$@canvas widget] itemconfigure ${self}BASE -fill $color
}

# it was class_new AtomBox {View Box}, which is wrong because already Box<View
# it shouldn't have mattered, but super doesn't support proper pruning yet
#class_new AtomBox {Box}
class_new AtomBox {TextBox}
def AtomBox draw_box {} {
	$self update_size
	mset {x1 y1 x2 y2} [$self bbox]
	set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
	$self item BASE polygon $points -fill [$self look bg] -outline $frcol
	[[$self get_canvas] widget] lower ${self}BASE ${self}TEXT
	$self draw_io
}

def AtomBox clear {var} {set @clear $var}
def AtomBox clear= {} {return $@clear}

def AtomBox filter_text {{for_edit 0}} {
	if {$for_edit} {return ""}
	if {[string length $@text] <= $@w} {return $@text}
	return [string range $@text 0 [expr $@w-1]]
}

def AtomBox update_size {} {
	set width [font measure [$self look font] 0]
	set ls [font metrics [$self look font] -linespace]
	set @xs [expr ($width*$@w)+3]
	set @ys [expr $ls+3]
}

class_new Comment {TextBox}

def Comment draw_box {} {
	super
        mset {x1 y1} [$self xy]
	set x2 [expr $x1+$@xs]
        set y2 [expr $y1+$@ys]
        set xya [list $x1 $y1 $x2 $y2]
	set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
	set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
	if {[$@canvas editmode]} {
		if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
		$self item BASE  rectangle $xya -fill [$self look bg] -outline $frcol
	} else {
		$self item_delete BASE
	}
	#$self item BASE1 line      $xyb -fill [$self look frame1]
	#$self item BASE2 line      $xyc -fill [$self look frame2]
	if {[$@canvas editmode]} {
		[$@canvas widget] lower ${self}BASE ${self}TEXT
		#[$@canvas widget] raise ${self}BASE1 ${self}BASE
		#[$@canvas widget] raise ${self}BASE2 ${self}BASE
	}
}

class_new Display {Box}

def Display height= {val} {set @height $val}

def Display init {{mess {}}} {
	set font [$self look font]
	set fw [font measure $font 0]
	set @max_width 40; #in chars
	set @wrap [expr $fw*$@max_width]; #in pixels
	set @content {display}
	set @height 1
	set @xs [expr [font measure [$self look font] 0]+3]
	set @ys [font metrics [$self look font] -linespace]
	set @textoffset [list 2 2]
	netsend [list .$self height]
	super $mess
}

def Display draw {} {
	super
	set font [$self look font]
	mset {x y} [$self xy]
	mset {xf yf} $@textoffset
	set fh [font metrics [$self look font] -linespace]
	set text [lindex $@content 0];
	for {set i 1} {$i < $@height} {incr i} {set text ${text}\n[lindex $@content $i]}
	set h 0; set w 0
	foreach line $@content {
		set tw [font measure $font $line]
		set h [expr int(ceil($tw/$@wrap.0)+$h)]
		set w [min [max $w $tw] $@wrap]
	}
	set h [max $h 1]
	$self item BASE rect [list $x $y [expr $x+$w+$xf+2] [expr $y+($@ys*$h)+$yf+1]] \
	    -fill [$self look bg]

	$self item TEXT text [l+ $@textoffset [$self xy]] -font $font -text $text \
	    -fill [$self look fg] -anchor nw -width $@wrap
	$self draw_io
}

def Display dis {text} {
	lappend @content $text
	if {[llength $@content] > $@height} {set @content [lrange $@content 1 end]}
	$self changed
}

class_new IEMGUI {}
def IEMGUI text {} {
	return [$self class]
}
class_new BlueBox {Labelled IEMGUI Box}
#class_new BlueBox {Box Labelled}

def BlueBox draw_box {} {
	super
	set xya [$self bbox]
	mset {x1 y1 x2 y2} $xya
	set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
	set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
	set color [color_* [$self look bg] [parse_color $@bcol]]
	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
	$self item BASE  rectangle $xya -fill $color -outline $frcol
	#below lines draws the 3d box edge
	#$self item BASE2 line      $xyb -fill #ffffff
	#$self item BASE3 line      $xyc -fill [darker $color]
	$self draw_io
}

def IEMGUI popup_properties {} {IEMPropertiesDialog new $self}

class_new PropertiesDialog {Dialog}

def PropertiesDialog init {of} {
	super cancel apply ok
	set @of $of
	set f .$self
	checkbutton $f.auto_apply -text [say auto_apply] -anchor w -variable @auto_apply
	frame $f.buttonsep2 -height 2 -borderwidth 1 -relief sunken
	pack $f.auto_apply $f.buttonsep2 -side bottom -fill x
	bind $f <KeyPress-Return> "break";#so that Return don't call do_auto_apply after Dialog ok
	bind $f <KeyPress>        [list $self do_auto_apply]
	bind $f <ButtonRelease>   [list $self do_auto_apply]
	set @auto_apply 0
	$self none_resizable
}

def PropertiesDialog do_auto_apply {} {
	if {$@auto_apply} {$self apply}
}

class_new IEMPropertiesDialog {PropertiesDialog}

def IEMGUI properties_apply {list {orient -1}} {
	set orig [list $self properties_apply]
	foreach var [lrange $::fields($@class) 5 end] {lappend orig $@$var}
	[$@canvas history] add $orig
	foreach v $list {switch -- $v {{} {set v "empty"}}; lappend props $v}
	netsend [concat [list .$self reload] $props]
	if {$orient >= 0} {
		netsend [list .$self orient $orient]
	}
}

def IEMPropertiesDialog apply {} {
	set class $_($@of:class)
	set props {}
	foreach var [lrange $::fields($class) 5 end] {
		set v $@$var
		if {[regexp -nocase {^[bfl]col$} $var]} {set v [unparse_color $v]}
		lappend props $v
	}
	if {[[$@of class] <= Slider] || [[$@of class] <= Radio]} {
		$@of properties_apply $props $@orient
	} else {
		$@of properties_apply $props
	}
}

def IEMPropertiesDialog init {of} {
	super $of
	set @class $_($of:class)
	wm title .$self "\[$@class\] [say popup_properties]"
	if {![info exists ::fields($@class)]} {set class obj}
	foreach var $::fields($@class) {
		set val $_($of:$var)
		switch -- $val { empty {set val ""}}
		if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]}
		set @$var $val
	}
	if {[[$of class] <= Slider] || [[$of class] <= Radio]} {
		set @orient $_($of:orient)
		$self add .$self [list orient choice -choices {horizontal vertical}]
	}
	foreach prop [lrange $::fields($@class) 5 end] {
		set d [concat [list $prop] [switch $prop {
			w      {list integer -width 7}
			h      {list integer -width 7}
			hold   {list float   -width 9}
			break  {list float   -width 9}
			min    {list float   -width 9}
			max    {list float   -width 9}
			is_log {list choice  -choices {linear logarithmic}}
			isa    {list choice  -choices {no yes}}
			n      {list integer -width 4}
			steady {list choice  -choices {steady_no steady_yes}}
			snd    {list entry   -width 20}
			rcv    {list entry   -width 20}
			lab    {list entry   -width 20}
			ldx    {list integer -width 5}
			ldy    {list integer -width 5}
			fstyle {list choice  -choices {Courier Helvetica Times}}
			fs     {list fontsize -width 5}
			bcol   {list color}
			fcol   {list color}
			lcol   {list color}
			val    {continue}
			on     {continue}
			change {list choice -choices {no yes}}
			nonzero {list float -width 9}
			log_height {list float -width 9}
			hh {continue}
			scale {list toggle}
			default {error "huh? ($prop)"}
		}]]
		$self add .$self $d
	}
}

def IEMPropertiesDialog dropmenu_open {f name} {super $f}
def IEMPropertiesDialog dropmenu_set {frame var part val} {
	switch $var {
		orient {if {[$@of class] == "Slider"} {set tmp $@h; set @h $@w; set @w $tmp}}
		default {}
	}
	set tmp ${var}choices
	set textvar ${var}2
	set @$textvar [say [lindex $@$tmp $val]]
	super $frame $var $part $val
	$self do_auto_apply
}

class_new CanvasPropertiesDialog {PropertiesDialog}

def CanvasPropertiesDialog init {of} {
	super $of
	set @canvas $of
	wm title .$self "[say canvas] [say popup_properties]"
	set @gop [$of gop]
	set @properties [list "gop" "xfrom" "xto" "yfrom" "yto" "width" "height" "xmargin" "ymargin"]
	set mess [$of get_mess]
	mset [list @xfrom @yfrom @xto @yto @width @height @xmargin @ymargin] $mess
	if {!$@width} {set @width 85}; if {!$@height} {set @height 60}
	$self add .$self [list gop toggle -command "$self gop_setting"]
	for {set i 1} {$i<[llength $@properties]} {incr i} {
		$self add .$self [list [lindex $@properties $i] integer -width 7]
	}
	$self gop_setting
}

def CanvasPropertiesDialog gop_setting {} {
	set entries [lrange $@properties 1 end]
	foreach entry $entries {
		if {!$@gop} {
			.$self.$entry.entry configure -state disable
		} else {
			.$self.$entry.entry configure -state normal
		}
	}
}

def CanvasPropertiesDialog apply {} {
	if {![$@canvas editmode]} {$@canvas editmode= 1}
	netsend [list .$@of coords $@xfrom $@yfrom $@xto $@yto $@width $@height $@gop $@xmargin $@ymargin]
}

proc gatom_escape {sym} {
	if {[string length $sym] == 0} {return "-"}
	if {[string equal -length 1 $sym "-"]} {return [string replace $sym 0 0 "--"]}
	return $sym
}

proc gatom_unescape {sym} {
	if {[string equal -length 1 $sym "-"]} {return [string replace $sym 0 0 ""]}
	return $sym
}

class_new BoxPropertiesDialog {PropertiesDialog}
def Box popup_properties {} {BoxPropertiesDialog new $self}
def Box popup_clear_wires {} {[$self canvas] selection= $self; [$self canvas] clear_wires}
def Box popup_remove_from_path {}   {[$self canvas] selection= $self; [$self canvas] remove_obj_from_path}
def Box popup_delete_from_path {}   {[$self canvas] selection= $self; [$self canvas] delete_obj_from_path}
def BoxPropertiesDialog init {of} {
	super $of
	wm title .$self "Box Properties"
	pack [label .$self.huh  -text "huh..."]
	pack [label .$self.huh2 -text "this is where some #V properties should go"]
}

class_new WirePropertiesDialog {PropertiesDialog}
def Wire popup_properties {} {WirePropertiesDialog new $self}
def WirePropertiesDialog init {of} {
	super $of
	wm title .$self "Wire Properties"
	pack [label .$self.huh  -text "huh..."]
	pack [label .$self.huh2 -text "this is where some #V properties should go"]
}

class_new GAtomPropertiesDialog {PropertiesDialog}

def AtomBox popup_properties {} {GAtomPropertiesDialog new $self}

# this is buggy due to miller's escapes vs iem's escapes.
def GAtomPropertiesDialog apply {} {
	netsend [list .$@of reload $@w $@min $@max $@pos [gatom_escape $@lab] [gatom_escape $@rcv] [gatom_escape $@snd]]
}

def GAtomPropertiesDialog init {of} {
	super $of
	foreach var {w min max pos} {set @$var $_($of:$var)}
	foreach var {lab rcv snd} {set @$var [gatom_unescape $_($of:$var)]}
	wm title .$self "Atom"
	global properties
	$self add .$self \
	    {w   entry -width 4} \
	    {min entry -width 8} \
	    {max entry -width 8} \
	    {lab entry -width 20} \
	    {pos side} \
	    {snd entry -width 20} \
	    {rcv entry -width 20}
	#foreach name {w min max} {bind .$self.$name.entry <KeyPress-Return> "$self ok"}
	.$self.w.entry select from 0
	.$self.w.entry select adjust end
	focus .$self.w.entry
}

class_new GraphPropertiesDialog {Dialog}

def GraphPropertiesDialog apply {} {
	netsend [list .$@of dialog $@x1 $@y1 $@x2 $@y2 $@xpix $@ypix]
}

def GraphPropertiesDialog init {of} {
	super $of
	foreach var {x1 y1 x2 y2 xpix ypix} {set @$var $_($of:$var)}
	wm title .$self "Graph"
	pack [label .$self.label -text "GRAPH BOUNDS"] -side top
	global properties
	$self add .$self {
		{x1   entry -width 7} \
		{x2   entry -width 7} \
		{xpix entry -width 7} \
		{y2   entry -width 7} \
		{y1   entry -width 7} \
		{ypix entry -width 7}
	}
	#.$self.xrangef.x2 select from 0
	#.$self.xrangef.x2 select adjust end
	#focus .$self.xrangef.x2
}

class_new ArrayPropertiesDialog {Dialog}

def ArrayPropertiesDialog apply {} {
	regsub {^\$} $@name "#" name
	netsend [list .$@apply arraydialog $name $@n $@saveit $@otherflag]
}

def ArrayPropertiesDialog init {of} {
	super $of
	foreach var {name n saveit} {set @$var $_($of:$var)}
	set @otherflag 0
	wm title $id "[say array] [say popup_properties]"
	$self add .$self {name entry} {n entry}
	pack [checkbutton .$self.saveme -text "save contents" -variable @saveit -anchor w] -side top
	if {$newone} {
		pack [frame .$self.radio] -side top
		foreach {i label} {0 "in new graph" 1 "in last graph"} {
			pack [radiobutton .$self.radio.radio$i -value $i -variable @otherflag -text $label] -side top -anchor w
		}
	} else {
		pack [checkbutton .$self.deleteme -text "delete me" -variable @otherflag -anchor w] -side top
	}
	if {$newone} {.$self.buttonframe.apply configure -state disabled}
	bind .$self.name.entry <KeyPress-Return> "$self ok"
	bind .$self.n.entry    <KeyPress-Return> "$self ok"
	.$self.name.entry select from 0
	.$self.name.entry select adjust end
	focus .$self.name.entry
}

class_new FloatBox  {AtomBox}
class_new SymbolBox {AtomBox}

def AtomBox init {mess} {
	super $mess
	set @clickpos {}
	set width [font measure [$self look font] W]
	set height [font metrics [$self look font] -linespace]
	set @xs [expr ($width*$@w)+3]
	set @ys [expr $height+3]
}

def FloatBox  init {mess} {super $mess; set @text 0;}

def FloatBox calc {x y x1 y1} {
	#puts "$@min $@max"
	if {!$@min && !$@max} {
		set d [expr $@ovalue+($y1-$y)*$@rate]
	} else {
		set span [expr $@max-$@min]
		set l [expr $@max-$@min]
		set d [clip [expr $@ovalue+(($y1-$y)*$span/($l+0.0))*$@rate] $@min $@max]
	}
	return $d
}

def SymbolBox init {mess} {super $mess; set @text "symbol"}

def AtomBox set {val} {set @text [format "%g" $val]; $self changed}

def AtomBox setto {text} {
	[$@canvas widget] configure -cursor {}
	if { [string is double $text]} {
		set @text $text; #so that the text gets updated immediately
		netsend [list .$self float  $text]
		#[$self get_canvas] selection-= $self
	}
}
def SymbolBox set {text} {set @text $text}
def SymbolBox setto {text} {
	[$@canvas widget] configure -cursor {}
	if {![string is double $text]} {netsend [list .$self symbol $text]}
}

def FloatBox ftoa {} {
	set f $@val
	set is_exp 0
	if {[string length $@buf]>0} {return $@buf}
	set buf [format %g $f]
	set bufsize [string length buf]
	if {$bufsize >= 5} {
		# exponential mode
		set is_exp [regexp -nocase e]
	}
	if {$bufsize > $@w} {
		# must shrink number
		if {$is_exp} {
			#...
		} {
			#...
		}
	}
	return $buf
}

def AtomBox click {x y f target} {
	set @clickx $x; set @clicky $y
	set canvas [$self get_canvas]
	set t [$canvas widget].${self}text
	set @ovalue [clip $@text $@min $@max]
	set @clickpos [list $x $y]
	set @mouse [list $x $y]
	$canvas focus= $self
	set @rate [expr $f&1 ? 0.01 : 1.00]
}

def AtomBox unclick {x y f target} {
	if {$x == $@clickx && $y == $@clicky} {$self edit}
	[$self get_canvas] focus= ""
}

def AtomBox motion {x y f target} {
	if {$@edit} {return}
	mset {clx cly} $@clickpos
	set @text [$self calc $x $y $clx $cly]
	netsend [list .$self float [expr {0+$@text}]]
}

def AtomBox log_ratio {} {
	set diff [expr $@is_log ? log($@max/$@min) : ($@max-$@min)]
	return [expr $diff / $@max]
}

def AtomBox key_incr {val1 val2} {
	set @text [expr $@text - $val2]
	netsend [list .$self float [expr {0+$@text}]]
}

def SymbolBox motion {x y f target} {}
class_new NumBox {Labelled IEMGUI AtomBox}

def NumBox init {mess} {
	super $mess
	set @clicking 0
	set changed 0
	set @buf ""
	set @text [clip 0 $@min $@max]
}

def NumBox calc {x y x1 y1} {
	set span [expr $@max-$@min]
	set l [expr $@is_log ? $@log_height : ($@max-$@min)]
	set d [expr {($y1-$y)*$span/($l+0.0)}]
	set d [expr $@is_log ? $@ovalue*exp($d*$@rate*[$self log_ratio]) : $@ovalue+$d*$@rate]
	set d [clip $d $@min $@max]
	return $d
}


def NumBox reinit {mess} {
	super $mess
	set @text $@val
}

def NumBox draw {} {
	super
	mset {x1 y1} [$self xy]
	set xs [expr 4+10*$@w]
	set ys $@h
	set x2 [expr $x1+$xs]
	set y2 [expr $y1+$ys]
	set c [[$self get_canvas] widget]
	set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
	set xt [expr $x1+$ys/2+2]
	set yt [expr $y1+$ys/2+1+$xs/34]
	set points2 [list $x1 $y1 [expr $x1+$ys/2] [expr $y1+$ys/2] $x1 $y2]
	set focused [$self == [$@canvas focus]]
	if {$focused} {set color4 #00ff00} {set color4 [$self look bg]}
	$self item BASE4  polygon $points2 -outline [$self look frame3] -fill $color4
	$c raise ${self}BASE4
}

def NumBox ftoa {} {
	set f $@text
	set is_exp 0
	if {[string length $@buf]>0} {return $@buf}
	set buf [format %g $f]
	set bufsize [string length buf]
	if {$bufsize >= 5} {
		# exponential mode
		set is_exp [regexp -nocase e]
	}
	if {$bufsize > $@w} {
		# must shrink number
		if {$is_exp} {
			#...
		} {
			#...
		}
	}
	return $buf
}

def NumBox unfocus {} {set @buf ""; $self changed}

class_new Radio {BlueBox}

def Radio reinit {mess} {
	super $mess
	switch [lindex $mess 4] {
		hradio {set @orient 0} hdl {set @orient 0}
		vradio {set @orient 1} vdl {set @orient 1}
		default {set @orient 0}
	}
}

def Radio bbox {} {
	mset {x1 y1} [$self xy]
	set x2 [expr $x1+$@w*($@orient ?1:$@n)]
	set y2 [expr $y1+$@w*($@orient ?$@n:1)]
	list $x1 $y1 $x2 $y2
}

def Radio draw {} {
	mset {x1 y1 x2 y2} [$self bbox]
	super
	$self item_delete BUT ;# would be cool if this didn't delete stuff that we're about to redraw.
	for {set i 0} {$i<$@n} {incr i} {
		$self item [list BUT$i BUT] rectangle \
		    [list [expr $x1+3] [expr $y1+3] [expr $x1+$@w-3] [expr $y1+$@w-3]] \
		    -fill #ffffff -outline #000000
		if {$@orient} {set y1 [expr $y1+$@w]} {set x1 [expr $x1+$@w]}
	}
	$self set $@on
}

def Radio set {value} {
	set c [$self get_canvas]
	[$c widget] itemconfigure ${self}BUT       -fill #ffffff
	[$c widget] itemconfigure ${self}BUT$value -fill #000000
}

def Radio click {x y f target} {
	mset {x1 y1} [$self xy]
	set i [expr {($@orient ?$y-$y1:$x-$x1)/$@w}]
	netsend [list .$self fout $i]
}

def Radio key_incr {val1 val2} {
	netsend [list .$self fout [expr $@on - $val2]]
}

class_new Slider {BlueBox}

# in sliders, @value is the kind of value that goes thru inlets and outlets
# whereas @val is always measured in "centipixels" (unzoomed).
def Slider reinit {mess} {
	super $mess
	set @knob_thick 4
	switch [lindex $mess 4] {
		hsl {set @orient 0}
		vsl {set @orient 1}
	}
	$self update_value
}

def Slider update_value {} {
	set span [expr {$@max-$@min}]
	set l [expr $@orient ?$@h:$@w]
	set @value [expr $@val*$span/($l-1)/100]
	#set t [expr $@val * [$self slider_ratio] * 0.01]
	#set @value [expr $@min*exp($t)]
}

def Slider init {mess} {
	super $mess
	set @oposition $@min
	$self update_value
}

def Slider bbox {} {
	mset {x1 y1} [$self xy]
	if {!$@orient} {
		list $x1 $y1 [expr $x1+$@w+$@knob_thick] [expr $y1+$@h]
	} else {
		list $x1 [expr $y1-$@knob_thick] [expr $x1+$@w] [expr $y1+$@h]
	}
}

#the value/centipixel ratio
def Slider slider_ratio {} {
	set diff [expr $@is_log ? log($@max/$@min) : ($@max-$@min)]
	return [expr $diff / ($@orient ? ($@h-1) : ($@w-1))]
}

def Slider draw_knob {} {
	mset {x1 y1 x2 y2} [$self bbox]
	set l [expr $@orient ?$@h:$@w]
	set span [expr {$@max-$@min}]
	set color [$self look bg]
	set scaled [expr {$@value*($l-1)/$span}]
	set thick [expr $@knob_thick/2]
	if {$@orient} {
		set y1 [expr $y1+$@knob_thick]
		set y [expr $y1+$@h-$scaled-2]
		set coords [list [expr $x1+2] $y [expr $x1+$@w-2] [expr $y-2]]
	} else {
		set x2 [expr $x1-$@knob_thick]
		set x [expr $x1+$scaled]
		set coords [list $x [expr $y1+$thick] [expr $x+2] [expr $y1+$@h-$thick]]
	}
	$self item KNOB rectangle $coords -outline red -fill [darker $color]
}

def Slider draw {} {
	mset {x1 y1 x2 y2} [$self bbox]
	#if {$@orient} {set y1 [expr $y1-2]} {set x1 [expr $x1-2]}
	#if {$@orient} {set ys [expr $@h+5]} {set xs [expr $@w+5]}
	super
	$self draw_knob
	$self update_value
}

# not used
def Slider draw_notches {} {
	if {$@orient} {
		set thick [clip [expr $xs/3] 1 5]
		set x3 [expr $x1+$xs-$thick/2-2]
		set eighth [expr round($ys/8-1)]
		set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
	} else {
		set thick [clip [expr $ys/3] 1 5]
		set y3 [expr $y1+$ys-$thick/2-2]
		set eighth [expr $xs/8]
		set coords [list $x1 $y3 [expr $x1+$xs] $y3]
	}
	# there were supposed to be 7 notches... i don't remember what happened here.
	$@canvas item NOTCH $coords -dash [list 1 $eighth 1 $eighth] -width $thick -fill [darker [$self look bg]]
}

def Slider click {x y f target} {
	set canvas [$self get_canvas]
	mset {type id detail} [$canvas identify_target $x $y $f]
	if {$type == "label"} {return}
	$canvas focus= $self
	set @click_at [list $x $y]
	set @rate [expr $f&1 ? 0.01 : 1.00]
	if {!$@steady} {
		mset {x1 y1 x2 y2} [$self bbox]
		set t [expr [$self calc $x $y $x1 $y2]*$@rate]
		set @value [expr $@is_log ? [expr $@min*exp($t*[$self slider_ratio])] : $t]
		set @oposition $t
		netsend [list .$self float $@value]
	} else {set @oposition $@value}
}

def Slider unclick {x y f target} {
	### keep focus if only clicked. do we want that feature?
	# if {[distance $@click_at [list $x $y]] == 0} {return}
	set canvas [$self get_canvas]
	$canvas focus= ""
}

def Slider motion {x y f target} {
	set canvas [$self get_canvas]
	set focused [$self == [$canvas focus]]
	if {!$focused} {return}
	mset {clx cly} $@click_at
	set d [$self calc $x $y $clx $cly]
	set t ($@oposition+$d*$@rate)
	set value [expr $@is_log ? [expr $@min*exp($t*[$self slider_ratio])] : $t]
	set out [clip $value $@min $@max]
	netsend [list .$self float $out]
}

def Slider key_incr {val1 val2} {
	set @value [expr $@value - $val2]
	netsend [list .$self float $@value]
}

def Slider calc {x y x1 y1} {
	set span [expr $@max-$@min]
	set l [expr {$@orient ?$@h:$@w}]
	set d [expr {($@orient ?$y1-$y:$x-$x1)*$span/($l+0.0)}]
	return $d
}

def Slider unfocus {} {$self draw}

class_new Labelled {}

def Labelled draw {} {
	global leet
	super
	mset {x1 y1} [$self xy]
	set lx [expr $x1+$@ldx]
	set ly [expr $y1+$@ldy]
	set label $@lab; switch -- $label { empty { set label "" }}
	set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
	set lcolor [parse_color $@lcol]
	if {$leet} {
		    set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $label]
	    } else {
		    set text $label
	    }
	$self item LABEL text [list $lx $ly] -text $text -anchor w -font $lfont -fill $lcolor
}
#-----------------------------------------------------------------------------------#
class_new Bang {BlueBox}
def Bang init {mess} {
	super $mess
	set @flash 0
	set @count 0
}

def Bang bbox {} {
	mset {x1 y1} [$self xy]
	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
}

def Bang draw {} {
	super
	mset {x1 y1 x2 y2} [$self bbox]
	if {$@flash} {
		set rect [list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]]
		#$self item BUT oval $rect -fill [color_* [$self look bg] [parse_color $@fcol]]
		set fcol [color_* [$self look bg] [parse_color $@fcol]]
		set bcol [color_* [$self look bg] [parse_color $@bcol]]
		$self item BUT oval $rect -fill $fcol
		after 100 [list $self item BUT oval $rect -fill $bcol]
		set @flash 0
	} else {
		set colour [parse_color $@bcol]
		set rect [list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]]
		$self item BUT oval $rect -fill [color_* [$self look bg] $colour] -outline [$self look frame3]
	}
}
def Bang unclick {x y f target} {}
def Bang click   {x y f target} {netsend [list .$self bang]}
def Bang bang {count} {set @count $count; set @flash 1}
def Bang key_incr {val1 val2} {netsend [list .$self bang]}

class_new Toggle {BlueBox}

def Toggle bbox {} {
	mset {x1 y1} [$self xy]
	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
}

def Toggle draw {} {
	super
	mset {x1 y1 x2 y2} [$self bbox]
	set colour [parse_color $@bcol]
	set t [expr int(($@w+29)/30)]
	set fill [color_* [$self look bg] $colour]
	set x3 [expr $x1+$t+2]; set y3 [expr $y1+$t+2]
	set x4 [expr $x2-$t-2]; set y4 [expr $y2-$t-2]
	if {$@on} {
		set fill [parse_color $@fcol]
	} {
		set fill [color_* [$self look bg] [parse_color $@bcol]]
	}
	$self item X1 line [list $x3 $y3 [expr $x4+1] [expr $y4+1]] -width $t -fill $fill
	$self item X2 line [list $x3 $y4 [expr $x4+1] [expr $y3-1]] -width $t -fill $fill
}

def Toggle unclick {x y f target} {}
def Toggle click {x y f target} {
	if {!$@on} {set @on 1} {set @on 0}
	netsend [list .$self float $@on]
	$self changed
}

class_new Vu {IEMGUI Box}

set vu_col {
	0 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
	15 15 15 15 15 15 15 15 15 15 14 14 13 13 13 13 13 13 13 13 13 13 13 19 19 19
}

def Vu init {mess} {
	super $mess
	set @value 0
	set @peak 0
}

def Vu bbox {} {
	mset {x1 y1} [$self xy]
	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
}

def Vu led_size {} {
	set n [expr $@h/40]
	if {$n < 2} {set n 2}
	return [expr $n-1]
}

def Vu draw {} {
	global vu_col
	mset {x1 y1 x2 y2} [$self bbox]
	set colour [parse_color $@bcol]
	super
	$self draw_io
	set led_size [$self led_size]
	set x3 [expr $x1+$@w/4]
	set x4 [expr $x2-$@w/4]
	$self item BASE rectangle [list $x1 $y1 $x2 $y2] -width 0 -fill [color_* [$self look bg] $colour]
	for {set i 1} {$i<=40} {incr i} {
		set y [expr $y1 + ($led_size+1)*(41-$i) - ($led_size+1)/2]
		$self item RMS${i} rectangle [list $x3 $y $x4 [expr $y+$led_size]] \
		    -fill [parse_color [lindex $vu_col $i]] -width 0
	}
	#if {!$@zoom} {return}
	set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
	set lcolor [parse_color $@lcol]
	set i 0
	foreach level { <-99 -50 -30 -20 -12 -6 -2 -0dB +2 +6 >+12 } {
		set k1 [expr $led_size+1]
		set k2 41
		set k3 [expr $k1/2]
		set k4 [expr $y1-$k3]
		set yyy [expr $k4 + $k1*($k2-4*$i)]
		$self item SCALE{$level} text [list [expr $x2+4] [expr $yyy+$k3-3]] \
		    -text $level -anchor w -font $lfont -fill $lcolor
		incr i
	}
	set y [expr $y1 + ($led_size+1)*(41-$@value) - ($led_size+1)/2]
	$self item MASK rectangle [list $x3 $y1 $x4 $y] -width 0 -fill [color_* [$self look bg] $colour]
	set c [lindex $vu_col [expr int($@peak)]]
	set y [expr $y1 + ($led_size+1)*(41-$@peak) - ($led_size+1)/2]
	$self item PEAK rectangle [list $x1 $y $x2 [expr $y+$led_size]] -fill [parse_color $c] -width 0
}

def Vu rms=  {rms } {set @value $rms; $self changed rms}
def Vu peak= {peak} {set @peak $peak; $self changed peak}

def Vu set {i j} {
	set @value $i
	set @peak  $j
	$self changed
}

if {![catch {
	package require tkdnd
	dnd bindtarget . text/uri-list <Drop> {open_file %D}
}]} {
	puts "warning: tkdnd package not found"
}

class_new Cnv {Labelled IEMGUI Box}

def Cnv draw {} {
	mset {x1 y1} [$self xy]
	$self item BASE rectangle [list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]] -fill [parse_color $@bcol]
	super
}

def Cnv bbox {} {
	mset {x1 y1} [$self xy]
	return [list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]]
}

class_new Array {Box}

def Array init {mess} {
	super $mess
	set @name [lindex $mess 2]
	set @length 0
	set @data {}
	set @draw 0
}

def Array bbox {} {
	return {0 0 1 1} ;# huh?
}

def Array draw_name {} {
	mset {x_off y_off} [$@canvas xy]
	$self item TEXT text [lmap + [list $x_off $y_off] 2] \
		    -font [View_look $self font] -text $@name \
		    -fill [View_look $self fg] -anchor nw
}

def Array draw {} {
	$self draw_name
	mset {x_off y_off} [$@canvas xy]
	set m [$@canvas get_mess]
	mset {xfrom yto xto yfrom pixwidth pixheight} $m
	if {[winfo exists [$@canvas widget]]} {
		mset {c_width c_height} [$@canvas get_dimen]
		set width [expr $c_width / $@length]
		set i 0
		foreach val $@data {
			if {!$val} {set val 0.0}
			set y [expr $c_height - (((double($val)+abs($yfrom))/($yto-$yfrom) * $c_height))]
			set x1 [expr $width * $i]
			set x2 [expr $x1 + $width]
			set line [list $x1 $y $x2 $y]
			$self item elem${i} line $line -fill [$@canvas look compfg] -width 2 -tags "$self ${self}elem${i}"
			#.$self.c raise ${self}elem${i}
			incr i
		}
	} else {
		set width [expr $pixwidth / $@length]
		set canvas [$self get_canvas]
		set i 0
		foreach val $@data {
			if {!$val} {set val 0.0}
			#set val2 [lindex $@data [expr $i+1]]
			set y [expr  ($pixheight - ((double($val)+abs($yfrom))/($yto-$yfrom) * $pixheight)) + $y_off]
			#set y2 [expr  ($pixheight - ((double($val2)+abs($yfrom))/($yto-$yfrom) * $pixheight)) + $y_off]
			set x1 [expr ($width * $i) + $x_off]
			set x2 [expr $x1 + $width]
			set line [list $x1 $y $x2 $y]
			$self item ${self}ELEM${i} line $line -fill [$self look fg] -width 2
			incr i
		}
		[$canvas widget] raise $self
		#set width [expr $pixwidth / [expr $@length-1]]
		#set canvas [$self get_canvas]
		#set i 0
		#for {set i 0} {$i < [expr $@length-1]} {incr i} {
		#	#if {!$val} {set val 0.0}
		#	set val [lindex $@data [expr $i]]
		#	set val2 [lindex $@data [expr $i+1]]
		#	set y [expr  ($pixheight - ((double($val)+abs($yfrom))/($yto-$yfrom) * $pixheight)) + $y_off]
		#	set y2 [expr  ($pixheight - ((double($val2)+abs($yfrom))/($yto-$yfrom) * $pixheight)) + $y_off]
		#	set x1 [expr ($width * $i) + $x_off]
		#	set x2 [expr $x1 + $width]
		#	set line [list $x1 $y $x2 $y2]
		#	$self item ${self}ELEM${i} line $line -fill [$self look fg] -width 0
		#}
	}
}

def Array click {x y f target} {
	if {[winfo exists [$@canvas widget]]} {set canvas $@canvas} else {set canvas [$@canvas canvas]}
	$canvas focus= $self
	set @draw 1
}
def Array unclick {x y f target} {
	if {[winfo exists [$@canvas widget]]} {set canvas $@canvas} else {set canvas [$@canvas canvas]}
	$canvas focus= ""
	set @draw 0
}
def Array motion {x y f target} {
	if {!$@draw} return
	if {[winfo exists [$@canvas widget]]} {
		mset {c_width c_height} [$@canvas get_dimen]
		mset {xfrom yto xto yfrom pixwidth pixheight} [$@canvas get_mess]
		set width [expr $c_width / $@length]
		set i [format %d [expr int($x/$width)]]
		set x1 [expr $width * $i]
		set x2 [expr $x1 + $width]
		set line [list $x1 $y $x2 $y]
		set val [expr (($c_height-$y)/$c_height) * ($yto-$yfrom) + $yfrom]
		netsend [list .$self $i $val]
	} else {
		mset {xfrom yto xto yfrom pixwidth pixheight} [$@canvas get_mess]
		mset {x_off y_off} [$@canvas xy]
		set width [expr $pixwidth / $@length]
		set i [format %d [expr int(($x-$x_off)/$width)]]
		set val [expr (($pixheight-$y+$y_off)/$pixheight) * ($yto-$yfrom) + $yfrom]
		netsend [list .$self $i $val]
	}
}
def Array length= {val} {set @length [format %f $val]}
def Array name= {val} {set @name $val}
def Array array_set {data_list} {
	if {[llength $data_list] == $@length} {
		set @data {}
		for {set i 0} {$i < $@length} {incr i} {
			lappend @data [lindex $data_list $i]
		}
	} else {
		puts "error..."
	}
}

############ evaluator

class_new Listener {Thing}

def Listener init {serf name command} {
	set @history [History new 20]
	set @command $command
	set @expanded 0
	set @serf $serf
	set font $::look(View:font)
	frame $serf
	pack [frame  $serf.1]   -side left -fill y
	pack [frame  $serf.1.1] -side bottom
	pack [button $serf.1.1.expander -image icon_plus -command "$self toggle_expand"] -side left
	pack [label  $serf.1.1.label -width 11 -font $font -text "$name: "] -side left
	pack [entry $serf.entry -width 40 -font $font] -side left -fill x -expand yes
	pack $serf -fill x -expand no
	bind $serf.entry <Up>     "$self scroll_history +1"
	bind $serf.entry <Down>   "$self scroll_history -1"
	bind $serf.entry <Return> "$self eval"
}

def Listener toggle_expand {} {
	set @expanded [expr 1-$@expanded]
	if {$@expanded} {$self expand} {$self unexpand}
}

def Listener expand {} {
	set e $@serf.entry
	set text [$e get]
	destroy $e
	pack [text $e -width 40 -height 8] -side left -fill x -expand yes
	$e insert 0.0 $text
	$@serf.1.1.expander configure -image icon_minus
	bind $e <Alt-Return> "$self eval"
}

def Listener unexpand {} {
	set e $@serf.entry
	set text [$e get 0.0 end]
	regsub "\n$" $text "" text
	destroy $e
	pack [entry $e -width 40] -side left -fill x -expand yes
	$e insert 0 $text
	$@serf.1.1.expander configure -image icon_plus
	bind $e <Up>     "$self up"
	bind $e <Down>   "$self down"
	bind $e <Return> "$self eval"
}

def Listener replace {stuff} {
	$@serf.entry delete 0 end
	$@serf.entry insert 0 $stuff
	$@serf.entry icursor end
}

def Listener scroll_history {incr} {
	if {![$@history histi]} {$@history set_hist 0 [$self get_command]}
	$self replace [$@history traverse $incr]
	
}

def Listener append {v}  {
	$@history prepend $v
	lappend @hist $v; set @histi [llength $@hist]
}

def Listener get_command {} {
	set e $@serf.entry
	if {$@expanded} {
		set l [$e get 0.0 end]; return $l
	} else {
		set l [$e get]; return $l
	}

}

def Listener eval {} {
	set e $@serf.entry
	$@history histi= 0
	set l [$self get_command]
	$self append $l
	if {$@expanded} {$e delete 0.0 end} {$e delete 0 end}
	$@command $self $l
}

proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] $l]"}
proc  pd_eval {self l} {post %s "pd: $l"; netsend $l}
proc canvas_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] [join [list [$self canvas] $l]]]"}
############ button bar

set butt {
	{ObjectBox  Object  {obj}}
	{MessageBox Message {msg}}
	{FloatBox   Number  {floatatom}}
	{SymbolBox  Symbol  {symbolatom}}
	{CommentBox Comment {text}}
	{bng     bng    {obj bng}}
	{tgl     tgl    {obj tgl}}
	{nbx     nbx    {obj nbx}}
	{vsl     vsl    {obj vsl}}
	{hsl     hsl    {obj hsl}}
	{vradio  vradio {obj vradio}}
	{hradio  hradio {obj hradio}}
	{vu      vu     {obj vu}}
	{cnv     cnv    {obj cnv}}
	{Graph   graph  {graph}}
	{Array   array  {menuarray 0}}
}

proc button_bar_add {x y} {
	global butt
	lappend butt [list $x $y noload]
}

if {$tk} {
	set dir $cmdline(icons)
	foreach icon {mode_edit mode_run pd_32}  {image create photo icon_$icon -file $dir/$icon.gif}
	foreach b $butt {mset {icon name cmd} $b; image create photo icon_$icon -file $dir/$icon.gif}
}

class_new ButtonBar {View}

def ButtonBar init {canvas} {
	set @canvas $canvas
	set bb .$@canvas.bbar
	frame $bb
	pack [button $bb.edit -image icon_mode_edit -border 1 -command [list $@canvas editmodeswitch]] -side left
	foreach e $::butt {
		mset {icon name cmd} $e
		pack [button $bb._$name -image icon_$icon -border 1 -command "$@canvas new_object $cmd"] -side left
		balloon $bb._$name [say $name]
	}
	pack [entry $bb.name -font {helvetica -12} -width 8 -border 0] -side right
	pack [spinbox $bb.scale -width 5 -command "$canvas zooming %d" -state readonly] -side right
	$bb.scale set [format %d%% [expr int(100*[$@canvas zoom])]]
	$bb.name insert 0 $@canvas
}

def ButtonBar widget {} {return .$@canvas.bbar}

proc obj_create {c flag} {}

############ crosshair

class_new Crosshair {View}

def Crosshair classtags {} {return {}}

def Crosshair init {canvas} {
	super
	set @canvas $canvas
	$self data= 0 0 {none}
}

def Crosshair data= {x y target} {
	set @x $x
	set @y $y
	set @target $target
}

def Crosshair draw {} {
	
	mset {type id detail} $@target
	set x $@x; set y $@y
	
	if {[$@canvas look hairsnap]} {
		switch -regexp -- $type {^object|outlet|inlet$ {mset {x y x3 y3} [$id bbox]}}
	}
	mset {x1 y1 x2 y2} [$self display_area]

	set h1 [list $x1 $y $x2 $y]
	set v1 [list $x $y1 $x $y2]
	$self item VHAIR1 line $v1 -fill [$@canvas look crosshair] -width 1 -dash {4 4 4 4}
	$self item HHAIR1 line $h1 -fill [$@canvas look crosshair] -width 1 -dash {4 4 4 4}
}

#def Crosshair erase {} {$self item_delete VHAIR1; $self item_delete HHAIR1}
class_new Sense {View}

def Sense init {canvas} {
	super
	set @canvas $canvas
	$self data= 0 0 0 red
}

def Sense data= {x y range col} {
	set @x $x
	set @y $y
	set @range $range
	set @col $col
}

def Sense flash {x y sense col} {
	$self data= $x $y $sense $col
	$self draw
	after 500 $self erase
}

def Sense draw {} {
	set c [$@canvas widget]
	set x1 [expr $@x-$@range]; set y1 [expr $@y-$@range]
	set x2 [expr $@x+$@range]; set y2 [expr $@y+$@range]
	$self item SENSE oval [list $x1 $y1 $x2 $y2] -fill $@col -outline yellow
}

def View display_area {} {
	set c [$@canvas widget]; set z [$@canvas zoom]
	set edge 10
	set x1 [expr {int([$c canvasx $edge]/$z)}]
	set y1 [expr {int([$c canvasy $edge]/$z)}]
	set x2 [expr {int(([$c canvasx [winfo width $c]]-$edge)/$z)}]
	set y2 [expr {int(([$c canvasy [winfo height $c]]-$edge)/$z)}]
	return [list $x1 $y1 $x2 $y2]
}

class_new Grid {View}

def Grid init {canvas} {
	super
	set @canvas $canvas
	set c [$@canvas widget]
	set @width [winfo width $c]
	set @height [winfo height $c]
	set @size [$@canvas look grid_size]
	set @col [$@canvas look grid]
	set @gap 5
}

def Grid classtags {} {return {}}

def Grid update {h w} {set @width $w; set @height $h}
def Grid size= {size} {set @size $size}
def Canvas snap_grid {} {return [$self look snap_grid]}
def Canvas snap_grid= {val} {set ::look(Canvas:snap_grid) $val}

def Canvas snap_objs2grid {} {
	if {![$self editmode]} {return}
	foreach obj [$@objects values] {
		mset {x y} [$obj xy]
		set grid [$self look grid_size]
		set x [expr floor($x/$grid)*$grid]
		set y [expr floor($y/$grid)*$grid]
		$obj moveto $x $y
	}
}

def Grid draw {} {
	mset {x1 y1 x2 y2} [$self display_area]
	set c [$@canvas widget]
	set lowest [$@canvas lowest_item]
	$self draw_lines $x1 $x2 $y1 $y2 VL
	$self draw_lines $y1 $y2 $x1 $x2 HL
	if {$lowest != -1} {$c lower $self $lowest}
}

def Grid draw_lines {v1 v2 v3 v4 tag} {
	set s $@size; set g $@gap
	for {set i $v1} {$i < $v2} {incr i} {
		#if {$l%$g == 0} {set width 1;set dash [list 7 1]} {set width 1;set dash [list 1 4 1 4]}
		if {![expr {$i % int($s*$g)}]} {set w 1;set d [list 7 1]} {set w 1;set d [list 1 4 1 4]}
		if {![expr {$i % int($s)}]} {
			switch $tag {VL {set line [list $i $v3 $i $v4]} HL {set line [list $v3 $i $v4 $i]}}
			$self item ${tag}$i line $line -fill $@col -width $w -dash $d
		}
	}
}

def Canvas lowest_item {} {
	set c [$self widget]
	set all [$c find withtag foo]
	if {![llength $all]} {return -1}
	set lowest [lindex [$c gettags [lindex $all 0]] 0]
	return $lowest
}

#def Canvas grid_size {} {return [$self look grid_size]}
def Canvas grid_size= {size} {
	set ::look(Canvas:grid_size) $size
	if {[$self editmode]} {$@grid size= $size; $@grid erase; after 0 $@grid draw}
}
############ tooltips (only those that are drawn as canvas items)

class_new Tooltip {View}

def Tooltip init {canvas pos curpos text type iserror} {
	set @canvas $canvas
	set @pos $pos
	set @curpos $curpos
	set @text $text
	set @type $type
	set @iserror $iserror
}

def Tooltip iserror {} {return $@iserror}
def Tooltip curpos  {} {return $@curpos}
def Tooltip text    {} {return $@text}

def Tooltip draw {} {
	set c [$@canvas widget]
	if {$@iserror} {
		set fg "#ffffff"; set bg "#dd0000"
	} else {
		set fg "#000000"; set bg "#ffffcc"
	}
	mset {x y} $@pos
	switch -- $@type {
		o {set ny [expr {$y+24}]}
		i {set ny [expr {$y-24}]}
	}
	$self item TEXT text [list [expr $x+12] $ny] -fill $fg -text $@text -anchor w
	mset {x1 y1 x2 y2} [l+ [$c bbox ${self}TEXT] [list -4 -4 +4 +4]]
	switch -- $@type {
	  o {set coords [list $x1 $y1 [expr $x1+8] $y1 $x $y [expr $x1+16] $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1]}
	  i {set coords [list $x1 $y1 $x2 $y1 $x2 $y2 [expr $x1+16] $y2 $x $y [expr $x1+8] $y2 $x1 $y2 $x1 $y1]}
	}
	$self item RECT polygon $coords -fill $bg -outline $fg
	$c lower ${self}RECT ${self}TEXT
}

# $c delete tooltip_bg tooltip_fg

set tooltip ""

def Canvas show_tooltip {x y text type {iserror 0}} {
	global tooltip
	if {$tooltip ne "" && [$tooltip text] eq $text} {return}
	if {$tooltip ne ""} {$tooltip delete}
	set tooltip [Tooltip new $self [list $x $y] $@curpos $text $type $iserror]
	$tooltip draw
}

############ class browser

class_new ServerClassDict {Observable Thing}
def ServerClassDict init {} {

}

# Completion/Browser init can be cleaned up a bit more, do it later...
class_new ClassBrowser {Dialog}
class_new Browser {ClassBrowser}
def Browser init {name x y textbox} {super $name $x $y $textbox}
class_new Completion {ClassBrowser}
def Completion init {name x y textbox} {super $name $x $y $textbox}

def Completion cancel {} {
	bind $@textbox <Key>            "$@textself key_input %W %x %y %K %A 0"
	bind $@textbox <Control-Return> "$@textself key_input %W %x %y 10 %A 0"
	bind $@textbox <Return>         "$@textself unedit"
	bind $@textbox <Tab>            "$@textself key_input %W %x %y %K %A 0"
	focus $@textbox
	$self delete
}
def ClassBrowser delete {} {set @exist 0; super}

def ClassBrowser init {name x y textbox} {
	set @name $name
	set @width 0
	set @height 0
	# so that in completion mode, it know which textbox to switch the focus to
	set @textbox $textbox
	netsend [list pd update-path]
        netsend [list pd update-class-list $self list_callback]
}

def ClassBrowser fill_box {s} {
	global class_list
	$@listbox delete 0 end
	foreach class [lsort $class_list] {
		if {[string length $s]==0 || [string first $s $class]>=0} {
			set t "\[$class\]"
			if {[can_say $class]} {append t "  [say $class]"}
			$@listbox insert end $t
			#if {[string length $t] > [string length $@width]} {set @width [string length $t]}
			if {[string length $t] > $@width} {set @width [string length $t]}
		}
	}
	set none [say no_matches]
	if {![$@listbox size]} {$@listbox insert 0 $none; set @width [string length $none]}
	$@listbox selection set 0 0
}
 
def Completion fill_box {s} {
	super $s
	wm maxsize .$self [winfo reqwidth .$self.comp] [winfo reqheight .$self.comp]
}

def Browser fill_box {s} {
	super $s
	.$self.title configure -text [format [say how_many_object_classes] [$@listbox size] [llength $::class_list]]
}

def ClassBrowser search_for_externs {} {
	global pd_path class_list
	foreach dir $pd_path {
		catch {
			set xs [glob "$dir/*.pd*"]
			foreach x $xs {
				set fn [lindex [file split $x] end]
				set fn [join [lrange [split $fn .] 0 end-1] .]
				lappend class_list $fn
			}
		}
	}
}

def ClassBrowser info {listbox} {
	set class [$self current_class]
	if {$class != ""} {netsend [list pd update-class-info $class $self info_callback]}
}

def Browser list_callback {} {
	$self search_for_externs
	set class_list [luniq [lsort $::class_list]]

	toplevel .$self
	set f .$self.cl
	pack [frame $f] -side top -fill both -expand yes
	pack [label .$self.title -text ""] -side top
	listbox $f.1 -width 50 -height 20 -yscrollcommand "$f.2 set" -activestyle none
	scrollbar $f.2 -command "$f.1 yview"
	text    $f.3 -width 30 -height 20 -yscrollcommand "$f.4 set"
	scrollbar $f.4 -command "$f.3 yview"
	set @listbox $f.1

	frame $f.5
	button $f.5.help -text [say help] -command [list $self help]
	pack $f.5.help -side top
	pack $f.5 -side left -fill    y -expand no
	pack $f.1 -side left -fill both -expand yes
	pack $f.2 -side left -fill    y -expand no
	pack $f.3 -side left -fill both -expand yes
	pack $f.4 -side left -fill    y -expand no

	set b .$self.butt
	frame $b
	pack [label $b.1 -text [say filter]] -side left
	pack [entry $b.2 -width 15] -side left
	pack [button $b.close -text [say close] -command "destroy .$self"] -side right
	pack $b -side bottom -fill x -expand no
	set @textbox $b.2
	$self fill_box ""
	#bind $f.1 <Button-1> "after 1 \"$self info $f.1 \""
	foreach w [list $f.1 $b.2] {
		bind $w       <KeyPress> "after 1 \"$self key %K 0\""
		bind $w <Shift-KeyPress> "after 1 \"$self key %K 1\""
		bind $w <Return> [list $self help]
	}
	focus $@textbox
}

def Browser help {} {
	set f .$self.cl
	netsend [list pd help [$self current_class]]
}

def Completion list_callback {} {
	$self search_for_externs
	set class_list [luniq [lsort $::class_list]]
	toplevel .$self
	wm protocol .$self WM_DELETE_WINDOW "$self cancel"
	wm overrideredirect .$self 1
	set canvas $@name
	set f .$self.comp
	set @listbox $f
	set @rootx [winfo rootx .$@name.c]
	set @rooty [winfo rooty .$@name.c]
	set @max [wm maxsize .$self]
	if {[regexp {(x[0-9a-z]{6,8})text$} $@textbox dummy textself]} {set @textself $textself}
	if {[$canvas look showcomp] <= 20} {set @height [$canvas look showcomp]} else {set @height 20}
	listbox $f -width $@width -height $@height -relief flat -activestyle dotbox -font $::look(View:font) \
	    -bg [$@textself look bg] -selectbackground [$@textself look fg] \
	    -fg [$@textself look fg] -selectforeground [$@textself look bg]
	$self adjust_box
	bind $f <Button-1> "after 1 \"$self complete\""
	bind $f <Return>   "after 1 \"$self complete\""
	bind $f       <KeyPress> "$self key %K 0"
	bind $f <Shift-KeyPress> "$self key %K 1"
	bind $@textbox <Tab>      "$self key %K; break"
	bind $@textbox <KeyPress> "$self key %K "
	focus .$self.comp
}

def Completion adjust_box {} {
	mset {x1 y1 x2 y2} [lmap * [$@textself bbox] [$@name zoom]]
	set x1 [format %0.f $x1];set y1 [format %0.f $y1]
	set x2 [format %0.f $x2];set y2 [format %0.f $y2]
	$self fill_box [$@textbox get 1.0 1.end]
	set f .$self.comp
	$f configure -width $@width
	set box_width  [winfo reqwidth  $f]
	set box_height [winfo reqheight $f]
	pack $f -side left -expand yes

	.$self configure -width $box_width
	.$self configure -height $box_height

	#test the right edge of the screen, assuming the left edge has enough space
	if {[expr $x1+$@rootx+$box_width] < [lindex $@max 0]} {
		set box_x [expr $x1+$@rootx]
	} else {
		set box_x [expr $x2 - $box_width + $@rootx]
	}
	#test the lower edge of the screen, assuming the upper edge has enough space
	if {[expr $y2+$@rooty+$box_height] < [lindex $@max 1]} {
		set box_y [expr $y2 + 5 + $@rooty]
	} else {
		set box_y [expr $y1 - $box_height - 2 + $@rooty]
	}

	wm geometry .$self [winfo reqwidth .$self]x[winfo reqheight .$self]+$box_x+$box_y

}

def ClassBrowser current_class {} {
	set i [$@listbox curselection]
	if {$i == ""} {return {}}
	return [string range [lindex [$@listbox get $i] 0] 1 end-1]
}

def ClassBrowser complete {} {
	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox obj]} {
		set cut [string first "text" $obj]
		set obj [string range $obj 0 [expr $cut -1]]
	}
	set class [$self current_class]
	$@textbox delete 1.0 1.end
	$@textbox insert 1.0 $class

	$obj unedit
	destroy .$self
}

def ClassBrowser key {key {shift 0}} {
 	switch -regexp -- $key {
		Up|Down {
			if {[focus] != $@listbox} {
				focus $@listbox
				event generate $@listbox <KeyPress> -keysym $key
			} else {
				if {$self == "browser"} {$self info $@listbox}
			}
		}
		Escape {after 1 "$self cancel"} ;# doesn't really work
		Tab {
			focus $@listbox
			set next [$@listbox index active]
			incr next
			if {$next >= [$@listbox size]} {set next 0}
			$@listbox activate $next
			$@listbox selection clear 0 [expr [$@listbox size] - 1]
			$@listbox selection set $next $next
			#if {$next >= [expr $@height - 1]} {$@listbox yview scroll 1 units}
			$@listbox see $next
			if {$self == "browser"} {$self info $@listbox}
		}
		BackSpace {
			if {[focus] == $@listbox} {focus $@textbox}
			#classbrowser uses entry as input widget, where as completion is text widget...
			switch $self {
				browser {$self fill_box [$@textbox get]}
				completion {$self adjust_box; $@textself resize; $@textself changed}
			}
		}
		default {
			$self key_default $key
		}
	}
}

def Browser key_default {key} {
	if {[focus] == $@listbox} {
		if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {
			.$self.butt.2 insert end $key
			$self fill_box [$@textbox get]
		}
	} else {$self fill_box [$@textbox get]}
}

def Completion key_default {key} {
	if {[focus] == $@listbox} {
		if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {
			$@textbox insert 1.end $key
			$@textself after_key $@textbox
			$self adjust_box
			focus $@textbox
		}
	}
	if {[focus] == $@textbox & $key != "Tab"} {
		$self adjust_box
		$@textself resize
		#hum, no idea why i need after 1 for it to work...
		after 1 $@textself after_key $@textbox
	}
}

def ClassBrowser info_callback {class} {
	global class_info
	set f .browser.cl
	set class [$self current_class]
	$f.3 delete 0.0 end
	$f.3 insert end "class $class\n"
	foreach {k v} $class_info($class) {$f.3 insert end "$k=\"$v\"\n"}
}

def TextBox propose_completions {} {
	set c [$@canvas widget]
	set widget $c.${self}text
	set propose $c.${self}propose
	#$propose configure -state normal
	if {![info exists ::class_list]} {
		netsend [list pd update-class-list $self propose_completions]
		return
	}
	set r {}
	set c {}
	set n 0
	set prev ""
	foreach class [luniq [lsort $::class_list]] {
		if {[string length $@text]==0 || [string first $@text $class]>=0} {
			if {[string compare [say $class] "{{$class}}"]} {
				lappend r "$class : [say $class]"
			} {
				lappend r $class
			}
			lappend c $class
			incr n
		}
		if {$n > 16} {lappend r ...; break}
	}
	set r [join $r "\n"]
	mset {x1 y1 x2 y2} [$self bbox]
	set @action [Completion new_as completion $@canvas $x1 $y1 $widget]
}

############ properties_dialog #########
proc change_entry {self val} {
	set v [expr [$self get]+$val]
	$self delete 0 end
	$self insert 0 $v
}

class_new Dialog {View}

def Dialog add_stuff {f name label} {
	frame $f
#	frame $f.label -width $@label_width -borderwidth 2
#	pack  [button  $f.label.0 -image "icon_empty" -width $@label_width] -side left
#	place [message $f.label.1 -text $label        -width $@label_width] -x 0 -y 0
#	puts [$f.label.1 cget -height]
	pack [label $f.label -text $label -width [expr $@label_width/7] -wraplength $@label_width -anchor e] -side left
	balloon $f.label $name
}

def Dialog add_side {f name label} {
	$self add_stuff $f $name $label
	frame $f.side -relief ridge -borderwidth 2
	foreach {i side} {0 left 1 right 2 top 3 bottom} {
		radiobutton $f.side.$side -value $i -variable @$name -text $side
	}
	pack $f.side.left   -side   left -fill y
	pack $f.side.right  -side  right -fill y
	pack $f.side.top    -side    top
	pack $f.side.bottom -side bottom
	pack $f.side -side left
}

def Dialog add_color {f name label} {
	$self add_stuff $f $name $label
	set v $@$name
	set text_color [complement $v]
	button $f.color -text $v -font {Courier 10} -width 10 -pady 2 -fg $text_color \
	    -command [list $self choose_col $f $name $v] -relief sunken -background $v \
	    -highlightbackground "#ffffff" -activebackground [darker $v]
	button $f.preset -text [say "preset"] -pady 2 -font {Helvetica 8} \
	    -command [list $self color_popup $f $name 10]
	bind $f.preset <Return> "$self color_popup $f $name 10"
	pack $f.color $f.preset -side left
}


def Dialog add_choice {f name label choices} {
	$self add_stuff $f $name $label
	menu $f.menu -tearoff 0
	set i 0
	foreach part $choices {
		$f.menu add command -label [say $part] -command [list $self dropmenu_set $f $name $part $i]
		incr i
	}
	set trim_name [string trimleft $name "-"]
	set _($self:${name}choices) $choices
	set choice $@$name
	if {[string is integer $choice]} {set choice [lindex $choices $choice]}
	label $f.butt -text [say $choice] -relief raised -width 20
	balloon $f.butt "click to change setting"
	pack $f.label $f.butt -side left
	bind $f.butt <1> [list $self dropmenu_open $f $name]
}

def Dialog add_key {f name label} {
	set text ""
	set n 0
	foreach item $name {
		if {$n != 0} {append text " & " [say $item]} else {set text [say $item]}
		incr n
	}
	$self add_stuff $f $name $text
	#balloon $f.label $name
	foreach item $name {
		set v $_($self:$item) ;# bug in objtcl
		set item_lower [string tolower $item]
		entry $f.$item_lower -width 15 -textvariable @$item
		pack $f.$item_lower -side left
	}
}

def Dialog add_folders {f name label} {
	$self add_stuff $f $name $label
	set v $_($self:$name) ;# bug in poetcl
	frame $f.a
	listbox $f.a.list -width 40 -height 8 -yscrollcommand "$f.a.yscroll set" \
	    -activestyle none -xscrollcommand "$f.a.xscroll set"
	foreach line $v {$f.a.list insert end $line}
	set @$name $f.a.list ;# save the listbox path at @$name instead
	scrollbar $f.a.yscroll -command "$f.a.list yview"
	scrollbar $f.a.xscroll -command "$f.a.list xview" -orient horizontal
	pack $f.a.xscroll -side bottom -fill x
	pack $f.a.list -side left -fill both -expand 1
	pack $f.a.yscroll -side left -fill y
	pack $f.a -side left
	frame $f.b -borderwidth 0
	foreach {cmd lab} {dir_add add listbox_remove remove listbox_up up listbox_down down} {
		pack [button $f.b.$cmd -command "$self $cmd $f.a.list" -text [say $lab] -width 6] -side top
		balloon $f.b.$cmd [say dir_$lab]
	}
	pack $f.b -side top
}

def Dialog add_libraries {f name label} {
	$self add_stuff $f $name $label
	set v $_($self:$name) ;# bug in objtcl
	frame $f.a
	listbox $f.a.list -width 32 -height 16 -yscrollcommand "$f.a.yscroll set" \
	    -activestyle none -xscrollcommand "$f.a.xscroll set"
	#foreach line $@$name {$f.a.list insert end $line}
	foreach line $v {$f.a.list insert end $line}
	# save the listbox path at @$name instead
	set @$name $f.a.list
	scrollbar $f.a.yscroll -command "$f.a.list yview"
	scrollbar $f.a.xscroll -command "$f.a.list xview" -orient horizontal

	pack $f.a.xscroll -side bottom -fill x
	pack $f.a.list -side left -fill both -expand 1
	pack $f.a.yscroll -side left -fill y
	pack $f.a -side left

	frame $f.b       -borderwidth 0
	entry $f.b.entry -width 15 -borderwidth 5 -relief ridge
	bind  $f.b.entry <Return> "$self lib_add $f.a.list"
	pack  $f.b.entry -side top

	foreach {cmd lab} {lib_add add listbox_remove remove listbox_up up listbox_down down} {
		pack [button $f.b.$cmd -command "$self $cmd $f.a.list" -text [say $lab] -width 6] -side top
		balloon $f.b.$cmd [say dir_$lab]
	}
	pack $f.b -side top
}

def Dialog dir_add {listbox} {
	set dir [tk_chooseDirectory -initialdir ~ -title "Choose a folder" -parent .$self]
	if {$dir == ""} {return}
	$listbox insert end $dir
	$listbox yview end
	focus .$self
}

# doesn't work with toplevel widget
proc upwidget {levels name} {
	set l [split $name .]
	return [join [lrange $l 0 end-$levels] .]
}

def Dialog lib_add {f} {
	set f [upwidget 2 $f]
	set listbox $f.a.list
	set entry $f.b.entry
	set var [$entry get]
	if {$var != ""} {$listbox insert end $var}
	$listbox yview end
	$entry delete 0 end
	focus $entry
}

def Dialog listbox_remove {listbox} {
	set sel [$listbox curselection]
	if {$sel == ""} {return}
	$listbox delete $sel
	$listbox selection set $sel
}

def Dialog listbox_swap {listbox dir} {
	set sel [$listbox curselection]
	if {$sel == ""} {return}
	if {![inside [expr $sel+$dir] 0 [$listbox size]]} {return}
	set line [$listbox get $sel]
	$listbox delete $sel
	incr sel $dir
	$listbox insert $sel $line
	$listbox selection set $sel
	$listbox see $sel
}

def Dialog add_devlist {f name label} {
	$self add_stuff $f $name $label
	menu $f.menu -tearoff 0
	set i 0
	set trim_name [string trimleft $name "-"]
	set part none ;# in case there are none
	foreach part $@$trim_name {
		$f.menu add command -label $part -command [list $self dropmenu_set $f $name $part $i]
		incr i
	}
	#label $f.butt -text [lindex $@$trim_name 0] -relief raised -width 20
	label $f.butt -textvariable _($self:${trim_name}0) -relief raised -width 20
	balloon $f.butt "click to change setting"
	pack $f.label $f.butt -side left
	bind $f.butt <1> [list $self dropmenu_open $f $name]
}

def Dialog add_spins {f name label option} {
	global _
	$self add_stuff $f $name $label
	set i 0
	set trim_name [string trimleft $name "-"]
	set n [llength $@$option]
	foreach part $@$trim_name {
		if {$i < $n} {set s "readonly"} else {set s "disabled"}
		set v "_($self:$trim_name${i})"
		spinbox $f.$i -width 2 -command "$self spinning %d $v" -state $s -textvariable $v
		pack $f.$i -side left
		balloon $f.$i "Device [expr $i+1]"
		incr i
	}
}

def Dialog spinning {mode v} {
	switch $mode {
		up {incr $v; puts " incr $v"}
		down {incr $v -1}
	}
}

def Dialog listbox_up   {listbox} {$self listbox_swap $listbox -1}
def Dialog listbox_down {listbox} {$self listbox_swap $listbox +1}

def Dialog add {w args} {
	foreach row $args {
		set name [lindex $row 0]
		set type [lindex $row 1]
		set options [lrange $row 2 end]
		set f $w.$name
		set label "[say $name]: "
		set k [lsearch $options -choices]
		if {$k>=0} {
			set choices [lindex   $options    [expr $k+1]]
			set options [lreplace $options $k [expr $k+1]]
		}
		#set v $@$name
		#set v $_($self:$name) ;# bug in poetcl
		switch -- $type {
			side      {$self add_side      $f $name $label}
			color     {$self add_color     $f $name $label}
			font      {$self add_font      $f $name $label $options}
			choice    {$self add_choice    $f $name $label $choices}
			key       {set f $w.[string tolower [lindex $name 0]]
				   $self add_key       $f $name $label}
			folders   {$self add_folders   $f $name $label}
			libraries {$self add_libraries $f $name $label}
			devlist   {$self add_devlist $f $name $label}
			spins     {$self add_spins $f $name $label $options}
			section    {label $f -text $label -bg "#0000aa" -fg "#ffff55" -font {helvetica -10 bold}}
			subsection {label $f -text $label -bg "#0000aa" -fg "#ffff55" -font {helvetica -10 bold}}
			toggle {
				$self add_stuff $f $name $label
				eval [concat [list checkbutton $f.toggle -variable @$name] $options]
				pack $f.toggle -side left
			}
			default {
				$self add_stuff $f $name $label
				set trim_name [string trimleft $name "-"]
				eval [concat [list entry $f.entry -textvariable _($self:$trim_name)] $options]
				pack $f.entry -side left
				bind $f.entry <Return> "$self ok"
				switch -regexp -- $type {
					integer|float|fontsize {
						frame $f.b -borderwidth 0
						button $f.b.1 -image icon_wedge_up   -command "change_entry $f.entry +1"
						button $f.b.2 -image icon_wedge_down -command "change_entry $f.entry -1"
						pack $f.b.1 $f.b.2 -side top
						pack $f.b -side left
						bind $f.entry <Button-4> "change_entry $f.entry +1"
						bind $f.entry <Button-5> "change_entry $f.entry -1"
					}
					entry {}
					default {
						label $f.type -text "($type)" -fg "#808080"
						pack $f.type -side right -anchor e
					}
				}
			}
		}
		pack $f -side top -fill x
	}
}

proc logvar {args} {
	set r {}
	foreach var $args {
		regsub {^_\(.*:(.*)\)$} $var {@\1} var2
		lappend r "$var2=[uplevel 1 list \$$var]"
	}
	puts [join $r "; "]
}

def Dialog spinbox_update {mode} {puts " $mode"}

def Dialog add_font {f name label class} {
	$self add_stuff $f $name $label
	set v $@$name
	label $f.font -text $v -font [lreplace $v 1 1 -10] -width [string length $v] -height 1 -pady 3 -fg black \
	    -relief sunken -bg white
	button $f.preset -text [say "edit"] -pady 2 -font {Helvetica 8} \
	    -command "FontDialog new_as $name $class $f.font"
	pack $f.font $f.preset -side left
}

class_new FontDialog {Dialog}

def Canvas fd {} {FontDialog new_as view_font [$self look font] "View"}

def FontDialog init {class orig} {
	if {[winfo exists .$self]} {return}
	super cancel ok
	set f .$self
	set @class $class
	set @orig $orig
	bind all <KeyPress-F1> help
	set font $::look($@class:font)
	set @family [lindex $font 0]
	set @size   [expr -[lindex $font 1]]
	set @bold   [expr [lsearch $font bold  ]>=0]
	set @italic [expr [lsearch $font italic]>=0]
	set @str $font
	logvar @family @size @bold @italic
	pack [label $f.label -text [say font_family] -anchor w] -side top -fill x
	frame $f.list -bd 2
	
	pack [listbox $f.list.box -relief sunken -yscrollcommand "$f.list.scroll set"] -side left
	pack [scrollbar $f.list.scroll -relief sunken -command "$f.list.box yview" -takefocus 0] -side right -fill y
	bind $f.list.box <<ListboxSelect>> "$self font_update $f"
	foreach name [lsort [font families]] {$f.list.box insert end $name}

	set fontlist [$f.list.box get 0 end]
	set find [lsearch $fontlist $@family]
	if {$find < 0} {set find 0}
	$f.list.box selection set $find $find
	$f.list.box activate $find
	$f.list.box see $find
	bind $f.list.box <ButtonRelease-1> "$self font_update $f"
	bind $f.list.box <ButtonPress-1> "focus $f.list.box"

	frame $f.var
	frame $f.var.size
	pack [label $f.var.size.label -text [say font_size]] -side left
	pack [spinbox $f.var.size.entry -relief sunken -textvariable fontsize -width 4 \
		      -command "$self font_changesize $f %d"] -side left
	bind $f.var.size.entry <KeyPress-Return> "$self font_update_size $f"
	$f.var.size.entry delete 0 end
	$f.var.size.entry insert 0 $@size

	frame $f.var.style
	pack [label $f.var.style.label -text [say font_style]] -side left
	set cmd [list $self font_update $f]
	pack [checkbutton $f.var.style.bold   -text [say font_bold]   -variable @bold   -command $cmd] -side top
	pack [checkbutton $f.var.style.italic -text [say font_italic] -variable @italic -command $cmd] -side top

	pack $f.var.size -side left 
	pack $f.var.style -side left -padx 20

	frame $f.preview
	pack [label  $f.preview.label -text [say font_preview]] -side left
	pack [canvas $f.preview.canvas -width 250 -height 50 -relief sunken -borderwidth 1]  -side left -fill x
	$f.preview.canvas create text 4 4 -tags ${self}TEXT -anchor nw -text [say font_preview_2] -font $font

	pack $f.list  -side left
	pack $f.var -side top -fill x
	pack $f.preview -side top -pady 10
	focus $f.list.box
	$self none_resizable
}

def FontDialog font_update {f} {
	global font
	set lb $f.list.box
	set @family [$lb get [$lb curselection]]
	set @str [list $@family [expr -$@size]]
	if {$@bold  } {lappend @str bold  }
	if {$@italic} {lappend @str italic}
	# logvar @str
	$f.preview.canvas itemconfigure ${self}TEXT -font $@str
}

def FontDialog font_changesize {f mode} {
	switch $mode {
		up   {set @size [expr $@size+1]}
		down {set @size [expr $@size-1]}
	}
	$f.var.size.entry delete 0 end
	$f.var.size.entry insert 0 $@size
	$self font_update $f
}

def FontDialog font_style {f bold} {
	set @bold $bold
	$self font_update $f
}

def FontDialog font_update_size {f} {
	set size [$f.var.size.entry get]
	if [regexp {^[0-9]+$} $size] {set @size $size}
	$self font_update $f
}

def FontDialog apply {} {
	set ::look($@class:font) $@str
	$@orig configure -font [lreplace $@str 1 1 -10] -text $@str -width [string length $@str]
}

############ .pdrc editor
#Turns #rgb into 3 elem list of decimal vals.
proc rgb2dec {c} {
	set c [string tolower $c]
	if {[regexp -nocase {^#([0-9a-f])([0-9a-f])([0-9a-f])$} $c x r g b]} {
		# double'ing the value make #9fc == #99ffcc
		scan "$r$r $g$g $b$b" "%x %x %x" r g b
	} else {
		if {![regexp {^#([0-9a-f]+)$} $c junk hex] || \
			[set len [string length $hex]]>12 || $len%3 != 0} {
			if {[catch {winfo rgb . $c} rgb]} {
				return -code error "bad color value \"$c\""
			} else {
				return $rgb
			}
		}
		set len [expr {$len/3}]
		scan $hex "%${len}x%${len}x%${len}x" r g b
	}
	return [list $r $g $b]
}
#Returns a complementary color
proc complement {orig {grays 1}} {
	foreach {r g b} [rgb2dec $orig] {break}
	set R [expr {(~$r)%256}]
	set G [expr {(~$g)%256}]
	set B [expr {(~$b)%256}]
	if {$grays && abs($R-$r) < 32 && abs($G-$g) < 32 && abs($B-$b) < 32} {
		set R [expr {($r+128)%256}]
		set G [expr {($g+128)%256}]
		set B [expr {($b+128)%256}]
	}
	return [format "\#%02x%02x%02x" $R $G $B]
}

# this makes the tooltip
proc balloon {w help} {
	bind $w <Any-Enter> "after 500 [list balloon:show %W [list $help]]"
	#bind $w <Any-Leave> "destroy %W.balloon; puts \"destroy balloon\" "
	bind $w <Any-Leave> "destroy %W.balloon"
}

proc balloon:show {w arg} {
	if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
	set top $w.balloon
	catch {destroy $top}
	toplevel $top -bd 1 -bg black
	wm overrideredirect $top 1
	if {$::tcl_platform(platform) == "macintosh"} {
		unsupported1 style $top floating sideTitlebar
	}
	pack [message $top.txt -aspect 10000 -bg lightyellow -font fixed -text $arg]
	set wmx [expr [winfo rootx $w]+[winfo width $w]]
	set wmy       [winfo rooty $w]
	wm geometry $top [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
	raise $top
}

def Dialog ok     {} {$self apply; $self cancel}
def Dialog cancel {} {if {[info exists @nbs]} {foreach x $@nbs {$x delete}}; after 1 [list $self delete]}
def Dialog close  {} {$self delete}
def Dialog apply  {} {}
def Dialog delete {} {destroy .$self; super}
def Dialog erase {} {}; # so that it doesn't call View erase

def Dialog init {args} {
	super
	set f .$self
	set @label_width 160 ;# 20
	toplevel $f
	frame $f.buttonsep -height 2 -borderwidth 1 -relief sunken
	frame $f.buttonframe
	set i 0
	foreach a $args {
		if {[llength $args]<=1 || $i>0} {
			pack [label $f.buttonframe.$i -width 1] -side left -fill x -expand 1
		}
		pack [button $f.buttonframe.$a -text [say $a] -command "$self $a"] -side left
		bind $f.buttonframe.$a <Return> "$self $a"
		incr i
	}
	pack $f.buttonframe -side bottom -fill x -pady 2m
	pack $f.buttonsep   -side bottom -fill x
	wm protocol $f WM_DELETE_WINDOW "$self cancel"
	bind .$self         <Tab> "$self traversal %K %W forward"
	bind .$self <Control-Tab> "$self traversal %K %W back"
}

def Dialog none_resizable {} {wm resizable .$self 0 0}

def Dialog traversal {k w direction} {
	switch $direction {
		forward {focus [tk_focusNext $w]}
		back    {focus [tk_focusPrev $w]}
	}
}

def Dialog dropmenu_open {frame} {
	set x [winfo rootx $frame.butt]
	set y [expr [winfo height $frame.butt] + [winfo rooty $frame.butt]]
	tk_popup $frame.menu $x $y
}

def Dialog dropmenu_set {frame var part val} {
	#if {$say} {set text [say $part]} else {set text $part}
	set @$var $val
	$frame.butt configure -text [say $part]
}

def Dialog color_popup_select {frame var color} {
	set @$var $color
	set col [format #%6.6x $color]
	if {$self == "ddrc"} {set @$var $col}
	$frame.color configure -background $col -foreground [complement $col] -text $col
	if {$self != "ddrc"} {$self do_auto_apply}
	#$self do_auto_apply
}

def Dialog color_popup {frame var i} {
	set w $frame.color.popup
	if [winfo exists $w] {destroy $w}
	menu $w -tearoff false
	global preset_colors
	for {set i 0} {$i<[llength $preset_colors]} {incr i} {
		set c [lindex $preset_colors $i]
		$w add command -label "     " -background "#$c" -activebackground "#$c" \
		    -command [list $self color_popup_select $frame $var [expr 0x$c]]
	}
	tk_popup $w [expr [winfo rootx $frame.color]] [expr [winfo rooty $frame.color]]
}

def Dialog choose_col {frame var val} {
	set c 0xFFFFFF
	set color [tk_chooseColor -title $val -initialcolor $val]
	if {$color != ""} {
		$frame.color configure -text $color
		$self color_popup_select $frame $var [expr [string replace $color 0 0 "0x"]&0xFFFFFF]
	}
}

class_new PagedDialog {Dialog}
class_new Notebook    {Thing}

def PagedDialog init {args} {
	eval [concat [list super] $args]
	set @nb [Notebook new_as $self.1]
	set @nbs $@nb
	pack .$@nb -expand 1 -fill both
	$self none_resizable
}
def Notebook delete {} {super}
def Notebook init {{width 590} {height 350}} {
	set f .$self
	frame $f
	pack [frame $f.bar] -fill x
	pack [frame $f.main -borderwidth 1 -relief raised -width $width -height $height] -fill both -expand yes
}

def Notebook page_select {i} {
	set f .$self
	catch {
		$f.bar.$@section configure -relief raised
		place forget $f.main.$@section
		pack $f.bar.$@section -pady {4 4}
	}
	set @section $i
	place $f.main.$@section -x 0 -y 0 ;# -width [winfo width $f.main] -height [winfo height $f.main]
	$f.bar.$@section configure -relief sunken
	pack $f.bar.$@section -pady {8 0}
}

def Notebook add_section {section text} {
	set f .$self
	frame $f.main.$section
	pack [button $f.bar.$section -text $text -command [list $self page_select $section]] -side left -pady {4 4}
	bind $f.bar.$section <Return> "$self page_select $section"
}

# numbers in section are for the % of space taken by labels
set pdrc_options {
	section {section_audio 50}
	integer -r
	devlist -audioindev|-soundindev
	devlist -audiooutdev|-soundoutdev
	spins {-inchannels audioindev}
	spins {-outchannels audiooutdev}
	integer -audiobuf|-soundbuf
	integer -blocksize
	integer -sleepgrain
	void -nodac
	void -noadc
	choice {audio_api_choice}
	void -32bit

	section {section_midi 50}
	void -nomidiin
	void -nomidiout
	devlist -midiindev
	devlist -midioutdev

	section {section_externals 20}
	libraries -lib

	section {section_paths 20}
	folders -path
	folders -helppath

	section {section_other 50}
	files -open
	void -verbose
	integer -d
	void -noloadbang
	string -send
	void -listdev
	void -realtime|-rt
}

proc pdtk_audio_dialog {indevlist indevs inchans outdevlist outdevs outchans sr dspblock advance multi longform} {
	pdrc audio_properties $indevlist $indevs $inchans $outdevlist $outdevs $outchans $sr $dspblock $advance $multi
}

class_new ServerPrefsDialog {PagedDialog}

def ServerPrefsDialog apply {} {
	set audio_props [$self audio_properties=?]
	#pd pd audio-dialog $audio_props
	netsend [list "pd" "audio-dialog" $audio_props]
	$self write
}

def ServerPrefsDialog init_reverse_hash {} {
	global pdrc_options pdrc_options_h pd_apilist2
	foreach {type names} $pdrc_options {
		set name [lindex $names 0]
		if {[info exists @$name]} {
			if {$name != "audio_api_choice"} {set @$name ""}
		} else {
			set @$name ""
		}
		foreach alias $names {set pdrc_options_h($alias) [list $type $name]}
		if {$name == "audio_api_choice"} {
			foreach alias [lrange $pd_apilist2 1 end] {set pdrc_options_h($alias) [list $type $name]}
		}
	}
}

def ServerPrefsDialog audio_properties {indevlist indevs inchans outdevlist outdevs outchans sr dspblock advance multi} {
	set @audioindev $indevlist
	set @audiooutdev $outdevlist
	# the following @audioindev* is used as -textvariable for devlist
	set @audioindev0  [lindex $@audioindev 0]
	set @audiooutdev0 [lindex $@audiooutdev 0]
	set @inchannels $inchans
	set @outchannels $outchans
	set @audiobuf $advance
	set @blocksize $dspblock
	set @usemulti $multi
	set @r $sr
	set @midiindev "midione"
	set @midioutdev "miditwo"
	# below are also used as -textvariable
	mset [list @inchannels0  @inchannels1  @inchannels2  @inchannels3]  $@inchannels
	mset [list @outchannels0 @outchannels1 @outchannels2 @outchannels3] $@outchannels
	set @audio_api_choice2 [say [lindex $::pd_apilist2 $@audio_api_choice]]
	if {![winfo exists .$self.1.main.1]} {
		$self init_content
	} else {
		$self update_content
	}
}

def ServerPrefsDialog audio_properties=? {} {
	set indev0 [lsearch $@audioindev $@audioindev0]
	set outdev0 [lsearch $@audiooutdev $@audiooutdev0]
	return [list $indev0  0 0 0  $@inchannels0  $@inchannels1  $@inchannels2  $@inchannels3 \
		     $outdev0 0 0 0 $@outchannels0 $@outchannels1 $@outchannels2 $@outchannels3 \
	             $@r $@blocksize $@audiobuf]
}

def ServerPrefsDialog read_one {type name contents i} {
	switch -- $type {
		folders   {incr i; lappend @$name [lindex $contents $i]}
		libraries {incr i; lappend @$name [lindex $contents $i]}
		files     {incr i; lappend @$name [lindex $contents $i]}
		choice    {
			if {$name == "audio_api_choice"} {
				if {$@$name == ""} {
				set @$name [lsearch $::pd_apilist2 [lindex $contents $i]]
				}
			} else {
				set @$name [lindex $contents $i]
			}
		}
		void      {        set @$name 1}
		default   {incr i; set @$name [lindex $contents $i]}
	}
	incr i
	return $i
}

def ServerPrefsDialog read {} {
	global pdrc_options pdrc_options_h cmdline
	set fd [open $cmdline(rcfilename) "RDONLY CREAT"]
	set contents {}
	foreach line [split [read $fd] "\n"] {
		if {[string index $line 0] != "#"} {lappend contents $line}
	}
	close $fd
	set contents [concat [join $contents " "]] ;# concat casts to list type (faster) (?)
	set i 0

	# prevent Tk8.5 from showing grey checkmarks
	foreach name {-nodac -noadc -32bit -nomidiin -nomidiout -verbose -noloadbang -listdev -realtime} {
		set _($self:$name) 0
	}

	while {$i < [llength $contents]} {
		set op [lindex $contents $i]
		if {[string length $op]==0} {break}
		if {![info exists pdrc_options_h($op)]} {
			post "unknown option: %s" $op
			incr i
			continue
		}
		mset {type name} $pdrc_options_h($op)
		set name [lindex [split $name "|"] 0]
		set i [$self read_one $type $name $contents $i]
	}
}

def ServerPrefsDialog write {} {
	set fd [open $::cmdline(rcfilename) w]
	#set fd stdout; puts "WOULD SAVE:"
	foreach {type names} $::pdrc_options {
		set name [lindex [split [lindex $names 0] "|"] 0]
		if {[info exists _($self:$name)]} {set v $_($self:$name)} ;# bug in objective.tcl ?
		switch $type {
			folders   {foreach item [$v get 0 end] {puts $fd "$name $item"}}
			libraries {foreach item [$v get 0 end] {puts $fd "$name $item"}}
			#files    {foreach item $v {puts $fd "$name $item"}}
			void      {if {$v != ""} {if {$v} {puts $fd $name}}}
			choice    {
				if {$name != "audio_api_choice"} {
					set vv [lindex $names [expr 1+$v]]
					if {$vv != "default"} {puts $fd $vv}
				} else {
					set vv [lindex $::pd_apilist2 $v]
					if {$vv != "default"} {puts $fd $vv}
				}
			}
			devlist {}
			default   {if {[string length $v]} {puts $fd "$name $v"}}
		}
	}
	close $fd
	#puts "THE END"
}
def ServerPrefsDialog reset {} {
}

def ServerPrefsDialog init_content {} {
	global pdrc_options
	set f .$self.1
	set section 0
	set @label_width 200 ;# 24
	foreach {type names} $pdrc_options {
		set name [lindex [split [lindex $names 0] "|"] 0]
		switch $type { void { set type toggle }}
		switch $type {
			section {
				set @label_width [expr 6*[lindex $names 1]] ;# % of 600 px
				$@nb add_section [incr section] [say $name]
			}
			choice  {
				if {$name == "audio_api_choice"} {
					set ops $::pd_apilist2
				} else {
					set ops [lrange $names 1 end]
				}
				$self add $f.main.$section [list $name choice -choices $ops]
			}
			devlist {$self add $f.main.$section [list $name devlist] }
			spins {$self add $f.main.$section [list $name spins [lindex $names 1]] }
			default {$self add $f.main.$section [list $name $type]}
		}
	}
	$@nb page_select 1
}

def ServerPrefsDialog update_content {} {
	$self update_channels
}

def ServerPrefsDialog update_channels {} {
	set indev_len [llength $@audioindev]
	set outdev_len [llength $@audiooutdev]
	set i 0
	foreach chan $@inchannels {
		if {$i < $indev_len} {set s "readonly"} else {set s "disabled"}
		.$self.1.main.1.-inchannels.$i configure -state $s
		incr i
	}
	set i 0
	foreach chan $@outchannels {
		if {$i < $outdev_len} {set s "readonly"} else {set s "disabled"}
		.$self.1.main.1.-outchannels.$i configure -state $s
		incr i
	}
}

def ServerPrefsDialog init {} {
	netsend [list pd audio-properties]
	$self init_reverse_hash
	$self read
	super reset cancel apply ok
	# pd pd  midi-properties
}

def ServerPrefsDialog dropmenu_set {frame var part val} {
	set trim_part [string trimleft $part "-"]
	set trim_var [string trimleft $var "-"]
	if {$var == "audio_api_choice"} {
		foreach api $::pd_apilist {
			if {$trim_part == [string tolower [lindex $api 0]]} {
				netsend [list pd audio-setapi [lindex $api 1]]
				after 1 [netsend [list pd audio-properties]]
			}
		}
	} else {
		set ::_($self:${trim_var}0) $part
	}
	super $frame $var $part $val
}
#used by choice and devlist
def ServerPrefsDialog dropmenu_open {f name} {
	set trim_name [string trimleft $name "-"]
	if {$trim_name != "audio_api_choice"} {
		set i 0
		set m $f.menu
		$m delete 0 end
		foreach part $@$trim_name {
			$m add command -label $part -command [list $self dropmenu_set $f $name $part $i]
			incr i
		}
	}
	super $f
}

#################### ClientPrefsDialog
set ddrc_options {
section Client section_color
  subsection Client canvas_color
    color Canvas bgedit
    color Canvas bgrun
    color Canvas grid
  subsection Client object_color
    color View bg
    color View fg
    color View frame1
    color View frame2
    color View frame3
    color Comment bg
    color Comment fg
    color Comment frame1
    color Comment frame2
    color Comment frame3
    color View selectframe
    font View font
  subsection Client wire_color
    color Wire fg
    color Wire dspfg
    color Wire fg2
    color FutureWire dash
  subsection Client others_color
    color Box inletfg
    color Box outletfg
    color SelRect rect
    font KeyboardDialog font
    font Console font
section Client keys
  subsection Client put
    key Canvas Object
    key Canvas Message
    key Canvas {Number nbx}
    key Canvas Symbol
    key Canvas Comment
    key Canvas bng
    key Canvas tgl
    key Canvas {vsl hsl}
    key Canvas {vradio hradio}
    key Canvas vu
    key Canvas cnv
    key Canvas Graph
    key Canvas Array
  subsection Client edit
    key Canvas {cut copy}
    key Canvas {undo redo}
    key Canvas {paste duplicate}
    key Canvas select_all
    key Canvas clear_selection
    key Canvas {reload redraw}
    key Canvas editmodeswitch
    key Canvas {insert_object chain_object}
    key Canvas {clear_wires auto_wire}
    key Canvas subpatcherize
  subsection Client general
    key Canvas Pdwindow
    key Canvas {new_file open_file}
    key Canvas {save save_as}
    key Client {server_prefs client_prefs}
    key Canvas {close quit}
    key Canvas {find find_again}
    key Canvas {audio_on audio_off}
    key Client {audio_settings midi_settings}
    key Client test_audio_and_midi
    key Canvas {load_meter latency_meter}
    key Canvas about
  subsection Canvas keynav
    key Canvas {key_nav_up key_nav_up_shift}
    key Canvas {key_nav_down key_nav_down_shift}
    key Canvas {key_nav_right key_nav_right_shift}
    key Canvas {key_nav_left key_nav_left_shift}
    key Canvas key_nav_ioselect
section Client others
    toggle Canvas hairstate
    toggle Canvas hairsnap
    toggle Canvas gridstate
    integer Canvas grid_size
    toggle Canvas snap_grid
    toggle Canvas buttonbar
    toggle Canvas statusbar
    toggle Canvas menubar
    toggle Canvas scrollbar
    toggle View tooltip
    toggle Wire wirearrow
    integer Client console
    language View language
    language View language2
    integer Canvas pointer_sense
}

class_new ClientPrefsDialog {PagedDialog}
def ClientPrefsDialog apply {} {$self write; $self do_apply}
def ClientPrefsDialog read {} {read_ddrc}

def ClientPrefsDialog do_apply {} {
	foreach canvas $::window_list {
		if {[$canvas class] == "Canvas"} {
			$canvas activate_menubar= [$canvas look menubar]
			$canvas activate_buttonbar= [$canvas look buttonbar]
			$canvas activate_statusbar= [$canvas look statusbar]
			$canvas activate_scrollbars= [$canvas look scrollbar]
			$canvas activate_grid= [$canvas look gridstate]
			$canvas redraw
		}
	}
}

def ClientPrefsDialog write {} {
	global look key
	$self get_val
	set fd [open $::cmdline(ddrcfilename) w]
	foreach category {look key} {
		set class_list {}
		puts $fd "$category \{"
		foreach name [array names $category] {
			mset {class var} [split $name ":"]
			lappend class_list $class
		}
		set class_list [luniq [lsort $class_list]]
		foreach class $class_list {
			puts $fd "  $class \{"
			foreach name [lsort [array names $category -glob $class:*]] {
				mset {class var} [split $name ":"]
				# the eval here annoys me a bit because of possible special chars -- matju
				puts $fd "    $var [eval list \$${category}($class:$var)]"
				#puts " $var $category $class $var"
			}
			puts $fd "  \}"
		}
		puts $fd "\}"
	}
	close $fd
}

#this retrieves the values set in the editor
def ClientPrefsDialog get_val {} {
	global ddrc_options look key accels
	set check_key {}
	foreach {type class name} $ddrc_options {
		switch -regexp -- $type {
			color {
				set str [string tolower $class$name]
				set look($class:$name) $@$str
			}
			key {
				foreach item $name {
					set new_key $@$item
					set old_key $key($class:$item)
					if {$key($class:$item) != $new_key} {
						if {[dict exists $accels $old_key]} {
							set cmd [dict get $accels $old_key]
							set accels [dict remove $accels $old_key]
							dict set accels $new_key $cmd
						}
					}
					if {[dict exists $check_key $new_key] && $new_key != ""} {
						error "$new_key already assigned"
					} else {dict set check_key $new_key key($item)}
					set key($class:$item) $new_key
				}
			}
			toggle { set look($class:$name) $@$name}
			integer {set look($class:$name) $@$name}
			choice|language {
			  if {$@$name == "autolanguage"} {set l auto} {set l $@$name}
			  set look($class:$name) $l
			}
			#font {set look(View:font) $@str}
		}
	}
}

def ClientPrefsDialog reset {} {
	# this should reload defaults.ddrc ?
}

def ClientPrefsDialog revert {} {
	# this should reload currently used settings ?
}

def ClientPrefsDialog init {} {
	global ddrc_options look key
	#do we need to read .ddrc each time the pref editor is opened?
	#$self read
	super cancel apply ok
	#super cancel reset revert apply ok
	set f .$self.1
	set section 0
	set subsection 0
	set @label_width 200 ;# 24

	foreach {type class names} $ddrc_options {
		set name [lindex [split $names |] 0]
		switch $type { void { set type toggle }}
		switch $type {
			section {
				$@nb add_section [incr section] [say $name]
				set which_section $f.main.$section
				set which_self $self
				set subsection 0
			}
			subsection {
				set subself $self.1.main.$section.subsections
				if {!$subsection} {
					lappend @nbs [Notebook new_as $subself 590 300]
					pack .$subself
				}
				$subself add_section [incr subsection] [say $name]
				$subself page_select 1
				set which_section .$subself.main.$subsection
				set which_self $subself
			}
			language {
				set @$name $look(View:$name)
				say autolanguage "[say auto] ([say [lindex [figure_out_language [guess_lang]] 1]])"
				$self add $which_section [list $name choice -choices [concat autolanguage $::langoptions]]
			}
			color {
				set str [string tolower $class$name]
				set @$str $look($class:$name)
				$self add $which_section [list $str $type]
			}
			key {
				foreach item $name {
					set @$item $key($class:$item)
				}
				$self add $which_section [list $name $type]
			}
			toggle {
				set @$name $look($class:$name)
				$self add $which_section [list $name $type]
			}
			font {
				set str [string tolower $class$name]
				set @$str $look($class:$name)
				$self add $which_section [list $str $type $class]
			}
			default {
				switch $name {
					console {set @$name $look(Client:console)}
					pointer_sense {set @$name $look(Canvas:pointer_sense)}
					grid_size {set @$name $look(Canvas:grid_size)}
					default {}
				}
				$self add $which_section [list $name $type]
			}
		}
	}
	$@nb page_select 1
}

def ClientPrefsDialog dropmenu_set {frame var part val} {
	set @$var $part
	# set _($self:${var}2) [say $part]
	$frame.butt configure -text [say $part]
}

def ClientPrefsDialog dropmenu_open {f name} {
	super $f
}

############ find dialog ###########

class_new FindDialog {Dialog}

def FindDialog init {canvas} {
	super cancel find
	set @canvas $canvas
	set @break 0
	set f .$self
	$self add $f [list "string" "entry"]
	focus .find.string.entry
}

def FindDialog find {} {$self ok}
def FindDialog ok {} {
	$@canvas find_string= $@string
	$@canvas search
	super
}
############ other stuff #########

def Client client_class_tree {} {ClientClassTreeDialog new}
class_new ClientClassTreeDialog {Dialog}

proc* place_stuff {args} {}

def ClientClassTreeDialog make_row {w tree} {
	pack [frame $w] -fill x
	pack [frame $w.row] -side top -fill x
	pack [button $w.row.butt -image icon_minus] -side left
	pack [label $w.row.label -text [lindex $tree 0]] -side left -fill x
	pack [frame $w.dent -width 32] -side left
	set i 1
	foreach node [lrange $tree 1 end] {
		$self make_row $w.$i $node
		incr i
	}
}

def ClientClassTreeDialog init {} {
	super close
	pack [frame .$self.1   -width 600 -height 400] -fill y -expand y
	pack [frame .$self.1.1 -width 600 -height 400 -bg "#6688aa"] -side left -fill y -expand y
	# "$w.1.scroll set"
	# i'd like a scrollable frame
	pack [scrollbar .$self.1.scroll -command "ClientClassTreeDialog_scroll $self"] -side left -fill y -expand y
	place [frame .$self.1.1.tree] -x 0 -y 0
	set w .$self.1.1.tree.1
	$self make_row $w [Thing get_hierarchy]
	after 100 "$self update_scrollbar"
}

def ClientClassTreeDialog update_scrollbar {} {
	set w .$self.1.1
	set zy [winfo height $w]
	set sy [winfo height $w.tree]
	set y1 [expr   0.0-[winfo y $w.tree]]
	set y2 [expr   0.0+$y1+$zy]
	.$self.1.scroll set [expr $y1/$sy] [expr $y2/$sy]
}

def ClientClassTreeDialog scroll {args} {
	set w .$self.1.1
	set zy [winfo height $w]
	set sy [winfo height $w.tree]
	switch [lindex $args 0] {
		moveto {
			set y [clip [expr (0.0-[lindex $args 1])*$sy] [expr $zy-$sy] 0]
			place .$self.1.1.tree -x 0 -y $y
			puts "args=[list $args] zy=$zy sy=$sy y=$y"
		}
		scroll {
		}
	}
	after 100 "$self update_scrollbar"
}

class_new AboutDialog {Dialog}

def AboutDialog init {} {
	super close
        wm title .$self "About DesireData"
        pack [label .$self.title -text $::pd_version -font {helvetica 18}] -side top
	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 -height 36] -side left -fill both -expand yes
	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y -expand yes
#12345678901234567890123456789012345678901234567890123456789012345678901 <- 72 chars
	.$self.text insert 0.0 \
"DesireData is a free (libre) real-time computer programming language
interpreter focused on realtime audio and video.
You can get DesireData from http://desiredata.goto10.org/

DesireData and PureData work on Linux, MacOSX, Windows, and others.

PureData is copyrighted, but is free for you to use for any reasonable
purpose, according to the SIBSD license. DesireData's client section
also is free, according to the GPL license. DesireData's server section
is an adaptation of the PureData code and is also using the SIBSD
license.

(insert here: links to both licenses)

Credits:
  DesireData server: Mathieu Bouchard
  DesireData client: Mathieu Bouchard & Chun Lee
  PureData: Miller Puckette feat. Thomas Musil,
  Günther Geiger, Krzysztof Czaja, Iohannes Zmölnig & others.

  Translations:
    Français (French): Patrice Colet
    Català (Catalan): Núria Verges
    Español (Spanish): Mario Mora, Ramiro Cosentino
    Deutsch (German): Max Neupert, Georg Holzmann, Thomas Grill
    Norsk Bokmål (Norwegian): Gisle Frøysland
    Português (Portuguese): Nuno Godinho
    Português do Brasil (Brazilian Portuguese): Carlos Paulino
    Italiano (Italian): Davide Morelli, Federico Ferri
    Euskara (Basque): Ibon Rodriguez Garcia
    Nihongo (Japanese): Kentaro Fukuchi
    Polski (Polish): Michal Seta
    Dansk (Danish): Steffen Leve Poulsen
    Zong wen (Chinese): Chun Lee
    Nederlands (Dutch): Tim Vets
    Türkçe (Turkish): Koray Tahiroglu
    Russkij (Russian): Ilya Dmitrichenko

Much more documentation and other resources at http://puredata.info/
The Pd mailing list archive at http://lists.puredata.info/pipermail/pd-list/

(insert here: link to \"reference documentation for Pd\", that is, chapter 1)"

	# this looks bad on OSX, iirc
	.$self.text configure -state disabled
}

set manager [Manager new]

def Class post_hierarchy {{i 0}} {
	post %*s%s [expr $i*2] "" $self
	foreach sub $@subclasses {$sub post_hierarchy [expr $i+1]}
}
def Class get_hierarchy {} {
	set l [list $self]
	foreach sub $@subclasses {lappend l [$sub get_hierarchy]}
	return $l
}

# Thing post_hierarchy

#----------------------------------------------------------------
class_new ClipboardDialog {Dialog}

def ClipboardDialog init {clipboard} {
	super close
	set @clipboard $clipboard
        wm title .$self "Clipboard"
	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72
	     ] -side left -fill both -expand yes
	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y
	$@clipboard subscribe $self
	$self notice
}

def ClipboardDialog notice {args} {
	.$self.text delete 0.0 end
	.$self.text insert 0.0 [$@clipboard value]
}

def ClipboardDialog delete {} {
	$@clipboard unsubscribe $self
	super
}

#----------------------------------------------------------------
class_new ListDialog {Dialog}

def ListDialog init {history title} {
	super close
	set @history $history
	wm title .$self $title
	frame .$self.1
	pack [listbox .$self.1.list -yscrollcommand ".$self.1.scroll set" -width 72 -height 20] -side left -fill both -expand yes
	pack [scrollbar .$self.1.scroll -command ".$self.1.list yview"] -side right -fill y
	pack .$self.1
	$@history subscribe $self
	$self notice
}

def ListDialog listbox {} {return .$self.1.list}

def ListDialog notice {args} {
	set w [$self listbox]
	$w delete 0 end
	foreach e [$@history list] {$w insert end $e}
	$w see end
}

def ListDialog delete {} {
	$@history unsubscribe $self
	super
}

class_new EventHistoryDialog {ListDialog}

def EventHistoryDialog init {history} {
	super $history [say event_history_view]
	pack [checkbutton .$self.hide -text [say hide_key_release]] -fill x
	[$self listbox] configure -font {Mono -10}
}

#----------------------------------------------------------------
#class_new Splash {Thing}

#def Splash init {} {
#	toplevel .$self
#	frame .$self.f
#	canvas .$self.f.canvas
#	image create photo .dd -format GIF -file desiredata.gif
#	.$self.f.canvas create image 0 0 -image .dd
#	pack .$self.f.canvas
#	pack .$self.f
#}

class_new KeyboardDialog {Dialog}

set keyboard_layouts {
    {
	{9 " " 67 68 69 70 " " 71 72 73 74 " " 75 76 95 96}
	{49 10 11 12 13 14 15 16 17 18 19 20 21 22}
	{23 24 25 26 27 28 29 30 31 32 33 34 35 51}
	{66 38 39 40 41 42 43 44 45 46 47 48 36}
	{50 52 53 54 55 56 57 58 59 60 61 62}
	{37 115 64 65 113 116 117 109}
    } {
	{" " " " 98 " "}
	{100 " " " " 102}
	{" " " " 104 " "}
	{" "}
        {" " " " 4 " "}
	{1 2 3}
        {" " " " 5 " "}
    }
}

foreach {k v} {
	9 5
	22 5
	23 4 51 4
	66 5 36 7
	50 8 62 8
	37 4 115 4 64 4 65 24 113 4 116 4 117 4 109 4
        98 2 100 2 102 2 104 2
	1 2 2 2 3 2 4 2 5 2
} {set keyboard_width_of($k) $v}

proc namekey {i args} {foreach name $args {set ::keyboard_text_of($i) $name; incr i}}
namekey 9 Esc
namekey 67 F1 F2 F3 F4 F5 F6 F7 F8 F9 F10
namekey 95 F11 F12
namekey 49 `
namekey 10 "1 !" "2 @" "3 #" "4 \$" "5 %" "6 ^" "7 &" "8 *" "9 (" "0 )" "- _" "= +" BkSp
namekey 23 Tab Q W E R T Y U I O P "\{ \[" "\} \]"
namekey 51 "\\ |"
namekey 66 Caps
namekey 38 A S D F G H J K L "\; :" "' \""
namekey 36 Return
namekey 50 Shift
namekey 52 Z X C V B N M ", <" ". >" "/ ?" Shift
namekey 37 Ctrl
namekey 115 Sup
namekey 64 Alt Space
namekey 113 AltGr
namekey 116 Sup Menu
namekey 109 Ctrl
namekey 98 (up)
namekey 100 (left)
namekey 102 (right)
namekey 104 (down)
namekey 1 1 2 3 4 5
#mouse clicks

def KeyboardDialog init {history} {
	super close
	set @history $history
	set @fade [dict create]
	wm title .$self "Keyboard View" ;# say
	set i 0; set j 0
	set @names {key misc}
	frame .$self.board
	set layouts {::keyboard_layout ::keyboard_layout2}
	set @keycount 0
	foreach layout $::keyboard_layouts {
		$self pack_keys $layout [lindex $@names $i] [llength [lindex $::keyboard_layouts [expr $i-1]]]
		incr i
	}
	pack .$self.board
	$@history subscribe $self
	$self fade
}

def KeyboardDialog pack_keys {keys name off} {
	set i $off
	frame .$self.board.$name
	foreach row $keys {
		frame .$self.board.$name.$i
		foreach key $row {
			if {$key==" "} {
				pack [label .$self.board.$name.$i.shim$@keycount -image icon_empty] -side left
				incr @keycount
				continue
			}
			set ::keyboard_row_of($key) $i
			if {[info exists ::keyboard_width_of($key)]} {
				set width $::keyboard_width_of($key)
			} else {set width 3}
			if {[info exists ::keyboard_text_of($key)]}  {
				set text  $::keyboard_text_of($key)
			} else  {set text $key}
			if {[regexp {\((\w+)\)} $text foo bar]} {
				set font [$self look font]
				pack [label .$self.board.$name.$i.key$key -image icon_$bar -relief raise -border 4 -bg \
					"#dddddd" -width [expr $width*[font measure $font 0]] \
					-height [font metrics $font -linespace]] -side left
			} else {
				pack [label .$self.board.$name.$i.key$key -text " $text " -relief raise -border 4 \
				  	-bg "#dddddd" -width $width -font [$self look font]] -side left
			}
		}
		pack .$self.board.$name.$i -fill x
		if {$i==0} {pack [label .$self.board.$name.shim -image icon_empty] -fill x -expand yes}
		incr i
	}
	switch $name {
		key {pack .$self.board.key -side left}
		misc {pack .$self.board.misc -side right}
	}
}

def KeyboardDialog notice {origin add event} {
	mset {type W x y mod K k} $event
	if {![info exists ::keyboard_row_of($k)]} {puts "unknown key $k"; return}
	set i $::keyboard_row_of($k)
	if {$i<[llength [lindex $::keyboard_layouts 0]]} {set section "key"} else {set section "misc"}
	switch -regexp -- $type {
		^KeyPress|ButtonPress$   {
			if { [dict exists $@fade $k]} {dict unset @fade $k}
			.$self.board.$section.$i.key$k configure -bg "#ff0000"
		}
		^KeyRelease|ButtonRelease$ {if {![dict exists $@fade $k]} {dict set @fade $k 255}}
	}
}

def KeyboardDialog fade {} {
	foreach {k v} $@fade {
		incr v -85
		if {$v<0} {set v 0}
		set r [expr 221+$v*2/15]
		set g [expr 221-$v*13/15]
		set i $::keyboard_row_of($k)
		if {$i<[llength [lindex $::keyboard_layouts 0]]} {set section "key"} else {set section "misc"}
		.$self.board.$section.$i.key$k configure -bg [format #%02x%02x%02x $r $g $g]
		if {$v} {dict set @fade $k $v} {dict unset @fade $k}
	}
	set @after [after 100 "$self fade"]
}

def KeyboardDialog delete {} {
  $@history unsubscribe $self
  after cancel $@after
  super
}

#----------------------------------------------------------------
# Deconstructors

def Wire deconstruct {{selcanvas ""}} {
	# the selcanvas system could be abstracted out using an ObjectList such that
	#   Canvas<ObjectList and $selection class == ObjectList
	if {$selcanvas == ""} {
		list #X connect \
		    [[$@canvas objects] search $@from] $@outlet \
		    [[$@canvas objects] search   $@to]  $@inlet
	} {
		list #X connect \
		    $::obj_index_sel($@canvas:$@from) $@outlet \
		    $::obj_index_sel($@canvas:$@to)   $@inlet
	}
}

def MessageBox deconstruct {} {concat [list #X msg        $@x1 $@y1] $@text}
def FloatBox   deconstruct {} {concat [list #X floatatom  $@x1 $@y1] $@w $@min $@max $@pos $@lab $@snd $@rcv}
def SymbolBox  deconstruct {} {concat [list #X symbolatom $@x1 $@y1] $@w $@min $@max $@pos $@lab $@snd $@rcv}
def Comment    deconstruct {} {concat [list #X text       $@x1 $@y1] $@text}


def Box deconstruct {} {
	if {[array names ::fields -exact $@pdclass] == ""} {
		return [concat [list #X obj  $@x1 $@y1] $@text]
	} {
		set r {}
		foreach field $::fields($@pdclass) {lappend r $_($self:$field)}
		return $r
	}
}

def View deconstruct_to {stream args} {
	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
	$stream << ";\n"
}

def Canvas deconstruct {} {
	return [concat [list #X restore $@x1 $@y1] $@text]
}
def Canvas deconstruct_to {stream args} {
	set r [concat [list #N canvas] $@canvas_pos $@canvas_size]
	if {$@subpatch || $@abs} {lappend r $@name $@mapped} else {lappend r $@fontsize}
	$stream << "[philtre $r];\n"
	foreach i [lsort -integer [$@objects keys]] {eval [concat [list [$@objects get $i] deconstruct_to $stream]]}
	foreach i [lsort -integer [  $@wires keys]] {eval [concat [list [  $@wires get $i] deconstruct_to $stream]]}
	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
	$stream << ";\n"
}

#----------------------------------------------------------------
# openpanel & savepanel

proc pdtk_openpanel {target localdir} {
    if {$localdir == ""} {set localdir $::pd_opendir}
    set filename [tk_getOpenFile -parent $::current_window -initialdir $localdir]
    if {$filename != ""} {
        set directory [string range $filename 0 [expr [string last / $filename]-1]]
        set pd_opendir $directory
        netsend [list $target callback [enquote $filename]]
    }
}

proc pdtk_savepanel {target localdir} {
    if {$localdir == ""} {
    	set filename [tk_getSaveFile -parent $::current_window]
    } else {
    	set filename [tk_getSaveFile -parent $::current_window -initialdir $localdir]
    }
    if {$filename != ""} {
        netsend [list $target callback [enquote $filename]]
    }
}

#----------------------------------------------------------------
# To err is human.

#proc bgerror {err} {
#	set info [error_dump]
#	tk_messageBox2 -message "$err: $info" -type ok
#}

class_new OopsDialog {Dialog}

def OopsDialog init {sig1 sig2 where} {
	super damn
	wm title .$self "Oops..."
	pack [label .$self.head -text $sig2 -font {Helvetica -14 bold}] -side top
	pack [label .$self.note -text "This program has performed a silly operation and has been shut down."] -side top
	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 -height 15] -side left -fill both -expand 1
	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y
	.$self.text insert 0.0 $where
}

# Nous sommes donc en présence d'un incendie. C'est normal...
def OopsDialog damn {} {$self ok}

#----------------------------------------------------------------

if {$tk} {
	set main [Client new]
	set window_list [list $main]
} else {
	set cmdline(console) 0
	#foreach dir $auto_path {
	#	set file $dir/libtclreadline[info sharedlibextension]
	#	puts "trying $file"
	#	if {![catch {load $file}]} {puts "found tclreadline !"}
	#}
	package require tclreadline
	proc ::tclreadline::prompt1 {} {return "desire> "}
	::tclreadline::Loop
	#while {1} {
	#	#set line [::tclreadline::readline read]
	#	puts -nonewline "desire> "
	#	flush stdout
	#	set line [gets stdin]
	#	if {[catch {puts [eval $line]}]} {
	#		puts "error: $::errorInfo"
	#	}
	#}
	#vwait foo
}

def Canvas auto_test {} {
	$self editmode= 1
	$self select_all
	$self selection_move +10 0
	$self selection_move +10 0
	$self selection_move +10 0
}

#-----------------------------------------------------------------
def Canvas visual_diff {} {
	if {$@blinky != ""} {
		after cancel $@blinky
		return
	}
	#regsub {\.pd} [$self name] {} filename
	set filename [$self name]
	set initialfile ""
        foreach suffix {gif jpg jpeg png} {
	    set t [$self folder]/$filename.$suffix
	    post %s $t
	    if {[file exist $t]} {set initialfile $filename.$suffix; break}
        }
	set filename [tk_getOpenFile -parent $::current_window -defaultextension .pd \
		-filetypes $::image_filetypes -initialdir [$self folder] -initialfile $initialfile]
	if {$filename == ""} {return}
	image create photo image_$self -file $filename
	$self blink_image
}

def Canvas blink_image {} {
	if {[llength [.$self.c gettags BLINKY]]} {
		.$self.c delete BLINKY
	} else {
		.$self.c create image 0 0 -image image_$self -tag BLINKY -anchor nw
	}
	set @blinky [after 500 [list $self blink_image]]
}

#-----------------------------------------------------------------

#lappend ::auto_path /usr/local/lib/graphviz
catch {package require Tcldot}
def Canvas graphviz_sort {} {
	error "this code has to be rewritten to use the new containers"
	set nodes {}
	set gwidth 0; set gh 0
	#toplevel .graph -height 600 -width 800
	#set c [canvas .graph.c -height 600 -width 800]
	#pack $c
	set g [dotnew digraph]
	$g setnodeattribute style filled color white
	foreach child $@children {
		lappend nodes [$g addnode $child label "[$child text]" shape "record" height "0.1"]
		lappend nodes $child
	}
	puts "$nodes"
	foreach wire $@wires {
		mset {from outlet to inlet}  [$wire report]
		set n1  [lindex $nodes [expr [lsearch $nodes $from]-1]]
		set n2  [lindex $nodes [expr [lsearch $nodes   $to]-1]]
		$n1 addedge $n2
	}
	#$g layout
        ;# see what render produces
	#if {$debug} {puts [$g render]}
	#eval [$g render]
	set f {}
	set fd [open graph.txt w]
	$g write $fd plain
	close $fd

	set fd [open graph.txt r]
	set contents [read $fd]
	close $fd
	exec rm graph.txt
	mset {x1 y1 x2 y2} [[$self widget] bbox all]
	set width [expr $x2 - $x1]
	set height [expr $y2 - $y1]
	foreach line [split $contents "\n"] {
		switch [lindex $line 0] {
			graph {set gw [lindex $line 2]; set gh [lindex $line 3]}
			node {
				set w [expr $width/$gw]
				set h [expr $height/$gh]
				set id [lindex $line 1]
				set x [lindex $line 2]; set y [lindex $line 3]
				$id moveto [expr $x*$w] [expr ($gh-$y)*$h]
			}
			edge {break}
		}
	}
}

proc widget_tree {w {indent 0}} {
  foreach element [winfo children $w] {
    puts [format "%*s%s" [expr 2*$indent] "" $element]
    widget_tree $element [expr 2+$indent]
  }
}