bdfedit

来自「Very very small GUI. Usefull for small s」· 代码 · 共 2,178 行 · 第 1/5 页

  puts $fh "FONT_ASCENT  [expr $fontinfo(height)+$fontinfo(yorigin)]"
  puts $fh "FONT_DESCENT [expr 0-$fontinfo(yorigin)]"
  puts $fh "ENDPROPERTIES"
  puts $fh "CHARS $numchars"
  showstatus 0 $numchars
  set count 0
  for {set encod 0} {$encod<256} {incr encod} {
    if (![info exists chardata($encod)]) continue
    #would we want to make this a save option?
    #glyph_save_full $fh $encod
    glyph_save_minimal $fh $encod
    incr count
    showstatus $count $numchars
  }
  puts $fh "ENDFONT"
  . config -cursor ""
}

proc glyph_save_full {fh encod} {
  global chardata fontinfo bin2hex
  if [info exists chardata(name,$encod)] {
    set name $chardata(name,$encod)
  } else {
    set name [format "C%03o" $encod]
  }
  puts $fh "STARTCHAR $name"
  puts $fh "ENCODING $encod"
  if [info exists chardata(dwidth,$encod)] {
    #SWIDTH is DWIDTH*1000/pointsize
    puts $fh "SWIDTH [expr int(1000*$chardata(dwidth,$encod)/$fontinfo(pointsize))] 0"
    puts $fh "DWIDTH $chardata(dwidth,$encod) 0"
  } else {
    #SWIDTH is DWIDTH*1000/pointsize
    puts $fh "SWIDTH [expr int(1000*$fontinfo(width)/$fontinfo(pointsize))] 0"
    puts $fh "DWIDTH $fontinfo(width) 0"
  }
  set width $fontinfo(width)
  set height $fontinfo(height)
  set xoff $fontinfo(xorigin)
  set yoff $fontinfo(yorigin)
  set left 0
  set right [expr $fontinfo(width)-1]
  set top 0
  set bottom [expr $fontinfo(height)-1]
  puts $fh "BBX $width $height $xoff $yoff"
  puts $fh "BITMAP"
  for {set y $top} {$y<=$bottom} { incr y } {
    #for wish8, something like this will do the same thing:
    #binary scan [binary format B* [join [lrange $row $left $right] ""]] H* out
    #
    set row [lindex $chardata($encod) $y]
    set hex ""
    for {set x $left} {$x<=$right} { incr x 4 } {
      set tmpbin ""
      for {set i 0} {$i<4} {incr i} {
	if ([expr $i+$x]>$right) {
	  lappend tmpbin 0
	} else {
	  lappend tmpbin [lindex $row [expr $x+$i]]
	}
      }
      set hex "${hex}$bin2hex($tmpbin)"
    }
    if [expr [string length $hex]%2] { set hex "${hex}0" }
    puts $fh $hex
  }
  puts $fh "ENDCHAR"
}

