38 lines
		
	
	
		
			1.2 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			38 lines
		
	
	
		
			1.2 KiB
		
	
	
	
		
			Factor
		
	
	
| ! Copyright (C) 2009 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: tools.test core-text core-text.fonts core-foundation
 | |
| core-foundation.dictionaries destructors arrays kernel generalizations
 | |
| locals math accessors core-foundation.utilities combinators hashtables colors
 | |
| colors.constants ;
 | |
| IN: core-text.tests
 | |
| 
 | |
| : test-font ( name -- font )
 | |
|     [ >cf &CFRelease 0.0 f CTFontCreateWithName ] with-destructors ;
 | |
| 
 | |
| { } [ "Helvetica" test-font CFRelease ] unit-test
 | |
| 
 | |
| { } [
 | |
|     [
 | |
|         kCTFontAttributeName "Helvetica" test-font &CFRelease 2array 1array
 | |
|         <CFDictionary> &CFRelease drop
 | |
|     ] with-destructors
 | |
| ] unit-test
 | |
| 
 | |
| :: test-typographic-bounds ( string font -- ? )
 | |
|     [
 | |
|         font test-font &CFRelease :> ctfont
 | |
|         string ctfont COLOR: white <CTLine> &CFRelease :> ctline
 | |
|         ctfont ctline compute-line-metrics {
 | |
|             [ width>> float? ]
 | |
|             [ ascent>> float? ]
 | |
|             [ descent>> float? ]
 | |
|             [ leading>> float? ]
 | |
|         } cleave and and and
 | |
|     ] with-destructors ;
 | |
| 
 | |
| { t } [ "Hello world" "Helvetica" test-typographic-bounds ] unit-test
 | |
| 
 | |
| { t } [ "Hello world" "Chicago" test-typographic-bounds ] unit-test
 | |
| 
 | |
| { t } [ "日本語" "Helvetica" test-typographic-bounds ] unit-test
 |