Pd-cvs September 2005

pd-cvs@lists.iem.at

10 participants
189 discussions

pd/src desire.tk,1.1.2.69,1.1.2.70
by chunlee 19 Sep '05

19 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28238 Modified Files: Tag: devel_0_39 desire.tk Log Message: some rendering fix before i go to work;) Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.69 retrieving revision 1.1.2.70 diff -C2 -d -r1.1.2.69 -r1.1.2.70 *** desire.tk 19 Sep 2005 04:13:55 -0000 1.1.2.69 --- desire.tk 19 Sep 2005 08:56:06 -0000 1.1.2.70 *************** *** 1517,1521 **** [lindex $@selection 0] unedit $self set @obj_in_edit 0 ! puts "completing it!" } } --- 1517,1521 ---- [lindex $@selection 0] unedit $self set @obj_in_edit 0 ! #puts "completing it!" } } *************** *** 1911,1915 **** set class [lindex $d $i] switch -- $class {obj {set i 4; set class [lindex $d 4]}} - if {![info exists _($x:_class)]} { if {[info exists classinfo($class)]} { --- 1911,1914 ---- *************** *** 1922,1931 **** set canvas $_($x:canvas) $x init ! set _($x:text) [lindex $d $i end] set _($x:valid) 0 $x update_size $x draw $canvas - puts "_($x:text)='$_($x:text)'" if {[string length $_($x:text)]==0} {$x edit $canvas} } if {![info exists fields($class)]} {set class obj} --- 1921,1930 ---- set canvas $_($x:canvas) $x init ! set _($x:text) [lrange $d $i end] set _($x:valid) 0 $x update_size $x draw $canvas if {[string length $_($x:text)]==0} {$x edit $canvas} + set _($_($x:canvas):selection) $x } if {![info exists fields($class)]} {set class obj} *************** *** 3026,3028 **** #c } #c that thing..redraws anythign that is currently selected or was currently selected ! #c lsort proably does what u want (has an integer flag too) \ No newline at end of file --- 3025,3027 ---- #c } #c that thing..redraws anythign that is currently selected or was currently selected ! #c lsort proably does what u want (has an integer flag too)

1 0

pd/src desire.tk,1.1.2.68,1.1.2.69
by Mathieu Bouchard 19 Sep '05

19 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13551 Modified Files: Tag: devel_0_39 desire.tk Log Message: . Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.68 retrieving revision 1.1.2.69 diff -C2 -d -r1.1.2.68 -r1.1.2.69 *** desire.tk 18 Sep 2005 19:43:37 -0000 1.1.2.68 --- desire.tk 19 Sep 2005 04:13:55 -0000 1.1.2.69 *************** *** 14,17 **** --- 14,20 ---- #-----------------------------------------------------------------------------------# + # for future use + # if {$tcl_version < 8.5} {source pre8.5.tcl} + #-----------------------------------------------------------------------------------# # OBJECT ORIENTED PROGRAMMING IN TCL (by Mathieu Bouchard) *************** *** 67,71 **** [...1432 lines suppressed...] proc propose_completions2 {} { global class_list completion_closure ! mset {self canvas x y text} $completion_closure set r {} set n 0 *************** *** 3166,3167 **** --- 3018,3028 ---- } } + + #c proc updatesel {_ sel} { + #c variable "" + #c set os [getsel $_] + #c up $_ canvas sel + #c redraw $_ [lsort -unique [concat $os $sel]] + #c } + #c that thing..redraws anythign that is currently selected or was currently selected + #c lsort proably does what u want (has an integer flag too) \ No newline at end of file

1 0

pd/src desire.c,1.1.2.20,1.1.2.21
by Mathieu Bouchard 19 Sep '05

