Vector Font
LWS 08 Jan 2011 - A simple vector font for canvases. I use 2D Coordinate Transformations for transformation, including rotation, although many other similar routines exist for that.
######################################################################
# A set of routines for drawing a vector font on a canvas. These
# display characters/strings at a specified canvas coordinate.
######################################################################
namespace eval VectorFont {
variable fontarray
# Define a 5x7 vector font indexed by the character.
array set fontarray {
a { {4 0 1 0 0 1 0 3 1 4 4 4 4 0} }
b { {0 6 0 0 3 0 4 1 4 3 3 4 0 4} }
c { {4 0 1 0 0 1 0 3 1 4 4 4} }
d { {4 6 4 0 1 0 0 1 0 3 1 4 4 4} }
e { {4 0 1 0 0 1 0 3 1 4 3 4 4 3 4 2 0 2} }
f { {2 0 2 5 3 6 4 6} {0 3 4 3} }
g { {0 0 3 0 4 1 4 4 3 5 1 5 0 4 0 3 1 2 4 2} }
h { {0 6 0 0} {0 4 3 4 4 3 4 0} }
i { {2 0 2 4} {2 5 2 6} }
j { { 0 0 1 0 2 1 2 4} {2 5 2 6} }
k { {0 0 0 6} {4 0 0 2 3 5} }
l { {1 6 2 6 2 0} {1 0 3 0} }
m { {0 0 0 4 1 4 2 3 3 4 4 4 4 0} {2 0 2 3} }
n { {0 4 0 0} {0 3 1 4 3 4 4 3 4 0} }
o { {0 1 0 3 1 4 3 4 4 3 4 1 3 0 1 0 0 1} }
p { {0 0 0 5 3 5 4 4 4 3 3 2 0 2} }
q { {4 0 4 5 1 5 0 4 0 3 1 2 4 2} }
r { {0 0 0 4 3 4 4 3} }
s { {0 0 4 0 4 2 0 2 0 4 4 4} }
t { { 1 6 1 1 2 0 3 0 4 1} {0 5 3 5} }
u { {4 4 4 0} {4 1 3 0 1 0 0 1 0 4} }
v { {0 4 2 0 4 4} }
w { {0 4 0 0 2 2 4 0 4 4} }
x { {0 0 4 4} {0 4 4 0} }
y { {0 5 0 3 1 2 3 2 4 3} {4 5 4 1 3 0 0 0} }
z { {0 4 4 4 0 0 4 0} }
A { {0 0 0 4 2 6 4 4 4 0} {0 2 4 2} }
B { {0 0 0 6 3 6 4 5 4 4 3 3 4 2 4 1 3 0 0 0} {0 3 3 3} }
C { {4 0 0 0 0 6 4 6} }
D { {0 0 0 6 2 6 4 4 4 2 2 0 0 0} }
E { {4 0 0 0 0 6 4 6} {0 3 4 3} }
F { {0 0 0 6 4 6} {0 3 3 3} }
G { {2 2 4 2 4 0 0 0 0 6 4 6 4 4} }
H { {0 0 0 6} {4 0 4 6} {0 3 4 3} }
I { {0 0 4 0} {2 0 2 6} {0 6 4 6} }
J { {0 2 2 0 4 0 4 6} }
K { {0 0 0 6} {4 6 0 3 4 0} }
L { {4 0 0 0 0 6} }
M { {0 0 0 6 2 4 4 6 4 0} }
N { {0 0 0 6 4 0 4 6} }
O { {0 0 0 6 4 6 4 0 0 0} }
P { {0 0 0 6 4 6 4 3 0 3} }
Q { {0 0 0 6 4 6 4 2 2 0 0 0} {2 2 4 0} }
R { {0 0 0 6 4 6 4 3 0 3} {1 3 4 0} }
S { {0 0 3 0 4 1 4 2 3 3 1 3 0 4 0 5 1 6 4 6} }
T { {2 0 2 6} {0 6 4 6} }
U { {0 6 0 0 4 0 4 6} }
V { {0 6 2 0 4 6} }
W { {0 6 0 0 2 2 4 0 4 6} }
X { {0 0 4 6} {0 6 4 0} }
Y { {0 6 2 4 4 6} {2 0 2 4} }
Z { {0 6 4 6 0 0 4 0} {1 3 3 3} }
0 { {0 0 0 6 4 6 4 0 0 0} {0 0 4 6} }
1 { {2 0 2 6 0 4} {0 0 4 0} }
2 { {0 6 4 6 4 3 0 3 0 0 4 0} }
3 { {0 6 4 6 4 0 0 0} {0 3 4 3} }
4 { {0 6 0 3 4 3} {4 6 4 0} }
5 { {0 0 4 0 4 3 0 3 0 6 4 6} }
6 { {4 6 0 6 0 0 4 0 4 3 0 3} }
7 { {0 6 4 6 4 0} }
8 { {0 0 0 6 4 6 4 0 0 0} {0 3 4 3} }
9 { {4 0 4 6 0 6 0 3 4 3} }
~ { {0 4 0 5 2 5 2 4 4 4 4 5} }
` { {1 6 3 4} }
! { {2 0 2 1} {2 2 2 6} }
@ { {3 2 3 4 1 4 1 2 3 2 4 1 4 6 0 6 0 0 3 0} }
\# { {1 0 1 6} {3 0 3 6} {0 2 4 2} {0 4 4 4} }
\$ { {0 2 0 1 4 1 4 3 0 3 0 5 4 5 4 4} {2 0 2 6} }
% { {0 6 0 4 2 4 2 6 0 6} {2 0 4 0 4 2 2 2 2 0} {0 0 4 6} }
^ { {0 4 2 6 4 4} }
& { {4 0 1 0 0 1 0 2 3 5 2 6 1 6 0 5 4 0} }
* { {2 0 2 6} {0 3 4 3} {0 1 4 5} {0 5 4 1} }
\( { {4 0 3 0 1 2 1 4 3 6 4 6} }
\) { {0 0 1 0 3 2 3 4 1 6 0 6} }
_ { {0 0 4 0} }
- { {0 3 4 3} }
+ { {0 3 4 3} {2 1 2 5} }
= { {0 2 4 2} {0 4 4 4} }
\[ { {4 0 2 0 2 6 4 6} }
\] { {0 0 2 0 2 6 0 6} }
\{ { {4 0 2 0 2 2 1 3 2 4 2 6 4 6} }
\} { {0 0 2 0 2 2 3 3 2 4 2 6 0 6} }
| { {2 0 2 2} {2 4 2 6} }
\\ { {0 6 4 0} }
: { {2 1 2 2 } {2 4 2 5} }
; { {1 0 2 1 2 2} {2 4 2 5} }
\" { {1 6 1 4} {3 6 3 4} }
' { {2 6 2 4} }
, { {1 0 2 1 2 2} }
. { {2 0 2 1} }
/ { {0 0 4 6} }
? { {2 0 2 1} {2 2 4 4 4 6 0 6 0 4} }
< { {4 6 0 3 4 0} }
> { {0 0 4 3 0 6} }
}
##################################################################
proc DrawLetter {c basecoords letter scale args} {
# Draws a given letter on canvas c, scaling the size of
# the letter according to scale. Returns a list of
# handles of canvas objects (lines) that form the new
# object.
variable fontarray
lassign $basecoords xbase ybase
set retlist {}
foreach coordset $fontarray($letter) {
# Adjust the coordinates by the scale factor.
# Could use ::lexpr from a linalg package.
set coords {}
foreach coord $coordset {
lappend coords [expr {$scale * $coord}]
}
set newcoords {}
# Apply the basecoord offset.
for {set i 0} {$i < [llength $coords]} {incr i} {
set cvalue [lindex $coords $i]
if {$i % 2} {
# Y coordinate
# This is subtracted since the letters are defined
# using paper-based cartesians rather than the
# screen-based flipped Y axis (Z into screen).
lappend newcoords [expr $ybase - $cvalue]
} else {
# X coordinate
lappend newcoords [expr $cvalue + $xbase]
}
}
lappend retlist [$c create line {*}$newcoords -capstyle round {*}$args]
}
return $retlist
}
##################################################################
proc DrawString {c basecoords string scale args} {
# Draws a string at the given basecoords on canvas c
# and at the given scale. Args are passed to the canvas
# line object creation command. Returns a list of all
# canvas object IDs corresponding to the vectors in
# the letters of the string.
lassign $basecoords xbase ybase
set retlist {}
set xcoord $xbase
set ycoord $ybase
for {set i 0} {$i < [string length $string]} {incr i} {
set char [string index $string $i]
switch -exact -- $char {
{ } {
# A space. Just add to the xcoordinate to make
# the space. To make a fixed-width font, make this
# the same as the addition in the default stub.
set xcoord [expr {$xcoord + (4 * $scale)}]
}
\n -
\r {
# A newline!
set xcoord $xbase
set ycoord [expr {$ycoord + (8 * $scale)}]
}
default {
# A character.
set r [DrawLetter $c [list $xcoord $ycoord] $char $scale {*}$args]
lappend retlist {*}$r
set xcoord [expr {$xcoord + (5.5 * $scale)}]
}
}
}
return $retlist
}
}The image at the top was created using the following:
canvas .c -background black -width 800 -height 600
pack .c
VectorFont::DrawString .c {75 50} "A Vector Font" 5.0 -width 5 -fill white
VectorFont::DrawString .c {10 100} "abcdefghijklmnopqrstuvwxyz\nABCDEFGHIJKLMNOPQRSTUVWXYZ\n0123456789\n~`!@\#\$%^&*\(\)_-+\n=\[\]\}\}|\\:;\"',./?<>" 3.2 -fill green -width 2Ro Jan 2011... FANTASTIC. Absolutely amazing. Already dreaming of uses and possibilities... thank you. I added scaling using this code:
bind .c <F3> {.c scale all %x %y 0.9 0.9}
bind .c <F4> {.c scale all %x %y 1.1 1.1}It gives a neat zooming like effect that you can see here: http://www.youtube.com/watch?v=n3sz_KRdRmY
(LWS says that this movie is a blast!)
IDG Jan 2011... Somewhere in the murky past I encoded the Hershey fonts as tcl lists. If anyone is interested, I could probably find them...
LWS - 2011-01-11 18:38:20
Thanks, Ro. IDG: if you're up for it, I'd love to see those Hershey fonts - depending how much data there is, I/we could integrate them into this.
IDG Ok, it's at http://www.sfu.ca/~gay/hershey_tcl.tar.gz
AK - 2011-01-11 21:55:33
See also Rotated Text Font and https://wiki.tcl-lang.org/_repo/hershey/
cptx032 - 2014-09-25 13:12:54
Hi! I made a python version of your code here: http://pastebin.com/MPD6cJMf
RZ - 2015-02-19 08:49:59
To view the original hershey font data look at hershey vector font
KPV 2019-02-18: Here's a simplified version of DrawLetter using lmap
proc DrawLetter {c basecoords letter scale args} {
# Draws a given letter on canvas c, scaling the size of
# the letter according to scale. Returns a list of
# handles of canvas objects (lines) that form the new
# object.
variable fontarray
lassign $basecoords xbase ybase
set retlist {}
foreach coordset $fontarray($letter) {
set xy [lmap {x y} $coordset {
list [expr {$xbase + $x * $scale}] [expr {$ybase - $y * $scale}]}]
lappend retlist [$c create line [concat {*}$xy] -capstyle round {*}$args]
}
return $retlist
}