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