bitmap.tcl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

source pdlib.tcl

pd::guiproc bitmap_draw_new {self c x y sz w h data} {
    set z 0
    for {set i 0} {$i < $h} {incr i} {
        for {set j 0} {$j < $w} {incr j} {
            $c create rectangle \
                [expr {0+$x+$j*$sz}] [expr {0+$y+$i*$sz}] \
                [expr {1+$x+($j+1)*$sz}] [expr {1+$y+($i+1)*$sz}] \
                -outline black -fill [lindex {white black} [lindex $data $z]] \
                -tags [list $c cell_${j}_${i}_$c]
            incr z
        }
    }
    set x2 [expr {$x+$w*$sz+1}]
    set y2 [expr {$y+$h*$sz+1}]
    $c create rectangle $x $y $x2 $y2 -outline black -tags [list $c border$c]
}

pd::guiclass bitmap {
    constructor {
        pd::add_outlet $self float

        set @sz [pd::default_arg 0 int 15]
        set @w [pd::default_arg 1 int 8]
        set @h [pd::default_arg 2 int 8]

        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]}]
            }
        }
    }
    
    0_getrow {
        set r [list]
        set n [pd::arg 0 int]
        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
    }

    object_save {
        return [list #X obj $@x $@y bitmap $@sz $@w $@h {*}$@data \;]
    }

    widgetbehavior_getrect {
        lassign $args x1 y1
        set x2 [expr {1+$x1+$@w*$@sz}]
        set y2 [expr {1+$y1+$@h*$@sz}]
        return [list $x1 $y1 $x2 $y2]
    }

    widgetbehavior_displace {
        set dx [lindex $args 0]
        set dy [lindex $args 1]
        if {$dx != 0 || $dy != 0} {
            incr @x $dx
            incr @y $dy
            sys_gui [list $@c move $@c $dx $dy]\n
        }
        return [list $@x $@y]
    }

    widgetbehavior_select {
        set sel [lindex $args 0]
        sys_gui [list $@c itemconfigure $@c -outline [lindex {black blue} $sel]]\n
    }

    widgetbehavior_activate {
    }

    widgetbehavior_vis {
        set @c [lindex $args 0]
        set @x [lindex $args 1]
        set @y [lindex $args 2]
        set vis [lindex $args 3]
        if {$vis} {
            sys_gui [list bitmap_draw_new $self $@c $@x $@y $@sz $@w $@h $@data ]\n
        } else {
            sys_gui [list $@c delete $@c]\n
        }
    }

    widgetbehavior_click {
        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}
        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 d [expr {[lindex $@data $idx]==0}]
            lset @data $idx $d
            sys_gui [list $@c itemconfigure cell_${j}_${i}_$@c -fill [lindex {white black} $d]]\n
        }
    }
}