Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23227
Modified Files: Tag: devel_0_39 pd_base.tk pd_objects.tk Log Message: http://whats-your.name/pd/chokun.png
Index: pd_objects.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd_objects.tk,v retrieving revision 1.1.2.13 retrieving revision 1.1.2.14 diff -C2 -d -r1.1.2.13 -r1.1.2.14 *** pd_objects.tk 17 Sep 2005 21:56:45 -0000 1.1.2.13 --- pd_objects.tk 18 Sep 2005 22:58:35 -0000 1.1.2.14 *************** *** 8,13 **** attributes { x 1 y 1 - ins 2 - outs 2 color {123 232 4} zero_x 0 --- 8,11 ---- *************** *** 25,29 **** } init { ! $_ create rect 0 0 0 0 -tags [concat $tags box] if {$img ne ""} { package require Img --- 23,27 ---- } init { ! $_ create rect $x $y $xx $yy -tags [concat $tags box] if {$img ne ""} { package require Img *************** *** 45,48 **** --- 43,93 ---- } } + + colors { + attributes {ins 1 out 1 x 1 y 3} + tags {box subwin} + init { + $_ create rect 0 0 0 0 -tags [concat $tags box] + set p [frame $_.$id] + $_ create window 0 0 -tags [concat $tags subwin] -window $_.$id -anchor nw + set picker {iVBORw0KGgoAAAANSUhEUgAAADIAAAEACAIAAAB+mLL0AAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QkNDBMQBB81AgAAELhJREFUeNqtnVty47wOhMGL/5nZ29n/ZkYiz0MsBQTQTciZFMulyE7SISEQpPAJ5X+//vwq5Xcpv0R+lfKrlF9S3mfWk+8z7w/I9VPfJ0VE/vyWP3+u9vz49/u4i5S1VXcm30TkJfIS6SJdHbTrtYnU67Vef666XyJdna0JifzMLesWZDR5ZV5TQbLIAX9XyzLKjLiKO+zdW0W9Hb5uP3C/ish/So1pXlMFNvPuLfPb/UHyPO8tPYJkEEWk9PW3k+PMW8a2Xq63qustYwN2EMNG3qpUVqcmH16PgcmT1nKy2g8GMXYQhepoT94Ke4ubfCEmX9xfMgfJ86KsKuMgYu9wm3w4Iua14bfCQbxNPuNOa3IQ2+4gPCngMkSTjxlK8X7LKPMiMmfCySe0emRbonurAF/QHrakrL2j7wkRPX0yM4hZ26q0n3p0jE7KqsmYfM9pKsjkvQ0ZQf5Vywp7y49gI+a17a0GBIXfEtvKmJdok/futOGu0jr8MZKVMfZqTB4NorGwUIpp4gzLdGfo5X80iHd75WT13Wwd9hk0+XAQSXs5WX1n8j4GrGiJUaPJ2BtWKOgVyQobCdfYILbdZWg0mVfBV8a2w77DB2TyFbuuUJmXhXxbo0HzxuRD22pg+JAsNBm0TDhv1ol5w3+5BbSXxceu5YNmHiCgK/Gr/Sci+JdUoK/wdaKPzb2aBgR9abp7KxNL7oPmgoNmYmGvSJyAYB8tCB4ENuYXdXAZGkFeVnLVVEjQXBIzD3GkxraeNhg0Z+bp5nzEKxrEcC1edot1FjTnewuNoyS2T0o0fPUnYWDGtsgO1PZbG0EUGjSjQQz91qPNxAp2OtlUXXcm781LPtputfZONpK2EQSyrfCPER3xxzoQVHeB/Mt5h5faNzPbaCXxlt12qzvXRaL4l7Mt0b89cRCfRybfProYzVeR4Cs8KaFtlSn1amXaM+82pM21DdXme0GW+iq7D/Qh4tsJ2kGXfObvlUgEP3kf97nTdNDlcItkFWw74et0x32IzFUT6rCDbspWcF0hN3AfzEhfH06Tl3LkIibJ+VNBe23X8fSDeO70kX0goXfYyJ236i6IHtr7cILOS5PfAUKyzMEAb8n11mLyX1Lmzuq3AZSRpT92C5rXmam2juo1cIvJT6Xp3LVjtx2L7goNpWZeUr7Oy3VSQpM/RVqitw4a7ZLQeF5NW5I+L+o49lvNaTq2W1JKVovm/7k2/9WIl781NafpiO5tGt9Yry7XsduXjrYK0m7Wy+2hvdfr9T64lRXsG0WZUVstqV3K/OQ4lLLb9vt0gpo61sN3YPeoB2JcIsaqZjq3WZSjD3prRL1VVzPfCpLLA93N2FPYVQWIgxFEzdzpBrK4dRv/Hn5y8VvDmdRWUAGyxvqXtKWf6vcMJU7Uj3TfScbquY2LMVXnh7QHv3/8XCeAobpNSLxVsIvyY2cUTPevhxHOwJpm6LfK1VXh3OI1hbKQVXk7rtFPwal6v8QE4+UFFZASM9wlwky+pN2BFjfcwAlY/HtBA/WWFoQ6LOwnP2QT+EwT89yXl+/yxeS9oJNq0uJG5MT9CNb1SkeD+Db5omSdShBa0HnrHgm3adoAvvd7EKuSVZQyiWw8FDQu20KddKxBzlgdr++w9yCaUTuj4UBjp2URezqUVTU3GdgIYqy/5cTWjex9AFnewHWA2cA4SiiLu4PpPNxwsgq2qq2gJWjW48id01TBnffAAtQ0tzjw/5J1pwNvNOkrtikpOsrTc0goSy96T7el4D3qYvISeYS5atJx8FCB6L0CEHqjJuytCTxqHyByMuN9a7rD86FWE1X9b+H2sNd00pixDzW3ozl4Kk23oKo0VWVbfG8YmZcR1/VEG9p4BT66RhtJ4R71mVYjprfI5WZcFNmMkOiu34HFTXcZTm9bU+1SeGXD9ZPPkNW99VfJ6ter2ahitmWuRKOmKE1jlz0sUT8dlyZyJY4wgrin6nvpXZUs/YFKd7Ak2jQ/co7URhDaxc91I2q6ZdOgt5REmflxtXM9DjtsIi9f1g3We+1W3JqObEDe6QZ/V2WkwyYwLzhVT7wDW/CiyNy10h12RvY+1ihymiXG41tY0Vs68efY9dbJg+ZZpBSRIpP+8ftjIu/j90/J+3gWEZHRZXQZ7d3mV6uugShqXjJ6FgmRNCFiUprN7Vu+WV3uW1F1Z8n58z/Phr2soacYkOQHCE/TXIfR9OG+h0EywAhHMXgmXhSn9zhN4bOT8lGaddRnfUN/lCcnicm3hLh4EPOECDpPsmE7SE5iJv9PIBFi8v1pfuc9iOT2Q/4DxOSRawB3aTrMzvjgQCg/tmVX1O5Fh1I+eBVKRG3RI2byGUIEnResqdN85poxeZT9uH0rafIp20KC8oRIjQiR1y53uLEpv++zynpCGcnib4mL0Vl9j3dYkKZOjzMmT2xL0CBmcsDJt5x56LkrcTH5ks7+Jine4nLznnJRgnqrJjQhTkQwbZe/Eq07Jd4BZZU1gGK8KJvYaIaHmOj0gxRPT4ggp/UMFCa9lUmFJbI+JttYBEHoIyNIdw8nRHJRPI4gUCIlgUS0rAb6KROjLibPvQOBaUyILJQ0ewJO4ql6S/q8HJMhO39L8JBqIogtP9YoEeWz+Dlfydn4QtxphhN5YbiAgyHbuJn5rS1ME/aZ5MDizWMEiJev2EG8EihGEsneLzFKYkIk9m5QjJZbrcCHZxB3+ggh03BBfplZiG09HcSOORF58uQGuiHVf8SPebig0odtkL0MGzR/4B0IQvbBA0r2QfMjiixEyJL7dYU+p+bB5EMA0wwhkt+htavqtiOrM5hPJq06ceajwIYgZNvkdNmdD0w+GQYShIyn72dS/OWHQTMiRArlLnLf/myJwcGVH3x1nApyJrCMv26X8t90V89RK8cO+/WyksY1w297RBaEwIMRh/Z0P7sUbYf1aAQ19mA0HTRA+cxNTSdxdnWrEeEhISHS8Kz2gZu3iXKot3yHHTiA8rL85DfopLgx+RPY/uESjDiNgUKI6f6HuoIrscmPh5CIj3lReDXUXfm5QlQeboF+6xGy4mWF4akhRPSxTrz4NnkvyEMip+NEakJWiIfMtcP8W4Hfag5fqY4WKXDJElwW0+kzudcGFRHttyaARDQbwgWJWihqduVOSpMo4dl02PszHQAPLQeJ+HltrJxIXdPlGpBllDGTz0Ai3h8aPKRiSKSEgr6Oe5oQqeyWd8yuDImBWDQNLL0VChoYEiFJ/foXhsnqsuZLQ3yl0xE8MYZImAyUBC+OxvCcyGLy012AJ3n8wC6HfuTy+ofKWnvQW+cuK0oiRoUQR6FhxahIaFuDavLmEqaphvpqLr8z9ltPU8In7jDTSTUCVwYaRLTE2CqbILccsXV1p2kaLx8iK2dCkODrrrjY0PBpKAE8kKVREaHDJw7IEMdnbQmRuMP6mu967iARATnFc40FCsAyECcyw94qjhNBkAhCMYysEMg4VtygkRRPbfKEE0G9NYCsEISqK/HLUjw7SHPNwFlGXMMg1IEhkTjF08jij7gI+0kzGbKjVkzriEbrDlwJXfnEnIjmH4U+ozSZbx2YPPICJqyrjl0JaQy9BD8Uu0ISm5cIIuOcDMCtCZGBaYyQExkOMYARRIYZqyvBMlYYvroFmQZDjlXcoCnNb5PnF11z6ztEi0iCWhlJ2wrBFY6vkFTKGgEZjWIPPqB921YFmE8F1ApJPK0AXCGQyEDrRP0oiy0kwtN0CbhCEAMbROhBLM4FGEgkREXMNpXupyMCV0JBw0cQw61uawSJhISITwE3O+YIMTgjisxugMs6BU13YAgRkjCvBd2oyOmAjE1E3ymRMp/jBZ4QCbtqZEy+5EiQDCrSFVLTV9KHcIDOQZTr6MJAimJAiojcPMgFg3yxIUXs8df1fFQ5qpxfrbzbcC1eihWZX2/1f8WGFPosfvJM6zCrudef3S41VNRrV0Ykl9/pZNXcswcrltUfYg/hDmwnBN3T86T8BBEXhuqd5AB8kDDwisbxYXKn6q08DFIozfmUPiruUVnfJv/osaScfeXP4q+7sjmLyf+wrkn9tLcKqvPwNYjlObXSsKyflFIQ01tl92DezElk8o+efl+8baFHFydPZp7Fn6pcoK9E8mzy7clGTX57JQZUKEkaqTs8xJyUKzOJMA9oQqy+t0qursn2LXlIAIaP+Ns4iGTdEC+rP8G1UKjSM8/QTTIjyfITGeyhl11CEqpr4g+4yfdE+YnF5MuOXem5V3lYGY0kLfb6UBM5+AwU3kQQ28xTwoa0CMV4YXvfooA9TEp/VLKjORRjW4isAlB477c+qCQS1hBpOVbYDmLy4dHk0fehrJ4u1lFJBPEx8EBktVxpk2cmTy7GF3gVcIW2J1N1EDQ3nHnacwngbVfXhCR/7afqmqhu8sLMA5mgUsXR0FT98YPJk0xqNmj+gGnbgit19y0LmjPlJ3hhDF9xZRvW1syCLFmsoyUqFzwtcZgKmh+VNkFVMTLo/763toVgSK68r1xQf9AkNPnMPN12lQsyJVFLIslw8VvtCSGC4IKnGz6V7EGU5zxNiJAlSwCT2KEQv5Whj3hvPX2+/Mbkk+W+Xrgqxs/3iONVdYYcQwjZB7ULhOw0J9dk2wjis0oPEgbNTwvvvXAE8c/qYjwqU5isuPIPqoh83d0o42pTijlztXpKWVtVrZz/sOTKJSuVl54EVz4rULP+bJdtqYfD3XpGEd1PyvnIUuqhp4AHLe7Ihb2Pih/JWuPkPYgjVw7miEI7U6H9aamoiR4lgEiakMYgGy7108JakdUDkx+RoBDFqA4uIPeuJqiGIvY59F1Gmh/LRJa8SttcnzEprsAJNPmRRla2snwaznSoSFXZHwoS6cEItmgQPSRScoRIdbnUNcopXm9ed+i0akSI8BCOl0+c+Kn47nyXR9VNeGkTUePV1KOAW1TdxJcRUTljXUgtGFPdpGBOxMjykIgnRLQ7NQVOlt4ylXM8HhIWXTFf56pJlzZpGDEoNt+tx8U6wnYkElQRAkVKm0RPre02XwlJJGoMTzPp42h9dnlx1YYE+S3CiRWc7SwkNxKblMbxBJn8lhMpuHqAPBTky4hMNFVXWt2ElzPwRVcEVzcpjg1RiYk9xtoI80CSi4XWgkLVTaIOBn4raeBCmQdS3aTy9C0SQZA178RlRDgIVVWhmUqS3UKTLyuQgazbZ6oLrbhSHAw7IezTvy8Hg2JkKhp4WZkyIqFVDR9BmAInvrpJwfWE7l/ad7BfxZCIK47Sv7P4x8qrnLiTJCptMunYabqnrVMwHESfWHrm4CxfRiTUpKMjQ4hMZPIjwatwNaSMiIFEzohdiR3EjJCaJDM2qayKIZG2oci6xUOIE/eZ6qaSiFADPylZYIPmuSZbI0IkrHEyVs5LsCZCiESlHjosbeI9gsdDmgNXw13rAxMig0w+BdfrEIyHNFeWQvD+3bmK47WPvoNmZNeC8ZDhjmW3obi1LTuIxC9k7tecFFzpbgTPZGATdlXBpU0KKJOr99ANHnImAKTFnRo8RKIyRxVDIkjW37WYSE+CWuhKJIQIv6skUSGYYzeIk5i8L23imYyxu58kyiMcuAhForpJ5OU9ITLWYJfcRjL3ro6IEDn39dH6stw2f2ZGKDu/h6TvE/kaIueucs4SNIvdjNvfzhIqy/M0B74GB4+3kne0yAfE3YHJ1IKJXPf/ARXN6/ssS+vjAAAAAElFTkSuQmCC} + image create photo colorpicker$id + colorpicker$id configure -data $picker + label $p.colors -bd 0 + entry $p.rgb -bd 0 -width 10 -font {{bitstream vera sans mono} 8} + bind $p.colors <B1-Motion> "::pd::colors:pick $_ $id %x %y" + bind $p.colors <1> "::pd::colors:pick $_ $id %x %y" + grid $p.colors -sticky nsew + grid $p.rgb -stick nsew + $p.colors configure -image colorpicker$id + } + + redraw { + $_ coords $box [expr $x - 10] $y $xx $yy + $_ itemconfigure $box -fill $color + $_ coords $subwin $x $y + set w [expr $xx - $x] + set h [expr $yy - $y] + if {[expr abs($w - [$_.$id cget -width]) >= 1 || abs($h - [$_.$id cget -height]) >= 1]} { + $_.$id configure -width $w -height $h + } + } + + destroy { + destroy $_.$id + } + methods { + proc colors:pick {_ id x y} { + if {![expr $y <= 255 && $y >= 0 && $x >= 0 && $x <= 50]} {return} + set p $_.$id + set rgb [hsvToRgb [expr (255 - $y) / 255.] [expr $x <= 25 ? 1. : ($x - 50) / -25.] [expr $x <= 25 ? $x / 25. : 1.]] + $p.rgb delete 0 end + $p.rgb insert 0 $rgb + $p.rgb configure -bg [color $rgb] + } + + } + } + canvas { attributes { *************** *** 83,105 **** } methods { - - proc sel {_ a x y} { - variable "" - switch $a { - first { - l $_ canvas sc - foreach xy {x y} {set ($_:c$xy) [set $xy];set ($_:f$xy) [set $xy]} - $_ create rect $($_:cx) $($_:cy) $($_:cx) $($_:cy) \ - -tags sel -fill "" -outline $sc -width 12} - release {$_ delete sel} - motion { - updatesel $_ [cleansel $_ [$_ find overlapping $($_:fx) $($_:fy) $x $y]] - $_ coords sel $($_:fx) $($_:fy) $x $y}}} - - proc getsel {_} { - variable "" - return [dict get $($_) canvas sel] - } - proc item_pos {_ item r x y xx yy} { update $_ $item $r [dict create x $x y $y xx $xx yy $yy] 1} --- 128,131 ---- *************** *** 111,115 **** item_pos $_ $($_:ci) abs [tr $_ x i $x] [tr $_ y i $y] [tr $_ x i $($_:fx)] [tr $_ y i $y] } ! first {set ($_:ci) [item_new $_ [dict create type rect id - x 0 y 0 xx 0 yy 0 v 1]]}}}
proc resize_canvas {_ a x y} {viewpoint $_ [dict create action resize x $x y $y]} --- 137,141 ---- item_pos $_ $($_:ci) abs [tr $_ x i $x] [tr $_ y i $y] [tr $_ x i $($_:fx)] [tr $_ y i $y] } ! first {set ($_:ci) [item_new $_ [dict create type rect id -]]}}}
proc resize_canvas {_ a x y} {viewpoint $_ [dict create action resize x $x y $y]} *************** *** 157,167 ****
} ! proc cleansel {_ sel} { ! set clean {} ! foreach item $sel { ! set class [lindex [$_ itemcget $item -tags] 0] ! if {$class eq "item" || $class eq "cable"} {lappend clean [lindex [$_ itemcget $item -tags] 2]}} ! set clean [lsort -unique $clean] ! return $clean }
--- 183,224 ----
} ! ! proc click {m button action _ x y X Y} { ! variable "" ! set clicked [cleansel $_ [$_ find overlapping $x $y $x $y]] ! set a $($_:submode) ! switch $action { ! first { ! foreach xy {x y} {set ($_:f$xy) [set $xy]} ! switch $button { ! 1 {if {$m eq "control"} { ! mode $_ pencil; pencil $_ $action $x $y ! } elseif {$m eq "double" || $m eq "shift"} { ! if {[llength $clicked] > 0} { ! togglesel $_ $clicked ! } else { ! item_new $_ [dict create type sel id sel xa $x ya $y xb $x yb $y] ! } ! } elseif {[$_ find withtag sel] ne ""} { ! item_delete $_ sel ! } elseif {[llength [getsel $_]] > 1 && [llength $clicked] > 0 && [lsearch [getsel $_] $clicked] == -1} { ! updatesel $_ $clicked} elseif {$a eq "cabledraw"} {eval $a $_ $action $x $y}} ! 2 {if {$clicked ne ""} {mode $_ item_scale} {mode $_ resize_canvas}} ! 3 {if {$clicked ne ""} {mode $_ item_v} {rmenu $_ $x $y $X $Y}}}} ! motion { ! # puts "$a $_ $action $x $y" ! eval $a $_ $action $x $y ! # catch {eval $a $_ $action $x $y} ! } ! release { ! switch $button { ! 1 {if {$a eq "draw" || $a eq "cabledraw"} {eval $a $_ $action $x $y}} ! 2 {mode $_ move_canvas} ! 3 {mode $_ move_canvas} ! } ! } ! } ! if {$clicked ne ""} {inspect $_ [lindex $clicked end]} ! foreach xy {x y} {set ($_:c$xy) [set $xy]} }
*************** *** 169,182 **** variable "" if {[$_ find withtag sel] ne ""} { ! sel $_ motion $x $y } else { ! set clicked [cleansel $_ [$_ find overlapping [expr $x - 2] [expr $y - 2] [expr $x + 2] [expr $y + 2]]] ! if {$clicked ne ""} { ! set c [lindex $clicked end] ! resize_modes $_ $x $y $c ! if {[llength [getsel $_]] <= 1} {updatesel $_ $c} ! inspect $_ $c ! } else { ! mode $_ move_canvas } } --- 226,250 ---- variable "" if {[$_ find withtag sel] ne ""} { ! update $_ sel abs [dict create xa $x ya $y] 1 } else { ! set clicked [$_ find overlapping [expr $x - 2] [expr $y - 2] [expr $x + 2] [expr $y + 2]] ! set out 0 ! foreach id $clicked { ! if {[lindex [$_ itemcget $id -tags] 3] eq "out"} { ! set out 1 ! set ($_:cable) [$_ itemcget $id -tags] ! break ! } ! } ! if {$out == 1} {mode $_ cabledraw} else { ! set clicked [cleansel $_ $clicked] ! if {$clicked ne ""} { ! set c [lindex $clicked end] ! resize_modes $_ $x $y $c ! if {[llength [getsel $_]] <= 1} {updatesel $_ $c} ! inspect $_ $c ! } else { ! mode $_ move_canvas ! } } } *************** *** 214,238 **** }
- proc togglesel {_ d} { - variable "" - if {[lsearch [getsel $_] $d] < 0} { - set sel [concat [getsel $_] $d] - } else { - set sel [lsearch -inline -not -all [getsel $_] $d] - } - up $_ canvas sel - redraw $_ $d - } - - proc updatesel {_ sel} { - variable "" - set os [getsel $_] - up $_ canvas sel - redraw $_ [lsort -unique [concat $os $sel]] - } - proc mode {_ m} { variable "" ! array set cursor {pencil pencil move_canvas fleur move_object dotbox item_v box_spiral resize_canvas bogosity sel cross_reverse item_scale sizing resize_left left_side resize_right right_side resize_top top_side resize_bottom bottom_side resize_tl top_left_corner resize_tr top_right_corner resize_bl bottom_left_corner resize_br bottom_right_corner} set ($_:submode) $m $_ configure -cursor $cursor($m) --- 282,288 ---- }
proc mode {_ m} { variable "" ! array set cursor {pencil pencil move_canvas fleur move_object dotbox item_v box_spiral resize_canvas bogosity sel cross_reverse item_scale sizing resize_left left_side cabledraw circle resize_right right_side resize_top top_side resize_bottom bottom_side resize_tl top_left_corner resize_tr top_right_corner resize_bl bottom_left_corner resize_br bottom_right_corner} set ($_:submode) $m $_ configure -cursor $cursor($m) *************** *** 276,315 **** } }
! proc click {m button action _ x y X Y} { variable "" ! set clicked [cleansel $_ [$_ find overlapping $x $y $x $y]] ! set a $($_:submode) ! switch $action { ! first { ! foreach xy {x y} {set ($_:f$xy) [set $xy]} ! switch $button { ! 1 {if {$m eq "control"} { ! mode $_ pencil; pencil $_ $action $x $y ! } elseif {$m eq "double" || $m eq "shift"} { ! if {[llength $clicked] > 0} { ! togglesel $_ $clicked ! } else { ! sel $_ first $x $y ! mode $_ sel ! } ! } elseif {[$_ find withtag sel] ne ""} { ! sel $_ release $x $y ! } elseif {[llength [getsel $_]] > 1 && [llength $clicked] > 0 && [lsearch [getsel $_] $clicked] == -1} { ! updatesel $_ $clicked}} ! 2 {if {$clicked ne ""} {mode $_ item_scale} {mode $_ resize_canvas}} ! 3 {if {$clicked ne ""} {mode $_ item_v} {rmenu $_ $x $y $X $Y}}}} ! motion {eval $a $_ $action $x $y} ! release { ! switch $button { ! 1 {if {$a eq "draw" || ($a eq "sel" && [expr {abs($($_:fx) - $x)}] >13)} {eval $a $_ $action $x $y}} ! 2 {mode $_ move_canvas} ! 3 {mode $_ move_canvas} ! } ! } } ! if {$clicked ne ""} {inspect $_ [lindex $clicked end]} ! foreach xy {x y} {set ($_:c$xy) [set $xy]} } } } --- 326,385 ---- } } + } + } + + sel { + attributes { + class selrect + outline {255 255 0} + fill {255 128 0} + width 0 + stipple gray12 + } + init { + $_ create rect $xa $xb $ya $yb -tags $tags + mode $_ sel + } + redraw { + updatesel $_ [cleansel $_ [$_ find overlapping $xa $ya $xb $yb]] + $_ coords $item $xa $ya $xb $yb + $_ itemconfigure $item -fill [color $fill] -stipple $stipple -outline [color $outline] -width $width + } + methods { + proc sel {_ a x y} { + update $_ sel abs [dict create xb $x yb $y] 1 + }
! proc getsel {_} { ! return [set [l $_ canvas sel]] ! } ! ! proc cleansel {_ sel} { ! set clean {} ! foreach item $sel { ! set class [lindex [$_ itemcget $item -tags] 0] ! if {$class eq "item" || $class eq "cable"} {lappend clean [lindex [$_ itemcget $item -tags] 2]}} ! set clean [lsort -unique $clean] ! return $clean ! } ! ! proc togglesel {_ d} { variable "" ! if {[lsearch [getsel $_] $d] < 0} { ! set sel [concat [getsel $_] $d] ! } else { ! set sel [lsearch -inline -not -all [getsel $_] $d] } ! up $_ canvas sel ! redraw $_ $d ! } ! ! proc updatesel {_ sel} { ! variable "" ! set os [getsel $_] ! up $_ canvas sel ! redraw $_ [lsort -unique [concat $os $sel]] } + } } *************** *** 373,376 **** --- 443,447 ---- kbd { attributes { + ins 1 outs 1 x 60 y 12 *************** *** 438,443 **** attributes { x 10 y 10 ! ins 0 ! outs 0 } init { --- 509,514 ---- attributes { x 10 y 10 ! ins 1 ! outs 1 } init { *************** *** 455,476 **** attributes { class cable ! x 10 y 10 from "" to "" } init { ! $_ create line 0 0 0 0 -tags $tags -fill green -arrow last -width 4 ! } ! destroy { ! puts byebye_cable } redraw { if {[llength $from] == 2 } { ! set loc [ioloc $_ [lindex $from 0] [lindex $from 1] outs] ! lassign $loc x y } if {[llength $to] == 2 } { ! set loc [ioloc $_ [lindex $to 0] [lindex $to 1] ins] ! lassign $loc xx yy } $_ coords $item $x $y $xx $yy --- 526,544 ---- attributes { class cable ! x 0 y 0 from "" to "" + arrow last + width 1 } init { ! $_ create line 0 0 0 0 -tags $tags -fill green -arrow $arrow -width $width } redraw { if {[llength $from] == 2 } { ! lassign [ioloc $_ [lindex $from 0] [lindex $from 1] outs] x y } if {[llength $to] == 2 } { ! lassign [ioloc $_ [lindex $to 0] [lindex $to 1] ins] xx yy } $_ coords $item $x $y $xx $yy *************** *** 480,490 **** } methods { ! proc ioloc {p t id n io} { variable "" ! foreach c {x xx y yy} { ! set $c [tr $_ [string range $c 0 0] t [dict get $($_) $id $c]]} ! if {$io eq "ins"} {set py $y} {set py $yy} ! set px [expr ($n / ([dict get $($_) $id $io] + 0.0)) * ($xx - $x + 0.0) + $x] ! return [list $px $py] } } --- 548,563 ---- } methods { ! proc cabledraw {_ a x y} { variable "" ! lassign $($_:cable) class iid id io ioid ionum cur ! switch $a { ! first { ! set ($_:cable:id) [item_new $_ [dict create type cable id - from [list $id $ionum]]] ! } ! motion { ! update $_ $($_:cable:id) abs [dict create xx [tr $_ x i $x] yy [tr $_ y i $y]] 1 ! } ! release {} ! } } } *************** *** 492,500 ****
io { init { ! # puts "io $ins $outs" } redraw { ! # puts "RedrawIO $ins $outs" } } --- 565,603 ----
io { + attributes { + class io + width 1 + height 0.3 + incolor {255 0 0} + outcolor {0 0 255} + } init { ! l $_ $id ins outs ! foreach io {in out} { ! for {set i 0} {$i < [set ${io}s]} {incr i} { ! set port [$_ create rect $x $y $x $y -tags [concat $tags $io $io$i $i] -width 0 -fill [color [dict get $obj io attributes ${io}color]]] ! # $_ bind $port <1> "puts lolport" ! } ! } } redraw { ! set w [tr $_ x id [dict get $obj io attributes width]] ! set h [tr $_ x id [dict get $obj io attributes height]] ! foreach io {in out} { ! for {set i 0} {$i < [set ${io}s]} {incr i} { ! lassign [ioloc $_ $id $i ${io}s] x y ! $_ coords [$_ find withtag "$tags && $io$i"] [expr $x - $w] [expr $y - $h] [expr $x + $w] [expr $y + $h] ! } ! } ! } ! methods { ! proc ioloc {_ id n io} { ! variable "" ! foreach c {x xx y yy} { ! set $c [tr $_ [string range $c 0 0] t [dict get $($_) $id $c]]} ! if {$io eq "ins"} {set py $y} {set py $yy} ! set px [expr ($n / ([dict get $($_) $id $io] + 0.0)) * ($xx - $x + 0.0) + $x] ! return [list $px $py] ! } } } *************** *** 519,523 **** }
! msg { tags { box txt --- 622,626 ---- }
! msg { tags { box txt *************** *** 540,544 **** --- 643,654 ---- set flare [expr $xx + ($xx - $x) / 12.] $_ coords $box $x $y $flare $y $xx [expr $y + ($yy - $y)/2.] $flare $yy $x $yy + # foreach z {x xx y yy} {set $z [tr $_ [string range $z 0 0] i [set $z]]} + # up $_ $id x y xx yy } + methods { + proc msg_updatetext {_} { + + } + } }
*************** *** 552,557 **** v 48 max 69 ! ins 0 ! outs 0 } init { --- 662,667 ---- v 48 max 69 ! ins 1 ! outs 1 } init {
Index: pd_base.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd_base.tk,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -C2 -d -r1.1.2.10 -r1.1.2.11 *** pd_base.tk 17 Sep 2005 21:56:45 -0000 1.1.2.10 --- pd_base.tk 18 Sep 2005 22:58:35 -0000 1.1.2.11 *************** *** 1,15 **** - # Pure-Deleuzian - # 2005 cdr (BSD, EULA, GPL, MIT..) # http://whats-your.name/pd
- set todo { - io boxes - scale selection, resize: shift square, shift-right corners - reparent to toplevel - } - foreach pkg {Img snack tkdnd tkpath} { ! if {[catch {package require $pkg}]} {set has_$pkg 0} {set has_$pkg 1} ! }
source pre8.5.tcl --- 1,6 ---- # http://whats-your.name/pd
foreach pkg {Img snack tkdnd tkpath} { ! if {[catch {package require $pkg}]} {set has_$pkg 0} {set has_$pkg 1}}
source pre8.5.tcl *************** *** 18,27 **** source pd_objects.tk
- # load object procs foreach type [dict keys $obj] { if {[dict exists $obj $type methods]} { eval [dict get $obj $type methods]}}
- # omg the colours!! proc rc {} {return [format "#%06x" [expr "int(floor(rand() * 16777216.))"]]} proc rgb {} {return [list [expr "int(floor(rand() * 256))"] [expr "int(floor(rand() * 256))"] [expr "int(floor(rand() * 256))"]]} --- 9,16 ---- *************** *** 47,54 **** 5 {return "$v $p $q"} default {error "i value $i is out of range"}}}} - option add *borderWidth 0 - option add *font {{bitstream vera sans} 10} - - # if you can shorten this you kick ass proc random_txt {n} { set i 0 --- 36,39 ---- *************** *** 60,63 **** --- 45,50 ---- incr i} return $text} + option add *borderWidth 0 + option add *font {{bitstream vera sans} 10}
proc item_new {_ a} { *************** *** 98,115 **** }
proc item_delete {_ {items ""}} { variable "" variable obj if {$items eq ""} {set items [getsel $_]} ! foreach item $items { ! foreach i [$_ find withtag i$item] { $_ delete $i } ! set type [dict get $($_) $item type] if {[dict exists $obj $type destroy]} { eval [dict get $obj $type destroy]} ! dict unset ($_) $item ! dict set ($_) canvas sel {} ! send "delete $_:$item" } } --- 85,138 ---- }
+ proc redraw {_ items} { + variable "" + variable obj + switch $items { + all {set items [dict keys $($_)]} + default {}} + foreach id $items { + foreach local [dict keys [dict get $($_) $id]] { + set $local [dict get $($_) $id $local]} + set x [tr $_ x t $x];set y [tr $_ y t $y];set xx [tr $_ x t $xx];set yy [tr $_ y t $yy] + if {[expr $x > $xx]} {lassign "$x $xx" xx x} + if {[expr $y > $yy]} {lassign "$y $yy" yy y} + set sx [expr $xx - $x]; set sy [expr $yy - $y] + if {[lsearch [getsel $_] $id] >= 0} {set rgb {233 233 233};set color [set [l $_ canvas sc]];set selected 1} else { + set rgb [dict get $($_) $id color];set color [color $rgb];set selected 0} + set atags [concat $class i$id $id] + set tags [concat $class && i$id && $id] + set item [$_ find withtag $tags] + if {[dict exists $obj $type tags]} { + foreach tag [dict get $obj $type tags] { + set $tag [$_ find withtag "$tags && $tag"]}} + if {[dict exists $obj $type redraw]} { + eval [dict get $obj $type redraw]} + if {$class eq "item" && ($ins > 0 || $outs > 0)} { + eval [dict get $obj io redraw] + foreach i [dict keys $($_)] { + if {[dict get $($_) $i class] eq "cable"} { + if {[lindex [dict get $($_) $i from] 0] eq $id || [lindex [dict get $($_) $i to] 0] eq $id} { + redraw $_ $i + } + } + } + } + } + } + proc item_delete {_ {items ""}} { variable "" variable obj if {$items eq ""} {set items [getsel $_]} ! foreach id $items { ! foreach i [$_ find withtag i$id] { $_ delete $i } ! set type [dict get $($_) $id type] if {[dict exists $obj $type destroy]} { eval [dict get $obj $type destroy]} ! dict unset ($_) $id ! set sel [lremove [dict get $($_) canvas sel] $id]; up $_ canvas sel ! send "delete $_:$id" } } *************** *** 122,127 **** rel {dict set ($_) $item $a [expr {[dict get $($_) $item $a] + [dict get $u $a]}]} } ! send [concat update $_:$item $a [dict get $($_) $item $a]] } if {$redraw == 1} {redraw $_ $item} } --- 145,151 ---- rel {dict set ($_) $item $a [expr {[dict get $($_) $item $a] + [dict get $u $a]}]} } ! # send [concat update $_:$item $a [dict get $($_) $item $a]] } + send [concat update $_:$item $u] if {$redraw == 1} {redraw $_ $item} } *************** *** 132,140 **** upvar $arg var dict set ($_) $id $arg $var } }
! proc update_one {_ item r k v redraw} { ! update $_ $item $r [dict create $k $v] $redraw }
--- 156,167 ---- upvar $arg var dict set ($_) $id $arg $var + send [concat update $_:$id $arg $var] } }
! proc item_mua {_ r u redraw {items -}} { ! variable "" ! if {$items eq "-"} {set items [getsel $_]} ! foreach item $items {update $_ $item $r $u $redraw} }
*************** *** 147,192 **** return $args } - - - - proc redraw {_ items} { - variable "" - variable obj - switch $items { - all {set items [dict keys $($_)]} - default {}} - foreach id $items { - foreach local [dict keys [dict get $($_) $id]] { - set $local [dict get $($_) $id $local]} - set x [tr $_ x t $x];set y [tr $_ y t $y];set xx [tr $_ x t $xx];set yy [tr $_ y t $yy] - if {[expr $x > $xx]} {lassign "$x $xx" xx x} - if {[expr $y > $yy]} {lassign "$y $yy" yy y} - set sx [expr $xx - $x]; set sy [expr $yy - $y] - if {[lsearch [getsel $_] $id] >= 0} {set rgb {233 233 233};set color [set [l $_ canvas sc]];set selected 1} else { - set rgb [dict get $($_) $id color];set color [color $rgb];set selected 0} - set atags [concat $class i$id $id] - set tags [concat $class && i$id && $id] - set item [$_ find withtag $tags] - if {[dict exists $obj $type tags]} { - foreach tag [dict get $obj $type tags] { - set $tag [$_ find withtag "$tags && $tag"]}} - if {[dict exists $obj $type redraw]} { - eval [dict get $obj $type redraw]} - if {$class eq "item" && ($ins > 0 || $outs > 0)} { - eval [dict get $obj io redraw] - # foreach i [dict keys $($_)] { - # if {[dict get $($_) $i class] eq "cable"} { - # if {[lindex [dict get $($_) $i from] 0] eq $id || [lindex [dict get $($_) $i to] 0] eq $id} { - # redraw $_ $i - # } - # } - # } - } - } - } - -
! proc msg {} { if {![winfo exists .msg]} { toplevel .msg --- 174,179 ---- return $args }
! proc msg {} { if {![winfo exists .msg]} { toplevel .msg *************** *** 194,223 **** bind .msg.text <KeyPress-Return> {::pd::send [.msg.text get]}}}
- proc colors {} { - variable "" - set p .colors - if {![winfo exists $p]} { - toplevel $p - # yes this will be generated algorithmically one day, god willing - set picker {iVBORw0KGgoAAAANSUhEUgAAADIAAAEACAIAAAB+mLL0AAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QkNDBMQBB81AgAAELhJREFUeNqtnVty47wOhMGL/5nZ29n/ZkYiz0MsBQTQTciZFMulyE7SISEQpPAJ5X+//vwq5Xcpv0R+lfKrlF9S3mfWk+8z7w/I9VPfJ0VE/vyWP3+u9vz49/u4i5S1VXcm30TkJfIS6SJdHbTrtYnU67Vef666XyJdna0JifzMLesWZDR5ZV5TQbLIAX9XyzLKjLiKO+zdW0W9Hb5uP3C/ish/So1pXlMFNvPuLfPb/UHyPO8tPYJkEEWk9PW3k+PMW8a2Xq63qustYwN2EMNG3qpUVqcmH16PgcmT1nKy2g8GMXYQhepoT94Ke4ubfCEmX9xfMgfJ86KsKuMgYu9wm3w4Iua14bfCQbxNPuNOa3IQ2+4gPCngMkSTjxlK8X7LKPMiMmfCySe0emRbonurAF/QHrakrL2j7wkRPX0yM4hZ26q0n3p0jE7KqsmYfM9pKsjkvQ0ZQf5Vywp7y49gI+a17a0GBIXfEtvKmJdok/futOGu0jr8MZKVMfZqTB4NorGwUIpp4gzLdGfo5X80iHd75WT13Wwd9hk0+XAQSXs5WX1n8j4GrGiJUaPJ2BtWKOgVyQobCdfYILbdZWg0mVfBV8a2w77DB2TyFbuuUJmXhXxbo0HzxuRD22pg+JAsNBm0TDhv1ol5w3+5BbSXxceu5YNmHiCgK/Gr/Sci+JdUoK/wdaKPzb2aBgR9abp7KxNL7oPmgoNmYmGvSJyAYB8tCB4ENuYXdXAZGkFeVnLVVEjQXBIzD3GkxraeNhg0Z+bp5nzEKxrEcC1edot1FjTnewuNoyS2T0o0fPUnYWDGtsgO1PZbG0EUGjSjQQz91qPNxAp2OtlUXXcm781LPtputfZONpK2EQSyrfCPER3xxzoQVHeB/Mt5h5faNzPbaCXxlt12qzvXRaL4l7Mt0b89cRCfRybfProYzVeR4Cs8KaFtlSn1amXaM+82pM21DdXme0GW+iq7D/Qh4tsJ2kGXfObvlUgEP3kf97nTdNDlcItkFWw74et0x32IzFUT6rCDbspWcF0hN3AfzEhfH06Tl3LkIibJ+VNBe23X8fSDeO70kX0goXfYyJ236i6IHtr7cILOS5PfAUKyzMEAb8n11mLyX1Lmzuq3AZSRpT92C5rXmam2juo1cIvJT6Xp3LVjtx2L7goNpWZeUr7Oy3VSQpM/RVqitw4a7ZLQeF5NW5I+L+o49lvNaTq2W1JKVovm/7k2/9WIl781NafpiO5tGt9Yry7XsduXjrYK0m7Wy+2hvdfr9T64lRXsG0WZUVstqV3K/OQ4lLLb9vt0gpo61sN3YPeoB2JcIsaqZjq3WZSjD3prRL1VVzPfCpLLA93N2FPYVQWIgxFEzdzpBrK4dRv/Hn5y8VvDmdRWUAGyxvqXtKWf6vcMJU7Uj3TfScbquY2LMVXnh7QHv3/8XCeAobpNSLxVsIvyY2cUTPevhxHOwJpm6LfK1VXh3OI1hbKQVXk7rtFPwal6v8QE4+UFFZASM9wlwky+pN2BFjfcwAlY/HtBA/WWFoQ6LOwnP2QT+EwT89yXl+/yxeS9oJNq0uJG5MT9CNb1SkeD+Db5omSdShBa0HnrHgm3adoAvvd7EKuSVZQyiWw8FDQu20KddKxBzlgdr++w9yCaUTuj4UBjp2URezqUVTU3GdgIYqy/5cTWjex9AFnewHWA2cA4SiiLu4PpPNxwsgq2qq2gJWjW48id01TBnffAAtQ0tzjw/5J1pwNvNOkrtikpOsrTc0goSy96T7el4D3qYvISeYS5atJx8FCB6L0CEHqjJuytCTxqHyByMuN9a7rD86FWE1X9b+H2sNd00pixDzW3ozl4Kk23oKo0VWVbfG8YmZcR1/VEG9p4BT66RhtJ4R71mVYjprfI5WZcFNmMkOiu34HFTXcZTm9bU+1SeGXD9ZPPkNW99VfJ6ter2ahitmWuRKOmKE1jlz0sUT8dlyZyJY4wgrin6nvpXZUs/YFKd7Ak2jQ/co7URhDaxc91I2q6ZdOgt5REmflxtXM9DjtsIi9f1g3We+1W3JqObEDe6QZ/V2WkwyYwLzhVT7wDW/CiyNy10h12RvY+1ihymiXG41tY0Vs68efY9dbJg+ZZpBSRIpP+8ftjIu/j90/J+3gWEZHRZXQZ7d3mV6uugShqXjJ6FgmRNCFiUprN7Vu+WV3uW1F1Z8n58z/Phr2soacYkOQHCE/TXIfR9OG+h0EywAhHMXgmXhSn9zhN4bOT8lGaddRnfUN/lCcnicm3hLh4EPOECDpPsmE7SE5iJv9PIBFi8v1pfuc9iOT2Q/4DxOSRawB3aTrMzvjgQCg/tmVX1O5Fh1I+eBVKRG3RI2byGUIEnResqdN85poxeZT9uH0rafIp20KC8oRIjQiR1y53uLEpv++zynpCGcnib4mL0Vl9j3dYkKZOjzMmT2xL0CBmcsDJt5x56LkrcTH5ks7+Jine4nLznnJRgnqrJjQhTkQwbZe/Eq07Jd4BZZU1gGK8KJvYaIaHmOj0gxRPT4ggp/UMFCa9lUmFJbI+JttYBEHoIyNIdw8nRHJRPI4gUCIlgUS0rAb6KROjLibPvQOBaUyILJQ0ewJO4ql6S/q8HJMhO39L8JBqIogtP9YoEeWz+Dlfydn4QtxphhN5YbiAgyHbuJn5rS1ME/aZ5MDizWMEiJev2EG8EihGEsneLzFKYkIk9m5QjJZbrcCHZxB3+ggh03BBfplZiG09HcSOORF58uQGuiHVf8SPebig0odtkL0MGzR/4B0IQvbBA0r2QfMjiixEyJL7dYU+p+bB5EMA0wwhkt+htavqtiOrM5hPJq06ceajwIYgZNvkdNmdD0w+GQYShIyn72dS/OWHQTMiRArlLnLf/myJwcGVH3x1nApyJrCMv26X8t90V89RK8cO+/WyksY1w297RBaEwIMRh/Z0P7sUbYf1aAQ19mA0HTRA+cxNTSdxdnWrEeEhISHS8Kz2gZu3iXKot3yHHTiA8rL85DfopLgx+RPY/uESjDiNgUKI6f6HuoIrscmPh5CIj3lReDXUXfm5QlQeboF+6xGy4mWF4akhRPSxTrz4NnkvyEMip+NEakJWiIfMtcP8W4Hfag5fqY4WKXDJElwW0+kzudcGFRHttyaARDQbwgWJWihqduVOSpMo4dl02PszHQAPLQeJ+HltrJxIXdPlGpBllDGTz0Ai3h8aPKRiSKSEgr6Oe5oQqeyWd8yuDImBWDQNLL0VChoYEiFJ/foXhsnqsuZLQ3yl0xE8MYZImAyUBC+OxvCcyGLy012AJ3n8wC6HfuTy+ofKWnvQW+cuK0oiRoUQR6FhxahIaFuDavLmEqaphvpqLr8z9ltPU8In7jDTSTUCVwYaRLTE2CqbILccsXV1p2kaLx8iK2dCkODrrrjY0PBpKAE8kKVREaHDJw7IEMdnbQmRuMP6mu967iARATnFc40FCsAyECcyw94qjhNBkAhCMYysEMg4VtygkRRPbfKEE0G9NYCsEISqK/HLUjw7SHPNwFlGXMMg1IEhkTjF08jij7gI+0kzGbKjVkzriEbrDlwJXfnEnIjmH4U+ozSZbx2YPPICJqyrjl0JaQy9BD8Uu0ISm5cIIuOcDMCtCZGBaYyQExkOMYARRIYZqyvBMlYYvroFmQZDjlXcoCnNb5PnF11z6ztEi0iCWhlJ2wrBFY6vkFTKGgEZjWIPPqB921YFmE8F1ApJPK0AXCGQyEDrRP0oiy0kwtN0CbhCEAMbROhBLM4FGEgkREXMNpXupyMCV0JBw0cQw61uawSJhISITwE3O+YIMTgjisxugMs6BU13YAgRkjCvBd2oyOmAjE1E3ymRMp/jBZ4QCbtqZEy+5EiQDCrSFVLTV9KHcIDOQZTr6MJAimJAiojcPMgFg3yxIUXs8df1fFQ5qpxfrbzbcC1eihWZX2/1f8WGFPosfvJM6zCrudef3S41VNRrV0Ykl9/pZNXcswcrltUfYg/hDmwnBN3T86T8BBEXhuqd5AB8kDDwisbxYXKn6q08DFIozfmUPiruUVnfJv/osaScfeXP4q+7sjmLyf+wrkn9tLcKqvPwNYjlObXSsKyflFIQ01tl92DezElk8o+efl+8baFHFydPZp7Fn6pcoK9E8mzy7clGTX57JQZUKEkaqTs8xJyUKzOJMA9oQqy+t0qursn2LXlIAIaP+Ns4iGTdEC+rP8G1UKjSM8/QTTIjyfITGeyhl11CEqpr4g+4yfdE+YnF5MuOXem5V3lYGY0kLfb6UBM5+AwU3kQQ28xTwoa0CMV4YXvfooA9TEp/VLKjORRjW4isAlB477c+qCQS1hBpOVbYDmLy4dHk0fehrJ4u1lFJBPEx8EBktVxpk2cmTy7GF3gVcIW2J1N1EDQ3nHnacwngbVfXhCR/7afqmqhu8sLMA5mgUsXR0FT98YPJk0xqNmj+gGnbgit19y0LmjPlJ3hhDF9xZRvW1syCLFmsoyUqFzwtcZgKmh+VNkFVMTLo/763toVgSK68r1xQf9AkNPnMPN12lQsyJVFLIslw8VvtCSGC4IKnGz6V7EGU5zxNiJAlSwCT2KEQv5Whj3hvPX2+/Mbkk+W+Xrgqxs/3iONVdYYcQwjZB7ULhOw0J9dk2wjis0oPEgbNTwvvvXAE8c/qYjwqU5isuPIPqoh83d0o42pTijlztXpKWVtVrZz/sOTKJSuVl54EVz4rULP+bJdtqYfD3XpGEd1PyvnIUuqhp4AHLe7Ihb2Pih/JWuPkPYgjVw7miEI7U6H9aamoiR4lgEiakMYgGy7108JakdUDkx+RoBDFqA4uIPeuJqiGIvY59F1Gmh/LRJa8SttcnzEprsAJNPmRRla2snwaznSoSFXZHwoS6cEItmgQPSRScoRIdbnUNcopXm9ed+i0akSI8BCOl0+c+Kn47nyXR9VNeGkTUePV1KOAW1TdxJcRUTljXUgtGFPdpGBOxMjykIgnRLQ7NQVOlt4ylXM8HhIWXTFf56pJlzZpGDEoNt+tx8U6wnYkElQRAkVKm0RPre02XwlJJGoMTzPp42h9dnlx1YYE+S3CiRWc7SwkNxKblMbxBJn8lhMpuHqAPBTky4hMNFVXWt2ElzPwRVcEVzcpjg1RiYk9xtoI80CSi4XWgkLVTaIOBn4raeBCmQdS3aTy9C0SQZA178RlRDgIVVWhmUqS3UKTLyuQgazbZ6oLrbhSHAw7IezTvy8Hg2JkKhp4WZkyIqFVDR9BmAInvrpJwfWE7l/ad7BfxZCIK47Sv7P4x8qrnLiTJCptMunYabqnrVMwHESfWHrm4CxfRiTUpKMjQ4hMZPIjwatwNaSMiIFEzohdiR3EjJCaJDM2qayKIZG2oci6xUOIE/eZ6qaSiFADPylZYIPmuSZbI0IkrHEyVs5LsCZCiESlHjosbeI9gsdDmgNXw13rAxMig0w+BdfrEIyHNFeWQvD+3bmK47WPvoNmZNeC8ZDhjmW3obi1LTuIxC9k7tecFFzpbgTPZGATdlXBpU0KKJOr99ANHnImAKTFnRo8RKIyRxVDIkjW37WYSE+CWuhKJIQIv6skUSGYYzeIk5i8L23imYyxu58kyiMcuAhForpJ5OU9ITLWYJfcRjL3ro6IEDn39dH6stw2f2ZGKDu/h6TvE/kaIueucs4SNIvdjNvfzhIqy/M0B74GB4+3kne0yAfE3YHJ1IKJXPf/ARXN6/ssS+vjAAAAAElFTkSuQmCC} - image create photo colorpicker - colorpicker configure -data $picker - label $p.colors -bd 0 - entry $p.rgb -bd 0 -width 10 -font {{bitstream vera sans mono} 8} - bind $p.colors <B1-Motion> {::pd::colors:pick %x %y} - bind $p.colors <1> {::pd::colors:pick %x %y} - grid $p.colors -sticky nsew - grid $p.rgb -stick nsew - $p.colors configure -image colorpicker - }} - proc colors:pick {x y} { - if {![expr $y <= 255 && $y >= 0 && $x >= 0 && $x <= 50]} {return} - set p .colors - set rgb [hsvToRgb [expr (255 - $y) / 255.] [expr $x <= 25 ? 1. : ($x - 50) / -25.] [expr $x <= 25 ? $x / 25. : 1.]] - $p.rgb delete 0 end - $p.rgb insert 0 $rgb - $p.rgb configure -bg [color $rgb] - } - proc inspector {_} { variable "" --- 181,184 ---- *************** *** 286,290 ****
$m add command -label reload -command {source pd_base.tk} - $m add command -label "colors" -command "::pd::colors" $m add command -label "console" -command {source /usr/local/bin/tkcon.tcl; tkcon show} $m add command -label "inspector" -command "::pd::inspector $_" --- 247,250 ---- *************** *** 391,403 **** }
- - - proc item_mua {_ r u redraw {items -}} { - variable "" - if {$items eq "-"} {set items [getsel $_]} - foreach item $items {update $_ $item $r $u $redraw} - } - - proc new {_} { variable "" --- 351,354 ---- *************** *** 413,418 **** set pd_send -1 proc connect {} { ! if {[catch {set pd_send [socket localhost 4400]}]} {set pd_send -1} {puts "connected $pd_send"} ! catch {set pd_receive [socket -server ::pd::receive_conn 4401]}} proc receive_conn {s addr port} { fileevent $s readable [list ::pd::receive $s] --- 364,371 ---- set pd_send -1 proc connect {} { ! if {[catch {set pd_send [socket localhost 13665]}]} {set pd_send -1} {puts "connected $pd_send"} ! catch {set pd_receive [socket -server ::pd::receive_conn 13666]} ! exec pd -guiport 13666 & ! } proc receive_conn {s addr port} { fileevent $s readable [list ::pd::receive $s] *************** *** 437,446 **** }
} - - if {$argv eq "1" && ![winfo exists .c]} { - toplevel .c -width 512 -height 512 - ::pd::new .c.c - #connect - } --- 390,398 ---- }
+ if {![winfo exists .c]} { + toplevel .c -width 512 -height 512 + new .c.c + # connect + }
}