basis/ui/text/core-text/core-text.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs accessors alien core-graphics.types core-text
   4 core-text.fonts kernel hashtables namespaces sequences
   5 ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl destructors
   6 combinators core-foundation core-foundation.strings memoize math
   7 math.vectors init colors ;
   8 IN: ui.text.core-text
   9
  10 SINGLETON: core-text-renderer
  11
  12 M: core-text-renderer string-dim
  13     [ " " string-dim { 0 1 } v* ] [ swap cached-line dim>> ] if-empty ;
  14
  15 TUPLE: rendered-line line texture display-list age disposed ;
  16
  17 : make-line-display-list ( line texture -- dlist )
  18     GL_COMPILE [
  19         GL_TEXTURE_2D [
  20             GL_TEXTURE_BIT [
  21                 GL_TEXTURE_COORD_ARRAY [
  22                     white gl-color
  23                     GL_TEXTURE_2D swap glBindTexture
  24                     init-texture rect-texture-coords
  25                     dim>> fill-rect-vertices (gl-fill-rect)
  26                     GL_TEXTURE_2D 0 glBindTexture
  27                 ] do-enabled-client-state
  28             ] do-attribs
  29         ] do-enabled
  30     ] make-dlist ;
  31
  32 : make-core-graphics-texture ( dim bitmap -- texture )
  33     GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV make-texture ;
  34
  35 : <rendered-line> ( line -- texture )
  36     #! Note: we only ref-line if make-texture and make-line-display-list
  37     #! succeed
  38     [
  39         dup [ dim>> ] [ bitmap>> ] bi make-core-graphics-texture
  40         2dup make-line-display-list
  41         0 f \ rendered-line boa
  42     ] keep ref-line ;
  43
  44 M: rendered-line dispose*
  45     [ line>> unref-line ]
  46     [ texture>> delete-texture ]
  47     [ display-list>> delete-dlist ] tri ;
  48
  49 : rendered-line ( string font -- rendered-line )
  50     world get fonts>>
  51     [ cached-line <rendered-line> ] 2cache 0 >>age ;
  52
  53 : age-rendered-lines ( world -- )
  54     [ [ age ] age-assoc ] change-fonts drop ;
  55
  56 M: core-text-renderer finish-text-rendering
  57     age-rendered-lines age-lines ;
  58
  59 M: core-text-renderer draw-string ( font string loc -- )
  60     [
  61         swap rendered-line
  62         display-list>> glCallList
  63     ] with-translation ;
  64
  65 M: core-text-renderer x>offset ( x font string -- n )
  66     [ 2drop 0 ] [
  67         swap cached-line line>>
  68         swap 0 <CGPoint> CTLineGetStringIndexForPosition
  69     ] if-empty ;
  70
  71 M: core-text-renderer offset>x ( n font string -- x )
  72     swap cached-line line>> swap f
  73     CTLineGetOffsetForStringIndex ;
  74
  75 M: core-text-renderer free-fonts ( fonts -- )
  76     values dispose-each ;
  77
  78 core-text-renderer font-renderer set-global