package provide dialog_array 0.1 namespace eval ::dialog_array:: { namespace export pdtk_array_dialog namespace export pdtk_array_listview_new namespace export pdtk_array_listview_fillpage namespace export pdtk_array_listview_setpage namespace export pdtk_array_listview_closeWindow } # global variables for the listview array set ::dialog_array::listview_entry {} array set ::dialog_array::listview_id {} array set ::dialog_array::listview_page {} array set ::dialog_array::listview_numpages {} set ::dialog_array::listview_pagesize 1000 # this stores the state of the "save me" check button array set ::dialog_array::saveme_button {} # this stores the state of the "draw as" radio buttons array set ::dialog_array::drawas_button {} # this stores the state of the "in new graph"/"in last graph" radio buttons # and the "delete array" checkbutton array set ::dialog_array::otherflag_button {} ############ pdtk_array_dialog -- dialog window for arrays ######### proc ::dialog_array::listview_windowname {arrayName} { set id $::dialog_array::listview_id($arrayName) return "${id}_listview" } proc ::dialog_array::listview_lbname {arrayName} { set id $::dialog_array::listview_id($arrayName) return "${id}_listview.data.lb" } proc ::dialog_array::listview_setpage {arrayName page {numpages {}} {pagesize {}}} { set ::dialog_array::listview_page($arrayName) $page set ::dialog_array::listview_numpages($arrayName) $numpages if {$pagesize ne {} && [string is double $pagesize]} { set ::dialog_array::listview_pagesize $pagesize } } proc ::dialog_array::listview_setdata {arrayName startIndex args} { set lb [listview_lbname $arrayName] if { [catch { # treeview ${lb} delete [${lb} children {}] set idx $startIndex foreach x $args { ${lb} insert {} end -values [list $idx $x] incr idx } } ] } { # listbox ${lb} delete 0 end set idx 0 foreach x $args { ${lb} insert $idx "[expr $startIndex + $idx]) $x" incr idx } } } proc ::dialog_array::listview_focus {arrayName item} { set lb [listview_lbname $arrayName] ${lb} yview $item } proc ::dialog_array::pdtk_array_listview_setpage {arrayName page} { listview_setpage $arrayName $page } proc ::dialog_array::listview_changepage {arrayName np} { pdtk_array_listview_setpage \ $arrayName [expr $::dialog_array::listview_page($arrayName) + $np] pdtk_array_listview_fillpage $arrayName } proc ::dialog_array::pdtk_array_listview_fillpage {arrayName} { set lb [listview_lbname ${arrayName}] # get the index of the topmost visible element # (so the scroll does not change after updating the elements) if {[winfo exists $lb]} { if { [catch { # treeview # this is index of the 'selected' element # (not what we want, but a good fallback...) set topItem [$lb index [$lb focus]] # search for the first visible cell set xy 0 for { set xy 0 } { $xy < 500 } { incr xy } { if { [$lb identify region $xy $xy ] eq "cell" } { # usually the first cell we find is still hidden # increment by one more pixel to get a valid one incr xy set item [$lb identify item $xy $xy] set topItem [$lb index $item] break } } } ] } { # listbox (much simpler) set topItem [expr [lindex [$lb yview] 0] * [$lb size]] } set cmd "$::dialog_array::listview_id($arrayName) \ arrayviewlistfillpage \ $::dialog_array::listview_page($arrayName) \ $topItem" pdsend $cmd } } proc ::dialog_array::pdtk_array_listview_new {id arrayName page} { set ::dialog_array::listview_page($arrayName) $page set ::dialog_array::listview_id($arrayName) $id set windowName [listview_windowname ${arrayName}] destroy $windowName toplevel $windowName -class DialogWindow wm group $windowName . wm protocol $windowName WM_DELETE_WINDOW \ "::dialog_array::listview_close $id \{$arrayName\}" wm title $windowName [concat $arrayName "(list view)"] frame $windowName.data pack $windowName.data -fill "both" -side top -expand 1 frame $windowName.buttons pack $windowName.buttons -fill "x" -side bottom set lb $windowName.data.lb set sb $windowName.data.sb if { [ catch { # treeview ttk::treeview $lb \ -columns {index value} -show headings \ -height 20 \ -selectmode extended \ -yscrollcommand "$sb set" $lb heading index -text "#" -anchor center $lb heading value -text $arrayName -anchor center $lb column index -width 75 -anchor e } stderr ] } { # listview listbox $lb -height 20 -width 25 \ -selectmode extended \ -relief solid -background white -borderwidth 1 \ -yscrollcommand "$sb set" } scrollbar $sb \ -command "$lb yview" -orient vertical pack $lb -expand 1 -fill both -side left pack $sb -fill y -side right bind $lb \ "::dialog_array::listview_edit \{$arrayName\} $page" # handle copy/paste catch { # this probably only works on X11 selection handle $lb \ "::dialog_array::listview_lbselection \{$arrayName\}" } # a Copy/Paste popup menu bind $lb \ "::dialog_array::listview_popup \{$arrayName\}" bind $lb <> \ "::dialog_array::listview_paste \{$arrayName\}; break" bind $lb <> \ "::dialog_array::listview_copy \{$arrayName\}; break" button $windowName.buttons.prev -text "\u2190" \ -command "::dialog_array::listview_changepage \{$arrayName\} -1" button $windowName.buttons.next -text "\u2192" \ -command "::dialog_array::listview_changepage \{$arrayName\} 1" frame $windowName.buttons.page entry $windowName.buttons.page.current -textvariable ::dialog_array::listview_page($arrayName) \ -validate key -validatecommand "string is double %P" \ -justify "right" -width 5 bind $windowName.buttons.page.current \ "::dialog_array::listview_changepage \{$arrayName\} 0" label $windowName.buttons.page.slash -text "/" label $windowName.buttons.page.total -text 0 -textvariable ::dialog_array::listview_numpages($arrayName) pack $windowName.buttons.page.current -side left pack $windowName.buttons.page.slash -side left pack $windowName.buttons.page.total -side left pack $windowName.buttons.prev -side left -ipadx 20 -pady 10 -anchor s pack $windowName.buttons.page -side left -padx 20 -pady 10 -anchor s pack $windowName.buttons.next -side right -ipadx 20 -pady 10 -anchor s focus $windowName } proc ::dialog_array::listview_lbselection {arrayName off size} { set lb [listview_lbname ${arrayName}] set items {} if { [catch { foreach idx [$lb selection] { lappend items [lindex [$lb item $idx -values] 1] } } ] } { foreach idx [$lb curselection] { set v [$lb get $idx] lappend items [string range $v [string first ") " $v]+2 end] } } return [join $items "\n"] } # parses 'data' into numbers, and sends them to the Pd-core so it # can set the values in 'arrayName' starting from 'startIndex' proc ::dialog_array::listview_edit+paste {arrayName startIndex data} { set values {} set offset [expr $startIndex \ + $::dialog_array::listview_pagesize \ * $::dialog_array::listview_page($arrayName)] foreach value [split $data ", \n"] { if {$value eq {}} {continue} if {! [string is double $value]} {continue} lappend values $value } if { $values ne {} } { pdsend "$::dialog_array::listview_id($arrayName) $offset $values" pdtk_array_listview_fillpage $arrayName } } # a popup menu for copy/paste proc ::dialog_array::listview_popup {arrayName} { set windowName [listview_windowname ${arrayName}] set lb [listview_lbname ${arrayName}] set popup ${lb}.popup destroy $popup # check if there's no selection, disable the popup set cur {} if { [catch { set cur [$lb selection] } ] } { set cur [$lb curselection] } if { $cur eq {} } { return } menu $popup -tearoff false $popup add command -label [_ "Copy"] \ -command "::dialog_array::listview_copy \{$arrayName\}; \ destroy $popup" $popup add command -label [_ "Paste"] \ -command "::dialog_array::listview_paste \{$arrayName\}; \ destroy $popup" tk_popup $popup [winfo pointerx $windowName] \ [winfo pointery $windowName] 0 } # copy current selection to clipboard (called from the copy/paste popup) proc ::dialog_array::listview_copy {arrayName} { set sel [listview_lbselection $arrayName {} {}] clipboard clear clipboard append $sel } # when data is pasted (called from the copy/paste popup), update the values proc ::dialog_array::listview_paste {arrayName} { set sel {} set itemNum {} # get data from CLIPBOARD if { $sel eq {} } {catch { set sel [selection get -selection CLIPBOARD] }} # if that failed, get it from the PRIMARY copy buffer if { $sel eq {} } {catch { set sel [selection get -selection PRIMARY] }} if { $sel eq {} } { # giving up return } # get the selection start, so we know where to paste to set lb [::dialog_array::listview_lbname $arrayName] if { [catch { set itemId [lindex [$lb selection] 0] if { $itemId ne {} } { set itemNum [$lb index ${itemId} ] } } ] } { set itemNum [lindex [$lb curselection] 0] } if { $itemNum ne {} } { ::dialog_array::listview_edit+paste $arrayName $itemNum $sel } } proc ::dialog_array::listview_edit {arrayName page {font {}}} { set lb [listview_lbname ${arrayName}] set entry ${lb}.entry if {[winfo exists $entry]} { ::dialog_array::listview_update_entry \ $arrayName $::dialog_array::listview_entry($arrayName) unset ::dialog_array::listview_entry($arrayName) } destroy $entry if { [catch { set focus [$lb focus] foreach {x y w h} [$lb bbox $focus 1] {break} entry $entry place configure ${lb}.entry -x ${x} -y ${y} -width ${w} -height ${h} set itemNum [$lb index $focus] } stderr ] } { set itemNum [$lb index active] set bbox [$lb bbox $itemNum] set y [expr [lindex $bbox 1] - 4] entry $entry place configure $entry -relx 0 -y $y -relwidth 1 } set ::dialog_array::listview_entry($arrayName) $itemNum $entry insert 0 [] lower $entry focus $entry bind $entry \ "::dialog_array::listview_update_entry \{$arrayName\} $itemNum; break" bind $entry \ "destroy $entry; break" } proc ::dialog_array::listview_update_entry {arrayName itemNum} { set entry [listview_lbname $arrayName].entry ::dialog_array::listview_edit+paste $arrayName $itemNum [$entry get] destroy $entry } proc ::dialog_array::pdtk_array_listview_closeWindow {arrayName} { destroy [listview_windowname ${arrayName}] } proc ::dialog_array::listview_close {mytoplevel arrayName} { pdtk_array_listview_closeWindow $arrayName pdsend "$mytoplevel arrayviewclose" } proc ::dialog_array::apply {mytoplevel} { pdsend "$mytoplevel arraydialog \ [::dialog_gatom::escape [$mytoplevel.array.name.entry get]] \ [$mytoplevel.array.size.entry get] \ [expr $::dialog_array::saveme_button($mytoplevel) + (2 * $::dialog_array::drawas_button($mytoplevel))] \ $::dialog_array::otherflag_button($mytoplevel)" } proc ::dialog_array::openlistview {mytoplevel} { pdsend "$mytoplevel arrayviewlistnew" } proc ::dialog_array::cancel {mytoplevel} { pdsend "$mytoplevel cancel" } proc ::dialog_array::ok {mytoplevel} { ::dialog_array::apply $mytoplevel ::dialog_array::cancel $mytoplevel } proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} { if {[winfo exists $mytoplevel]} { wm deiconify $mytoplevel raise $mytoplevel focus $mytoplevel } else { create_dialog $mytoplevel $newone } $mytoplevel.array.name.entry insert 0 [::dialog_gatom::unescape $name] $mytoplevel.array.size.entry insert 0 $size set ::dialog_array::saveme_button($mytoplevel) [expr $flags & 1] set ::dialog_array::drawas_button($mytoplevel) [expr ( $flags & 6 ) >> 1] set ::dialog_array::otherflag_button($mytoplevel) 0 # pd -> tcl # 2 * (int)(template_getfloat(template_findbyname(sc->sc_template), gensym("style"), x->x_scalar->sc_vec, 1))); # tcl->pd # int style = ((flags & 6) >> 1); } proc ::dialog_array::create_dialog {mytoplevel newone} { toplevel $mytoplevel -class DialogWindow wm title $mytoplevel [_ "Array Properties"] wm group $mytoplevel . wm resizable $mytoplevel 0 0 wm transient $mytoplevel $::focused_window $mytoplevel configure -menu $::dialog_menubar $mytoplevel configure -padx 0 -pady 0 ::pd_bindings::dialog_bindings $mytoplevel "array" # array labelframe $mytoplevel.array -borderwidth 1 -text [_ "Array"] -padx 5 pack $mytoplevel.array -side top -fill x frame $mytoplevel.array.name -height 7 -padx 5 pack $mytoplevel.array.name -side top -anchor e label $mytoplevel.array.name.label -text [_ "Name:"] entry $mytoplevel.array.name.entry -width 17 pack $mytoplevel.array.name.entry $mytoplevel.array.name.label -side right frame $mytoplevel.array.size -height 7 -padx 5 pack $mytoplevel.array.size -side top -anchor e label $mytoplevel.array.size.label -text [_ "Size:"] entry $mytoplevel.array.size.entry -width 17 pack $mytoplevel.array.size.entry $mytoplevel.array.size.label -side right checkbutton $mytoplevel.array.saveme -text [_ "Save contents"] \ -variable ::dialog_array::saveme_button($mytoplevel) -anchor w pack $mytoplevel.array.saveme -side top # draw as labelframe $mytoplevel.drawas -text [_ "Draw as:"] -padx 20 -borderwidth 1 pack $mytoplevel.drawas -side top -fill x radiobutton $mytoplevel.drawas.points -value 0 \ -variable ::dialog_array::drawas_button($mytoplevel) -text [_ "Polygon"] radiobutton $mytoplevel.drawas.polygon -value 1 \ -variable ::dialog_array::drawas_button($mytoplevel) -text [_ "Points"] radiobutton $mytoplevel.drawas.bezier -value 2 \ -variable ::dialog_array::drawas_button($mytoplevel) -text [_ "Bezier curve"] pack $mytoplevel.drawas.points -side top -anchor w pack $mytoplevel.drawas.polygon -side top -anchor w pack $mytoplevel.drawas.bezier -side top -anchor w # options if {$newone == 1} { labelframe $mytoplevel.options -text [_ "Put array into:"] -padx 20 -borderwidth 1 pack $mytoplevel.options -side top -fill x radiobutton $mytoplevel.options.radio0 -value 0 \ -variable ::dialog_array::otherflag_button($mytoplevel) -text [_ "New graph"] radiobutton $mytoplevel.options.radio1 -value 1 \ -variable ::dialog_array::otherflag_button($mytoplevel) -text [_ "Last graph"] pack $mytoplevel.options.radio0 -side top -anchor w pack $mytoplevel.options.radio1 -side top -anchor w } else { labelframe $mytoplevel.options -text [_ "Options"] -padx 20 -borderwidth 1 pack $mytoplevel.options -side top -fill x button $mytoplevel.options.listview -text [_ "Open List View..."] \ -command "::dialog_array::openlistview $mytoplevel [$mytoplevel.array.name.entry get]" pack $mytoplevel.options.listview -side top checkbutton $mytoplevel.options.deletearray -text [_ "Delete array"] \ -variable ::dialog_array::otherflag_button($mytoplevel) -anchor w pack $mytoplevel.options.deletearray -side top } # buttons frame $mytoplevel.buttonframe pack $mytoplevel.buttonframe -side bottom -pady 2m button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \ -command "::dialog_array::cancel $mytoplevel" pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 15 -ipadx 10 if {$newone == 0 && $::windowingsystem ne "aqua"} { button $mytoplevel.buttonframe.apply -text [_ "Apply"] \ -command "::dialog_array::apply $mytoplevel" pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 15 -ipadx 10 } button $mytoplevel.buttonframe.ok -text [_ "OK"]\ -command "::dialog_array::ok $mytoplevel" -default active pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 15 -ipadx 10 # live widget updates on OSX in lieu of Apply button if {$::windowingsystem eq "aqua"} { # only bind if there is an existing array to edit if {$newone == 0} { # call apply on button changes $mytoplevel.array.saveme config -command [ concat ::dialog_array::apply $mytoplevel ] $mytoplevel.drawas.points config -command [ concat ::dialog_array::apply $mytoplevel ] $mytoplevel.drawas.polygon config -command [ concat ::dialog_array::apply $mytoplevel ] $mytoplevel.drawas.bezier config -command [ concat ::dialog_array::apply $mytoplevel ] # call apply on Return in entry boxes that are in focus & rebind Return to ok button bind $mytoplevel.array.name.entry "::dialog_array::apply_and_rebind_return $mytoplevel" bind $mytoplevel.array.size.entry "::dialog_array::apply_and_rebind_return $mytoplevel" # unbind Return from ok button when an entry takes focus $mytoplevel.array.name.entry config -validate focusin -vcmd "::dialog_array::unbind_return $mytoplevel" $mytoplevel.array.size.entry config -validate focusin -vcmd "::dialog_array::unbind_return $mytoplevel" } # remove cancel button from focus list since it's not activated on Return $mytoplevel.buttonframe.cancel config -takefocus 0 # show active focus on the ok button as it *is* activated on Return $mytoplevel.buttonframe.ok config -default normal bind $mytoplevel.buttonframe.ok "$mytoplevel.buttonframe.ok config -default active" bind $mytoplevel.buttonframe.ok "$mytoplevel.buttonframe.ok config -default normal" # since we show the active focus, disable the highlight outline $mytoplevel.buttonframe.ok config -highlightthickness 0 $mytoplevel.buttonframe.cancel config -highlightthickness 0 } position_over_window ${mytoplevel} ${::focused_window} } # for live widget updates on OSX proc ::dialog_array::apply_and_rebind_return {mytoplevel} { ::dialog_array::apply $mytoplevel bind $mytoplevel "::dialog_array::ok $mytoplevel" focus $mytoplevel.buttonframe.ok return 0 } # for live widget updates on OSX proc ::dialog_array::unbind_return {mytoplevel} { bind $mytoplevel break return 1 }