19 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1137 Modified Files: Tag: devel_0_39 desire.c Log Message: . Index: desire.c =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.c,v retrieving revision 1.1.2.20 retrieving revision 1.1.2.21 diff -C2 -d -r1.1.2.20 -r1.1.2.21 *** desire.c 18 Sep 2005 19:43:37 -0000 1.1.2.20 --- desire.c 19 Sep 2005 02:56:07 -0000 1.1.2.21 *************** *** 930,935 **** while ((oc = linetraverser_next(&t))) sys_vgui("wire_update %lx %lx %d %d %d %d %d", oc, ! glist_getcanvas(x), t.tr_ob, t.tr_outno, t.tr_ob2, t.tr_inno, ! (outlet_getsymbol(t.tr_outlet) == &s_signal)); } --- 930,935 ---- while ((oc = linetraverser_next(&t))) sys_vgui("wire_update %lx %lx %d %d %d %d %d", oc, ! glist_getcanvas(x), t.tr_ob, t.tr_outno, t.tr_ob2, t.tr_inno, ! (outlet_getsymbol(t.tr_outlet) == &s_signal)); } *************** *** 12621,12626 **** //sys_mgui(self,"inlets=","i", obj_ninlets((t_text *)self)); //sys_mgui(self,"outlets=","i",obj_noutlets((t_text *)self)); ! sys_vgui("%lx inlets= %d\n", self, obj_ninlets((t_text *)self)); ! sys_vgui("%lx outlets= %d\n", self, obj_noutlets((t_text *)self)); binbuf_free(buf); free(s); --- 12621,12626 ---- //sys_mgui(self,"inlets=","i", obj_ninlets((t_text *)self)); //sys_mgui(self,"outlets=","i",obj_noutlets((t_text *)self)); ! sys_vgui("%lx ninlets= %d\n", self, obj_ninlets((t_text *)self)); ! sys_vgui("%lx noutlets= %d\n", self, obj_noutlets((t_text *)self)); binbuf_free(buf); free(s);

1 0

pd/src pd_base.tk, 1.1.2.10, 1.1.2.11 pd_objects.tk, 1.1.2.13, 1.1.2.14
by carmen rocco 19 Sep '05

19 Sep '05

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 + } }

1 0

