[PD-cvs] SF.net SVN: pure-data:[10675] branches/pd-devel/0.41.4/src
eighthave at users.sourceforge.net
eighthave at users.sourceforge.net
Thu Jan 29 04:48:16 CET 2009
Revision: 10675
http://pure-data.svn.sourceforge.net/pure-data/?rev=10675&view=rev
Author: eighthave
Date: 2009-01-29 03:48:16 +0000 (Thu, 29 Jan 2009)
Log Message:
-----------
- copied array code and got arrays and graphs to display. They still need
work to get everything going.
Modified Paths:
--------------
branches/pd-devel/0.41.4/src/pd.tk
branches/pd-devel/0.41.4/src/pd_bindings.tcl
branches/pd-devel/0.41.4/src/pd_menus.tcl
branches/pd-devel/0.41.4/src/pdtk_canvas.tcl
branches/pd-devel/0.41.4/src/pkgIndex.tcl
Added Paths:
-----------
branches/pd-devel/0.41.4/src/pdtk_array.tcl
Modified: branches/pd-devel/0.41.4/src/pd.tk
===================================================================
--- branches/pd-devel/0.41.4/src/pd.tk 2009-01-29 03:46:51 UTC (rev 10674)
+++ branches/pd-devel/0.41.4/src/pd.tk 2009-01-29 03:48:16 UTC (rev 10675)
@@ -56,6 +56,7 @@
package require pd_bindings
package require pd_post
package require pd_iemgui
+package require pdtk_array
package require pdtk_canvas
package require pdtk_text
# TODO eliminate this kludge:
@@ -238,7 +239,7 @@
}
proc create_pdwindow {} {
- ::pd_menus::create_menubar .menubar
+ ::pd_menus::create_menubar .menubar .
. configure -menu .menubar -width 400 -height 250
::pd_menus::configure_pdwindow .menubar
::pd_bindings::pdwindow_bindings .
Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-29 03:46:51 UTC (rev 10674)
+++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-29 03:48:16 UTC (rev 10675)
@@ -73,7 +73,7 @@
#bind $mytoplevel <FocusIn> {pdtk_pdwindowmaintenance}
}
-proc ::pd_bindings::panel_bindings {mytoplevel} {
+proc ::pd_bindings::panel_bindings {mytoplevel panelname} {
variable modifier
window_bindings $mytoplevel
Modified: branches/pd-devel/0.41.4/src/pd_menus.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-29 03:46:51 UTC (rev 10674)
+++ branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-29 03:48:16 UTC (rev 10675)
@@ -34,7 +34,7 @@
# ------------------------------------------------------------------------------
#
-proc ::pd_menus::create_menubar {mymenubar} {
+proc ::pd_menus::create_menubar {mymenubar mytoplevel} {
variable accelerator
if {$::windowingsystem eq "aqua"} {
set accelerator "Cmd"
@@ -49,7 +49,7 @@
menu $mymenubar.$mymenu
$mymenubar add cascade -label [string totitle $mymenu] \
-menu $mymenubar.$mymenu
- [format build_%s_menu $mymenu] $mymenubar.$mymenu PLACEHOLDER
+ [format build_%s_menu $mymenu] $mymenubar.$mymenu $mytoplevel
if {$::windowingsystem eq "win32"} {
# fix menu font size on Windows with tk scaling = 1
$mymenubar.$mymenu configure -font menufont
Added: branches/pd-devel/0.41.4/src/pdtk_array.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pdtk_array.tcl (rev 0)
+++ branches/pd-devel/0.41.4/src/pdtk_array.tcl 2009-01-29 03:48:16 UTC (rev 10675)
@@ -0,0 +1,350 @@
+package provide pdtk_array 0.1
+
+package require pd_connect
+
+#### jsarlo #####
+proc pdtk_array_listview_setpage {arrayName page} {
+ global pd_array_listview_page
+ set pd_array_listview_page($arrayName) $page
+}
+
+proc pdtk_array_listview_changepage {arrayName np} {
+ global pd_array_listview_page
+ pdtk_array_listview_setpage \
+ $arrayName [expr $pd_array_listview_page($arrayName) + $np]
+ pdtk_array_listview_fillpage $arrayName
+}
+
+proc pdtk_array_listview_fillpage {arrayName} {
+ global pd_array_listview_page
+ global pd_array_listview_id
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set topItem [expr [lindex [$windowName.lb yview] 0] * \
+ [$windowName.lb size]]
+
+ if {[winfo exists $windowName]} {
+ set cmd "$pd_array_listview_id($arrayName) \
+ arrayviewlistfillpage \
+ $pd_array_listview_page($arrayName) \
+ $topItem"
+
+ pdsend $cmd
+ }
+}
+
+proc pdtk_array_listview_new {id arrayName page} {
+ global pd_nt
+ global pd_array_listview_page
+ global pd_array_listview_id
+ global fontname fontweight
+ set pd_array_listview_page($arrayName) $page
+ set pd_array_listview_id($arrayName) $id
+ set windowName [format ".%sArrayWindow" $arrayName]
+ if [winfo exists $windowName] then [destroy $windowName]
+ toplevel $windowName
+ wm protocol $windowName WM_DELETE_WINDOW \
+ "pdtk_array_listview_close $id $arrayName"
+ wm title $windowName [concat $arrayName "(list view)"]
+ # FIXME
+ set font 12
+ set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
+ -selectmode extended \
+ -relief solid -background white -borderwidth 1 \
+ -font [format {{%s} %d %s} $fontname $font $fontweight]\
+ -yscrollcommand "$windowName.lb.sb set"]
+ set $windowName.lb.sb [scrollbar $windowName.lb.sb \
+ -command "$windowName.lb yview" -orient vertical]
+ place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
+ pack $windowName.lb -expand 1 -fill both
+ bind $windowName.lb <Double-ButtonPress-1> \
+ "pdtk_array_listview_edit $arrayName $page $font"
+ # handle copy/paste
+ if {$pd_nt == 0} {
+ selection handle $windowName.lb \
+ "pdtk_array_listview_lbselection $arrayName"
+ } else {
+ if {$pd_nt == 1} {
+ bind $windowName.lb <ButtonPress-3> \
+ "pdtk_array_listview_popup $arrayName"
+ }
+ }
+ set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
+ -command "pdtk_array_listview_changepage $arrayName -1"]
+ set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
+ -command "pdtk_array_listview_changepage $arrayName 1"]
+ pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
+ pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
+ focus $windowName
+}
+
+proc pdtk_array_listview_lbselection {arrayName off size} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set itemNums [$windowName.lb curselection]
+ set cbString ""
+ for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ append cbString "\n"
+ }
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ set last $cbString
+}
+
+# Win32 uses a popup menu for copy/paste
+proc pdtk_array_listview_popup {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ if [winfo exists $windowName.popup] then [destroy $windowName.popup]
+ menu $windowName.popup -tearoff false
+ $windowName.popup add command -label {Copy} \
+ -command "pdtk_array_listview_copy $arrayName; \
+ destroy $windowName.popup"
+ $windowName.popup add command -label {Paste} \
+ -command "pdtk_array_listview_paste $arrayName; \
+ destroy $windowName.popup"
+ tk_popup $windowName.popup [winfo pointerx $windowName] \
+ [winfo pointery $windowName] 0
+}
+
+proc pdtk_array_listview_copy {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set itemNums [$windowName.lb curselection]
+ set cbString ""
+ for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ append cbString "\n"
+ }
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ clipboard clear
+ clipboard append $cbString
+}
+
+proc pdtk_array_listview_paste {arrayName} {
+ global pd_array_listview_page
+ global pd_array_listview_pagesize
+ set cbString [selection get -selection CLIPBOARD]
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ set itemNum [lindex [$lbName curselection] 0]
+ set splitChars ", \n"
+ set itemString [split $cbString $splitChars]
+ set flag 1
+ for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
+ if {[lindex $itemString $i] != {}} {
+ pdsend "$arrayName [expr $itemNum + \
+ [expr $counter + \
+ [expr $pd_array_listview_pagesize \
+ * $pd_array_listview_page($arrayName)]]] \
+ [lindex $itemString $i]"
+ incr counter
+ set flag 0
+ }
+ }
+}
+
+proc pdtk_array_listview_edit {arrayName page font} {
+ global pd_array_listview_entry
+ global pd_nt
+ global fontname fontweight
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ if {[winfo exists $lbName.entry]} {
+ pdtk_array_listview_update_entry \
+ $arrayName $pd_array_listview_entry($arrayName)
+ unset pd_array_listview_entry($arrayName)
+ }
+ set itemNum [$lbName index active]
+ set pd_array_listview_entry($arrayName) $itemNum
+ set bbox [$lbName bbox $itemNum]
+ set y [expr [lindex $bbox 1] - 4]
+ set $lbName.entry [entry $lbName.entry \
+ -font [format {{%s} %d %s} $fontname $font $fontweight]]
+ $lbName.entry insert 0 []
+ place configure $lbName.entry -relx 0 -y $y -relwidth 1
+ lower $lbName.entry
+ focus $lbName.entry
+ bind $lbName.entry <Return> \
+ "pdtk_array_listview_update_entry $arrayName $itemNum;"
+}
+
+proc pdtk_array_listview_update_entry {arrayName itemNum} {
+ global pd_array_listview_page
+ global pd_array_listview_pagesize
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ set splitChars ", \n"
+ set itemString [split [$lbName.entry get] $splitChars]
+ set flag 1
+ for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
+ if {[lindex $itemString $i] != {}} {
+ pdsend [concat $arrayName [expr $itemNum + \
+ [expr $counter + \
+ [expr $pd_array_listview_pagesize \
+ * $pd_array_listview_page($arrayName)]]] \
+ [lindex $itemString $i] \;]
+ incr counter
+ set flag 0
+ }
+ }
+ pdtk_array_listview_fillpage $arrayName
+ destroy $lbName.entry
+}
+
+proc pdtk_array_listview_closeWindow {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ destroy $windowName
+}
+
+proc pdtk_array_listview_close {id arrayName} {
+ pdtk_array_listview_closeWindow $arrayName
+ pdsend "$id arrayviewclose"
+}
+##### end jsarlo #####
+
+############ pdtk_array_dialog -- dialog window for arrays #########
+# see comments above (pdtk_gatom_dialog) about variable name handling
+
+proc array_apply {id} {
+ # strip "." from the TK id to make a variable name suffix
+ set vid [string trimleft $id .]
+ # for each variable, make a local variable to hold its name...
+ set var_array_name [concat array_name_$vid]
+ global $var_array_name
+ set var_array_n [concat array_n_$vid]
+ global $var_array_n
+ set var_array_saveit [concat array_saveit_$vid]
+ global $var_array_saveit
+ set var_array_drawasrects [concat array_drawasrects_$vid]
+ global $var_array_drawasrects
+ set var_array_otherflag [concat array_otherflag_$vid]
+ global $var_array_otherflag
+ set mofo [eval concat $$var_array_name]
+ if {[string index $mofo 0] == "$"} {
+ set mofo [string replace $mofo 0 0 #] }
+
+ set saveit [eval concat $$var_array_saveit]
+ set drawasrects [eval concat $$var_array_drawasrects]
+
+ pdsend "$id arraydialog $mofo [eval concat $$var_array_n] \
+ [expr $saveit + 2 * $drawasrects] [eval concat $$var_array_otherflag]"
+}
+
+# jsarlo
+proc array_viewlist {id} {
+ pdsend "$id arrayviewlistnew"
+}
+# end jsarlo
+
+proc array_cancel {id} {
+ pdsend "$id cancel"
+}
+
+proc array_ok {id} {
+ array_apply $id
+ array_cancel $id
+}
+
+proc pdtk_array_dialog {id name n flags newone} {
+ set vid [string trimleft $id .]
+
+ set var_array_name [concat array_name_$vid]
+ global $var_array_name
+ set var_array_n [concat array_n_$vid]
+ global $var_array_n
+ set var_array_saveit [concat array_saveit_$vid]
+ global $var_array_saveit
+ set var_array_drawasrects [concat array_drawasrects_$vid]
+ global $var_array_drawasrects
+ set var_array_otherflag [concat array_otherflag_$vid]
+ global $var_array_otherflag
+
+ set $var_array_name $name
+ set $var_array_n $n
+ set $var_array_saveit [expr ( $flags & 1 ) != 0]
+ set $var_array_drawasrects [expr ( $flags & 2 ) != 0]
+ set $var_array_otherflag 0
+
+ toplevel $id
+ wm title $id {array}
+ wm resizable $id 0 0
+ wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id]
+
+ ::pd_bindings::panel_bindings $id "array"
+
+ frame $id.name
+ pack $id.name -side top
+ label $id.name.label -text "name"
+ entry $id.name.entry -textvariable $var_array_name
+ pack $id.name.label $id.name.entry -side left
+
+ frame $id.n
+ pack $id.n -side top
+ label $id.n.label -text "size"
+ entry $id.n.entry -textvariable $var_array_n
+ pack $id.n.label $id.n.entry -side left
+
+ checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \
+ -anchor w
+ pack $id.saveme -side top
+
+ frame $id.drawasrects
+ pack $id.drawasrects -side top
+ radiobutton $id.drawasrects.drawasrects0 -value 0 \
+ -variable $var_array_drawasrects \
+ -text "draw as points"
+ radiobutton $id.drawasrects.drawasrects1 -value 1 \
+ -variable $var_array_drawasrects \
+ -text "polygon"
+ radiobutton $id.drawasrects.drawasrects2 -value 2 \
+ -variable $var_array_drawasrects \
+ -text "bezier curve"
+ pack $id.drawasrects.drawasrects0 -side top -anchor w
+ pack $id.drawasrects.drawasrects1 -side top -anchor w
+ pack $id.drawasrects.drawasrects2 -side top -anchor w
+
+ if {$newone != 0} {
+ frame $id.radio
+ pack $id.radio -side top
+ radiobutton $id.radio.radio0 -value 0 \
+ -variable $var_array_otherflag \
+ -text "in new graph"
+ radiobutton $id.radio.radio1 -value 1 \
+ -variable $var_array_otherflag \
+ -text "in last graph"
+ pack $id.radio.radio0 -side top -anchor w
+ pack $id.radio.radio1 -side top -anchor w
+ } else {
+ checkbutton $id.deleteme -text {delete me} \
+ -variable $var_array_otherflag -anchor w
+ pack $id.deleteme -side top
+ }
+ # jsarlo
+ if {$newone == 0} {
+ button $id.listview -text {View list}\
+ -command "array_viewlist $id $name 0"
+ pack $id.listview -side left
+ }
+ # end jsarlo
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "array_cancel $id"
+ if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\
+ -command "array_apply $id"}
+ button $id.buttonframe.ok -text {OK}\
+ -command "array_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1}
+ pack $id.buttonframe.ok -side left -expand 1
+
+ $id.name.entry select from 0
+ $id.name.entry select adjust end
+ focus $id.name.entry
+}
Modified: branches/pd-devel/0.41.4/src/pdtk_canvas.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-01-29 03:46:51 UTC (rev 10674)
+++ branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-01-29 03:48:16 UTC (rev 10675)
@@ -15,7 +15,7 @@
proc pdtk_canvas_new {mytoplevel width height geometry editable} {
# TODO check size of window
toplevel $mytoplevel -width $width -height $height -class CanvasWindow
- ::pd_menus::create_menubar $mytoplevel.menubar
+ ::pd_menus::create_menubar $mytoplevel.menubar $mytoplevel
$mytoplevel configure -menu $mytoplevel.menubar
# TODO slide off screen windows into view
Modified: branches/pd-devel/0.41.4/src/pkgIndex.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-29 03:46:51 UTC (rev 10674)
+++ branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-29 03:48:16 UTC (rev 10675)
@@ -16,6 +16,7 @@
package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
package ifneeded pd_post 0.1 [list source [file join $dir pd_post.tcl]]
package ifneeded pd_say 0.1 [list source [file join $dir pd_say.tcl]]
+package ifneeded pdtk_array 0.1 [list source [file join $dir pdtk_array.tcl]]
package ifneeded pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]]
package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]]
package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the Pd-cvs
mailing list