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.