proc glyph_save_minimal {fh encod} {
  global chardata fontinfo bin2hex
  if [info exists chardata(name,$encod)] {
    set name $chardata(name,$encod)
  } else {
    set name [format "C%03o" $encod]
  }
  puts $fh "STARTCHAR $name"
  puts $fh "ENCODING $encod"
  if [info exists chardata(dwidth,$encod)] {
    #SWIDTH is DWIDTH*1000/pointsize
    puts $fh "SWIDTH [expr int(1000*$chardata(dwidth,$encod)/$fontinfo(pointsize))] 0"
    puts $fh "DWIDTH $chardata(dwidth,$encod) 0"
  } else {
    #SWIDTH is DWIDTH*1000/pointsize
    puts $fh "SWIDTH [expr int(1000*$fontinfo(width)/$fontinfo(pointsize))] 0"
    puts $fh "DWIDTH $fontinfo(width) 0"
  }
  set top -1
  set bottom -1
  set left 1000
  set right -1
  set y 0
  foreach row $chardata($encod) {
    set first -1
    set last -1
    set x 0
    foreach elem $row {
      if ($elem==1) {
	if ($first<0) { set first $x }
	set last $x
      }
      incr x
    }
    if ($first!=-1) {
      if ($top<0) { set top $y }
      set bottom $y
      if ($first<$left) { set left $first }
      if ($last>$right) { set right $last }
    }
    incr y
  }
  set width [expr $right-$left+1]
  set height [expr $bottom-$top+1]
  set xoff [expr $left+$fontinfo(xorigin)]
  set yoff [expr ($fontinfo(height)-1-$bottom)+$fontinfo(yorigin)]
  if ($top==-1) {
    set width 0
    set height 0
    set xoff 0
    set yoff 0
    #this keeps the save loop below from saving a single empty line
    set bottom [expr $top-1]
  }
  puts $fh "BBX $width $height $xoff $yoff"
  puts $fh "BITMAP"
  for {set y $top} {$y<=$bottom} { incr y } {
    #for wish8, something like this will do the same thing:
    #binary scan [binary format B* [join [lrange $row $left $right] ""]] H* out
    #
    set row [lindex $chardata($encod) $y]
    set hex ""
    for {set x $left} {$x<=$right} { incr x 4 } {
      set tmpbin ""
      for {set i 0} {$i<4} {incr i} {
	if ([expr $i+$x]>$right) {
	  lappend tmpbin 0
	} else {
	  lappend tmpbin [lindex $row [expr $x+$i]]
	}
      }
      set hex "${hex}$bin2hex($tmpbin)"
    }
    if [expr [string length $hex]%2] { set hex "${hex}0" }
    puts $fh $hex
  }
  puts $fh "ENDCHAR"
}

#
# haven't bothered putting pid intofilename because of low probability of
# collisions
#
proc make_drag_cursor {width height hotx hoty data} {
  if [catch "open /tmp/drag_cursor.bm w" fh] {
    return 0
  }
  puts $fh "#define dragc_width $width"
  puts $fh "#define dragc_height $height"
  puts $fh "#define dragc_x_hot $hotx"
  puts $fh "#define dragc_y_hot $hoty"
  puts $fh "static char dragc_bits\[\] = {"
  puts -nonewline $fh "  "
  set bwidth [expr ($width+7)/8]
  set pixels ""

  for {set y 0} {$y<$height} {incr y} {
    for {set x 0} {$x<$bwidth} {incr x} {
      set byte 0
      set startbit [expr $x*8]
      set endbit [expr ($x+1)*8]
      if ($endbit>$width) { set endbit $width }
      for {set i $startbit} {$i<$endbit} { incr i } {
	if [lindex [lindex $data $y] $i] {
	  set byte [expr $byte+(1<<($i-$startbit))]
	}
      }
      lappend pixels [format %02x $byte]
    }
  }
  #dump it to a file
  set col 2
  foreach pix $pixels {
    puts -nonewline $fh " 0x$pix,"
    if {[incr col 6]>70} {
      puts $fh ""
      puts -nonewline $fh "  "
      set col 2
    }
  }
  puts $fh "};"
  close $fh
  return 1
}

proc showstatus {sofar all args} {
  if [string length $args] {
    .status.l config -text [lindex $args 0]
  }
  set x [expr 201*$sofar/$all]
  .status.bar.c coords bar 0 0 $x 21
  update
}

proc readrc {} {
  global env default
  set rcfile $env(HOME)/.bdfeditrc
  if [file exists $rcfile] {
    if [catch "source $rcfile" err] {
      .messdialog.m config -text "Error reading rc file ($rcfile):\n$err"
      wm deiconify .messdialog
    }
  }
}

#
toplevel .status
wm withdraw .status
wm transient .status .
wm group .status .
label .status.l -text "Loading font..."
pack .status.l -side top
frame .status.bar -bd 2 -relief sunken
pack .status.bar -side top -padx 30 -pady 30
canvas .status.bar.c -width 200 -height 20 -highlightthickness 0 -bg white
pack .status.bar.c
.status.bar.c create rectangle 0 0 0 0 -fill skyblue -tags bar -outline skyblue

