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