aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bitmap.tcl195
1 files changed, 163 insertions, 32 deletions
diff --git a/bitmap.tcl b/bitmap.tcl
index 7554e52..edb4072 100644
--- a/bitmap.tcl
+++ b/bitmap.tcl
@@ -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
}
}
}