# This file is a Tcl script to test out the procedures in tkMacFont.c.
|
# This file is a Tcl script to test out the procedures in tkMacFont.c.
|
# It is organized in the standard fashion for Tcl tests.
|
# It is organized in the standard fashion for Tcl tests.
|
#
|
#
|
# Some of these tests are visually oriented and cannot be checked
|
# Some of these tests are visually oriented and cannot be checked
|
# programmatically (such as "does an underlined font appear to be
|
# programmatically (such as "does an underlined font appear to be
|
# underlined?"); these tests attempt to exercise the code in question,
|
# underlined?"); these tests attempt to exercise the code in question,
|
# but there are no results that can be checked.
|
# but there are no results that can be checked.
|
#
|
#
|
# Copyright (c) 1996 Sun Microsystems, Inc.
|
# Copyright (c) 1996 Sun Microsystems, Inc.
|
#
|
#
|
# See the file "license.terms" for information on usage and redistribution
|
# See the file "license.terms" for information on usage and redistribution
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
#
|
#
|
# RCS: @(#) $Id: macFont.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
|
# RCS: @(#) $Id: macFont.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
|
|
|
if {$tcl_platform(platform)!="macintosh"} {
|
if {$tcl_platform(platform)!="macintosh"} {
|
return
|
return
|
}
|
}
|
|
|
if {[string compare test [info procs test]] != 0} {
|
if {[string compare test [info procs test]] != 0} {
|
source defs
|
source defs
|
}
|
}
|
|
|
catch {destroy .b}
|
catch {destroy .b}
|
toplevel .b
|
toplevel .b
|
update idletasks
|
update idletasks
|
|
|
set courier {Courier 10}
|
set courier {Courier 10}
|
set cx [font measure $courier 0]
|
set cx [font measure $courier 0]
|
|
|
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
|
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
|
pack .b.l
|
pack .b.l
|
canvas .b.c -closeenough 0
|
canvas .b.c -closeenough 0
|
|
|
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
|
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
|
pack .b.c
|
pack .b.c
|
update
|
update
|
|
|
set ax [winfo reqwidth .b.l]
|
set ax [winfo reqwidth .b.l]
|
set ay [winfo reqheight .b.l]
|
set ay [winfo reqheight .b.l]
|
proc getsize {} {
|
proc getsize {} {
|
update
|
update
|
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
|
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
|
}
|
}
|
|
|
test macfont-1.1 {TkpGetNativeFont procedure: not native} {
|
test macfont-1.1 {TkpGetNativeFont procedure: not native} {
|
list [catch {font measure {} xyz} msg] $msg
|
list [catch {font measure {} xyz} msg] $msg
|
} {1 {font "" doesn't exist}}
|
} {1 {font "" doesn't exist}}
|
test macfont-1.2 {TkpGetNativeFont procedure: native} {
|
test macfont-1.2 {TkpGetNativeFont procedure: native} {
|
font measure system "0"
|
font measure system "0"
|
font measure application "0"
|
font measure application "0"
|
set x {}
|
set x {}
|
} {}
|
} {}
|
|
|
test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
|
test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
|
font actual {-underline 1} -family
|
font actual {-underline 1} -family
|
} [font actual system -family]
|
} [font actual system -family]
|
test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
|
test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
|
set x "12345678901234567890123456789012345678901234567890"
|
set x "12345678901234567890123456789012345678901234567890"
|
set x "$x$x$x$x$x$x"
|
set x "$x$x$x$x$x$x"
|
font actual "-family $x" -family
|
font actual "-family $x" -family
|
} [font actual system -family]
|
} [font actual system -family]
|
test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
|
test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
|
font actual {-family Courier} -family
|
font actual {-family Courier} -family
|
} {Courier}
|
} {Courier}
|
test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
|
test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
|
set x {}
|
set x {}
|
lappend x [font actual {-family "Times"} -family]
|
lappend x [font actual {-family "Times"} -family]
|
lappend x [font actual {-family "Times New Roman"} -family]
|
lappend x [font actual {-family "Times New Roman"} -family]
|
} {Times Times}
|
} {Times Times}
|
test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
|
test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
|
set x {}
|
set x {}
|
lappend x [font actual {-family "Courier"} -family]
|
lappend x [font actual {-family "Courier"} -family]
|
lappend x [font actual {-family "Courier New"} -family]
|
lappend x [font actual {-family "Courier New"} -family]
|
} {Courier Courier}
|
} {Courier Courier}
|
test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
|
test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
|
set x {}
|
set x {}
|
lappend x [font actual {-family "Geneva"} -family]
|
lappend x [font actual {-family "Geneva"} -family]
|
lappend x [font actual {-family "Helvetica"} -family]
|
lappend x [font actual {-family "Helvetica"} -family]
|
lappend x [font actual {-family "Arial"} -family]
|
lappend x [font actual {-family "Arial"} -family]
|
} {Geneva Helvetica Helvetica}
|
} {Geneva Helvetica Helvetica}
|
test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-weight normal} -weight
|
font actual {-weight normal} -weight
|
} {normal}
|
} {normal}
|
test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-weight bold} -weight
|
font actual {-weight bold} -weight
|
} {bold}
|
} {bold}
|
test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-slant roman} -slant
|
font actual {-slant roman} -slant
|
} {roman}
|
} {roman}
|
test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-slant italic} -slant
|
font actual {-slant italic} -slant
|
} {italic}
|
} {italic}
|
test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-underline false} -underline
|
font actual {-underline false} -underline
|
} {0}
|
} {0}
|
test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-underline true} -underline
|
font actual {-underline true} -underline
|
} {1}
|
} {1}
|
test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-overstrike false} -overstrike
|
font actual {-overstrike false} -overstrike
|
} {0}
|
} {0}
|
test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
|
test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
|
font actual {-overstrike true} -overstrike
|
font actual {-overstrike true} -overstrike
|
} {0}
|
} {0}
|
|
|
test macfont-3.1 {TkpDeleteFont procedure} {
|
test macfont-3.1 {TkpDeleteFont procedure} {
|
font actual {-family xyz}
|
font actual {-family xyz}
|
set x {}
|
set x {}
|
} {}
|
} {}
|
|
|
test macfont-4.1 {TkpGetFontFamilies procedure} {
|
test macfont-4.1 {TkpGetFontFamilies procedure} {
|
font families
|
font families
|
set x {}
|
set x {}
|
} {}
|
} {}
|
|
|
test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
|
test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
|
.b.l config -wrap 0 -text "000000"
|
.b.l config -wrap 0 -text "000000"
|
getsize
|
getsize
|
} "[expr $ax*6] $ay"
|
} "[expr $ax*6] $ay"
|
test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
|
test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
|
.b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
|
.b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
|
getsize
|
getsize
|
} "[expr $ax*256] $ay"
|
} "[expr $ax*256] $ay"
|
test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
|
test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
|
.b.l config -wrap [expr $ax*10] -text "00000000"
|
.b.l config -wrap [expr $ax*10] -text "00000000"
|
getsize
|
getsize
|
} "[expr $ax*8] $ay"
|
} "[expr $ax*8] $ay"
|
test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
|
test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
|
.b.l config -wrap [expr $ax*6] -text "00000000"
|
.b.l config -wrap [expr $ax*6] -text "00000000"
|
getsize
|
getsize
|
} "[expr $ax*6] [expr $ay*2]"
|
} "[expr $ax*6] [expr $ay*2]"
|
test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
|
test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
|
.b.l config -wrap [expr $ax*12] -text "000000 0000000"
|
.b.l config -wrap [expr $ax*12] -text "000000 0000000"
|
getsize
|
getsize
|
} "[expr $ax*7] [expr $ay*2]"
|
} "[expr $ax*7] [expr $ay*2]"
|
test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
|
test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
|
.b.l config -wrap [expr $ax*12] -text "000 00 00000"
|
.b.l config -wrap [expr $ax*12] -text "000 00 00000"
|
getsize
|
getsize
|
} "[expr $ax*7] [expr $ay*2]"
|
} "[expr $ax*7] [expr $ay*2]"
|
test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
|
test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
|
.b.c dchars $t 0 end
|
.b.c dchars $t 0 end
|
.b.c insert $t 0 "0000"
|
.b.c insert $t 0 "0000"
|
.b.c index $t @[expr int($ax*2.5)],1
|
.b.c index $t @[expr int($ax*2.5)],1
|
} {2}
|
} {2}
|
test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} {
|
test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} {
|
.b.l config -text "000000" -wrap 1
|
.b.l config -text "000000" -wrap 1
|
getsize
|
getsize
|
} "$ax [expr $ay*6]"
|
} "$ax [expr $ay*6]"
|
test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
|
test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
|
.b.l config -wrap [expr $ax*8] -text "000000 0000"
|
.b.l config -wrap [expr $ax*8] -text "000000 0000"
|
getsize
|
getsize
|
} "[expr $ax*6] [expr $ay*2]"
|
} "[expr $ax*6] [expr $ay*2]"
|
test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
|
test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
|
.b.l config -wrap [expr $ax*12] -text "0000000000000000"
|
.b.l config -wrap [expr $ax*12] -text "0000000000000000"
|
getsize
|
getsize
|
} "[expr $ax*12] [expr $ay*2]"
|
} "[expr $ax*12] [expr $ay*2]"
|
|
|
test macfont-6.1 {Tk_DrawChars procedure} {
|
test macfont-6.1 {Tk_DrawChars procedure} {
|
.b.l config -text "a"
|
.b.l config -text "a"
|
update
|
update
|
} {}
|
} {}
|
|
|
test macfont-7.1 {AllocMacFont procedure: use old font} {
|
test macfont-7.1 {AllocMacFont procedure: use old font} {
|
font create xyz
|
font create xyz
|
button .c -font xyz
|
button .c -font xyz
|
font configure xyz -family times
|
font configure xyz -family times
|
update
|
update
|
destroy .c
|
destroy .c
|
font delete xyz
|
font delete xyz
|
} {}
|
} {}
|
test macfont-7.2 {AllocMacFont procedure: extract info from style} {
|
test macfont-7.2 {AllocMacFont procedure: extract info from style} {
|
font actual {Monaco 9 bold italic underline overstrike}
|
font actual {Monaco 9 bold italic underline overstrike}
|
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
|
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
|
test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
|
test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
|
font metric {Geneva 10} -fixed
|
font metric {Geneva 10} -fixed
|
} {0}
|
} {0}
|
test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
|
test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
|
font metric "Monaco 9" -fixed
|
font metric "Monaco 9" -fixed
|
} {1}
|
} {1}
|
|
|
destroy .b
|
destroy .b
|
|
|
