TKE  3.6
Advanced code editor for programmers
bitmap Namespace Reference

Functions

 create w type args
 
 widget_cmd w args
 
 cget w args
 
 configure w args
 
 draw_grid w width height ?fg?
 
 set_grid_size w type
 
 change_square w row col dir
 
 change_square_motion w x y
 
 get_info w
 
 set_from_info w info_list ?resize?
 
 parse_bmp bmp_str
 
 update_menus w
 
 set_custom_color w index
 
 set_color w index color
 
 import w vec
 
 export w type
 
 count_blanks w orient rows cols
 
 move w dir
 
 flip w orient
 
 rotate w
 

Function Documentation

§ cget()

bitmap::cget   w args  

Definition at line 192 of file bitmap.tcl.

192  proc cget {w args} {
193 
194  variable data
195 
196  if {[llength $args] != 1} {
197  return -code error "Illegal number of arguments to bitmap::cget"
198  }
199 
200  if {![info exists data($w,[lindex $args 0])]} {
201  return -code error "Unknown bitmap option [lindex $args 0]"
202  }
203 
204  return $data($w,[lindex $args 0])
205 
206  }

§ change_square()

bitmap::change_square   w row col dir  

Definition at line 299 of file bitmap.tcl.

299  proc change_square {w row col dir} {
300 
301  variable data
302 
303  # Get the current color
304  set curr_tag [string index [$data($w,grid) itemcget $data($w,$row,$col) -tags] 1]
305 
306  # If this is the initial press, save the replace color
307  set data($w,replace) $curr_tag
308  set data($w,replace_with) [expr ($curr_tag + $dir) % [llength $data($w,colors)]]
309 
310  # Set the square fill color
311  $data($w,grid) itemconfigure $data($w,$row,$col) -fill [lindex $data($w,colors) $data($w,replace_with)] -tags s$data($w,replace_with)
312 
313  # Update the preview
314  array set info [get_info $w]
315  $data($w,preview) configure -data $info(dat) -maskdata $info(msk)
316 
317  # Generate the event
318  event generate $w <<BitmapChanged>> -data [array get info]
319 
320  }

§ change_square_motion()

bitmap::change_square_motion   w x y  

Definition at line 324 of file bitmap.tcl.

324  proc change_square_motion {w x y} {
325 
326  variable data
327 
328  set id [$data($w,grid) find closest $x $y]
329 
330  # Get the current color
331  set tag [string index [$data($w,grid) itemcget $id -tags] 1]
332 
333  if {$data($w,replace) eq $tag} {
334 
335  # Configure the square color
336  $data($w,grid) itemconfigure $id -fill [lindex $data($w,colors) $data($w,replace_with)] -tags s$data($w,replace_with)
337 
338  # Update the preview
339  array set info [get_info $w]
340  $data($w,preview) configure -data $info(dat) -maskdata $info(msk)
341 
342  # Generate the event
343  event generate $w <<BitmapChanged>> -data [array get info]
344 
345  }
346 
347  }

§ configure()

bitmap::configure   w args  

Definition at line 210 of file bitmap.tcl.

210  proc configure {w args} {
211 
212  variable data
213 
214  if {[llength $args] % 2} {
215  return -code error "Illegal number of arguments to bitmap::configure"
216  }
217 
218  array set opts {
219  -background {}
220  -swatches {}
221  }
222  array set opts $args
223 
224  # Store the options
225  set data($w,-swatches) $opts(-swatches)
226 
227  # If a background color was specified, change the color in the widget
228  if {$opts(-background) ne ""} {
229  lset data($w,colors) 0 $opts(-background)
230  $data($w,grid) configure -background $opts(-background)
231  $data($w,plabel) configure -background $opts(-background)
232  }
233 
234  # Update the UI
235  update_menus $w
236 
237  }

§ count_blanks()

bitmap::count_blanks   w orient rows cols  

Definition at line 651 of file bitmap.tcl.

651  proc count_blanks {w orient rows cols} {
652 
653  variable data
654 
655  set blanks 0
656 
657  if {$orient eq "row"} {
658  foreach row $rows {
659  foreach col $cols {
660  if {[$data($w,grid) itemcget $data($w,$row,$col) -tags] ne "s0"} {
661  return $blanks
662  }
663  }
664  incr blanks
665  }
666  } else {
667  foreach col $cols {
668  foreach row $rows {
669  if {[$data($w,grid) itemcget $data($w,$row,$col) -tags] ne "s0"} {
670  return $blanks
671  }
672  }
673  incr blanks
674  }
675  }
676 
677  return $blanks
678 
679  }