#
toplevel .resizedialog
wm withdraw .resizedialog
wm group .resizedialog .
wm group .resizedialog .
label .resizedialog.l
pack .resizedialog.l -side top
canvas .resizedialog.c -bg white -width 200 -height 200 -bd 2 -relief sunken
pack .resizedialog.c -side top -pady 5
frame .resizedialog.butts
button .resizedialog.butts.resize -command doresize \
  -text "Resize" -highlightthickness 0
button .resizedialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .resizedialog; grab release .resizedialog"
pack .resizedialog.butts.resize -side left -padx 20
pack .resizedialog.butts.cancel -side right -padx 20
pack .resizedialog.butts -side top -fill x -pady 10

#
toplevel .newdialog
wm withdraw .newdialog
wm transient .newdialog .
wm group .newdialog .
frame .newdialog.wh
pack .newdialog.wh -side top
label .newdialog.wh.l1 -text "Size:"
pack .newdialog.wh.l1 -side left
entry .newdialog.wh.w -width 4
pack .newdialog.wh.w -side left
label .newdialog.wh.l2 -text "x"
pack .newdialog.wh.l2 -side left
entry .newdialog.wh.h -width 4
pack .newdialog.wh.h -side left
frame .newdialog.b
pack .newdialog.b -side top
label .newdialog.b.l -text "Baseline:"
pack .newdialog.b.l -side left
entry .newdialog.b.b -width 4
pack .newdialog.b.b -side left
frame .newdialog.butts
button .newdialog.butts.new -command {newfont [.newdialog.wh.w get] [.newdialog.wh.h get] [.newdialog.b.b get]} \
  -text "Do it" -highlightthickness 0
button .newdialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .newdialog; grab release .newdialog"
pack .newdialog.butts.new -side left -padx 20
pack .newdialog.butts.cancel -side right -padx 20
pack .newdialog.butts -side top -fill x -pady 10

#
toplevel .savedialog
wm withdraw .savedialog
wm transient .savedialog .
wm group .savedialog .
label .savedialog.l -text "Save file as:"
pack .savedialog.l -side top
entry .savedialog.e -width 50
completion_bindings .savedialog.e
pack .savedialog.e -side top
frame .savedialog.butts
button .savedialog.butts.save -command {dosave [.savedialog.e get]} \
	  -text Save -highlightthickness 0
button .savedialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .savedialog; grab release .savedialog"
pack .savedialog.butts.save -side left -padx 20
pack .savedialog.butts.cancel -side right -padx 20
pack .savedialog.butts -side top -fill x -pady 10
bind .savedialog.e <Return> ".savedialog.butts.save invoke"

#
toplevel .loaddialog
wm withdraw .loaddialog
wm transient .loaddialog .
wm group .loaddialog .
label .loaddialog.l -text "Load file:"
pack .loaddialog.l -side top
entry .loaddialog.e -width 50
completion_bindings .loaddialog.e
pack .loaddialog.e -side top
frame .loaddialog.butts
button .loaddialog.butts.load -command {doload [.loaddialog.e get]} \
	  -text Load -highlightthickness 0
button .loaddialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .loaddialog; grab release .loaddialog"
pack .loaddialog.butts.load -side left -padx 20
pack .loaddialog.butts.cancel -side right -padx 20
pack .loaddialog.butts -side top -fill x -pady 10
bind .loaddialog.e <Return> ".loaddialog.butts.load invoke"

#
toplevel .chardialog
wm withdraw .chardialog
wm transient .chardialog .
wm group .chardialog .
label .chardialog.l -text "Character name:"
pack .chardialog.l -side top
entry .chardialog.e
pack .chardialog.e -side top
frame .chardialog.butts
button .chardialog.butts.apply -text Apply -highlightthickness 0 \
	  -command { setcharname [.chardialog.e get] }
