From e6e831c57707289ce2d96ea4104a392684095fe1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 19 Jan 2009 22:58:09 -0600
Subject: [PATCH] Add font and line cache to core text binding

---
 basis/core-text/core-text.factor | 39 ++++++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 5 deletions(-)

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index f71169c645..309decf4aa 100644
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays alien alien.c-types alien.syntax kernel destructors
-parser accessors fry words hashtables sequences math math.functions locals
+USING: arrays alien alien.c-types alien.syntax kernel destructors words
+parser accessors fry words hashtables sequences memoize
+assocs math math.functions locals init
 core-foundation core-foundation.strings
 core-foundation.attributed-strings
 core-graphics core-graphics.types ;
@@ -21,6 +22,8 @@ FUNCTION: CTFontRef CTFontCreateWithName (
         [ <CFString> &CFRelease ] dip f CTFontCreateWithName
     ] with-destructors ;
 
+MEMO: cached-font ( name size -- font ) <CTFont> ;
+
 <<
 
 : C-GLOBAL:
@@ -64,7 +67,7 @@ TUPLE: typographic-bounds width ascent descent leading ;
     [ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@
     typographic-bounds boa ;
 
-TUPLE: line string font line bounds dim bitmap disposed ;
+TUPLE: line string font line bounds dim bitmap age disposed ;
 
 : bounds>dim ( bounds -- dim )
     [ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi
@@ -81,11 +84,37 @@ TUPLE: line string font line bounds dim bitmap disposed ;
         2dup <CTLine> |CFRelease
         dup line-typographic-bounds
         dup bounds>dim 3dup [ draw-line ] with-bitmap-context
-        f line boa
+        0 f line boa
     ] with-destructors ;
 
 M: line dispose*
     [
         [ font>> &CFRelease drop ]
         [ line>> &CFRelease drop ] bi
-    ] with-destructors ;
\ No newline at end of file
+    ] with-destructors ;
+
+<PRIVATE
+
+MEMO: (cached-line) ( string font -- line ) <line> ;
+
+: cached-lines ( -- assoc )
+    \ (cached-line) "memoize" word-prop ;
+
+: set-cached-lines ( assoc -- )
+    \ (cached-line) "memoize" set-word-prop ;
+
+CONSTANT: max-line-age 5
+
+PRIVATE>
+
+: age-lines ( -- )
+    cached-lines
+    [ nip [ 1+ ] change-age age>> max-line-age <= ] assoc-filter
+    set-cached-lines ;
+
+: cached-line ( string font -- line ) (cached-line) 0 >>age ;
+
+[
+    \ cached-font reset-memoized
+    \ (cached-line) reset-memoized
+] "core-text" add-init-hook
\ No newline at end of file