Vector Font

http://www.ece.ualberta.ca/~wyard/wiki.tcl.tk/vectorfont.jpg

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 2

Ro 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
    }