1# 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# Copyright (c) 1998-1999 by Scriptics Corporation.
11# All rights reserved.
12#
13# RCS: @(#) $Id: macFont.test,v 1.6 2002/07/14 05:48:46 dgp Exp $
14
15package require tcltest 2.1
16namespace import -force tcltest::configure
17namespace import -force tcltest::testsDirectory
18configure -testdir [file join [pwd] [file dirname [info script]]]
19configure -loadfile [file join [testsDirectory] constraints.tcl]
20tcltest::loadTestedCommands
21
22catch {destroy .b}
23toplevel .b
24update idletasks
25
26set courier {Courier 12}
27set cx [font measure $courier 0]
28
29set fixed {Monaco 12}
30label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed
31pack .b.l
32canvas .b.c -closeenough 0
33
34set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
35pack .b.c
36update
37
38set ax [winfo reqwidth .b.l]
39set ay [winfo reqheight .b.l]
40proc getsize {} {
41    update
42    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
43}
44
45testConstraint gothic 0
46set gothic {gothic 12}
47set mx [font measure  $gothic \u4e4e]
48if {[font actual $gothic -family] != [font actual system -family]} {
49    testConstraint gothic 1
50}
51
52test macFont-1.1 {TkpFontPkgInit} {macOnly} {
53} {}
54
55test macfont-2.1 {TkpGetNativeFont: not native} {macOnly} {
56    list [catch {font measure {} xyz} msg] $msg
57} {1 {font "" doesn't exist}}
58test macFont-2.2 {TkpGetNativeFont: native} {macOnly} {
59    font measure system "0"
60    font measure application "0"
61    set x {}
62} {}
63
64test macFont-3.1 {TkpGetFontFromAttributes: no family} {macOnly} {
65    font actual {-underline 1} -family
66} [font actual system -family]
67test macFont-3.2 {TkpGetFontFromAttributes: long family name} {macOnly} {
68    set x "12345678901234567890123456789012345678901234567890"
69    set x "$x$x$x$x$x$x"
70    font actual "-family $x" -family
71} [font actual system -family]
72test macFont-3.3 {TkpGetFontFromAttributes: family} {macOnly} {
73    font actual {-family Courier} -family
74} {Courier}
75test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {macOnly} {
76    set x {}
77    lappend x [font actual {-family "Times"} -family]
78    lappend x [font actual {-family "Times New Roman"} -family]
79} {Times Times}
80test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {macOnly} {
81    set x {}
82    lappend x [font actual {-family "Courier"} -family]
83    lappend x [font actual {-family "Courier New"} -family]
84} {Courier Courier}
85test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {macOnly} {
86    set x {}
87    lappend x [font actual {-family "Geneva"} -family]
88    lappend x [font actual {-family "Helvetica"} -family]
89    lappend x [font actual {-family "Arial"} -family]
90} {Geneva Helvetica Helvetica}
91test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {macOnly} {
92    font actual {arial 10} -family
93} {Helvetica}    
94test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {macOnly} {
95    font actual {{ms sans serif} 10} -family
96} {Chicago}
97test macFont-3.9 {TkpGetFontFromAttributes: styles} {macOnly} {
98    font actual {-weight normal} -weight
99} {normal}
100test macFont-3.10 {TkpGetFontFromAttributes: styles} {macOnly} {
101    font actual {-weight bold} -weight
102} {bold}
103test macFont-3.11 {TkpGetFontFromAttributes: styles} {macOnly} {
104    font actual {-slant roman} -slant
105} {roman}
106test macFont-3.12 {TkpGetFontFromAttributes: styles} {macOnly} {
107    font actual {-slant italic} -slant
108} {italic}
109test macFont-3.13 {TkpGetFontFromAttributes: styles} {macOnly} {
110    font actual {-underline false} -underline
111} {0}
112test macFont-3.14 {TkpGetFontFromAttributes: styles} {macOnly} {
113    font actual {-underline true} -underline
114} {1}
115test macFont-3.15 {TkpGetFontFromAttributes: styles} {macOnly} {
116    font actual {-overstrike false} -overstrike
117} {0}
118test macFont-3.16 {TkpGetFontFromAttributes: styles} {macOnly} {
119    font actual {-overstrike true} -overstrike
120} {0}
121
122test macFont-4.1 {TkpDeleteFont} {macOnly} {
123    font actual {-family xyz}
124    set x {}
125} {}
126
127test macFont-5.1 {TkpGetFontFamilies} {macOnly} {
128    expr {[lsearch [font families] Geneva] > 0}
129} {1}
130
131test macFont-6.1 {TkpGetSubFonts} {testfont gothic macOnly} {
132    .b.l config -text "abc\u4e4e" 
133    update
134    set x [testfont subfonts $fixed]
135} "Monaco [font actual $gothic -family]"    
136
137test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {macOnly} {
138    .b.l config -wrap 0 -text "000000"
139    getsize
140} "[expr $ax*6] $ay"
141test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {macOnly} {
142    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
143    getsize
144} "[expr $ax*256] $ay"
145test macFont-7.3 {Tk_MeasureChars: all chars did fit} {macOnly} {
146    .b.l config -wrap [expr $ax*10] -text "00000000"
147    getsize
148} "[expr $ax*8] $ay"
149test macFont-7.4 {Tk_MeasureChars: not all chars fit} {macOnly} {
150    .b.l config -wrap [expr $ax*6] -text "00000000"
151    getsize
152} "[expr $ax*6] [expr $ay*2]"
153test macFont-7.5 {Tk_MeasureChars: already saw space in line} {macOnly} {
154    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
155    getsize
156} "[expr $ax*7] [expr $ay*2]"
157test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {macOnly} {
158    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
159    getsize
160} "[expr $ax*7] [expr $ay*2]"
161test macFont-7.7 {Tk_MeasureChars: include last partial char} {macOnly} {
162    .b.c dchars $t 0 end
163    .b.c insert $t 0 "0000"
164    .b.c index $t @[expr int($ax*2.5)],1
165} {2}
166test macFont-7.8 {Tk_MeasureChars: at least one char on line} { macOnly} {
167    .b.l config -text "000000" -wrap 1
168    getsize
169} "$ax [expr $ay*6]"
170test macFont-7.9 {Tk_MeasureChars: whole words} {macOnly} {
171    .b.l config -wrap [expr $ax*8] -text "000000 0000"
172    getsize
173} "[expr $ax*6] [expr $ay*2]"
174test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {macOnly} {
175    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
176    getsize
177} "[expr $ax*12] [expr $ay*2]"
178test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {macOnly} {
179    font measure system {}
180} {0}
181test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {macOnly} {
182    font measure $courier abcd
183} "[expr $cx*4]"
184test macFont-7.13 {Tk_MeasureChars: loop on each char} {macOnly} {
185    font measure $courier abcd
186} "[expr $cx*4]"
187test macFont-7.14 {Tk_MeasureChars: p == end} {macOnly} {
188    font measure $courier abcd
189} "[expr $cx*4]"
190test macFont-7.15 {Tk_MeasureChars: p > end} {macOnly} {
191    font measure $courier abc\xc2
192} "[expr $cx*4]"
193test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
194    font measure $courier abc\u4e4edef
195} [expr $cx*6+$mx]
196test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
197    font measure $courier \u4e4edef
198} [expr $mx+$cx*3]
199test macFont-7.18 {Tk_MeasureChars: final measure} {gothic macOnly} {
200    font measure $courier \u4e4edef
201} [expr $mx+$cx*3]
202test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
203    font measure $courier \u4e4e
204} [expr $mx]
205test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {macOnly} {
206    .b.l config -wrap [expr $ax*8] -text "000"
207    getsize
208} "[expr $ax*3] $ay"
209test macFont-7.21 {Tk_MeasureChars: loop on each char} {macOnly} {
210    .b.l config -wrap [expr $ax*8] -text "000"
211    getsize
212} "[expr $ax*3] $ay"
213test macFont-7.22 {Tk_MeasureChars: p == end} {macOnly} {
214    .b.l config -wrap [expr $ax*8] -text "000"
215    getsize
216} "[expr $ax*3] $ay"
217test macFont-7.23 {Tk_MeasureChars: p > end} {macOnly} {
218    .b.l config -wrap [expr $ax*8] -text "00\xc2"
219    getsize
220} "[expr $ax*3] $ay"
221test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} {
222    .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
223    getsize
224} "[expr $ax*4+$mx] $ay"
225test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} {
226    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
227    getsize
228} "[expr $mx+$ax*2] $ay"
229test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic macOnly} {
230    .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
231    getsize
232} "[expr $ax*8+$mx*2] $ay"
233test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic macOnly} {
234    .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
235    getsize
236} "[expr $ax*5] [expr $ay*3]"
237test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic macOnly} {
238    # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.  
239    .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
240    getsize
241} "[expr $ax*6+$mx] [expr $ay*3]"
242test macFont-7.29 {Tk_MeasureChars: final measure} {gothic macOnly} {
243    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
244    getsize
245} "[expr $mx+$ax*2] $ay"
246test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} {
247    .b.l config -wrap [expr $ax*8] -text "\u4e4e"
248    getsize
249} "$mx $ay"
250test macFont-7.31 {Tk_MeasureChars: rest == NULL} {macOnly} {
251    .b.l config -wrap [expr $ax*1000] -text 0000
252    getsize
253} "[expr $ax*4] $ay"
254test macFont-7.32 {Tk_MeasureChars: rest != NULL} {macOnly} {
255    .b.l config -wrap [expr $ax*6] -text "00000000"
256    getsize
257} "[expr $ax*6] [expr $ay*2]"
258
259test macFont-8.1 {Tk_DrawChars procedure} {macOnly} {
260    .b.l config -text "a"
261    update
262} {}
263
264test macFont-9.1 {AllocMacFont: use old font} {macOnly} {
265    font create xyz
266    button .c -font xyz
267    font configure xyz -family times
268    update
269    destroy .c
270    font delete xyz
271} {}
272test macFont-9.2 {AllocMacFont: extract info from style} {macOnly} {
273    font actual {Monaco 9 bold italic underline overstrike}
274} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
275test macFont-9.3 {AllocMacFont: extract text metrics} {macOnly} {
276    font metric {Geneva 10} -fixed
277} {0}
278test macFont-9.4 {AllocMacFont: extract text metrics} {macOnly} {
279    font metric "Monaco 9" -fixed
280} {1}
281
282destroy .b
283
284# cleanup
285::tcltest::cleanupTests
286return
287