§ create()

bitmap::create   w type args  

Definition at line 56 of file bitmap.tcl.

56  proc create {w type args} {
57 
58  variable data
59 
60  array set opts {
61  -color1 blue
62  -color2 green
63  -size 10
64  -width 32
65  -height 32
66  -swatches {}
67  }
68 
69  array set opts $args
70 
71  # Initialize variables
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)
77 
78  if {$type eq "mono"} {
79  set data($w,colors) [list $data(bg) $opts(-color1)]
80  } else {
81  set data($w,colors) [list $data(bg) $opts(-color1) $opts(-color2)]
82  }
83 
84  ttk::frame $w
85 
86  # Create the bitmap canvas
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]
90 
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]
93 
94  # Create the right frame
95  ttk::frame $w.rf
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:"
112  } else {
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]]]
115  }
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]]
120 
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)
125 
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"]
134 
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
145  }
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
150 
151  pack $w.c -side left -padx 2 -pady 2
152  pack $w.rf -side left -padx 2 -pady 2 -fill y
153 
154  # Draw the bitmap
155  draw_grid $w $data($w,-width) $data($w,-height)
156 
157  # Update the menus
158  update_menus $w
159 
160  # Create the preview image
161  array set info [get_info $w]
162  if {$type eq "mono"} {
163  set data($w,preview) [image create bitmap -data $info(dat) -maskdata $info(msk) -foreground $info(fg)]
164  } else {
165  set data($w,preview) [image create bitmap -data $info(dat) -maskdata $info(msk) -foreground $info(fg) -background $info(bg)]
166  }
167  $data($w,plabel) configure -image $data($w,preview)
168 
169  rename ::$w $w
170  interp alias {} ::$w {} bitmap::widget_cmd $w
171 
172  return $w
173 
174  }

§ draw_grid()

bitmap::draw_grid   w width height ?fg?  

Definition at line 241 of file bitmap.tcl.

241  proc draw_grid {w width height {fg ""}} {
242 
243  variable data
244 
245  # Calculate the background and foreground colors, if necessary
246  set bg [lindex $data($w,colors) 0]
247  set fg [expr {($fg eq "") ? $data(fg) : $fg}]
248 
249  # Clear the grid
250  $data($w,grid) delete all
251 
252  # Calculate the x and y adjustment
253  set x_adjust [expr ((32 - $width) * ($data($w,-size) / 2)) + 1]
254  set y_adjust [expr ((32 - $height) * ($data($w,-size) / 2)) + 1]
255 
256  for {set row 0} {$row < $height} {incr row} {
257 
258  for {set col 0} {$col < $width} {incr col} {
259 
260  # Calculate the square positions
261  set x1 [expr ($col * $data($w,-size)) + $x_adjust]
262  set y1 [expr ($row * $data($w,-size)) + $y_adjust]
263  set x2 [expr (($col + 1) * $data($w,-size)) + $x_adjust]
264  set y2 [expr (($row + 1) * $data($w,-size)) + $y_adjust]
265 
266  # Create the square
267  set data($w,$row,$col) [$data($w,grid) create rectangle $x1 $y1 $x2 $y2 -fill $bg -outline $fg -width 1 -tags s0]
268 
269  # Create the square bindings
270  $data($w,grid) bind $data($w,$row,$col) <ButtonPress-1> [list bitmap::change_square $w $row $col 1]
271  $data($w,grid) bind $data($w,$row,$col) <ButtonPress-$::right_click> [list bitmap::change_square $w $row $col -1]
272 
273  }
274 
275  }
276 
277  }

§ export()

bitmap::export   w type  

Definition at line 622 of file bitmap.tcl.

