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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [macFont.test] - Blame information for rev 1779

Go to most recent revision | 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 tkMacFont.c.
2 
# It is organized in the standard fashion for Tcl tests.
3 
#
4 
# Some 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 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: macFont.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
15 
 
16 
if {$tcl_platform(platform)!="macintosh"} {
17 
    return
18 
}
19 
 
20 
if {[string compare test [info procs test]] != 0} {
21 
    source defs
22 
}
23 
 
24 
catch {destroy .b}
25 
toplevel .b
26 
update idletasks
27 
 
28 
set courier {Courier 10}
29 
set cx [font measure $courier 0]
30 
 
31 
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
32 
pack .b.l
33 
canvas .b.c -closeenough 0
34 
 
35 
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
36 
pack .b.c
37 
update
38 
 
39 
set ax [winfo reqwidth .b.l]
40 
set ay [winfo reqheight .b.l]
41 
proc getsize {} {
42 
    update
43 
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
44 
}
45 
 
46 
test macfont-1.1 {TkpGetNativeFont procedure: not native} {
47 
    list [catch {font measure {} xyz} msg] $msg
48 
} {1 {font "" doesn't exist}}
49 
test macfont-1.2 {TkpGetNativeFont procedure: native} {
50 
    font measure system "0"
51 
    font measure application "0"
52 
    set x {}
53 
} {}
54 
 
55 
test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
56 
    font actual {-underline 1} -family
57 
} [font actual system -family]
58 
test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
59 
    set x "12345678901234567890123456789012345678901234567890"
60 
    set x "$x$x$x$x$x$x"
61 
    font actual "-family $x" -family
62 
} [font actual system -family]
63 
test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
64 
    font actual {-family Courier} -family
65 
} {Courier}
66 
test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
67 
    set x {}
68 
    lappend x [font actual {-family "Times"} -family]
69 
    lappend x [font actual {-family "Times New Roman"} -family]
70 
} {Times Times}
71 
test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
72 
    set x {}
73 
    lappend x [font actual {-family "Courier"} -family]
74 
    lappend x [font actual {-family "Courier New"} -family]
75 
} {Courier Courier}
76 
test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
77 
    set x {}
78 
    lappend x [font actual {-family "Geneva"} -family]
79 
    lappend x [font actual {-family "Helvetica"} -family]
80 
    lappend x [font actual {-family "Arial"} -family]
81 
} {Geneva Helvetica Helvetica}
82 
test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
83 
    font actual {-weight normal} -weight
84 
} {normal}
85 
test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
86 
    font actual {-weight bold} -weight
87 
} {bold}
88 
test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
89 
    font actual {-slant roman} -slant
90 
} {roman}
91 
test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
92 
    font actual {-slant italic} -slant
93 
} {italic}
94 
test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
95 
    font actual {-underline false} -underline
96 
} {0}
97 
test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
98 
    font actual {-underline true} -underline
99 
} {1}
100 
test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
101 
    font actual {-overstrike false} -overstrike
102 
} {0}
103 
test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
104 
    font actual {-overstrike true} -overstrike
105 
} {0}
106 
 
107 
test macfont-3.1 {TkpDeleteFont procedure} {
108 
    font actual {-family xyz}
109 
    set x {}
110 
} {}
111 
 
112 
test macfont-4.1 {TkpGetFontFamilies procedure} {
113 
    font families
114 
    set x {}
115 
} {}
116 
 
117 
test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
118 
    .b.l config -wrap 0 -text "000000"
119 
    getsize
120 
} "[expr $ax*6] $ay"
121 
test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
122 
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
123 
    getsize
124 
} "[expr $ax*256] $ay"
125 
test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
126 
    .b.l config -wrap [expr $ax*10] -text "00000000"
127 
    getsize
128 
} "[expr $ax*8] $ay"
129 
test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
130 
    .b.l config -wrap [expr $ax*6] -text "00000000"
131 
    getsize
132 
} "[expr $ax*6] [expr $ay*2]"
133 
test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
134 
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
135 
    getsize
136 
} "[expr $ax*7] [expr $ay*2]"
137 
test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
138 
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
139 
    getsize
140 
} "[expr $ax*7] [expr $ay*2]"
141 
test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
142 
    .b.c dchars $t 0 end
143 
    .b.c insert $t 0 "0000"
144 
    .b.c index $t @[expr int($ax*2.5)],1
145 
} {2}
146 
test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} {
147 
    .b.l config -text "000000" -wrap 1
148 
    getsize
149 
} "$ax [expr $ay*6]"
150 
test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
151 
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
152 
    getsize
153 
} "[expr $ax*6] [expr $ay*2]"
154 
test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
155 
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
156 
    getsize
157 
} "[expr $ax*12] [expr $ay*2]"
158 
 
159 
test macfont-6.1 {Tk_DrawChars procedure} {
160 
    .b.l config -text "a"
161 
    update
162 
} {}
163 
 
164 
test macfont-7.1 {AllocMacFont procedure: use old font} {
165 
    font create xyz
166 
    button .c -font xyz
167 
    font configure xyz -family times
168 
    update
169 
    destroy .c
170 
    font delete xyz
171 
} {}
172 
test macfont-7.2 {AllocMacFont procedure: extract info from style} {
173 
    font actual {Monaco 9 bold italic underline overstrike}
174 
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
175 
test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
176 
    font metric {Geneva 10} -fixed
177 
} {0}
178 
test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
179 
    font metric "Monaco 9" -fixed
180 
} {1}
181 
 
182 
destroy .b

powered by: WebSVN 2.1.0

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