button .chardialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .chardialog; grab release .chardialog"
pack .chardialog.butts.apply -side left -padx 20
pack .chardialog.butts.cancel -side right -padx 20
pack .chardialog.butts -side top -fill x -pady 10
bind .chardialog.e <Return> ".chardialog.butts.apply invoke"

#
toplevel .messdialog
wm withdraw .messdialog
wm transient .messdialog .
wm group .messdialog .
message .messdialog.m -aspect 10000
pack .messdialog.m -side top
button .messdialog.ok -command "wm withdraw .messdialog" \
	  -text Ok -highlightthickness 0
pack .messdialog.ok -side top

#
toplevel .commdialog
wm withdraw .commdialog
wm transient .commdialog .
wm group .commdialog .
label .commdialog.l -text "Comment:"
pack .commdialog.l -side top
text .commdialog.t -bg white
pack .commdialog.t -side top
frame .commdialog.butts
button .commdialog.butts.apply -text Apply -highlightthickness 0 \
	  -command { changecomment [.commdialog.t get 0.0 end] }
button .commdialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .commdialog; grab release .commdialog"
pack .commdialog.butts.apply -side left -padx 20
pack .commdialog.butts.cancel -side right -padx 20
pack .commdialog.butts -side top -fill x -pady 10

#Properties:
#  font name
#  comments?
#  point size?
#  proportional
#  parts of font name
#
set proplist [list fontname pointsize foundry family weight slant widthname copyright]
toplevel .propdialog
wm withdraw .propdialog
wm transient .propdialog .
wm group .propdialog .
frame .propdialog.butts
button .propdialog.butts.apply -command changeprops \
	  -text Apply -highlightthickness 0
button .propdialog.butts.cancel -text Cancel -highlightthickness 0 \
	  -command "wm withdraw .propdialog; grab release .propdialog"
pack .propdialog.butts.apply -side left -padx 20
pack .propdialog.butts.cancel -side right -padx 20
pack .propdialog.butts -side bottom -fill x -pady 10
text .propdialog.labels -width 15 -height 10 -bg $BG -relief flat \
      -highlightthickness 0
pack .propdialog.labels -side left
text .propdialog.values -width 50 -height 10 -bg white
pack .propdialog.values -side right
bind .propdialog.values <Any-Key> setpropwidth

. config -width 0 -height 0
bind .c <1> "click %x %y on"
bind .c <2> "click %x %y toggle"
bind .c <3> "click %x %y off"
bind .c <B1-Motion> "bmotion %x %y on"
bind .c <B2-Motion> "bmotion %x %y toggle"
bind .c <B3-Motion> "bmotion %x %y off"

bind .fc <1> "pickchar %x %y"
bind .fc <Control-3> "nukechar %x %y"
bind .fc <B1-Motion> "dragchar %x %y"
bind .fc <ButtonRelease-1> "enddragchar %x %y"

focus .
bind . <Left> slideleft
bind . <Right> slideright
bind . <Up> slideup
bind . <Down> slidedown
bind . <Control-Left> selectleft
bind . <Control-Right> selectright
bind . <Control-Up> selectup
bind . <Control-Down> selectdown

readrc

if [llength $argv]>1 {
  puts "usage: bdfedit \[filename\]"
} elseif [llength $argv]==1 {
  update
  set fontinfo(yorigin) $default(DESCENT)
  set WIDTH $default(WIDTH)
  set HEIGHT $default(HEIGHT)
  if [string compare $argv -]==0 {
    loadbdffont stdin
    set chardata(work) $chardata(65)
    makegrid $WIDTH $HEIGHT $fontinfo(xorigin) $fontinfo(yorigin)
    showfont
    setgrid chardata work
  } else {
    doload $argv
  }
} else {
  newfont $default(WIDTH) $default(HEIGHT) $default(DESCENT)
  makegrid $WIDTH $HEIGHT $fontinfo(xorigin) $fontinfo(yor