622  proc export {w type} {
623 
624  # Prompt the user for a BMP filename to save to
625  if {[set fname [tk_getSaveFile -parent $w -filetypes {{{Bitmap files} {.bmp}}}]] ne ""} {
626 
627  # Open the file for writing
628  if {[catch { open $fname w} rc]} {
629  return -code error "Unable to open $fname for writing"
630  }
631 
632  # Get the bitmap information
633  array set info [get_info $w]
634 
635  # Write the information
636  if {$type eq "data"} {
637  puts $rc $info(dat)
638  } else {
639  puts $rc $info(msk)
640  }
641 
642  # Close the file
643  close $rc
644 
645  }
646 
647  }

§ flip()

bitmap::flip   w orient  

Definition at line 741 of file bitmap.tcl.

741  proc flip {w orient} {
742 
743  variable data
744 
745  for {set i 0} {$i < $data($w,-height)} {incr i} { lappend rows $i}
746  for {set i 0} {$i < $data($w,-width)} {incr i} { lappend cols $i}
747 
748  if {$orient eq "vertical"} {
749  foreach row $rows {
750  foreach lcol $cols rcol [lreverse $cols] {
751  if {$lcol >= $rcol} {
752  break
753  } else {
754  set fill [$data($w,grid) itemcget $data($w,$row,$lcol) -fill]
755  set tags [$data($w,grid) itemcget $data($w,$row,$lcol) -tags]
756  $data($w,grid) itemconfigure $data($w,$row,$lcol) \
757  -fill [$data($w,grid) itemcget $data($w,$row,$rcol) -fill] \
758  -tags [$data($w,grid) itemcget $data($w,$row,$rcol) -tags]
759  $data($w,grid) itemconfigure $data($w,$row,$rcol) -fill $fill -tags $tags
760  }
761  }
762  }
763  } else {
764  foreach col $cols {
765  foreach trow $rows brow [lreverse $rows] {
766  if {$trow >= $brow} {
767  break
768  } else {
769  set fill [$data($w,grid) itemcget $data($w,$trow,$col) -fill]
770  set tags [$data($w,grid) itemcget $data($w,$trow,$col) -tags]
771  $data($w,grid) itemconfigure $data($w,$trow,$col) \
772  -fill [$data($w,grid) itemcget $data($w,$brow,$col) -fill] \
773  -tags [$data($w,grid) itemcget $data($w,$brow,$col) -tags]
774  $data($w,grid) itemconfigure $data($w,$brow,$col) -fill $fill -tags $tags
775  }
776  }
777  }
778  }
779 
780  # Update the preview
781  array set info [get_info $w]
782  $data($w,preview) configure -data $info(dat) -maskdata $info(msk)
783 
784  # Generate the event
785  event generate $w <<BitmapChanged>> -data [array get info]
786 
787  }

§ get_info()

bitmap::get_info   w  

Definition at line 351 of file bitmap.tcl.

351  proc get_info {w} {
352 
353  variable data
354 
355  set dat "#define img_width $data($w,-width)\n#define img_height $data($w,-height)\nstatic char img_bits\[\] = {\n"
356  set msk "#define img_width $data($w,-width)\n#define img_height $data($w,-height)\nstatic char img_bits\[\] = {\n"
357 
358  lassign $data($w,colors) dummy color1 color2
359 
360  for {set row 0} {$row < $data($w,-height)} {incr row} {
361  set dat_val 0
362  set msk_val 0
363  for {set col 0} {$col < $data($w,-width)} {incr col} {
364  set color [$data($w,grid) itemcget $data($w,$row,$col) -fill]
365  if {$color eq $color1} {
366  set dat_val [expr $dat_val | (0x1 << $col)]
367  set msk_val [expr $msk_val | (0x1 << $col)]
368  } elseif {$color eq $color2} {
369  set msk_val [expr $msk_val | (0x1 << $col)]
370  }
371  }
372  for {set i 0} {$i < [expr $data($w,-width) / 8]} {incr i} {
373  append dat [format {0x%02x, } [expr ($dat_val >> ($i * 8)) & 0xff]]
374  append msk [format {0x%02x, } [expr ($msk_val >> ($i * 8)) & 0xff]]
375  }
376  if {[expr $data($w,-width) % 8]} {
377  set byte [expr $data($w,-width) / 8]
378  append dat [format {0x%02x, } [expr ($dat_val >> ($byte * 8)) & 0xff]]
379  append msk [format {0x%02x, } [expr ($msk_val >> ($byte * 8)) & 0xff]]
380  }
381  }
382 
383  set dat "[string range $dat 0 end-2]};"
384  set msk "[string range $msk 0 end-2]};"
385 
386  if {$data($w,type) eq "mono"} {
387  return [list dat $dat msk $msk fg $color1]
388  } else {
389  return [list dat $dat msk $msk fg $color1 bg $color2]
390  }
391 
392  }

