diff options
Diffstat (limited to 'bitmap.tcl')
| -rw-r--r-- | bitmap.tcl | 195 |
1 files changed, 163 insertions, 32 deletions
@@ -1,5 +1,7 @@ source pdlib.tcl +set ::script_path [file dirname [info script]] + pd::guiproc bitmap_draw_new {self c x y sz w h data} { set z 0 for {set i 0} {$i < $h} {incr i} { @@ -19,26 +21,111 @@ pd::guiproc bitmap_draw_new {self c x y sz w h data} { pd::guiclass bitmap { constructor { + set s [file join $::script_path properties.tcl] + sys_gui "source {$s}\n" + pd::add_outlet $self float - set @sz [pd::default_arg 0 int 15] - if {$@sz < 4} {set @sz 4} - set @w [pd::default_arg 1 int 8] - set @h [pd::default_arg 2 int 8] + # set defaults: + set @config [list] + lappend @config -width 8 + lappend @config -height 8 + lappend @config -cellsize 16 + lappend @config -label "" + lappend @config -labelpos "top" + lappend @config -sendsymbol "" + lappend @config -receivesymbol "" + lappend @config -fgcolor "#000000" + lappend @config -bgcolor "#ffffff" + lappend @config -lblcolor "#000000" + set @data { + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + } + + ::$self 0 config {*}$args - set @data [list] - set z 2 - for {set i 0} {$i < $@h} {incr i} { - for {set j 0} {$j < $@w} {incr j} { - lappend @data [expr {0!=[pd::default_arg [incr z] int 0]}] + set @rcvLoadData {#bitmap} + pd_bind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + } + + 0_config { + if {$args == {}} { + return $@config + } else { + set newconf [list] + set optlist [pd::strip_selectors $args] + set optlist [pd::strip_empty $optlist] + for {set i 0} {$i < [llength $optlist]} {} { + set k [lindex $optlist $i] + if {![dict exists $@config $k]} { + return -code error "unknown option '$k'" + } + incr i + set v [lindex $optlist $i] + if {[lsearch -exact {-width -height -cellsize} $k] != -1} { + set v [expr {int($v)}] + } + dict set newconf $k $v + incr i + } + if {[dict get $@config -width] != [dict get $newconf -width] || + [dict get $@config -height] != [dict get $newconf -height]} { + $self 0 resize {*}[pd::add_selectors [list \ + [dict get $newconf -width] \ + [dict get $newconf -height] \ + ]] + } + set ui 0 + foreach opt {label labelpos cellsize fgcolor bgcolor lblcolor} { + set old [dict get $@config -$opt] + if {[dict exists $newconf -$opt]} { + set new [dict get $newconf -$opt] + if {$old != $new} { + dict set @config -$opt $new + set ui 1 + } + } + } + if {$ui && [info exists @c]} { + sys_gui [list $@c delete $self]\n + sys_gui [list bitmap_draw_new $self \ + $@c $@x $@y \ + [dict get $@config -cellsize] \ + [dict get $@config -width] \ + [dict get $@config -height] \ + $@data]\n } } } + 0_resize { + set w [pd::arg 0 int] + set h [pd::arg 1 int] + set oldw [dict get $@config -width] + set oldh [dict get $@config -height] + set newd {} + for {set y 0} {$y < $h} {incr y} { + for {set x 0} {$x < $w} {incr x} { + if {$x < $oldw && $y < $oldh} { + lappend newd [lindex $d [expr {$y*$oldw+$x}]] + } else { + lappend newd 0 + } + } + } + dict set @config -width $w + dict set @config -height $h + set @data $newd + } + 0_getrow { set r [list] set n [pd::arg 0 int] - for {set i [expr {$n*$@w}]} {$i < [expr {($n+1)*$@w}]} {incr i} { + set w [dict get $@config -width] + for {set i [expr {$n*$w}]} {$i < [expr {($n+1)*$w}]} {incr i} { lappend r [list float [lindex $@data $i]] } pd::outlet $self 0 list $r @@ -47,7 +134,9 @@ pd::guiclass bitmap { 0_getcol { set r [list] set n [pd::arg 0 int] - for {set i [expr {$n}]} {$i < [expr {$@w*$@h}]} {incr i $@w} { + set w [dict get $@config -width] + set h [dict get $@config -height] + for {set i [expr {$n}]} {$i < [expr {$w*$h}]} {incr i $w} { lappend r [list float [lindex $@data $i]] } pd::outlet $self 0 list $r @@ -56,17 +145,20 @@ pd::guiclass bitmap { 0_getcell { set r [pd::arg 0 int] set c [pd::arg 1 int] - pd::outlet $self 0 float [lindex $@data [expr {$r*$@w+$c}]] + set w [dict get $@config -width] + pd::outlet $self 0 float [lindex $@data [expr {$r*$w+$c}]] } 0_setrow { set row [pd::arg 0 int] set z 1 set col 0 - for {set i [expr {$row*$@w}]} {$i < [expr {($row+1)*$@w}]} {incr i} { + set w [dict get $@config -width] + for {set idx [expr {$row*$w}]} {$idx < [expr {($row+1)*$w}]} {incr idx} { set d [expr {0!=[pd::arg $z int]}] - lset @data $i $d - sys_gui [list $@c itemconfigure cell_${col}_${row}_$self -fill [lindex {white black} $d]]\n + lset @data $idx $d + sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \ + -fill [lindex {white black} $d]]\n incr z incr col } @@ -76,10 +168,13 @@ pd::guiclass bitmap { set col [pd::arg 0 int] set z 1 set row 0 - for {set i [expr {$col}]} {$i < [expr {$@w*$@h}]} {incr i $@w} { + set w [dict get $@config -width] + set h [dict get $@config -height] + for {set idx [expr {$col}]} {$idx < [expr {$w*$h}]} {incr idx $w} { set d [expr {0!=[pd::arg $z int]}] - lset @data $i $d - sys_gui [list $@c itemconfigure cell_${col}_${row}_$self -fill [lindex {white black} $d]]\n + lset @data $idx $d + sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \ + -fill [lindex {white black} $d]]\n incr z incr row } @@ -89,18 +184,46 @@ pd::guiclass bitmap { set r [pd::arg 0 int] set c [pd::arg 1 int] set d [expr {0!=[pd::arg 2 int]}] - lset @data [expr {$r*$@w+$c}] $d - sys_gui [list $@c itemconfigure cell_${r}_${c}_$self -fill [lindex {white black} $d]]\n + set w [dict get $@config -width] + set idx [expr {$r*$w+$c}] + lset @data $idx $d + sys_gui [list $@c itemconfigure cell_${r}_${c}_$self \ + -fill [lindex {white black} $d]]\n + } + + 0_setdata { + set d [pd::strip_selectors $args] + set l [llength $d] + set w [dict get $@config -width] + set h [dict get $@config -height] + if {$l != $w*$h} { + return -code error "bad data size" + } + set @data [list] + foreach i $d {lappend @data [expr {int($i)}]} + if {$@rcvLoadData != {}} { + pd_unbind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + set @rcvLoadData {} + } } object_save { - return [list #X obj $@x $@y bitmap $@sz $@w $@h {*}$@data \;] + return [list #X obj $@x $@y bitmap {*}[pd::add_empty $@config] \; \ + \#bitmap setdata {*}$@data \; ] + } + + object_properties { + sys_gui [list propertieswindow .prop:$self \ + $@config {Bitmap properties}]\n } widgetbehavior_getrect { lassign $args x1 y1 - set x2 [expr {1+$x1+$@w*$@sz}] - set y2 [expr {1+$y1+$@h*$@sz}] + set w [dict get $@config -width] + set h [dict get $@config -height] + set sz [dict get $@config -cellsize] + set x2 [expr {1+$x1+$w*$sz}] + set y2 [expr {1+$y1+$h*$sz}] return [list $x1 $y1 $x2 $y2] } @@ -117,7 +240,8 @@ pd::guiclass bitmap { widgetbehavior_select { set sel [lindex $args 0] - sys_gui [list $@c itemconfigure $self -outline [lindex {black blue} $sel]]\n + sys_gui [list $@c itemconfigure $self \ + -outline [lindex {black blue} $sel]]\n } widgetbehavior_activate { @@ -128,30 +252,37 @@ pd::guiclass bitmap { set @x [lindex $args 1] set @y [lindex $args 2] set vis [lindex $args 3] + set w [dict get $@config -width] + set h [dict get $@config -height] + set sz [dict get $@config -cellsize] if {$vis} { - sys_gui [list bitmap_draw_new $self $@c $@x $@y $@sz $@w $@h $@data ]\n + sys_gui [list bitmap_draw_new $self \ + $@c $@x $@y $sz $w $h $@data ]\n } else { sys_gui [list $@c delete $self]\n } } widgetbehavior_click { + set w [dict get $@config -width] + set h [dict get $@config -height] + set sz [dict get $@config -cellsize] set xpix [expr {[lindex $args 0]-$@x-1}] set ypix [expr {[lindex $args 1]-$@y-1}] - if {$xpix < 0 || $xpix >= $@w*$@sz} {return} - if {$ypix < 0 || $ypix >= $@h*$@sz} {return} + if {$xpix < 0 || $xpix >= $w*$sz} {return} + if {$ypix < 0 || $ypix >= $h*$sz} {return} set shift [lindex $args 2] set alt [lindex $args 3] set dbl [lindex $args 4] set doit [lindex $args 5] if {$doit} { - set j [expr {$xpix/$@sz}] - set i [expr {$ypix/$@sz}] - set idx [expr {$@w*${i}+${j}}] - puts stderr "RELX=$xpix RELY=$ypix IDX=$idx" + set j [expr {$xpix/$sz}] + set i [expr {$ypix/$sz}] + set idx [expr {$w*${i}+${j}}] set d [expr {[lindex $@data $idx]==0}] lset @data $idx $d - sys_gui [list $@c itemconfigure cell_${j}_${i}_$self -fill [lindex {white black} $d]]\n + sys_gui [list $@c itemconfigure cell_${j}_${i}_$self \ + -fill [lindex {white black} $d]]\n } } } |