56 proc create {w type args} {
72 set data($w,type) $type
73 set data($w,-size) $opts(-size)
74 set data($w,-width) $opts(-width)
75 set data($w,-height) $opts(-height)
76 set data($w,-swatches) $opts(-swatches)
78 if {$type eq "mono"} {
79 set data($w,colors) [list $data(bg) $opts(-color1)]
81 set data($w,colors) [list $data(bg) $opts(-color1) $opts(-color2)]
87 set width [
expr ($data($w,-size) * 32) + 1]
88 set height [
expr ($data($w,-size) * 32) + 1]
89 set data($w,grid) [
canvas $w.c -background $data(bg) -width $width -height $height]
91 bind $data($w,grid) <B1-Motion> [list bitmap::change_square_motion $w %x %y]
92 bind $data($w,grid) <B$::right_click-Motion> [list bitmap::change_square_motion $w %x %y]
96 set data($w,plabel) [ttk::label $w.rf.p -relief solid -padding 10 -anchor center]
97 ttk::labelframe $w.rf.mf -text [msgcat::mc "Transform Tools"]
98 grid columnconfigure $w.rf.mf 0 -weight 1
99 grid columnconfigure $w.rf.mf 4 -weight 1
100 grid [ttk::button $w.rf.mf.up -style BButton -text "\u25b2" -command [list bitmap::move $w up]] -row 0 -column 2 -sticky news -padx 2 -pady 2
101 grid [ttk::button $w.rf.mf.left -style BButton -text "\u25c0" -command [list bitmap::move $w left]] -row 1 -column 1 -sticky news -padx 2 -pady 2
102 grid [ttk::button $w.rf.mf.center -style BButton -text "\u25fc" -command [list bitmap::move $w center]] -row 1 -column 2 -sticky news -padx 2 -pady 2
103 grid [ttk::button $w.rf.mf.right -style BButton -text "\u25b6" -command [list bitmap::move $w right]] -row 1 -column 3 -sticky news -padx 2 -pady 2
104 grid [ttk::button $w.rf.mf.down -style BButton -text "\u25bc" -command [list bitmap::move $w down]] -row 2 -column 2 -sticky news -padx 2 -pady 2
105 grid [ttk::button $w.rf.mf.flipv -style BButton -text "\u2b0c" -command [list bitmap::flip $w vertical]] -row 3 -column 1 -sticky news -padx 2 -pady 2
106 grid [ttk::button $w.rf.mf.rot -style BButton -text "\u21ba" -command [list bitmap::rotate $w]] -row 3 -column 2 -sticky news -padx 2 -pady 2
107 grid [ttk::button $w.rf.mf.fliph -style BButton -text "\u2b0d" -command [list bitmap::flip $w horizontal]] -row 3 -column 3 -sticky news -padx 2 -pady 2
108 set data($w,c1_lbl) [ttk::label $w.rf.l1 -text "Color-1:" -background [
lindex $data($w,colors) 1]]
109 set data($w,color1) [ttk::menubutton $w.rf.sb1 -text [
lindex $data($w,colors) 1] -menu [
set data($w,color1_mnu) [
menu $w.rf.mnu1 -tearoff 0]]]
110 if {$type eq "mono"} {
111 $data($w,c1_lbl) configure -text "Color:"
113 set data($w,c2_lbl) [ttk::label $w.rf.l2 -text "Color-2:" -background [
lindex $data($w,colors) 2]]
114 set data($w,color2) [ttk::menubutton $w.rf.sb2 -text [
lindex $data($w,colors) 2] -menu [
set data($w,color2_mnu) [
menu $w.rf.mnu2 -tearoff 0]]]
116 ttk::label $w.rf.l3 -text "Width:"
117 set data($w,width) [$data(sb) $w.rf.width {*}$data(sb_opts) -width 2 -values [list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16] -command [list bitmap::set_grid_size $w width]]
118 ttk::label $w.rf.l4 -text "Height:"
119 set data($w,height) [$data(sb) $w.rf.height {*}$data(sb_opts) -width 2 -values [list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16] -command [list bitmap::set_grid_size $w height]]
121 $data($w,width) set $data($w,-width)
122 $data($w,height) set $data($w,-height)
123 $data($w,width) {*}$data(sb_readonly)
124 $data($w,height) {*}$data(sb_readonly)
126 tooltip::tooltip $w.rf.mf.up [msgcat::mc "Move image up"]
127 tooltip::tooltip $w.rf.mf.left [msgcat::mc "Move image left"]
128 tooltip::tooltip $w.rf.mf.center [msgcat::mc "Center image"]
129 tooltip::tooltip $w.rf.mf.right [msgcat::mc "Move image right"]
130 tooltip::tooltip $w.rf.mf.down [msgcat::mc "Move image down"]
131 tooltip::tooltip $w.rf.mf.flipv [msgcat::mc "Flip image vertically"]
132 tooltip::tooltip $w.rf.mf.rot [msgcat::mc "Rotate image 90 degrees"]
133 tooltip::tooltip $w.rf.mf.fliph [msgcat::mc "Flip image horizontally"]
135 grid rowconfigure $w.rf 1 -weight 1
136 grid rowconfigure $w.rf 3 -weight 1
137 grid columnconfigure $w.rf 1 -weight 1
138 grid $data($w,plabel) -row 0 -column 0 -padx 2 -pady 2 -columnspan 2
139 grid $w.rf.mf -row 2 -column 0 -padx 2 -pady 2 -columnspan 2
140 grid $data($w,c1_lbl) -row 4 -column 0 -sticky news -padx 2 -pady 2
141 grid $data($w,color1) -row 4 -column 1 -sticky news -padx 2 -pady 2
142 if {$type ne "mono"} {
143 grid $data($w,c2_lbl) -row 5 -column 0 -sticky news -padx 2 -pady 2
144 grid $data($w,color2) -row 5 -column 1 -sticky news -padx 2 -pady 2
146 grid $w.rf.l3 -row 6 -column 0 -sticky news -padx 2 -pady 2
147 grid $data($w,width) -row 6 -column 1 -sticky news -padx 2 -pady 2
148 grid $w.rf.l4 -row 7 -column 0 -sticky news -padx 2 -pady 2
149 grid $data($w,height) -row 7 -column 1 -sticky news -padx 2 -pady 2
151 pack $w.c -side left -padx 2 -pady 2
152 pack $w.rf -side left -padx 2 -pady 2 -fill y
155 draw_grid $w $data($w,-width) $data($w,-height)
162 if {$type eq "mono"} {
163 set data($w,preview) [
image create bitmap -data $info(dat) -maskdata $info(msk) -foreground $info(fg)]
165 set data($w,preview) [
image create bitmap -data $info(dat) -maskdata $info(msk) -foreground $info(fg) -background $info(bg)]
167 $data($w,plabel) configure -image $data($w,preview)
170 interp alias {} ::$w {} bitmap::widget_cmd $w