§ import()

bitmap::import   w vec  

Definition at line 584 of file bitmap.tcl.

584  proc import {w vec} {
585 
586  variable data
587 
588  # Prompt the user for a BMP filename
589  if {[set fname [tk_getOpenFile -parent $w -filetypes {{{Bitmap files} {.bmp}}}]] ne ""} {
590 
591  # Open the file for reading
592  if {[catch { open $fname r} rc]} {
593  return -code error "Unable to open $fname for reading"
594  }
595 
596  # Get the file content
597  set content [read $rc]
598  close $rc
599 
600  # Update the UI
601  array set info [get_info $w]
602  if {$vec & 0x1} {
603  set info(dat) $content
604  }
605  if {$vec & 0x2} {
606  set info(msk) $content
607  }
608  if {[catch { set_from_info $w [array get info]} rc]} {
609  tk_messageBox -parent $w -icon error -message "Unable to parse BMP file $fname"
610  }
611 
612  # Generate the event
613  event generate $w <<BitmapChanged>> -data [array get info]
614 
615  }
616 
617  }

§ move()

bitmap::move   w dir  

Definition at line 684 of file bitmap.tcl.

684  proc move {w dir} {
685 
686  variable data
687 
688  set row_adjust 0
689  set col_adjust 0
690 
691  for {set i 0} {$i < $data($w,-height)} {incr i} { lappend rows $i}
692  for {set i 0} {$i < $data($w,-width)} {incr i} { lappend cols $i}
693 
694  switch $dir {
695  up { set row_adjust 1}
696  down { set row_adjust -1; set rows [lreverse $rows]}
697  left { set col_adjust 1}
698  right { set col_adjust -1; set cols [lreverse $cols]}
699  center {
700  set top [count_blanks $w row $rows $cols]
701  set bottom [count_blanks $w row [lreverse $rows] $cols]
702  set left [count_blanks $w col $rows $cols]
703  set right [count_blanks $w col $rows [lreverse $cols]]
704  if {[set row_adjust [expr $top - (($top + $bottom) / 2)]] < 0} {
705  set rows [lreverse $rows]
706  }
707  if {[set col_adjust [expr $left - (($left + $right) / 2)]] < 0} {
708  set cols [lreverse $cols]
709  }
710  if {($row_adjust == 0) && ($col_adjust == 0)} {
711  return
712  }
713  }
714  }
715 
716  foreach row $rows {
717  set old_row [expr $row + $row_adjust]
718  foreach col $cols {
719  set old_col [expr $col + $col_adjust]
720  if {($old_row < 0) || ($old_row >= $data($w,-height)) || ($old_col < 0) || ($old_col >= $data($w,-width))} {
721  $data($w,grid) itemconfigure $data($w,$row,$col) -fill "" -tags s0
722  } else {
723  $data($w,grid) itemconfigure $data($w,$row,$col) \
724  -fill [$data($w,grid) itemcget $data($w,$old_row,$old_col) -fill] \
725  -tags [$data($w,grid) itemcget $data($w,$old_row,$old_col) -tags]
726  }
727  }
728  }
729 
730  # Update the preview
731  array set info [get_info $w]
732  $data($w,preview) configure -data $info(dat) -maskdata $info(msk)
733 
734  # Generate the event
735  event generate $w <<BitmapChanged>> -data [array get info]
736 
737  }

§ parse_bmp()

bitmap::parse_bmp   bmp_str  

Definition at line 473 of file bitmap.tcl.

