아래는 캔버스 위젯에 백터 폰트를 출력하는 코드입니다. 간단한 캐드 프로그램을 만들때 요긴하게 쓰일겁니다.
# 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
아래는 다른 벡터 폰트 출력 코드입니다. 참고하세요.
'Tcl & Tk > 팁 (Tip)' 카테고리의 다른 글
Multi-Threaded use of Tcl Interpreters (0) | 2025.03.20 |
---|---|
TCP 포트 스캔 구현 (0) | 2025.03.20 |
Tcl의 인코딩에 대하여 (0) | 2025.03.19 |
윈도우 always on top 구현 (0) | 2025.03.17 |
Jacl을 이용한 SWT 간단 예제 (0) | 2025.03.17 |