diff options
| author | IOhannes m zmölnig <zmoelnig@users.sourceforge.net> | 2008-02-07 23:05:57 +0000 |
|---|---|---|
| committer | IOhannes m zmölnig <zmoelnig@users.sourceforge.net> | 2008-02-07 23:05:57 +0000 |
| commit | 6adfba996c34b2c78515e8a50ad5928188d78612 (patch) | |
| tree | e93ec4c07be45ae47f8e6065f21b59098998afe5 /xgui/bin | |
| parent | c0ab517b9027bd66c32f931ce592932c85f43d7b (diff) | |
reorganizing
svn path=/trunk/; revision=9376
Diffstat (limited to 'xgui/bin')
| -rwxr-xr-x | xgui/bin/pdx.sh | 6 | ||||
| -rw-r--r-- | xgui/bin/xgui-client.sh | 867 | ||||
| -rw-r--r-- | xgui/bin/xgui.bat | 1 | ||||
| -rwxr-xr-x | xgui/bin/xgui.sh | 908 |
4 files changed, 0 insertions, 1782 deletions
diff --git a/xgui/bin/pdx.sh b/xgui/bin/pdx.sh deleted file mode 100755 index 0c893b65..00000000 --- a/xgui/bin/pdx.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh -/usr/local/bin/xgui & -/usr/local/bin/pd -open /usr/local/lib/pdx/main/pdx_connect.pd \ - -path /usr/local/lib/pdx/main/ \ - -path /usr/local/lib/pdx/patch4pdx/ - diff --git a/xgui/bin/xgui-client.sh b/xgui/bin/xgui-client.sh deleted file mode 100644 index 12090187..00000000 --- a/xgui/bin/xgui-client.sh +++ /dev/null @@ -1,867 +0,0 @@ -#!/bin/sh -# the next line restarts using wish \ -exec wish "$0" "$@" - - -################################################# -puts "pd(x) - Step 2 : xgui-client" -puts "xgui b0.10 dh200209xx" -puts "Damien HENRY (c)" - -################################################# -# define the globals variables needed for a node
-global xgui_gui
-global xgui_cmd_out
-global data_data
-
-global from_all -
-global host_name
-global host_port
-global xgui_me
-set host_name localhost
-set host_port 4877
-set xgui_me "$host_name:$host_port"
-
-global pd_name
-global pd_port
-global pd_sok
-global xgui_pd -set pd_name xxx
-set pd_port 000
-set xgui_pd "$pd_name:$pd_port"
-set pd_sok -1
-
-global neibourg_list
-global neibourg_data
-set neibourg_list [list]
-set neibourg_data [list]
-set data_data [list]
-set xgui_gui 1 -set xgui_cmd_out 0
-
-#################################################
-# Read what are the argument
-if { [lsearch argv --help] != -1 } { puts "xgui localhost 4877 -nogui -no_cmd_out" } -
-#################################################
-# puts up my windows
-if { $xgui_gui } {
- global text2out - global text_from_outside
- global text_comment
- wm title . "Xgui b0.09"
- frame .haut
- frame .config1
- frame .config2 - frame .bas - entry .haut.e_in -width 50 -textvariable text2in
- entry .haut.e_fo -width 50 -textvariable text_from_outside -state disabled
- entry .haut.e_rem -width 50 -textvariable text_comment -state disabled - entry .haut.t_out -width 50 -textvariable text2out -state disabled
-
- entry .config1.host -width 10 -textvariable host_name - entry .config1.port -width 5 -textvariable host_port
-
- entry .config2.host -width 10 -textvariable pd_name - entry .config2.port -width 5 -textvariable pd_port
-
- button .config1.do -text "change" -command {
- global xgui_me
- global host_name
- global host_port - global from_all
- set xgui_me "$host_name:$host_port"
- catch {close $from_all}
- set from_all [socket -server seg_receive $host_port]
- }
-
- button .config2.do -text "change" -command {
- global xgui_pd
- global pd_name
- global pd_port
- set xgui_pd "$pd_name:$pd_port"
- catch {close $pd_sok}
- catch {set pd_sok [socket $pd_name $pd_port]}
- }
-
- button .bas.b_quit -text "quit" -width 7 -command {
- send2nodes / */ "# $xgui_me disconnected"
- do_this "$xgui_me/ ~/ disconnect *" xgui
- exit
- }
- button .bas.b_do -text do -width 7 -command { do_this $text2in xgui}
- button .bas.b_clear -text clear -width 7 -command { set text2in "" }
-
- pack .haut.e_in .haut.e_fo .haut.t_out .haut.e_rem - pack .config1.host .config1.port .config1.do -side left
- pack .config2.host .config2.port .config2.do -side left
- pack .bas.b_do .bas.b_clear .bas.b_quit -side left -pady 2 -padx 5
- pack .haut .config1 .config2 .bas -pady 2 - wm resizable . false false
-}
-
-#################################################
-# definition de la partie serveur -
-catch {set from_all [socket -server seg_receive $host_port]}
-
-proc seg_receive {channel addr port} {
- global xgui_me
- fileevent $channel readable "readLine $channel $addr $port" - do_this "/ */ # $xgui_me connected from $channel $addr $port" 0 -}
-
-proc readLine {channel addr port} {
- global neibourg_list
- global neibourg_data
- global xgui_me - global text_from_outside - if {[gets $channel line]<0} {
- fileevent $channel readable {} - after idle "close $channel"
- set n [lsearch $neibourg_data $channel]
- if {$n != -1 } {
- set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n] - } - send2nodes / */ "# $xgui_me disconnected from $addr:$port" - } else { -# catch { do_this $line $channel } - set text_from_outside "$addr:$port $line" -# set text_from_outside "$line" - do_this $line $channel - } -} - - -#################################################
-# tell that every thing OK
-set text_comment "$xgui_me created"
-
-# end of the initialisations
-########################################################################################
-
-#################################################
-#methods for xgui_node
-proc xgui_node_add_canvas {canvas_name} {
- set canvas_name [string trim $canvas_name "/"] - set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name - data_forget ~/$canvas_name - toplevel .$canvas_name
- wm title .$canvas_name $canvas_name - wm resizable .$canvas_name false false - canvas .$canvas_name.$canvas_name
- pack .$canvas_name.$canvas_name
- data_remember ~/$canvas_name/ "~/$canvas_name add_canvas"
- send2nodes / */ "# added ~/$canvas_name"
-
- set c .$canvas_name.$canvas_name
- $c bind all <Any-Enter> "itemEnter $c"
- $c bind all <Any-Leave> "itemLeave $c"
- bind $c <1> "itemStartDrag $c %x %y click" - bind $c <2> "itemStartDrag $c %x %y m-click"
- bind $c <3> "itemStartDrag $c %x %y r_click"
- bind $c <Shift-1> "itemStartDrag $c %x %y s-click" - bind $c <Shift-2> "itemStartDrag $c %x %y s-m-click"
- bind $c <Shift-3> "itemStartDrag $c %x %y s-r-click"
- bind $c <Control-1> "itemStartDrag $c %x %y c-click"
- bind $c <Control-2> "itemStartDrag $c %x %y c-m-click"
- bind $c <Control-3> "itemStartDrag $c %x %y c-r-click"
- bind $c <B1-Motion> "itemDrag $c %x %y drag"
- bind $c <B2-Motion> "itemDrag $c %x %y m-drag" - bind $c <B3-Motion> "itemDrag $c %x %y r-drag"
- bind $c <Shift-B1-Motion> "itemDrag $c %x %y s-drag"
- bind $c <Shift-B2-Motion> "itemDrag $c %x %y s-m-drag"
- bind $c <Shift-B3-Motion> "itemDrag $c %x %y s-r-drag"
- bind $c <Key> "itemKeyPress $c %A %k"
-}
-
-proc xgui_node_del_canvas {canvas_name } { - global text_comment - set canvas_name [string trim $canvas_name "/"]
- set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name
- data_forget ~/$canvas_name
- set text_comment "deleted $canvas_name" -} -
-proc xgui_node_error {from error} { - global text_comment - set text_comment "# error : unable to do <$error> ($from)" -}
-
-proc xgui_node_connect { c_who c_from channel } {
- global neibourg_list
- global neibourg_data
- global xgui_me - global text_comment - set c_from [string trim $c_from "/"]
- switch $c_who {
- "me" {
- set n [lsearch $neibourg_data $channel] - if { $n == -1 } { - lappend neibourg_list $c_from - lappend neibourg_data $channel - set text_comment "$xgui_me connect himself to $c_from onto channel $channel" - } else { - set text_comment "$xgui_me already connected to $c_from onto channel $channel" - } - } - "pd" { - global pd_name
- global pd_port - global pd_sok - global xgui_pd
- set c_host [split $c_from ":"]
- set pd_name [lindex $c_host 0]
- set pd_port [lindex $c_host 1]
- set xgui_pd "$pd_name:$pd_port"
- set pd_sok [socket -async $pd_name $pd_port]
- # set pd_sok [socket $pd_name $pd_port] - if { $pd_sok != -1 } { - set text_comment " $xgui_me connected to pd" - } else { set text_comment "connection refused with pd" }
- }
- default { - set c_host [split $c_who ":"]
- set c_name [lindex $c_host 0]
- set c_port [lindex $c_host 1]
- set sok -1 - catch {set sok [socket -async $c_name $c_port]} - if { $sok != -1 } {
- lappend neibourg_list $c_who
- lappend neibourg_data $sok - fileevent $sok readable [list read_and_do $sok] - set text_comment "$xgui_me connected $c_who" - } else { set text_comment "connection refused with $c_who" } - }
- }
-}
-
-proc xgui_node_disconnect { d_who d_from channel} {
- global neibourg_list
- global neibourg_data - global text_comment - switch $d_who {
- "me" { - set d_who [string trim $d_from "/"] - set n [lsearch $neibourg_list $d_who] - if {$n != -1 } { - catch { close [lrange $neibourg_data $n $n] } - set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n] - set text_comment "$d_who disconnected himself" - } else { set text_comment "error $d_from not a neibourg" } - } - - "pd" {
- global pd_name
- global pd_port
- global pd_sok
- global xgui_pd
- set pd_name none
- set pd_port none
- set xgui_pd "$pd_name:$pd_port" - set pd_sok -1 - catch {close pd_sok}
- } - "*" {
- foreach sok $neibourg_data { close $sok }
- set neibourg_list [list] - set neibourg_data [list] - set text_comment "$d_from disconnect *" - }
- default {
- set n [lsearch $neibourg_list $d_who]
- if {$n != -1 } {
- catch { close [lrange $neibourg_data $n $n]
} - set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n]
- set text_comment "$d_who disconnected $d_from" - } else { set text_comment "error $d_who not a neibourg" } - }
- } -} -
-proc xgui_node_hide { canvas } {
- set canvas_name [string trim $canvas_name "/"]
- set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name
-}
-
-proc xgui_node_neibourg { w_from } {
- global neibourg_list
- global neibourg_data
- global xgui_me
- foreach name $neibourg_list {
- send2nodes / $w_from "# $xgui_me connected to $name"
- }
-}
-
-proc xgui_node_clone { obj new_obj } {
- data_clone $obj $new_obj
-}
-
-proc xgui_node_load { file } {
- data_load $file
-}
-
-proc xgui_node_save { obj file } {
- data_save $obj $file
-}
-
-proc xgui_node_load_coord { file } {
- data_load_send $file
-}
-
-proc xgui_node_save_coord { obj file } {
- data_save_param $obj coord $file -}
-
-proc xgui_node_debug { from var } { - global host_name
- global host_port
- global xgui_me - global neibourg_list - global neibourg_data
- global xgui_gui
- global xgui_cmd_out
- global data_data
- global text_comment
- global pd_name
- global pd_port - global pd_sok
- global xgui_pd - global from_all
- set text_comment "$var = [subst $var ]"
-} - -proc xgui_node_help { w_from } {
- send2nodes / $w_from "# method: connect who"
- send2nodes / $w_from "# method: disconnect who"
- send2nodes / $w_from "# method: neibourg"
- send2nodes / $w_from "# method: ping"
- send2nodes / $w_from "# method: add_canvas"
- send2nodes / $w_from "# method: del_canvas"
-}
-#################################################
-#methods for canvas
-
-proc canvas_size {canvas_name x y} {
- .$canvas_name.$canvas_name configure -width $x
- .$canvas_name.$canvas_name configure -height $y
- wm geometry .$canvas_name
- data_remember ~/$canvas_name//size "~/$canvas_name size $x $y"
-}
-
-proc canvas_color {canvas_name color} {
- .$canvas_name.$canvas_name configure -bg $color
- data_remember ~/$canvas_name//color "~/$canvas_name color $color"
- }
-
-#################################################
-#methods for all objects
-
-proc obj_move {canvas gobj_name x y } {
- global xgui_pd
- catch {.$canvas.$canvas move $gobj_name $x $y
- send2pd / pd/$canvas/$gobj_name "coord [.$canvas.$canvas coords $gobj_name]"
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [.$canvas.$canvas coords $gobj_name]"
- }
-}
-
-proc obj_color {canvas gobj_name new_color} { - .$canvas.$canvas itemconfigure $gobj_name -fill $new_color
- data_remember ~/$canvas/$gobj_name//color "~/$canvas/$gobj_name color $new_color"
-} -
-proc obj_border {canvas gobj_name new_color} {
- .$canvas.$canvas itemconfigure $gobj_name -outline $new_color - data_remember ~/$canvas/$gobj_name//border "~/$canvas/$gobj_name border $new_color" -}
-
-proc obj_raise {canvas gobj_name } {
- .$canvas.$canvas raise $gobj_name
- data_remember ~/$canvas/$gobj_name//raise "~/$canvas/$gobj_name raise"
-}
- -proc obj_coord {canvas gobj_name x1 y1 x2 y2 } {
- catch { - .$canvas.$canvas coords $gobj_name $x1 $y1 $x2 $y2
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 $x2 $y2"
- } -} -
-proc obj_xy1 {canvas gobj_name x1 y1 } {
- catch {
- set old_coord [.$canvas.$canvas coords $gobj_name]
- .$canvas.$canvas coords $gobj_name $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]"
- }
-}
-
-proc obj_xy2 {canvas gobj_name x2 y2 } {
- catch {
- set old_coord [.$canvas.$canvas coords $gobj_name]
- .$canvas.$canvas coords $gobj_name [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2"
- }
-}
-
-proc obj_width {canvas gobj_name new_width} {
- .$canvas.$canvas itemconfigure $gobj_name -width $new_width
- data_remember ~/$canvas/$gobj_name//width "~/$canvas/$gobj_name width $new_width"
-}
-
-proc obj_near {canvas gobj_name x y} {
- # to be done...
-}
-
-proc obj_del {canvas obj_name} {
- .$canvas.$canvas delete $obj_name
- send2nodes /$canvas */$canvas "# deleted $obj_name"
- data_forget ~/$canvas/$obj_name
-}
-
-#################################################
-#methods for seg
- -proc seg_add {canvas gobj_name x1 y1 x2 y2 } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create line $x1 $y1 $x2 $y2 -width 3 -tags $gobj_name -capstyle round
- # send2nodes /$canvas */$canvas "added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_seg" -} -
-proc seg_caps {canvas gobj_name new_cap} {
- .$canvas.$canvas itemconfigure $gobj_name -capstyle $new_cap
- data_remember ~/$canvas/$gobj_name//caps "~/$canvas/$gobj_name caps $new_cap"
-}
-
-################################################# -#methods for text
- -proc text_add {canvas gobj_name x1 y1 text } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create text $x1 $y1 -text $text -tags $gobj_name -anchor sw - # send2nodes /$canvas */$canvas "added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_text"
-}
-
-proc text_value {canvas gobj_name value} {
- .$canvas.$canvas itemconfigure $gobj_name -text $value
- data_remember ~/$canvas/$gobj_name//text "~/$canvas/$gobj_name text $value"
-}
-
-proc text_anchor {canvas gobj_name value} { - .$canvas.$canvas itemconfigure $gobj_name -anchor $value
- data_remember ~/$canvas/$gobj_name//anchor "~/$canvas/$gobj_name anchor $value"
-}
-
-proc text_justify {canvas gobj_name value} {
- .$canvas.$canvas itemconfigure $gobj_name -justify $value
- data_remember ~/$canvas/$gobj_name//justify "~/$canvas/$gobj_name justify $value"
-}
-
-proc text_pos {canvas gobj_name x y} {
- .$canvas.$canvas coords $gobj_name $x $y
- data_remember ~/$canvas/$gobj_name//pos "~/$canvas/$gobj_name pos $x $y"
-}
-
-#################################################
-#methods for rect
-
-proc rect_add {canvas gobj_name x1 y1 x2 y2 } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name
- .$canvas.$canvas create rectangle $x1 $y1 $x2 $y2 -width 2 -tags $gobj_name
- # send2nodes /$canvas */$canvas "# added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_rect"
-}
- -#################################################
-#methods for arc
- -proc arc_add {canvas gobj_name x1 y1 x2 y2 start width} {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create arc $x1 $y1 $x2 $y2 -start $start -extent $width -width 2 -tags $gobj_name - # send2nodes /$canvas */$canvas "# added $gobj_name "
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_arc"
-}
-
-proc arc_start {canvas gobj_name new_start} {
- .$canvas.$canvas itemconfigure $gobj_name -start $new_start
- data_remember ~/$canvas/$gobj_name//start "~/$canvas/$gobj_name start $new_start"} -
-proc arc_width {canvas gobj_name new_width} { - .$canvas.$canvas itemconfigure $gobj_name -extent $new_width
- data_remember ~/$canvas/$gobj_name//angle "~/$canvas/$gobj_name angle $new_width"}
- -proc arc_style {canvas gobj_name new_style} { - .$canvas.$canvas itemconfigure $gobj_name -style $new_style
- data_remember ~/$canvas/$gobj_name//style "~/$canvas/$gobj_name style $new_style "}
-
-################################################
-# Set up event bindings for all canvas:
-
-proc itemStartDrag {c x y event} {
- global xgui_pd
- global lastX lastY
- global my_selected
- set lastX [$c canvasx $x] - set lastY [$c canvasy $y]
- set my_selected [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_selected "$event $x $y" -}
-
-proc itemDrag {c x y event} {
- global xgui_pd
- global lastX lastY
- global my_selected
- set x [$c canvasx $x]
- set y [$c canvasy $y]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_selected "$event [expr $x-$lastX] [expr $y-$lastY]"
- set lastX $x
- set lastY $y
-}
-
-proc itemEnter {c} {
- global xgui_pd
- set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item enter
-} -
-proc itemLeave {c} {
- global xgui_pd - set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item leave -} -
-proc itemKeyPress {c ascii num} {
- global xgui_pd
- set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item "keypress $ascii $num"
- send2pd / pd/$c "keypress $ascii $num" -}
- -#####################################################################################
-# Here the procedures that keep a memory about all objectz.
- -proc data_remember {obj_sel m} { - global data_data
- set line_to_destroy 0
- foreach line $data_data {
- if {[string match "$obj_sel/*" $line] == 1} {
- set line_to_destroy $line
- }
- }
- if { $line_to_destroy !=0 } {
- set n [lsearch $data_data $line_to_destroy ]
- set data_data [lreplace $data_data $n $n "$obj_sel/ $m" ]
- } else {
- lappend data_data "$obj_sel/ $m" - }
-}
- -proc data_forget { obj } {
- global data_data
- while { [lsearch $data_data $obj/* ] != -1} {
- set n [lsearch $data_data $obj/* ]
- set data_data [lreplace $data_data $n $n]
- }
-}
-
-proc data_clone { from_obj to_new_obj } {
- global data_data
- foreach line $data_data {
- if {[string match "$from_obj/*" $line] == 1} {
- set new_line [join [lreplace [split $line] 0 0 ] ]
- regsub -all -- $from_obj $new_line $to_new_obj newest_line
- do_this "~/ $newest_line" 0
- }
- }
-}
-
-proc data_save { from_obj file } { - global data_data
- set file_chn [open $file w]
- foreach line $data_data { - if {[string match "$from_obj/*" $line] == 1} {
- set new_line [join [lreplace [split $line] 0 0 ] ]
- puts $file_chn "$new_line" - } - }
- close $file_chn
-}
-
-proc data_save_param { from_obj selector file } {
- global data_data
- set file_chn [open $file w] - foreach line $data_data {
- if {[string match "$from_obj/*//$selector*" $line] == 1} { - set new_line [join [lreplace [split $line] 0 0 ] ]
- puts $file_chn "$new_line"
- } - } - close $file_chn
-}
-
-proc data_load { file } {
- global data_data
- set file_chn [open $file r]
- while {[eof $file_chn]==0} {
- set line [gets $file_chn]
- do_this "~/ $line" 0
- }
- close $file_chn
-}
- -proc data_load_send { file } {
- global data_data - set file_chn [open $file r]
- while {[eof $file_chn]==0} {
- set line [gets $file_chn]
- set line2s [split $line]
- set line2s [join [linsert $line2s 1 update]]
-# regsub -all -- ~/ $line2s */ new_line
-# do_this "~/ $line" 0
- send2pd / $line2s ""
- }
- close $file_chn -} - - -################################################################################################ -#anything to send somewhere ??? -proc send2nodes { m_from m_to ms2send } { - global xgui_gui - global xgui_cmd_out - global text2out - global xgui_me - global neibourg_list - global neibourg_data - - global text_comment - - set m2send "$xgui_me$m_from $m_to $ms2send" - set m_to [string trim $m_to "/"] - set m_to_l [split $m_to "/"] - set m_to_node [lindex $m_to_l 0] - - if { $xgui_gui == 1 } { - set text2out $m2send - } - if { $xgui_cmd_out == 1 } { - puts $m2send - } - - switch [lindex [split $m_to "/"] 0 ] { - "*" { - foreach n $neibourg_list { - regsub -all -- {\*} $m_to $n m2 - send2nodes $m_from $m2 $ms2send - } - } - "." { - foreach n $neibourg_data { - catch {puts $n $ms2send;flush $n} - } - } - default { - set n [lsearch $neibourg_list $m_to_node] - if { $n != -1 } { - # if catch = error then we have to remove the link. - catch { - puts [lrange $neibourg_data $n $n] "$m2send;" - flush [lrange $neibourg_data $n $n] - } - } else { - set $text_comment "didn't find any coresponding neigbourg" - } - } - } -} - -proc send2pd { m_from m_to ms2send } { - global xgui_gui - global xgui_cmd_out - global text2out - global xgui_me - global pd_sok - - set m2send "$xgui_me$m_from $m_to $ms2send;" - - if { $xgui_gui == 1 } { - set text2out $m2send - } - if { $xgui_cmd_out == 1 } { - puts $m2send - } - - # catch { - puts $pd_sok $m2send ; flush $pd_sok - # } -} - - -##################################################################################### -# the 3 main proc that do every thing ########################################## -##################################################################################### - -proc read_and_do { channel } { - gets $channel message - global text_from_outside - set text_from_outside "$channel \"$message" - do_this $message $channel -} - -proc do_this { m channel} {
- global xgui_me
- set m [string trim $m ";"] - if {[llength $m] >= 3} {
- set m_to [string trim [lindex $m 1] "/"] - set m_to_l [split $m_to "/"]
- set m_to_node [lindex $m_to_l 0]
- set m_from [string trim [lindex $m 0] "/"] - set m_cmd [lrange $m 2 end]
- #you have to know who you are :
- if { "$m_to_node" == "$xgui_me" } { set m_to_node "~" } - switch $m_to_node { - "~" { catch {do_this_here $m_from $m_to $m_cmd $channel}
} - "*" { - # you too are a part of the whole !!!
- catch { do_this_here $m_from $m_to $m_cmd $channel
} - send2nodes / $m_to "[lrange $m 2 end]" - } - "pd" {send2pd / $m_to "[lrange $m 2 end]"} - default {send2nodes / $m_to "[lrange $m 2 end]"}
- } - } else {
- if {$m == "help"} { - # send2nodes / $m_to "# syntax : sender receiver method args..." - } else { - xgui_node_error "not enought args" $m
- }
- }
-}
-
-proc do_this_here { m_from m_to m_cmd channel} { - global xgui_me - global xgui_pd - set m_to [split $m_to "/"]
- set m_from_l [split $m_from "/"]
- set m_from_node [lindex $m_from_l 0]
- set m_selector [lindex $m_cmd 0]
- set m_argc [llength $m_cmd]-1 - if {$m_argc >= 1} { set m_argv [lrange $m_cmd 1 end]
- set a1 [lindex $m_argv 0]
- if {$m_argc >=2 } { set a2 [lindex $m_argv 1]
- if {$m_argc >=3 } { set a3 [lindex $m_argv 2]
- if {$m_argc >=4 } { set a4 [lindex $m_argv 3]
- if {$m_argc >=5 } { set a5 [lindex $m_argv 4]
- if {$m_argc >=6 } { set a6 [lindex $m_argv 5]
- if {$m_argc >=7 } { set a7 [lindex $m_argv 6]
- if {$m_argc >=8 } { set a8 [lindex $m_argv 7]
- if {$m_argc >=9 } { set a9 [lindex $m_argv 8]
- if {$m_argc >=10 } { set a10 [lindex $m_argv 9]
- } } } } } } } } }
- } else {set m_argv "{}" }
-
- switch [llength $m_to] { - 1 { # this is for the node ########################## - switch $m_selector {
- "add_canvas" { xgui_node_add_canvas $a1}
- "del_canvas" { xgui_node_del_canvas $a1}
- "show" { xgui_node_clone $a1 $a1 }
- "hide" { xgui_node_hide } - "connect" { if {$a1 == "pd"} { xgui_node_connect pd $a2 $channel - } else { xgui_node_connect $a1 $m_from $channel} } - "connect_on" { xgui_node_connect $a1 $m_from $channel - send2nodes / $a1/ "connect me" - send2nodes / $a1/ "clone ~/$a2 $xgui_me/$a2" - send2nodes / $a1/ "connect_on_pd $xgui_me" } - "connect_on_pd" { send2nodes / $a1/ "connect pd $xgui_pd" } - "disconnect" { xgui_node_disconnect $a1 $m_from $channel} - - "neibourg" { xgui_node_neibourg $m_from }
- "clone" { xgui_node_clone $a1 $a2 }
- "save" { xgui_node_save $a1 $a2 } - "save_coord" { xgui_node_save_coord $a1 $a2 }
- "load_coord" { xgui_node_load_coord $a1 }
- "load" { xgui_node_load $a1 } - "help" { xgui_node_help $m_from } - "debug" { xgui_node_debug $m_from $$a1 }
- "ping" { send2nodes / $m_from "# $m_from pinged" } - "#" { global text_comment ; set text_comment $m_argv}
- default { xgui_node_error "node method $m_selector does not exist" $m_cmd } - }
- }
- 2 { # this is for the canvas $m_c ########################## - set m_c [lindex $m_to 1] - switch $m_selector {
- "add_canvas" { catch {xgui_node_add_canvas $m_c }}
- "del_canvas" { xgui_node_del_canvas $m_c }
- "size" {canvas_size $m_c $a1 $a2}
- "color" {canvas_color $m_c $a1}
- "del" {obj_del $m_c $a1}
- "kill" {obj_del $m_c $a1}
- "add_seg" {seg_add $m_c $a1 10 10 20 20 }
- "add_text" {text_add $m_c $a1 10 10 "text" }
- "add_rect" {rect_add $m_c $a1 10 10 20 20 }
- "add_arc" {arc_add $m_c $a1 10 10 20 20 0 90 }
- default {xgui_node_error "canvas method $m_selector does not exist" $m_cmd }
- }
- }
- 3 { # this is for the object $m_o witch is into $m_c ########
- set m_c [lindex $m_to 1]
- set m_o [lindex $m_to 2]
- switch $m_selector {
- "add_seg" {seg_add $m_c $m_o 10 10 20 20 }
- "add_text" {text_add $m_c $m_o 10 10 "text" }
- "add_rect" {rect_add $m_c $m_o 10 10 20 20 }
- "add_arc" {arc_add $m_c $m_o 10 10 20 20 0 90 }
- "del" {obj_del $m_c $m_o}
- "kill" {obj_del $m_c $m_o}
- "show" {obj_show $m_c $m_o }
- "hide" {obj_hide $m_c $m_o } - "move" {obj_move $m_c $m_o $a1 $a2}
- "scale" {obj_scale $m_c $m_o $a1 $a2 $a3 $a4 }
- "raise" {obj_raise $m_c $m_o }
- "near" {obj_near $m_c $m_o $a1 $a2 }
- "color" {obj_color $m_c $m_o $a1}
- "width" {obj_width $m_c $m_o $a1}
- "coord" {obj_coord $m_c $m_o $a1 $a2 $a3 $a4 }
- "xy1" {obj_xy1 $m_c $m_o $a1 $a2 } - "xy2" {obj_xy2 $m_c $m_o $a1 $a2 }
- "border" {obj_border $m_c $m_o $a1}
-
- "caps" {seg_caps $m_c $m_o $a1} - - "text" {text_value $m_c $m_o $a1}
- "pos" {text_pos $m_c $m_o $a1 $a2 }
- "anchor" {text_anchor $m_c $m_o $a1}
- "justify" {text_justify $m_c $m_o $a1} -
- "start" {arc_start $m_c $m_o $a1 }
- "angle" { arc_width $m_c $m_o $a1 } - "style" {arc_style $m_c $m_o $a1} -
- default {xgui_node_error "obj_method $m_selector does not exist" $m_argv }
- }
- }
- }
-}
-
diff --git a/xgui/bin/xgui.bat b/xgui/bin/xgui.bat deleted file mode 100644 index 4133fe0e..00000000 --- a/xgui/bin/xgui.bat +++ /dev/null @@ -1 +0,0 @@ -..\..\bin\wish83.exe .\xgui.sh --help
diff --git a/xgui/bin/xgui.sh b/xgui/bin/xgui.sh deleted file mode 100755 index da0bfcd6..00000000 --- a/xgui/bin/xgui.sh +++ /dev/null @@ -1,908 +0,0 @@ -#!/bin/sh -# the next line restarts using wish \ -exec wish "$0" "$@" - - -################################################# -puts "pd(x) - Step 2 : xgui" -puts "xgui b0.10 dh200209xx" -puts "Damien HENRY (c)" - -################################################# -# define the globals variables needed for a node -global xgui_gui
-global xgui_cmd_out
-global data_data
-
-global from_all -
-global host_name
-global host_port
-global xgui_me
-set host_name localhost -set host_port 4877 -set xgui_me "$host_name:$host_port"
-
-global pd_name
-global pd_port
-global pd_sok
-global xgui_pd -set pd_name xxx
-set pd_port 000
-set xgui_pd "$pd_name:$pd_port"
-set pd_sok -1
-
-global neibourg_list
-global neibourg_data
-set neibourg_list [list]
-set neibourg_data [list]
-set data_data [list]
-set xgui_gui 1 -set xgui_cmd_out 0 - -global time4flush -set time4flush 20 -
-#################################################
-# Read what are the argument
-if { [lsearch argv --help] != -1 } { puts "xgui localhost 4877 -nogui -no_cmd_out" } -
-#################################################
-# puts up my windows -proc xgui_node_visu {onoff} { - set xgui_gui $onoff - if { $xgui_gui } { - global text2out - global text_from_outside - global text_comment - wm title . "Xgui b0.09" - frame .haut - frame .config1 - frame .config2 - frame .bas - entry .haut.e_in -width 50 -textvariable text2in - entry .haut.e_fo -width 50 -textvariable text_from_outside -state disabled - entry .haut.e_rem -width 50 -textvariable text_comment -state disabled - entry .haut.t_out -width 50 -textvariable text2out -state disabled - - entry .config1.host -width 10 -textvariable host_name - entry .config1.port -width 5 -textvariable host_port - - entry .config2.host -width 10 -textvariable pd_name - entry .config2.port -width 5 -textvariable pd_port - - button .config1.do -text "change" -command { - global xgui_me - global host_name - global host_port - global from_all - set xgui_me "$host_name:$host_port" - catch {close $from_all} - set from_all [socket -server seg_receive $host_port] - } - - button .config2.do -text "change" -command { - global xgui_pd - global pd_name - global pd_port - set xgui_pd "$pd_name:$pd_port" - catch {close $pd_sok} - catch {set pd_sok [socket $pd_name $pd_port]} - } - - button .bas.b_quit -text "quit" -width 7 -command { - send2nodes / */ "# $xgui_me disconnected" - do_this "$xgui_me/ ~/ disconnect *" xgui - exit - } - button .bas.b_do -text do -width 7 -command { do_this $text2in xgui} - button .bas.b_clear -text clear -width 7 -command { set text2in "" } - - pack .haut.e_in .haut.e_fo .haut.t_out .haut.e_rem - pack .config1.host .config1.port .config1.do -side left - pack .config2.host .config2.port .config2.do -side left - pack .bas.b_do .bas.b_clear .bas.b_quit -side left -pady 2 -padx 5 - pack .haut .config1 .config2 .bas -pady 2 - wm resizable . false false - } -} - -################################################# -# definition de la partie serveur -#catch { - set from_all [socket -server seg_receive $host_port] -#} - -proc seg_receive {channel addr port} { - global xgui_me - fileevent $channel readable "readLine $channel $addr $port" - do_this "/ */ # $xgui_me connected from $channel $addr $port" 0 -}
-
-proc readLine {channel addr port} {
- global neibourg_list
- global neibourg_data
- global xgui_me - global text_from_outside - if {[gets $channel line]<0} {
- fileevent $channel readable {} - after idle "close $channel"
- set n [lsearch $neibourg_data $channel]
- if {$n != -1 } {
- set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n] - } - send2nodes / */ "# $xgui_me disconnected from $addr:$port" - } else { - set text_from_outside "$addr:$port $line" - # catch { - do_this $line $channel - # } - } -} - - -#################################################
-# tell that every thing OK
-set text_comment "$xgui_me created"
-
-# end of the initialisations
-########################################################################################
-
-#################################################
-#methods for xgui_node - -proc xgui_node_name { name port } { - global xgui_me - global host_name - global host_port - global from_all - set host_name $name - set host_port $port - set xgui_me "$host_name:$host_port" - catch {close $from_all} - set from_all [socket -server seg_receive $host_port] -} - -proc xgui_node_gui { on_off } { - if ( on_off == on ) { - } -} - -proc xgui_node_add_canvas {canvas_name} { - set canvas_name [string trim $canvas_name "/"] - set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name - data_forget ~/$canvas_name - toplevel .$canvas_name
- wm title .$canvas_name $canvas_name - wm resizable .$canvas_name false false - canvas .$canvas_name.$canvas_name
- pack .$canvas_name.$canvas_name
- data_remember ~/$canvas_name/ "~/$canvas_name add_canvas"
- send2nodes / */ "# added ~/$canvas_name"
-
- set c .$canvas_name.$canvas_name
- $c bind all <Any-Enter> "itemEnter $c"
- $c bind all <Any-Leave> "itemLeave $c"
- bind $c <1> "itemStartDrag $c %x %y click" - bind $c <2> "itemStartDrag $c %x %y m-click"
- bind $c <3> "itemStartDrag $c %x %y r_click" - bind $c <Shift-1> "itemStartDrag $c %x %y s-click" - bind $c <Shift-2> "itemStartDrag $c %x %y s-m-click"
- bind $c <Shift-3> "itemStartDrag $c %x %y s-r-click" - bind $c <Control-1> "itemStartDrag $c %x %y c-click" - bind $c <Control-2> "itemStartDrag $c %x %y c-m-click"
- bind $c <Control-3> "itemStartDrag $c %x %y c-r-click"
- bind $c <B1-Motion> "itemDrag $c %x %y drag"
- bind $c <B2-Motion> "itemDrag $c %x %y m-drag" - bind $c <B3-Motion> "itemDrag $c %x %y r-drag"
- bind $c <Shift-B1-Motion> "itemDrag $c %x %y s-drag"
- bind $c <Shift-B2-Motion> "itemDrag $c %x %y s-m-drag"
- bind $c <Shift-B3-Motion> "itemDrag $c %x %y s-r-drag"
- bind $c <Key> "itemKeyPress $c %A %k"
-}
-
-proc xgui_node_del_canvas {canvas_name } { - global text_comment - set canvas_name [string trim $canvas_name "/"]
- set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name
- data_forget ~/$canvas_name
- set text_comment "deleted $canvas_name" -} -
-proc xgui_node_error {from error} { - global text_comment - set text_comment "# error : unable to do <$error> ($from)" -}
-
-proc xgui_node_connect { c_who c_from channel } {
- global neibourg_list
- global neibourg_data
- global xgui_me - global text_comment - set c_from [string trim $c_from "/"] - switch $c_who {
- "me" {
- set n [lsearch $neibourg_data $channel] - if { $n == -1 } { - lappend neibourg_list $c_from - lappend neibourg_data $channel - set text_comment "$xgui_me connect himself to $c_from onto channel $channel" -# fconfigure $channel -blocking false -bufering line - } else { - set text_comment "$xgui_me already connected to $c_from onto channel $channel" - } - } - "pd" { - global pd_name
- global pd_port - global pd_sok - global xgui_pd
- set c_host [split $c_from ":"]
- set pd_name [lindex $c_host 0]
- set pd_port [lindex $c_host 1] - set xgui_pd "$pd_name:$pd_port" -# test perf a faire.... - set pd_sok [socket -async $pd_name $pd_port] -# set pd_sok [socket $pd_name $pd_port] - if { $pd_sok != -1 } { - set text_comment " $xgui_me connected to pd" -# fconfigure $pd_sok -blocking false -bufering line - } else { set text_comment "connection refused with pd" } - }
- default { - set c_host [split $c_who ":"]
- set c_name [lindex $c_host 0]
- set c_port [lindex $c_host 1]
- set sok -1 - catch {set sok [socket -async $c_name $c_port]} - if { $sok != -1 } {
- lappend neibourg_list $c_who
- lappend neibourg_data $sok - fileevent $sok readable [list read_and_do $sok] -# fconfigure $sok -blocking false -bufering line - set text_comment "$xgui_me connected $c_who" - } else { set text_comment "connection refused with $c_who" } - }
- }
-}
-
-proc xgui_node_disconnect { d_who d_from channel} {
- global neibourg_list
- global neibourg_data - global text_comment - switch $d_who {
- "me" { - set d_who [string trim $d_from "/"] - set n [lsearch $neibourg_list $d_who] - if {$n != -1 } { - catch { close [lrange $neibourg_data $n $n] } - set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n] - set text_comment "$d_who disconnected himself" - } else { set text_comment "error $d_from not a neibourg" } - } - - "pd" {
- global pd_name
- global pd_port
- global pd_sok
- global xgui_pd
- set pd_name none
- set pd_port none
- set xgui_pd "$pd_name:$pd_port" - set pd_sok -1 - catch {close pd_sok}
- } - "*" {
- foreach sok $neibourg_data { close $sok }
- set neibourg_list [list] - set neibourg_data [list] - set text_comment "$d_from disconnect *" - }
- default { - set n [lsearch $neibourg_list $d_who]
- if {$n != -1 } {
- catch { close [lrange $neibourg_data $n $n]
} - set neibourg_list [lreplace $neibourg_list $n $n] - set neibourg_data [lreplace $neibourg_data $n $n]
- set text_comment "$d_who disconnected $d_from" - } else { set text_comment "error $d_who not a neibourg" } - }
- } -} -
-proc xgui_node_hide { canvas } {
- set canvas_name [string trim $canvas_name "/"]
- set canvas_name [split $canvas_name "/"]
- set canvas_name [lindex $canvas_name end]
- destroy .$canvas_name
-}
-
-proc xgui_node_neibourg { w_from } {
- global neibourg_list
- global neibourg_data
- global xgui_me
- foreach name $neibourg_list {
- send2nodes / $w_from "# $xgui_me connected to $name"
- }
-}
-
-proc xgui_node_clone { obj new_obj } {
- data_clone $obj $new_obj
-}
-
-proc xgui_node_load { file } {
- data_load $file -}
-
-proc xgui_node_save { obj file } {
- data_save $obj $file
-}
-
-proc xgui_node_load_coord { file } {
- data_load_send $file
-}
-
-proc xgui_node_save_coord { obj file } {
- data_save_param $obj coord $file -}
-
-proc xgui_node_debug { from var } { - global host_name
- global host_port
- global xgui_me - global neibourg_list - global neibourg_data - global xgui_gui
- global xgui_cmd_out - global data_data
- global text_comment
- global pd_name
- global pd_port - global pd_sok
- global xgui_pd - global from_all
- set text_comment "$var = [subst $var ]"
-} - -proc xgui_node_help { w_from } {
- send2nodes / $w_from "# method: connect who"
- send2nodes / $w_from "# method: disconnect who"
- send2nodes / $w_from "# method: neibourg"
- send2nodes / $w_from "# method: ping"
- send2nodes / $w_from "# method: add_canvas"
- send2nodes / $w_from "# method: del_canvas"
-}
-#################################################
-#methods for canvas
-
-proc canvas_size {canvas_name x y} {
- .$canvas_name.$canvas_name configure -width $x
- .$canvas_name.$canvas_name configure -height $y
- wm geometry .$canvas_name
- data_remember ~/$canvas_name//size "~/$canvas_name size $x $y"
-}
-
-proc canvas_color {canvas_name color} {
- .$canvas_name.$canvas_name configure -bg $color
- data_remember ~/$canvas_name//color "~/$canvas_name color $color"
- }
-
-#################################################
-#methods for all objects
-
-proc obj_move {canvas gobj_name x y } {
- global xgui_pd
- catch {.$canvas.$canvas move $gobj_name $x $y
- send2pd / pd/$canvas/$gobj_name "coord [.$canvas.$canvas coords $gobj_name]"
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [.$canvas.$canvas coords $gobj_name]"
- }
-}
-
-proc obj_color {canvas gobj_name new_color} { - .$canvas.$canvas itemconfigure $gobj_name -fill $new_color
- data_remember ~/$canvas/$gobj_name//color "~/$canvas/$gobj_name color $new_color"
-} -
-proc obj_border {canvas gobj_name new_color} {
- .$canvas.$canvas itemconfigure $gobj_name -outline $new_color - data_remember ~/$canvas/$gobj_name//border "~/$canvas/$gobj_name border $new_color" -}
-
-proc obj_raise {canvas gobj_name } { - .$canvas.$canvas raise $gobj_name
- data_remember ~/$canvas/$gobj_name//raise "~/$canvas/$gobj_name raise"
-}
- -proc obj_coord {canvas gobj_name x1 y1 x2 y2 } {
- catch { - .$canvas.$canvas coords $gobj_name $x1 $y1 $x2 $y2
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 $x2 $y2"
- } -} -
-proc obj_xy1 {canvas gobj_name x1 y1 } {
- catch {
- set old_coord [.$canvas.$canvas coords $gobj_name]
- .$canvas.$canvas coords $gobj_name $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]"
- }
-}
-
-proc obj_xy2 {canvas gobj_name x2 y2 } {
- catch {
- set old_coord [.$canvas.$canvas coords $gobj_name]
- .$canvas.$canvas coords $gobj_name [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2
- data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2"
- }
-}
-
-proc obj_width {canvas gobj_name new_width} {
- .$canvas.$canvas itemconfigure $gobj_name -width $new_width
- data_remember ~/$canvas/$gobj_name//width "~/$canvas/$gobj_name width $new_width"
-}
-
-proc obj_near {canvas gobj_name x y} {
- # to be done...
-}
-
-proc obj_del {canvas obj_name} {
- .$canvas.$canvas delete $obj_name
- send2nodes /$canvas */$canvas "# deleted $obj_name"
- data_forget ~/$canvas/$obj_name
-}
-
-#################################################
-#methods for seg
- -proc seg_add {canvas gobj_name x1 y1 x2 y2 } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create line $x1 $y1 $x2 $y2 -width 3 -tags $gobj_name -capstyle round
- # send2nodes /$canvas */$canvas "added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_seg" -} -
-proc seg_caps {canvas gobj_name new_cap} {
- .$canvas.$canvas itemconfigure $gobj_name -capstyle $new_cap - data_remember ~/$canvas/$gobj_name//caps "~/$canvas/$gobj_name caps $new_cap"
-}
-
-################################################# -#methods for text
- -proc text_add {canvas gobj_name x1 y1 text } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create text $x1 $y1 -text $text -tags $gobj_name -anchor sw - # send2nodes /$canvas */$canvas "added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_text"
-}
-
-proc text_value {canvas gobj_name value} {
- .$canvas.$canvas itemconfigure $gobj_name -text $value
- data_remember ~/$canvas/$gobj_name//text "~/$canvas/$gobj_name text $value"
-}
-
-proc text_anchor {canvas gobj_name value} { - .$canvas.$canvas itemconfigure $gobj_name -anchor $value
- data_remember ~/$canvas/$gobj_name//anchor "~/$canvas/$gobj_name anchor $value"
-}
-
-proc text_justify {canvas gobj_name value} {
- .$canvas.$canvas itemconfigure $gobj_name -justify $value
- data_remember ~/$canvas/$gobj_name//justify "~/$canvas/$gobj_name justify $value"
-}
-
-proc text_pos {canvas gobj_name x y} {
- .$canvas.$canvas coords $gobj_name $x $y
- data_remember ~/$canvas/$gobj_name//pos "~/$canvas/$gobj_name pos $x $y"
-}
-
-#################################################
-#methods for rect
-
-proc rect_add {canvas gobj_name x1 y1 x2 y2 } {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name
- .$canvas.$canvas create rectangle $x1 $y1 $x2 $y2 -width 2 -tags $gobj_name
- # send2nodes /$canvas */$canvas "# added $gobj_name"
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_rect"
-}
- -#################################################
-#methods for arc
- -proc arc_add {canvas gobj_name x1 y1 x2 y2 start width} {
- .$canvas.$canvas delete $gobj_name
- data_forget ~/$canvas/$gobj_name - .$canvas.$canvas create arc $x1 $y1 $x2 $y2 -start $start -extent $width -width 2 -tags $gobj_name - # send2nodes /$canvas */$canvas "# added $gobj_name "
- data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_arc"
-} -
-proc arc_start {canvas gobj_name new_start} {
- .$canvas.$canvas itemconfigure $gobj_name -start $new_start
- data_remember ~/$canvas/$gobj_name//start "~/$canvas/$gobj_name start $new_start"} -
-proc arc_width {canvas gobj_name new_width} { - .$canvas.$canvas itemconfigure $gobj_name -extent $new_width
- data_remember ~/$canvas/$gobj_name//angle "~/$canvas/$gobj_name angle $new_width"}
- -proc arc_style {canvas gobj_name new_style} { - .$canvas.$canvas itemconfigure $gobj_name -style $new_style
- data_remember ~/$canvas/$gobj_name//style "~/$canvas/$gobj_name style $new_style "}
-
-################################################
-# Set up event bindings for all canvas:
-
-proc itemStartDrag {c x y event} {
- global xgui_pd
- global lastX lastY
- global my_selected
- set lastX [$c canvasx $x] - set lastY [$c canvasy $y]
- set my_selected [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_selected "$event $x $y" -}
-
-proc itemDrag {c x y event} {
- global xgui_pd
- global lastX lastY
- global my_selected
- set x [$c canvasx $x]
- set y [$c canvasy $y]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_selected "$event [expr $x-$lastX] [expr $y-$lastY]"
- set lastX $x
- set lastY $y
-}
-
-proc itemEnter {c} {
- global xgui_pd
- set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item enter
-} -
-proc itemLeave {c} {
- global xgui_pd - set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item leave -} -
-proc itemKeyPress {c ascii num} {
- global xgui_pd - set my_item [lindex [$c gettags current] 0]
- set c [lindex [split $c "."] 1]
- send2pd / pd/$c/$my_item "keypress $ascii $num"
- send2pd / pd/$c "keypress $ascii $num" -}
- -#####################################################################################
-# Here the procedures that keep a memory about all objectz.
- -proc data_remember {obj_sel m} { - global data_data
- set line_to_destroy 0
- foreach line $data_data {
- if {[string match "$obj_sel/*" $line] == 1} {
- set line_to_destroy $line
- }
- }
- if { $line_to_destroy !=0 } {
- set n [lsearch $data_data $line_to_destroy ]
- set data_data [lreplace $data_data $n $n "$obj_sel/ $m" ]
- } else {
- lappend data_data "$obj_sel/ $m" - }
-}
- -proc data_forget { obj } {
- global data_data
- while { [lsearch $data_data $obj/* ] != -1} {
- set n [lsearch $data_data $obj/* ]
- set data_data [lreplace $data_data $n $n]
- }
-}
-
-proc data_clone { from_obj to_new_obj } {
- global data_data
- foreach line $data_data {
- if {[string match "$from_obj/*" $line] == 1} {
- set new_line [join [lreplace [split $line] 0 0 ] ]
- regsub -all -- $from_obj $new_line $to_new_obj newest_line
- do_this "~/ $newest_line" 0
- }
- }
-}
-
-proc data_save { from_obj file } { - global data_data
- set file_chn [open $file w]
- foreach line $data_data { - if {[string match "$from_obj/*" $line] == 1} {
- set new_line [join [lreplace [split $line] 0 0 ] ]
- puts $file_chn "$new_line" - } - }
- close $file_chn
-} -
-proc data_save_param { from_obj selector file } {
- global data_data
- set file_chn [open $file w] - foreach line $data_data {
- if {[string match "$from_obj/*//$selector*" $line] == 1} { - set new_line [join [lreplace [split $line] 0 0 ] ]
- puts $file_chn "$new_line"
- } - } - close $file_chn
-}
-
-proc data_load { file } {
- global data_data
- set file_chn [open $file r]
- while {[eof $file_chn]==0} {
- set line [gets $file_chn]
- do_this "~/ $line" 0
- }
- close $file_chn
-}
- -proc data_load_send { file } {
- global data_data - set file_chn [open $file r]
- while {[eof $file_chn]==0} {
- set line [gets $file_chn]
- set line2s [split $line] - set line2s [join [linsert $line2s 1 update]]
-# regsub -all -- ~/ $line2s */ new_line
-# do_this "~/ $line" 0
- send2pd / $line2s ""
- }
- close $file_chn -} - - -################################################################################################ -#anything to send somewhere ??? -proc send2nodes { m_from m_to ms2send } { - global xgui_gui - global xgui_cmd_out - global text2out - global xgui_me - global neibourg_list - global neibourg_data - - global text_comment - - global time4flush - - set m2send "$xgui_me$m_from $m_to $ms2send" - set m_to [string trim $m_to "/"] - set m_to_l [split $m_to "/"] - set m_to_node [lindex $m_to_l 0] - - if { $xgui_gui == 1 } { - set text2out $m2send - } - if { $xgui_cmd_out == 1 } { - puts $m2send - } - - switch [lindex [split $m_to "/"] 0 ] { - "*" { - foreach n $neibourg_list { - regsub -all -- {\*} $m_to $n m2 - send2nodes $m_from $m2 $ms2send - } - } - "." { - foreach n $neibourg_data { - catch { - puts $n $ms2send - #after cancel {flush $n} - #after $time4flush {flush $n} - flush $n - } - } - } - default { - set n [lsearch $neibourg_list $m_to_node] - if { $n != -1 } { - # if catch = error then we have to remove the link. - catch { - puts [lrange $neibourg_data $n $n] "$m2send;" - #after cancel {flush [lrange $neibourg_data $n $n]} - #after $time4flush {flush [lrange $neibourg_data $n $n]} - flush [lrange $neibourg_data $n $n] - } - } else { - set $text_comment "didn't find any coresponding neigbourg" - } - } - } -} - -proc send2pd { m_from m_to ms2send } { - global xgui_gui - global xgui_cmd_out - global text2out - global xgui_me - global pd_sok - - set m2send "$xgui_me$m_from $m_to $ms2send;" - - if { $xgui_gui == 1 } { - set text2out $m2send - } - if { $xgui_cmd_out == 1 } { - puts $m2send - } - - # catch { - puts $pd_sok $m2send - flush $pd_sok - # } -} - - -##################################################################################### -# the 3 main proc that do every thing ########################################## -##################################################################################### - -proc read_and_do { channel } { - gets $channel message - global text_from_outside - set text_from_outside "$channel \"$message" - do_this $message $channel -} - -proc do_this { m channel} {
- global xgui_me
- set m [string trim $m ";"] - if {[llength $m] >= 3} {
- set m_to [string trim [lindex $m 1] "/"] - set m_to_l [split $m_to "/"]
- set m_to_node [lindex $m_to_l 0]
- set m_from [string trim [lindex $m 0] "/"] - set m_cmd [lrange $m 2 end]
- #you have to know who you are :
- if { "$m_to_node" == "$xgui_me" } { set m_to_node "~" } - switch $m_to_node { - "~" { catch {do_this_here $m_from $m_to $m_cmd $channel}
} - "*" {
- # you too are a part of the whole !!!
- catch { do_this_here $m_from $m_to $m_cmd $channel
} - send2nodes / $m_to "[lrange $m 2 end]" - } - "pd" {send2pd / $m_to "[lrange $m 2 end]"} - default {send2nodes / $m_to "[lrange $m 2 end]"}
- } - } else {
- if {$m == "help"} { - # send2nodes / $m_to "# syntax : sender receiver method args..." - } else { - xgui_node_error "not enought args" $m
- }
- } -}
-
-proc do_this_here { m_from m_to m_cmd channel} { - global xgui_me - global xgui_pd - set m_to [split $m_to "/"]
- set m_from_l [split $m_from "/"]
- set m_from_node [lindex $m_from_l 0]
- set m_selector [lindex $m_cmd 0]
- set m_argc [llength $m_cmd]-1 - if {$m_argc >= 1} { set m_argv [lrange $m_cmd 1 end]
- set a1 [lindex $m_argv 0] - if {$m_argc >=2 } { set a2 [lindex $m_argv 1]
- if {$m_argc >=3 } { set a3 [lindex $m_argv 2]
- if {$m_argc >=4 } { set a4 [lindex $m_argv 3]
- if {$m_argc >=5 } { set a5 [lindex $m_argv 4]
- if {$m_argc >=6 } { set a6 [lindex $m_argv 5]
- if {$m_argc >=7 } { set a7 [lindex $m_argv 6]
- if {$m_argc >=8 } { set a8 [lindex $m_argv 7]
- if {$m_argc >=9 } { set a9 [lindex $m_argv 8]
- if {$m_argc >=10 } { set a10 [lindex $m_argv 9]
- } } } } } } } } }
- } else {set m_argv "{}" }
-
- switch [llength $m_to] { - 1 { # this is for the node ########################## - switch $m_selector { - "rename" { xgui_node_name $a1 $a2 } - - "add_canvas" { xgui_node_add_canvas $a1}
- "del_canvas" { xgui_node_del_canvas $a1}
- "show" { xgui_node_clone $a1 $a1 }
- "hide" { xgui_node_hide } - "connect" { if {$a1 == "pd"} { xgui_node_connect pd $a2 $channel - } else { xgui_node_connect $a1 $m_from $channel} } - "connect_on" { xgui_node_connect $a1 $m_from $channel - send2nodes / $a1/ "connect me" - send2nodes / $a1/ "clone ~/$a2 $xgui_me/$a2" - send2nodes / $a1/ "connect_on_pd $xgui_me" } - "connect_on_pd" { send2nodes / $a1/ "connect pd $xgui_pd" } - "disconnect" { xgui_node_disconnect $a1 $m_from $channel} - - "neibourg" { xgui_node_neibourg $m_from }
- "clone" { xgui_node_clone $a1 $a2 }
- "save" { xgui_node_save $a1 $a2 } - "save_coord" { xgui_node_save_coord $a1 $a2 }
- "load_coord" { xgui_node_load_coord $a1 }
- "load" { xgui_node_load $a1 } - "help" { xgui_node_help $m_from } - "debug" { xgui_node_debug $m_from $$a1 }
- "ping" { send2nodes / $m_from "# $m_from pinged" } - "#" { global text_comment ; set text_comment $m_argv}
- default { xgui_node_error "node method $m_selector does not exist" $m_cmd } - }
- }
- 2 { # this is for the canvas $m_c ########################## - set m_c [lindex $m_to 1] - switch $m_selector {
- "add_canvas" { catch {xgui_node_add_canvas $m_c }}
- "del_canvas" { xgui_node_del_canvas $m_c }
- "size" {canvas_size $m_c $a1 $a2}
- "color" {canvas_color $m_c $a1}
- "del" {obj_del $m_c $a1}
- "kill" {obj_del $m_c $a1}
- "add_seg" {seg_add $m_c $a1 10 10 20 20 }
- "add_text" {text_add $m_c $a1 10 10 "text" }
- "add_rect" {rect_add $m_c $a1 10 10 20 20 }
- "add_arc" {arc_add $m_c $a1 10 10 20 20 0 90 }
- default {xgui_node_error "canvas method $m_selector does not exist" $m_cmd } - }
- }
- 3 { # this is for the object $m_o witch is into $m_c ########
- set m_c [lindex $m_to 1]
- set m_o [lindex $m_to 2]
- switch $m_selector {
- "add_seg" {seg_add $m_c $m_o 10 10 20 20 }
- "add_text" {text_add $m_c $m_o 10 10 "text" }
- "add_rect" {rect_add $m_c $m_o 10 10 20 20 }
- "add_arc" {arc_add $m_c $m_o 10 10 20 20 0 90 }
- "del" {obj_del $m_c $m_o}
- "kill" {obj_del $m_c $m_o}
- "show" {obj_show $m_c $m_o }
- "hide" {obj_hide $m_c $m_o } - "move" {obj_move $m_c $m_o $a1 $a2}
- "scale" {obj_scale $m_c $m_o $a1 $a2 $a3 $a4 }
- "raise" {obj_raise $m_c $m_o }
- "near" {obj_near $m_c $m_o $a1 $a2 }
- "color" {obj_color $m_c $m_o $a1}
- "width" {obj_width $m_c $m_o $a1}
- "coord" {obj_coord $m_c $m_o $a1 $a2 $a3 $a4 }
- "xy1" {obj_xy1 $m_c $m_o $a1 $a2 } - "xy2" {obj_xy2 $m_c $m_o $a1 $a2 }
- "border" {obj_border $m_c $m_o $a1}
-
- "caps" {seg_caps $m_c $m_o $a1} - - "text" {text_value $m_c $m_o $a1} - "pos" {text_pos $m_c $m_o $a1 $a2 }
- "anchor" {text_anchor $m_c $m_o $a1}
- "justify" {text_justify $m_c $m_o $a1} -
- "start" {arc_start $m_c $m_o $a1 }
- "angle" { arc_width $m_c $m_o $a1 } - "style" {arc_style $m_c $m_o $a1} -
- default {xgui_node_error "obj_method $m_selector does not exist" $m_argv }
- }
- }
- }
-}
-
|