백터 폰트 출력 예제

아래는 캔버스 위젯에 백터 폰트를 출력하는 코드입니다. 간단한 캐드 프로그램을 만들때 요긴하게 쓰일겁니다.

# 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." { {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
    }
}

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

아래는 다른 벡터 폰트 출력 코드입니다. 참고하세요.

hershey_tcl.tar.gz

0.42MB