473  proc parse_bmp {bmp_str} {
474 
475  array set bmp_data [list]
476 
477  # Parse out the width and height
478  if {[regexp {#define\s+\w+\s+(\d+).*#define\s+\w+\s+(\d+).*\{(.*)\}} [string map {\n { }} $bmp_str] -> bmp_data(width) bmp_data(height) values]} {
479  if {$bmp_data(width) > 32} {
480  return -code error "BMP data width is greater than 32"
481  }
482  if {$bmp_data(height) > 32} {
483  return -code error "BMP data height is greater than 32"
484  }
485  set values [string map {{,} {}} [string trim $values]]
486  switch [expr ($bmp_data(width) - 1) / 8] {
487  0 {
488  foreach val $values {
489  lappend bmp_data(rows) $val
490  }
491  }
492  1 {
493  foreach {val1 val2} $values {
494  lappend bmp_data(rows) [expr ($val2 << 8) | $val1]
495  }
496  }
497  2 {
498  foreach {val1 val2 val3} $values {
499  lappend bmp_data(rows) [expr ($val3 << 16) | ($val2 << 8) | $val1]
500  }
501  }
502  3 {
503  foreach {val1 val2 val3 val4} $value {
504  lappend bmp_data(rows) [expr ($val4 << 24) | ($val3 << 16) | ($val2 << 8) | $val1]
505  }
506  }
507  }
508  return [array get bmp_data]
509  }
510 
511  return -code error "Illegal BMP data string specified"
512 
513  }

§ rotate()

bitmap::rotate   w  

Definition at line 791 of file bitmap.tcl.

791  proc rotate {w} {
792 
793  variable data
794 
795  for {set i 0} {$i < $data($w,-height)} {incr i} { lappend rows $i}
796  for {set i 0} {$i < $data($w,-width)} {incr i} { lappend cols $i}
797 
798  # Copy the image to a source array and clear the destination
799  foreach row $rows {
800  set src_row [list]
801  foreach col $cols {
802  lappend src_row [list -fill [$data($w,grid) itemcget $data($w,$row,$col) -fill] -tags [$data($w,grid) itemcget $data($w,$row,$col) -tags]]
803  $data($w,grid) itemconfigure $data($w,$row,$col) -fill "" -tags ""
804  }
805  lappend src $src_row
806  }
807 
808  foreach col $cols src_row $rows {
809  if {($col eq "") || ($src_row eq "")} {
810  return
811  }
812  foreach row [lreverse $rows] src_col $cols {
813  if {($row eq "") || ($src_col eq "")} {
814  break
815  }
816  $data($w,grid) itemconfigure $data($w,$row,$col) {*}[lindex $src $src_row $src_col]
817  }
818  }
819 
820  # Update the preview
821  array set info [get_info $w]
822  $data($w,preview) configure -data $info(dat) -maskdata $info(msk)
823 
824  # Generate the event
825  event generate $w <<BitmapChanged>> -data [array get info]
826 
827  }

§ set_color()

bitmap::set_color   w index color  

Definition at line 551 of file bitmap.tcl.

551  proc set_color {w index color} {
552 
553  variable data
554 
555  # Set the color
556  lset data($w,colors) $index $color
557 
558  # Set the preview color
559  if {$index == 1} {
560  $data($w,preview) configure -foreground $color
561  } else {
562  $data($w,preview) configure -background $color
563  }
564 
565  # Set the label background color
566  $data($w,c${index}_lbl) configure -background $color
567 
568  # Set the menubutton label
569  $data($w,color$index) configure -text $color
570 
571  # Update the colors
572  foreach id [$data($w,grid) find withtag s$index] {
573  $data($w,grid) itemconfigure $id -fill $color
574  }
575 
576  # Generate a BitmapChanged event
577  event generate $w <<BitmapChanged>> -data [get_info $w]
578 
579  }

§ set_custom_color()

bitmap::set_custom_color   w index  

Definition at line 538 of file bitmap.tcl.

538  proc set_custom_color {w index} {
539 
540  variable data
541 
542  if {[set color [tk_chooseColor -initialcolor [lindex $data($w,colors) $index]]] ne ""} {
543  set_color $w $index $color
544  }
545 
546  }

§ set_from_info()

bitmap::set_from_info   w info_list ?resize?  

Definition at line 396 of file bitmap.tcl.

396  proc set_from_info {w info_list {resize 1}} {
397 
398  variable data
399 
400  array set info $info_list
401 
402  # Set the background color if it does not exist
403  if {($data($w,type) ne "mono") && ![info exists info(bg)]} {
404  set info(bg) $data(bg)
405  }
406 
407  # Set the grid foreground
408  set grid_fg [expr {($info(fg) eq "black") ? "grey" : "black"}]
409 
410  # Parse the data and mask BMP strings
411  if {[catch {
412  array set dat_info [parse_bmp $info(dat)]
413  if {$data($w,type) eq "mono"} {
414  array set msk_info [array get dat_info]
415  } else {
416  array set msk_info [parse_bmp $info(msk)]
417  }
418  } rc]} {
419  return -code error "Error parsing BMP file ($rc)"
420  }
421 
422  # Set the variables
423  if {$resize} {
424  set data($w,-width) $dat_info(width)
425  set data($w,-height) $dat_info(height)
426  }
427  if {$data($w,type) eq "mono"} {
428  lset data($w,colors) 1 $info(fg)
429  } else {
430  lset data($w,colors) 1 $info(fg)
431  lset data($w,colors) 2 $info(bg)
432  }
433 
434  # Update the preview
435  if {$data($w,type) eq "mono"} {
436  $data($w,preview) configure -foreground $info(fg) -data $info(dat) -maskdata $info(msk)
437  } else {
438  $data($w,preview) configure -foreground $info(fg) -background $info(bg) -data $info(dat) -maskdata $info(msk)
439  }
440 
441  # Redraw the grid
442  draw_grid $w $data($w,-width) $data($w,-height) $grid_fg
443 
444  # Update the widgets
445  $data($w,c1_lbl) configure -background $info(fg) -foreground [utils::get_complementary_mono_color $info(fg)]
446  $data($w,color1) configure -text $info(fg)
447  if {$data($w,type) ne "mono"} {
448  $data($w,c2_lbl) configure -background $info(bg) -foreground [utils::get_complementary_mono_color $info(bg)]
449  $data($w,color2) configure -text $info(bg)
450  }
451  $data($w,width) set $dat_info(width)
452  $data($w,height) set $dat_info(height)
453 
454  for {set row 0} {$row < $data($w,-height)} {incr row} {
455  set dat_val [lindex $dat_info(rows) $row]
456  set msk_val [lindex $msk_info(rows) $row]
457  for {set col 0} {$col < $data($w,-width)} {incr col} {
458  if {[expr $dat_val & (0x1 << $col)]} {
459  $data($w,grid) itemconfigure $data($w,$row,$col) -fill $info(fg) -tags s1
460  } elseif {[expr $msk_val & (0x1 << $col)]} {
461  $data($w,grid) itemconfigure $data($w,$row,$col) -fill $info(bg) -tags s2
462  } else {
463  $data($w,grid) itemconfigure $data($w,$row,$col) -tags s0
464  }
465  }
466  }
467 
468  }

§ set_grid_size()

bitmap::set_grid_size   w type  

Definition at line 281 of file bitmap.tcl.

281  proc set_grid_size {w type} {
282 
283  variable data
284 
285  # Get the spinbox value
286  set data($w,-$type) [$data($w,$type) get]
287 
288  # Update the grid
289  set_from_info $w [set info [get_info $w]] 0
290 
291  # Generate the event
292  event generate $w <<BitmapChanged>> -data $info
293 
294  }

§ update_menus()

bitmap::update_menus   w  

Definition at line 517 of file bitmap.tcl.

517  proc update_menus {w} {
518 
519  variable data
520 
521  for {set i 1} {$i <= [expr {($data($w,type) eq "mono") ? 1 : 2}]} {incr i} {
522  set mnu $data($w,color${i}_mnu)
523  $mnu delete 0 end
524  $mnu add command -label "Custom color..." -command [list bitmap::set_custom_color $w $i]
525  if {[llength $data($w,-swatches)] > 0} {
526  $mnu add separator
527  $mnu add command -label "Swatch Colors" -state disabled
528  foreach swatch $data($w,-swatches) {
529  $mnu add command -label $swatch -command [list bitmap::set_color $w $i $swatch]
530  }
531  }
532  }
533 
534  }

§ widget_cmd()

bitmap::widget_cmd   w args  

Definition at line 178 of file bitmap.tcl.

178  proc widget_cmd {w args} {
179 
180  set args [lassign $args cmd]
181 
182  switch -exact $cmd {
183  cget { return [cget $w {*}$args]}
184  configure { return [configure $w {*}$args]}
185  default { return -code error "Unknown bitmap command ($cmd)"}
186  }
187 
188  }