tkgate-data 1.8.7-4 / usr / share / tkgate-1.8.7 / scripts / bitedit.tcl

#   Copyright (C) 1987-2007 by Jeffery P. Hansen
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Last edit by hansen on Thu May  9 16:58:53 2002
#

#############################################################################
#
# Bitmap editor
#
namespace eval Bitmap {
  variable bits
  variable width 
  variable height 
  variable x_hot 
  variable y_hot 
  variable scale 15
  variable orgx 0
  variable orgy 0
  variable emode point

  proc setbit {x y} {
    variable bits
    set bits(${x},$y) 1
  }
  proc clrbit {x y} {
    variable bits
    set bits(${x},$y) 0
  }

  proc paint {w} {
    variable width 
    variable height
    variable scale
    variable orgx
    variable orgy
    variable x_hot
    variable y_hot
    variable bits

    set ew $w.ea.c
    set lw $w.left.c

    set win_width [winfo width $ew]
    set win_height [winfo height $ew]

    set s1 [expr $win_width/$width]
    set s2 [expr $win_height/$height]
    set scale [min $s1 $s2]

    if {$scale < 5 } { set scale 5 }
    if {$scale > 15 } { set scale 15 }

    set act_width [expr $width*$scale]
    set act_height [expr $height*$scale]

    if {$act_width < $win_width} {
      set orgx [expr ($win_width - $act_width)/2]
      set scroll_width $win_width
    } else {
      set orgx 0
      set scroll_width $act_width
    }

    if {$act_height < $win_height} {
      set orgy [expr ($win_height - $act_height)/2]
      set scroll_height $win_height
    } else {
      set orgy 0
      set scroll_height $act_height
    }

    $ew delete all
    $lw delete all
    for { set x 0 } { $x < $width } { incr x } { 
      for { set y 0 } { $y < $height } { incr y } { 
	set X [expr $x * $scale + $orgx]
	set Y [expr $y * $scale + $orgy]

	if {$bits($x,$y)} {
	  set color black
	} else {
	  set color white
	}

	$ew create rectangle $X $Y [expr $X + $scale] [expr $Y + $scale] -fill $color -outline gray -tags ${x},$y -width 1
	$ew bind ${x},$y <1> "Bitmap::setbit $x $y"
	$ew bind ${x},$y <3> "Bitmap::clrbit $x $y"

	set lx [expr $x + 100 - $x_hot]
	set ly [expr $y + 100 - $y_hot]

	$lw create rectangle $lx $ly $lx $ly -fill $color -outline "" -tags ${x},$y -width 0
      }
    }
    $ew configure -scrollregion [list 0 0 $scroll_width $scroll_height]
    
  }

  proc update_bit {w a e op} {
    variable bits


    if {$bits($e)} {
      $w.ea.c itemconfigure $e -fill black
      $w.left.c itemconfigure $e -fill black
    } else {
      $w.ea.c itemconfigure $e -fill white
      $w.left.c itemconfigure $e -fill white
    }
  }

  #
  # Decode an X11 bitmap into the Bitmap internal data structures
  #
  proc decode {w data} {
    variable width 
    variable height
    variable x_hot 
    variable y_hot 
    variable bits

    catch { unset bits }

    set data [string map {";" "" "," "" "[" "" "]" "" "=" "" "\#" "" "static unsigned char " ""} $data]
    set width [lindex $data 2]
    set height [lindex $data 5]
    if {[lindex $data 6] == "define"} {
      set x_hot [lindex $data 8]
      set y_hot [lindex $data 11]
      set data [lindex $data 13]
    } else {
      set x_hot [expr $width/2]
      set y_hot [expr $height/2]
      set data [lindex $data 7]
    }

    set x 0
    set y 0
    foreach v $data {
      for { set i 0 } { $i < 8 } { incr i } {
	if {[expr $v & (1 << $i)] != 0} {
	  set bits($x,$y) 1
	} else {
	  set bits($x,$y) 0
	}
	trace variable bits($x,$y) w "Bitmap::update_bit $w"

	incr x
	if { $x >= $width } {
	  incr y
	  set x 0
	  break
	}
      }
    }
  }

  #
  # Encode the bitmap data into a standard X11 bitmap form 
  #
  proc encode {} {
    variable width 
    variable height
    variable x_hot 
    variable y_hot
    variable bits

    set l1 "\#define bitmap_width $width\n"
    set l2 "\#define bitmap_height $height\n"
    set l3 "\#define bitmap_x_hot $x_hot\n"
    set l4 "\#define bitmap_y_hot $y_hot\n"
    set l5 "static unsigned char bitmap_bits\[\] = \{\n"

    set L {}

    for {set y 0} {$y < $height} {incr y } {
      set v 0
      set b 0
      for {set x 0} {$x < $width} {incr x } {
	set v [expr $v | ($bits(${x},$y) << $b)]
	incr b
	if {$b == 8} {
	  lappend L [format "0x%02x" $v]
	  set b 0
	  set v 0
	}
      }
      if {$b != 0} {
	lappend L [format "0x%02x" $v]
      }
    }

    set S ""
    while {[llength $L] > 0} {
      set R [string map {" " ", "} [lrange $L 0 11]]
      set L [lrange $L 12 end]

      if {[llength $L] > 0} {
	set S "$S   $R,\n"
      } else {
	set S "$S   $R\};\n"
      }
    }
    return "$l1$l2$l3$l4$l5$S"
  }

  proc edit {args} {
    variable width 
    variable height
    global bd

    set w .bitmap_edit

    set data ""

    set width 20
    set height 20

    if {[catch { toplevel $w }]} return
    wm title $w "Bitmap Editor"
    wm iconbitmap $w "@$bd/gatelogo.xbm"

    parseargs $args {-data}

    decode $w $data

    frame $w.ea 
    canvas $w.ea.c -width 300 -height 300 -bd 2 -relief sunken -bg white -yscrollcommand "$w.ea.vb set" -xscrollcommand "$w.ea.hb set"
    scrollbar $w.ea.vb -orient vertical -command "$w.ea.c yview"
    scrollbar $w.ea.hb -orient horizontal -command "$w.ea.c xview"
    grid $w.ea.c -row 0 -column 0 -sticky nsew
    grid $w.ea.vb -row 0 -column 1 -sticky ns
    grid $w.ea.hb -row 1 -column 0 -sticky ew
    grid rowconfigure $w.ea 0 -weight 1
    grid columnconfigure $w.ea 0 -weight 1
    bind $w.ea.c <Configure> "Bitmap::paint $w"


    frame $w.left
    canvas $w.left.c -width 200 -height 200 -bg white -bd 2 -relief sunken
    nameframe $w.left.mode "Edit Modes"
    radiobutton $w.left.mode.f.point -text "Point" -variable Bitmap::emode -value point
    radiobutton $w.left.mode.f.line -text "Line" -variable Bitmap::emode -value line
    radiobutton $w.left.mode.f.sethot -text "Set Origin" -variable Bitmap::emode -value sethot
    pack $w.left.mode.f.point $w.left.mode.f.line $w.left.mode.f.sethot -anchor w
    pack $w.left.c -padx 5 -pady 5
    pack $w.left.mode -padx 5 -pady 5 -fill x

    button $w.dismiss -text Dismiss -command "destroy $w"

    pack $w.left -side left -anchor nw
    pack $w.ea -padx 5 -pady 5 -fill both -expand 1
    pack $w.dismiss -padx 5 -pady 5

    tkwait window $w
    return [encode]
  }
}