pd/src desire.c, 1.1.2.19, 1.1.2.20 desire.tk, 1.1.2.67, 1.1.2.68
by Mathieu Bouchard 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21061 Modified Files: Tag: devel_0_39 desire.c desire.tk Log Message: drawing inlets and outlets works again Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.67 retrieving revision 1.1.2.68 diff -C2 -d -r1.1.2.67 -r1.1.2.68 *** desire.tk 18 Sep 2005 16:35:01 -0000 1.1.2.67 --- desire.tk 18 Sep 2005 19:43:37 -0000 1.1.2.68 *************** *** 89,94 **** proc super {args} { ! upvar 2 methods methods self self ! set i [expr 1+[uplevel 2 {list $i}]] puts "!!! super #$i" if {[llength $methods] < $i} {error "no more supermethods"} --- 89,94 ---- proc super {args} { ! upvar 2 methods methods self self i oi ! set i [expr 1+$oi] puts "!!! super #$i" if {[llength $methods] < $i} {error "no more supermethods"} *************** *** 100,103 **** --- 100,105 ---- class_new thing set _(thing:_super) {} + # virtual destructor + def* thing ~ {} {} #-----------------------------------------------------------------------------------# *************** *** 1175,1180 **** for {set i 0} {$i<$n} {incr i} { set onset [expr $x1 + ($@xs-$look(iowidth)) * $i / $nplus] ! set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]] ! set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]] # will update this code when proc item deals with mult.tags if {[llength [$c gettags ${self}$which$i]] != 0} { --- 1177,1181 ---- for {set i 0} {$i<$n} {incr i} { set onset [expr $x1 + ($@xs-$look(iowidth)) * $i / $nplus] ! set points [list [expr $onset] $y [expr $onset+$look(iowidth)] [expr $y+1]] # will update this code when proc item deals with mult.tags if {[llength [$c gettags ${self}$which$i]] != 0} { *************** *** 1191,1196 **** set fy $look(iopos) foreach {x1 y1} [$self xy $canvas] {} ! io_draw/2 $self $canvas i $@inlets [expr $y1-$fy+$look(extrapix)] ! io_draw/2 $self $canvas o $@outlets [expr $y1+$fy] } --- 1192,1197 ---- set fy $look(iopos) foreach {x1 y1} [$self xy $canvas] {} ! io_draw/2 $self $canvas i $@inlets [expr $y1-$fy-1] ! io_draw/2 $self $canvas o $@outlets [expr $y1+$fy+$@ys] } *************** *** 1200,1214 **** class_new textbox {view} def textbox draw {canvas} { global font look foreach {x1 y1} [$self xy $canvas] {} puts "x1=$x1 y1=$y1" ! item $self $canvas TEXT text [list $x1 $y1] \ ! -font [format -*-courier-medium--normal--%d-* $font(size)] \ ! -text $@text -fill $look(objectfg) -anchor nw } def* textbox edit {canvas} { global look font set @edit 1 set _($canvas:obj_in_edit_old) $self --- 1201,1224 ---- class_new textbox {view} + def textbox inlets= {v} {set @inlets $v} + def textbox outlets= {v} {set @outlets $v} + def textbox draw {canvas} { global font look foreach {x1 y1} [$self xy $canvas] {} puts "x1=$x1 y1=$y1" ! if {$@edit} { ! set t .x$canvas.c.${self}text ! $t configure -width [expr [string length $@text]+1] ! } { ! item $self $canvas TEXT text [l+ {2 2} [list $x1 $y1]] \ ! -font [format -*-courier-medium--normal--%d-* $font(size)] \ ! -text $@text -fill $look(objectfg) -anchor nw ! } } def* textbox edit {canvas} { global look font + if {$@edit} {return} set @edit 1 set _($canvas:obj_in_edit_old) $self *************** *** 1218,1222 **** set @oldtext $@text $self update_size - $self draw $canvas set t .x$canvas.c.${self}text text $t -height 1 -width [string length $@text] -relief flat \ --- 1228,1231 ---- *************** *** 1230,1233 **** --- 1239,1243 ---- .x$canvas.c create window [expr $@cx+1] [expr $@cy+1] \ -window $t -anchor nw -tags "${self}text $self" + $self draw $canvas $t configure -pady 0 $t insert 1.0 $@text *************** *** 1236,1246 **** def* text key {canvas widget x y key iso shift} { ! global font ! set @text [$widget get 1.0 1.end] ! set n [expr [string length $@text]+1] ! puts "@text=$@text n=$n" ! $self update_size ! $self draw $canvas ! $widget configure -width $n } --- 1246,1254 ---- def* text key {canvas widget x y key iso shift} { ! # after 0 "global _ ! set @text [$widget get 1.0 1.end] ! $self update_size ! $self draw $canvas ! # " } *************** *** 1272,1276 **** } ! def* objectbox update_size {} { global font set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]-$@valid)] --- 1280,1284 ---- } ! def* textbox update_size {} { global font set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]-$@valid)] *************** *** 2038,2046 **** set i 1 set class [lindex $d $i] ! switch -- $class { obj { ! set i 4 ! set class [lindex $d 4] ! # puts "_($x:text)=$_($x:text)" ! }} if {![info exists _($x:_class)]} { if {[info exists classinfo($class)]} { --- 2046,2050 ---- set i 1 set class [lindex $d $i] ! switch -- $class {obj {set i 4; set class [lindex $d 4]}} if {![info exists _($x:_class)]} { if {[info exists classinfo($class)]} { *************** *** 2050,2060 **** } # hack ! set c $_($x:canvas) $x init set _($x:text) [lindex $d $i end] set _($x:valid) 0 $x update_size ! $x draw $c ! if {[string length $@text]==0} {$x edit $canvas} } if {![info exists fields($class)]} {set class obj} --- 2054,2065 ---- } # hack ! set canvas $_($x:canvas) $x init set _($x:text) [lindex $d $i end] set _($x:valid) 0 $x update_size ! $x draw $canvas ! puts "_($x:text)='$_($x:text)'" ! if {[string length $_($x:text)]==0} {$x edit $canvas} } if {![info exists fields($class)]} {set class obj} *************** *** 2080,2084 **** def* view wb_activate {args} {} def* view wb_select {args} {} ! def* view wb_delete {args} {} proc item {self canvas suffix type coords args} { --- 2085,2089 ---- def* view wb_activate {args} {} def* view wb_select {args} {} ! def* view wb_delete {canvas} {$self erase $canvas; $self ~} proc item {self canvas suffix type coords args} { Index: desire.c =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.c,v retrieving revision 1.1.2.19 retrieving revision 1.1.2.20 diff -C2 -d -r1.1.2.19 -r1.1.2.20 *** desire.c 18 Sep 2005 09:22:18 -0000 1.1.2.19 --- desire.c 18 Sep 2005 19:43:37 -0000 1.1.2.20 *************** *** 6045,6052 **** sprintf(tag, "graph%lx", (t_int)x); ! if (vis) ! glist_drawiofor(parent_glist, &x->gl_obj, 1, ! tag, x1, y1, x2, y2); ! else glist_eraseiofor(parent_glist, &x->gl_obj, tag); /* if we look like a graph but have been moved to a toplevel, just show the bounding rectangle */ --- 6045,6052 ---- sprintf(tag, "graph%lx", (t_int)x); ! if (vis) { ! sys_mgui(x,"ninlets=","d",obj_ninlets(x)); ! sys_mgui(x,"noutlets=","d",obj_noutlets(x)); ! } else glist_eraseiofor(parent_glist, &x->gl_obj, tag); /* if we look like a graph but have been moved to a toplevel, just show the bounding rectangle */ *************** *** 12340,12344 **** void text_eraseborder(t_text *x, t_glist *glist, char *tag) {} ! static void text_setto(t_text *x, t_glist *glist, char *buf, int bufsize) { if (x->te_type == T_OBJECT) { t_binbuf *b = binbuf_new(); --- 12340,12344 ---- void text_eraseborder(t_text *x, t_glist *glist, char *tag) {} ! void text_setto(t_text *x, t_glist *glist, char *buf, int bufsize) { if (x->te_type == T_OBJECT) { t_binbuf *b = binbuf_new(); *************** *** 12619,12622 **** --- 12619,12626 ---- binbuf_gettext(buf,&s,&n); sys_vgui("update_object %x {%.*s}\n", (unsigned)self,n,s); + //sys_mgui(self,"inlets=","i", obj_ninlets((t_text *)self)); + //sys_mgui(self,"outlets=","i",obj_noutlets((t_text *)self)); + sys_vgui("%lx inlets= %d\n", self, obj_ninlets((t_text *)self)); + sys_vgui("%lx outlets= %d\n", self, obj_noutlets((t_text *)self)); binbuf_free(buf); free(s);

1 0

pd/src pre8.5.tcl,1.1.2.1,1.1.2.2
by carmen rocco 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18866 Modified Files: Tag: devel_0_39 pre8.5.tcl Log Message: lremove Index: pre8.5.tcl =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pre8.5.tcl,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -d -r1.1.2.1 -r1.1.2.2 *** pre8.5.tcl 11 Sep 2005 11:03:28 -0000 1.1.2.1 --- pre8.5.tcl 18 Sep 2005 19:29:42 -0000 1.1.2.2 *************** *** 1,2 **** --- 1,26 ---- + proc lremove {args} { + array set opts {-all 0 pattern -exact} + while {[string match -* [lindex $args 0]]} { + switch -glob -- [lindex $args 0] { + -a* { set opts(-all) 1 } + -g* { set opts(pattern) -glob } + -r* { set opts(pattern) -regexp } + -- { set args [lreplace $args 0 0]; break } + default {return -code error "unknown option \"[lindex $args 0]\""} + } + set args [lreplace $args 0 0] + } + set l [lindex $args 0] + foreach i [join [lreplace $args 0 0]] { + if {[set ix [lsearch $opts(pattern) $l $i]] == -1} continue + set l [lreplace $l $ix $ix] + if {$opts(-all)} { + while {[set ix [lsearch $opts(pattern) $l $i]] != -1} { + set l [lreplace $l $ix $ix] + } + } + } + return $l + } if {![llength [info commands dict]]} { proc lassign {list args} {

1 0

pd/src desire.tk,1.1.2.66,1.1.2.67
by carmen rocco 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13567 Modified Files: Tag: devel_0_39 desire.tk Log Message: redifining def (in slightly diff ways to accoutn for storage) which would break desire.tk Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.66 retrieving revision 1.1.2.67 diff -C2 -d -r1.1.2.66 -r1.1.2.67 *** desire.tk 18 Sep 2005 12:04:33 -0000 1.1.2.66 --- desire.tk 18 Sep 2005 16:35:01 -0000 1.1.2.67 *************** *** 103,109 **** #-----------------------------------------------------------------------------------# - # carmen's canvas - source pd_base.tk - set OS $tcl_platform(platform) --- 103,106 ---- *************** *** 679,683 **** populate_menu .mbar.file {} { {"New" {menu_new} "Ctrl+n"} - {"New 2" {toplevel .c -width 512 -height 512; ::pd::new .c.c} ""} {"Open" {menu_open} "Ctrl+o"} {} --- 676,679 ----

1 0

pd/src desire.tk,1.1.2.65,1.1.2.66
by Mathieu Bouchard 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20191 Modified Files: Tag: devel_0_39 desire.tk Log Message: huh Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.65 retrieving revision 1.1.2.66 diff -C2 -d -r1.1.2.65 -r1.1.2.66 *** desire.tk 18 Sep 2005 09:58:49 -0000 1.1.2.65 --- desire.tk 18 Sep 2005 12:04:33 -0000 1.1.2.66 *************** *** 1155,1163 **** set c .x$canvas.c $c itemconfigure ${self}BASE -outline $frcol ! if {$@isnew} { $c itemconfigure ${self}BASE -dash {8 8 8 8} } { $c itemconfigure ${self}BASE -dash {} } } --- 1155,1165 ---- set c .x$canvas.c $c itemconfigure ${self}BASE -outline $frcol ! if {$@valid} { $c itemconfigure ${self}BASE -dash {8 8 8 8} } { $c itemconfigure ${self}BASE -dash {} } + #super $canvas + textbox_draw $self $canvas } *************** *** 1203,1214 **** def textbox draw {canvas} { foreach {x1 y1} [$self xy $canvas] {} ! item $self $canvas TEXT create text $x1 $y1 \ ! -font [format -*-courier-medium--normal--%d-* $font] \ ! -text $text -fill $color -anchor nw } def* textbox edit {canvas} { global look font set _($canvas:obj_in_edit_old) $self set _($canvas:obj_in_edit) 1 --- 1205,1219 ---- def textbox draw {canvas} { + global font look foreach {x1 y1} [$self xy $canvas] {} ! puts "x1=$x1 y1=$y1" ! item $self $canvas TEXT text [list $x1 $y1] \ ! -font [format -*-courier-medium--normal--%d-* $font(size)] \ ! -text $@text -fill $look(objectfg) -anchor nw } def* textbox edit {canvas} { global look font + set @edit 1 set _($canvas:obj_in_edit_old) $self set _($canvas:obj_in_edit) 1 *************** *** 1226,1230 **** bind $t <Control-Return> "text_key $self $canvas %W %x %y 10 %A 0" bind $t <Return> "$self unedit $canvas" - set @isnew 1 set t .x$canvas.c.${self}text .x$canvas.c create window [expr $@cx+1] [expr $@cy+1] \ --- 1231,1234 ---- *************** *** 1247,1281 **** #----------------------------------------------------------------------------------- class_new objectbox {textbox} ! def objectbox init {canvas} { global font look ! set @isnew 1 set @inlets 0 set @outlets 0 ! set @canvas $canvas set @class "" ! set @text "" set @edit 0 ! $self add $canvas ! if {[info exists _($canvas:selection)]} { ! if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { ! set object [lindex $_($canvas:selection) 0] ! $object unedit $canvas ! } ! foreach obj $_($canvas:selection) { ! .x$canvas.c itemconfigure ${obj}BASE -outline $look(objectframe3) ! } ! set _($canvas:selection) {} ! } ! set _($canvas:obj_in_edit) 1 ! set _($canvas:selection) {} ! set _($canvas:selection) [linsert $_($canvas:selection) 0 $self] ! $self update_size ! $self draw $canvas ! if {[string length $@text]==0} {$self edit $canvas} } def* objectbox update_size {} { global font ! set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]+$@isnew)] set @ys [expr $font(pady)+$font(height)] } --- 1251,1282 ---- #----------------------------------------------------------------------------------- class_new objectbox {textbox} ! def objectbox init {args} { global font look ! set @valid 0 set @inlets 0 set @outlets 0 ! #set @canvas "deadbeef" set @class "" ! set @text $args set @edit 0 ! #if {[info exists _($canvas:selection)]} { ! # if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { ! # set object [lindex $_($canvas:selection) 0] ! # $object unedit $canvas ! # } ! # foreach obj $_($canvas:selection) { ! # .x$canvas.c itemconfigure ${obj}BASE -outline $look(objectframe3) ! # } ! # set _($canvas:selection) {} ! #} ! #set _($canvas:obj_in_edit) 1 ! #set _($canvas:selection) {} ! #set _($canvas:selection) [linsert $_($canvas:selection) 0 $self] ! #puts "new objectbox has text '$@text'" } def* objectbox update_size {} { global font ! set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]-$@valid)] set @ys [expr $font(pady)+$font(height)] } *************** *** 1288,1292 **** set @text [$t get 1.0 1.end] $c delete ${self}text ! #destroy $t set l {} foreach c [split $@text ""] {lappend l [scan $c %c]} --- 1289,1293 ---- set @text [$t get 1.0 1.end] $c delete ${self}text ! after 1 "destroy $t" set l {} foreach c [split $@text ""] {lappend l [scan $c %c]} *************** *** 1297,1301 **** global font set @selected? 0 - set @isnew 0 $self erase $canvas $self update_size --- 1298,1301 ---- *************** *** 2037,2051 **** proc update_object {x d} { ! global _ ! global fields set d [string trimright $d "\n"] set d [string trimright $d ";"] set i 1 set class [lindex $d $i] ! switch -- $class { ! obj { set i 4 ! set class [lindex $d $i] ! set _($x:text) $d }} if {![info exists _($x:_class)]} { --- 2037,2049 ---- proc update_object {x d} { ! global _ fields set d [string trimright $d "\n"] set d [string trimright $d ";"] set i 1 set class [lindex $d $i] ! switch -- $class { obj { set i 4 ! set class [lindex $d 4] ! # puts "_($x:text)=$_($x:text)" }} if {![info exists _($x:_class)]} { *************** *** 2056,2060 **** } # hack ! objectbox_init $x $_($x:canvas) } if {![info exists fields($class)]} {set class obj} --- 2054,2064 ---- } # hack ! set c $_($x:canvas) ! $x init ! set _($x:text) [lindex $d $i end] ! set _($x:valid) 0 ! $x update_size ! $x draw $c ! if {[string length $@text]==0} {$x edit $canvas} } if {![info exists fields($class)]} {set class obj}

1 0

pd/src desire.tk,1.1.2.64,1.1.2.65
by Mathieu Bouchard 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32169 Modified Files: Tag: devel_0_39 desire.tk Log Message: . Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.64 retrieving revision 1.1.2.65 diff -C2 -d -r1.1.2.64 -r1.1.2.65 *** desire.tk 18 Sep 2005 09:23:16 -0000 1.1.2.64 --- desire.tk 18 Sep 2005 09:58:49 -0000 1.1.2.65 *************** *** 1202,1220 **** class_new textbox {view} ! proc text_new {canvas self x y text font color} { ! .x$canvas.c create text $x $y \ -font [format -*-courier-medium--normal--%d-* $font] \ ! -tags "${self}TEXT $self" -text $text -fill $color -anchor nw ! foreach {x1 y1 x2 y2} [.x$canvas.c bbox ${self}TEXT] {} ! } ! ! proc text_set {canvas myname text} { ! .x$canvas.c itemconfigure $myname -text $text ! foreach {x1 y1 x2 y2} [.x$canvas.c bbox ${myname}] { ! .x$canvas.c coords ${myname}_R $x1 $y1 $x2 $y2 ! } } ! def textbox edit {canvas} { global look font set _($canvas:obj_in_edit_old) $self --- 1202,1213 ---- class_new textbox {view} ! def textbox draw {canvas} { ! foreach {x1 y1} [$self xy $canvas] {} ! item $self $canvas TEXT create text $x1 $y1 \ -font [format -*-courier-medium--normal--%d-* $font] \ ! -text $text -fill $color -anchor nw } ! def* textbox edit {canvas} { global look font set _($canvas:obj_in_edit_old) $self *************** *** 1255,1258 **** --- 1248,1252 ---- class_new objectbox {textbox} def objectbox init {canvas} { + global font look set @isnew 1 set @inlets 0 *************** *** 1261,1275 **** set @class "" set @text "" $self add $canvas - } - - def* objectbox update_size {} { - global font - set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]+$@isnew)] - set @ys [expr $font(pady)+$font(height)] - } - - def objectbox add {canvas} { - global font look if {[info exists _($canvas:selection)]} { if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { --- 1255,1260 ---- set @class "" set @text "" + set @edit 0 $self add $canvas if {[info exists _($canvas:selection)]} { if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { *************** *** 1287,1294 **** $self update_size $self draw $canvas ! $self edit $canvas } ! def objectbox unedit {canvas} { set c .x$canvas.c set t $c.${self}text --- 1272,1287 ---- $self update_size $self draw $canvas ! if {[string length $@text]==0} {$self edit $canvas} } ! def* objectbox update_size {} { ! global font ! set @xs [expr $font(padx)+$font(width)*([expr [string length $@text]+1]+$@isnew)] ! set @ys [expr $font(pady)+$font(height)] ! } ! ! def* objectbox unedit {canvas} { ! if {!$@edit} {return} ! set @edit 0 set c .x$canvas.c set t $c.${self}text *************** *** 1355,1358 **** --- 1348,1353 ---- #-----------------------------------------------------------------------------------# + def* canvas window_title {args} {} + def canvas delete_selection {} { foreach obj $@selection {$obj erase} *************** *** 2048,2052 **** set i 1 set class [lindex $d $i] ! switch -- $class { obj { set i 4; set class [lindex $d $i] }} if {![info exists _($x:_class)]} { if {[info exists classinfo($class)]} { --- 2043,2052 ---- set i 1 set class [lindex $d $i] ! switch -- $class { ! obj { ! set i 4 ! set class [lindex $d $i] ! set _($x:text) $d ! }} if {![info exists _($x:_class)]} { if {[info exists classinfo($class)]} {

1 0

pd/src desire.tk,1.1.2.63,1.1.2.64
by Mathieu Bouchard 18 Sep '05

18 Sep '05

Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26361 Modified Files: Tag: devel_0_39 desire.tk Log Message: stuff Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.63 retrieving revision 1.1.2.64 diff -C2 -d -r1.1.2.63 -r1.1.2.64 *** desire.tk 18 Sep 2005 02:00:12 -0000 1.1.2.63 --- desire.tk 18 Sep 2005 09:23:16 -0000 1.1.2.64 *************** *** 597,619 **** set to [lindex $wire_to 0] set inlet_number [lindex $wire_to 1] - set inlet_flag 0 - set outlet_flag 1 - #puts "wire_from ==> $wire_from" #puts "wire_to ==> $wire_to" #puts "outlet_number ==> $outlet_number" ! ! if {[info exists _($from:$outlet_flag:$outlet_number)]} { ! lappend _($from:$outlet_flag:$outlet_number) $wire_id } else { ! set _($from:$outlet_flag:$outlet_number) $wire_id ! #puts "**** $from:$outlet_flag:$outlet_number ****" } ! if {[info exists _($to:$inlet_flag:$inlet_number)]} { ! lappend _($to:$inlet_flag:$inlet_number) $wire_id } else { ! set _($to:$inlet_flag:$inlet_number) $wire_id ! #puts "*** $to:$inlet_flag:$inlet_number ***" } --- 597,617 ---- set to [lindex $wire_to 0] set inlet_number [lindex $wire_to 1] #puts "wire_from ==> $wire_from" #puts "wire_to ==> $wire_to" #puts "outlet_number ==> $outlet_number" ! ! ! if {[info exists _($from:o:$outlet_number)]} { ! lappend _($from:o:$outlet_number) $wire_id } else { ! set _($from:o:$outlet_number) $wire_id ! #puts "**** $from:o:$outlet_number ****" } ! if {[info exists _($to:i:$inlet_number)]} { ! lappend _($to:i:$inlet_number) $wire_id } else { ! set _($to:$i:$inlet_number) $wire_id ! #puts "*** $to:i:$inlet_number ***" } *************** *** 737,740 **** --- 735,739 ---- global sock puts $sock [join $args " "] + flush $sock puts "<- [join $args " "]" } *************** *** 1128,1131 **** --- 1127,1133 ---- } + #def view connect {} { + #} + # in the future, one view may have several canvases. # this means that the following proc will have to die. *************** *** 1198,1203 **** #-----------------------------------------------------------------------------------# ! # create a new text object ! class_new text {thing} proc text_new {canvas self x y text font color} { --- 1200,1204 ---- #-----------------------------------------------------------------------------------# ! class_new textbox {view} proc text_new {canvas self x y text font color} { *************** *** 1208,1213 **** } - # change the text - proc* pdtk_text_set {canvas myname text} {} proc text_set {canvas myname text} { .x$canvas.c itemconfigure $myname -text $text --- 1209,1212 ---- *************** *** 1217,1223 **** } ! def text create {canvas font_size text} { global look font ! set @text $text $self update_size $self draw $canvas --- 1216,1226 ---- } ! def textbox edit {canvas} { global look font ! set _($canvas:obj_in_edit_old) $self ! set _($canvas:obj_in_edit) 1 ! set @selected? 1 ! .x$canvas.c delete ${self}TEXT ! set @oldtext $@text $self update_size $self draw $canvas *************** *** 1225,1231 **** text $t -height 1 -width [string length $@text] -relief flat \ -bg ${look(objectbg)} -borderwidth 0 \ ! -font [format -*-courier-medium--normal--%d-* $font_size] set _(focus) $self ! bind $t <KeyRelease> "text_key $self $canvas %W %x %y %K %A 0" set @isnew 1 set t .x$canvas.c.${self}text --- 1228,1236 ---- text $t -height 1 -width [string length $@text] -relief flat \ -bg ${look(objectbg)} -borderwidth 0 \ ! -font [format -*-courier-medium--normal--%d-* $font(size)] set _(focus) $self ! bind $t <Key> "text_key $self $canvas %W %x %y %K %A 0" ! bind $t <Control-Return> "text_key $self $canvas %W %x %y 10 %A 0" ! bind $t <Return> "$self unedit $canvas" set @isnew 1 set t .x$canvas.c.${self}text *************** *** 1233,1237 **** -window $t -anchor nw -tags "${self}text $self" $t configure -pady 0 ! $t insert 1.0 $text focus $t } --- 1238,1242 ---- -window $t -anchor nw -tags "${self}text $self" $t configure -pady 0 ! $t insert 1.0 $@text focus $t } *************** *** 1247,1257 **** } ! #-----------------------------------------------------------------------------------# ! class_new objectbox {view} ! def objectbox init {} { set @isnew 1 set @inlets 0 set @outlets 0 ! set canvas $_(focus) set @class "" set @text "" --- 1252,1262 ---- } ! #----------------------------------------------------------------------------------- ! class_new objectbox {textbox} ! def objectbox init {canvas} { set @isnew 1 set @inlets 0 set @outlets 0 ! set @canvas $canvas set @class "" set @text "" *************** *** 1270,1274 **** if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { set object [lindex $_($canvas:selection) 0] ! $object complete $canvas } foreach obj $_($canvas:selection) { --- 1275,1279 ---- if {[info exists _($canvas:obj_in_edit)] && $_($canvas:obj_in_edit)} { set object [lindex $_($canvas:selection) 0] ! $object unedit $canvas } foreach obj $_($canvas:selection) { *************** *** 1282,1297 **** $self update_size $self draw $canvas ! text_create $self $canvas $font(size) "" } ! def objectbox complete {canvas} { ! global font ! set @selected? 0 ! set @isnew 0 set c .x$canvas.c set t $c.${self}text ! set obj_name [$t get 1.0 1.end] ! destroy $t $c delete ${self}text $self erase $canvas $self update_size --- 1287,1308 ---- $self update_size $self draw $canvas ! $self edit $canvas } ! def objectbox unedit {canvas} { set c .x$canvas.c set t $c.${self}text ! set @text [$t get 1.0 1.end] $c delete ${self}text + #destroy $t + set l {} + foreach c [split $@text ""] {lappend l [scan $c %c]} + pd ".x$canvas text_setto !$self $l ;" + } + + def objectbox complete2 {canvas} { + global font + set @selected? 0 + set @isnew 0 $self erase $canvas $self update_size *************** *** 1321,1335 **** } - def objectbox edit {canvas} { - global font - set _($canvas:obj_in_edit_old) $self - set _($canvas:obj_in_edit) 1 - set @isnew 0 - set @selected? 1 - set old_obj_name [.x$canvas.c itemcget ${self}TEXT -text] - .x$canvas.c delete ${self}TEXT - text_create $self $canvas $font(size) $old_obj_name - } - def objectbox click {args} { puts "$self is being clicked in run mode" --- 1332,1335 ---- *************** *** 1613,1617 **** set old_obj [lindex $@selection 0] if {$@select_by == "click"} { ! objectbox_complete $old_obj $self } set @obj_in_edit 0 --- 1613,1617 ---- set old_obj [lindex $@selection 0] if {$@select_by == "click"} { ! $old_obj unedit $self } set @obj_in_edit 0 *************** *** 1655,1661 **** puts "and some object is being edited" if {$@obj_in_edit > 0} { ! [lindex $@selection 0] complete $self set @obj_in_edit 0 ! puts "competing it!" } } --- 1655,1661 ---- puts "and some object is being edited" if {$@obj_in_edit > 0} { ! [lindex $@selection 0] unedit $self set @obj_in_edit 0 ! puts "completing it!" } } *************** *** 2056,2060 **** } # hack ! objectbox_init $x } if {![info exists fields($class)]} {set class obj} --- 2056,2060 ---- } # hack ! objectbox_init $x $_($x:canvas) } if {![info exists fields($class)]} {set class obj} *************** *** 2080,2083 **** --- 2080,2084 ---- def* view wb_activate {args} {} def* view wb_select {args} {} + def* view wb_delete {args} {} proc item {self canvas suffix type coords args} {

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
19
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

Pd-cvs September 2005