diff options
author | Miller Puckette <millerpuckette@users.sourceforge.net> | 2009-08-17 23:31:36 +0000 |
---|---|---|
committer | Miller Puckette <millerpuckette@users.sourceforge.net> | 2009-08-17 23:31:36 +0000 |
commit | 282671282b20fa17ab9dbbaba9d1cf2246b5029d (patch) | |
tree | f7af53ee269efd2564ca872a4da187e1ae687f3b /pd/tcl/pdtk_array.tcl | |
parent | 76d1c8472e025126a4b3e1571f817198b2fec9f9 (diff) |
merge in new tcl implementation by Steiner & Chun
svn path=/trunk/; revision=11934
Diffstat (limited to 'pd/tcl/pdtk_array.tcl')
-rw-r--r-- | pd/tcl/pdtk_array.tcl | 346 |
1 files changed, 346 insertions, 0 deletions
diff --git a/pd/tcl/pdtk_array.tcl b/pd/tcl/pdtk_array.tcl new file mode 100644 index 00000000..107a722c --- /dev/null +++ b/pd/tcl/pdtk_array.tcl @@ -0,0 +1,346 @@ +package provide pdtk_array 0.1 + +#### 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_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 {[tk windowingsystem] eq "x11"} { + selection handle $windowName.lb \ + "pdtk_array_listview_lbselection $arrayName" + } else { + if {[tk windowingsystem] eq "win32"} { + 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 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 +} |