OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [winFont.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test out the procedures in tkWinFont.c.
2 
# It is organized in the standard fashion for Tcl tests.
3 
#
4 
# Many of these tests are visually oriented and cannot be checked
5 
# programmatically (such as "does an underlined font appear to be
6 
# underlined?"); these tests attempt to exercise the code in question,
7 
# but there are no results that can be checked.
8 
#
9 
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
10 
#
11 
# See the file "license.terms" for information on usage and redistribution
12 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 
#
14 
# RCS: @(#) $Id: winFont.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
15 
 
16 
if {$tcl_platform(platform)!="windows"} {
17 
    return
18 
}
19 
 
20 
if {[string compare test [info procs test]] != 0} {
21 
    source defs
22 
}
23 
 
24 
catch {destroy .b}
25 
catch {font delete xyz}
26 
 
27 
toplevel .b
28 
update idletasks
29 
 
30 
set courier {Courier 14}
31 
set cx [font measure $courier 0]
32 
 
33 
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed
34 
pack .b.l
35 
canvas .b.c -closeenough 0
36 
 
37 
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
38 
pack .b.c
39 
update
40 
 
41 
set ax [winfo reqwidth .b.l]
42 
set ay [winfo reqheight .b.l]
43 
proc getsize {} {
44 
    update
45 
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
46 
}
47 
 
48 
test winfont-1.1 {TkpGetNativeFont procedure: not native} {
49 
    list [catch {font measure {} xyz} msg] $msg
50 
} {1 {font "" doesn't exist}}
51 
test winfont-1.2 {TkpGetNativeFont procedure: native} {
52 
    font measure ansifixed 0
53 
    font measure ansi 0
54 
    font measure device 0
55 
    font measure oemfixed 0
56 
    font measure systemfixed 0
57 
    font measure system 0
58 
    set x {}
59 
} {}
60 
 
61 
test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
62 
    expr [font actual {-size -10} -size]>0
63 
} {1}
64 
test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
65 
    expr [font actual {-family Arial} -size]>0
66 
} {1}
67 
test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
68 
    font actual {-weight normal} -weight
69 
} {normal}
70 
test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
71 
    font actual {-weight bold} -weight
72 
} {bold}
73 
test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
74 
    catch {expr {[font actual {-size 10} -size]}}
75 
} 0
76 
test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
77 
    font actual {-family Arial} -family
78 
} {Arial}
79 
test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
80 
    set x {}
81 
    lappend x [font actual {-family "Times"} -family]
82 
    lappend x [font actual {-family "New York"} -family]
83 
    lappend x [font actual {-family "Times New Roman"} -family]
84 
} {{Times New Roman} {Times New Roman} {Times New Roman}}
85 
test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {
86 
    set x {}
87 
    lappend x [font actual {-family "Courier"} -family]
88 
    lappend x [font actual {-family "Monaco"} -family]
89 
    lappend x [font actual {-family "Courier New"} -family]
90 
} {{Courier New} {Courier New} {Courier New}}
91 
test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
92 
    set x {}
93 
    lappend x [font actual {-family "Helvetica"} -family]
94 
    lappend x [font actual {-family "Geneva"} -family]
95 
    lappend x [font actual {-family "Arial"} -family]
96 
} {Arial Arial Arial}
97 
test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {
98 
    # No way to get it to fail! Any font name is acceptable.
99 
} {}
100 
 
101 
test winfont-3.1 {TkpDeleteFont procedure} {
102 
    font actual {-family xyz}
103 
    set x {}
104 
} {}
105 
 
106 
test winfont-4.1 {TkpGetFontFamilies procedure} {
107 
    font families
108 
    set x {}
109 
} {}
110 
 
111 
test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
112 
    .b.l config -wrap 0 -text "000000"
113 
    getsize
114 
} "[expr $ax*6] $ay"
115 
test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
116 
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
117 
    getsize
118 
} "[expr $ax*256] $ay"
119 
test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
120 
    .b.l config -wrap [expr $ax*10] -text "00000000"
121 
    getsize
122 
} "[expr $ax*8] $ay"
123 
test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
124 
    .b.l config -wrap [expr $ax*6] -text "00000000"
125 
    getsize
126 
} "[expr $ax*6] [expr $ay*2]"
127 
test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {
128 
    .b.c dchars $t 0 end
129 
    .b.c insert $t 0 "0000"
130 
    .b.c index $t @[expr int($cx*2.5)],1
131 
} {2}
132 
test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {
133 
    .b.l config -text "000000" -wrap 1
134 
    getsize
135 
} "$ax [expr $ay*6]"
136 
test winfont-5.7 {Tk_MeasureChars procedure: whole words} {
137 
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
138 
    getsize
139 
} "[expr $ax*6] [expr $ay*2]"
140 
test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {
141 
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
142 
    getsize
143 
} "[expr $ax*7] [expr $ay*2]"
144 
test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {
145 
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
146 
    getsize
147 
} "[expr $ax*7] [expr $ay*2]"
148 
test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
149 
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
150 
    getsize
151 
} "[expr $ax*12] [expr $ay*2]"
152 
test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} {
153 
    set font [.b.l cget -font]
154 
    .b.l config -font {{MS Sans Serif} 8} -text "W"
155 
    set width [winfo reqwidth .b.l]
156 
    .b.l config -text "XaYoYaKaWx"
157 
    set x [lindex [getsize] 0]
158 
    .b.l config -font $font
159 
    expr $x < ($width*10)
160 
} 1
161 
test winfont-6.1 {Tk_DrawChars procedure: loop test} {
162 
    .b.l config -text "a"
163 
    update
164 
} {}
165 
 
166 
test winfont-7.1 {AllocFont procedure: use old font} {
167 
    font create xyz
168 
    catch {destroy .c}
169 
    button .c -font xyz
170 
    font configure xyz -family times
171 
    update
172 
    destroy .c
173 
    font delete xyz
174 
} {}
175 
test winfont-7.2 {AllocFont procedure: extract info from logfont} {
176 
    font actual {arial 10 bold italic underline overstrike}
177 
} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
178 
test winfont-7.3 {AllocFont procedure: extract info from textmetric} {
179 
    font metric {arial 10 bold italic underline overstrike} -fixed
180 
} {0}
181 
test winfont-7.4 {AllocFont procedure: extract info from textmetric} {
182 
    font metric systemfixed -fixed
183 
} {1}
184 
 
185 
destroy .b

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.