Major refactor of pango/cairo gadgets. Added freetype backend.
Matthew Willis
parent
d29069ed0b
commit
07b964fff1
|
|
@ -13,21 +13,23 @@ IN: cairo.gadgets
|
|||
>r first2 over width>stride
|
||||
[ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
|
||||
[ cairo_image_surface_create_for_data ] 3bi
|
||||
r> with-cairo-from-surface ;
|
||||
r> with-cairo-from-surface ; inline
|
||||
|
||||
TUPLE: cairo-gadget < texture-gadget quot ;
|
||||
TUPLE: cairo-gadget < texture-gadget dim quot ;
|
||||
|
||||
: <cairo-gadget> ( dim quot -- gadget )
|
||||
cairo-gadget construct-gadget
|
||||
swap >>quot
|
||||
swap >>dim ;
|
||||
|
||||
M: cairo-gadget format>> drop GL_BGRA ;
|
||||
M: cairo-gadget cache-key* [ dim>> ] [ quot>> ] bi 2array ;
|
||||
|
||||
M: cairo-gadget render* ( gadget -- )
|
||||
dup
|
||||
[ dim>> 2^-bounds ] [ quot>> copy-cairo ] bi
|
||||
>>bytes call-next-method ;
|
||||
: render-cairo ( dim quot -- bytes format )
|
||||
>r 2^-bounds r> copy-cairo GL_BGRA ;
|
||||
|
||||
M: cairo-gadget render*
|
||||
[ dim>> dup ] [ quot>> ] bi
|
||||
render-cairo render-bytes* ;
|
||||
|
||||
! maybe also texture>png
|
||||
! : cairo>png ( gadget path -- )
|
||||
|
|
@ -40,11 +42,16 @@ M: cairo-gadget render* ( gadget -- )
|
|||
cr swap 0 0 cairo_set_source_surface
|
||||
cr cairo_paint ;
|
||||
|
||||
: <png-gadget> ( path -- gadget )
|
||||
normalize-path cairo_image_surface_create_from_png
|
||||
TUPLE: png-gadget < texture-gadget path ;
|
||||
: <png> ( path -- gadget )
|
||||
png-gadget construct-gadget
|
||||
swap >>path ;
|
||||
|
||||
M: png-gadget render*
|
||||
path>> normalize-path cairo_image_surface_create_from_png
|
||||
[ cairo_image_surface_get_width ]
|
||||
[ cairo_image_surface_get_height 2array dup 2^-bounds ]
|
||||
[ [ copy-surface ] curry copy-cairo ] tri
|
||||
GL_BGRA rot <texture-gadget> ;
|
||||
|
||||
GL_BGRA render-bytes* ;
|
||||
|
||||
M: png-gadget cache-key* path>> ;
|
||||
|
|
|
|||
|
|
@ -155,6 +155,16 @@ C-STRUCT: face
|
|||
{ "face-size*" "size" }
|
||||
{ "void*" "charmap" } ;
|
||||
|
||||
C-STRUCT: FT_Bitmap
|
||||
{ "int" "rows" }
|
||||
{ "int" "width" }
|
||||
{ "int" "pitch" }
|
||||
{ "void*" "buffer" }
|
||||
{ "short" "num_grays" }
|
||||
{ "char" "pixel_mode" }
|
||||
{ "char" "palette_mode" }
|
||||
{ "void*" "palette" } ;
|
||||
|
||||
FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
|
||||
|
||||
FUNCTION: FT_Error FT_New_Memory_Face ( void* library, FT_Byte* file_base, FT_Long file_size, FT_Long face_index, FT_Face* aface ) ;
|
||||
|
|
@ -170,6 +180,15 @@ C-ENUM:
|
|||
FT_RENDER_MODE_LCD
|
||||
FT_RENDER_MODE_LCD_V ;
|
||||
|
||||
C-ENUM:
|
||||
FT_PIXEL_MODE_NONE
|
||||
FT_PIXEL_MODE_MONO
|
||||
FT_PIXEL_MODE_GRAY
|
||||
FT_PIXEL_MODE_GRAY2
|
||||
FT_PIXEL_MODE_GRAY4
|
||||
FT_PIXEL_MODE_LCD
|
||||
FT_PIXEL_MODE_LCD_V ;
|
||||
|
||||
FUNCTION: int FT_Render_Glyph ( glyph* slot, int render_mode ) ;
|
||||
|
||||
FUNCTION: void FT_Done_Face ( face* face ) ;
|
||||
|
|
@ -177,3 +196,4 @@ FUNCTION: void FT_Done_Face ( face* face ) ;
|
|||
FUNCTION: void FT_Done_FreeType ( void* library ) ;
|
||||
|
||||
FUNCTION: FT_Long FT_MulFix ( FT_Long a, FT_Long b ) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,10 +2,57 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: locals math.functions math namespaces
|
||||
opengl.gl accessors kernel opengl ui.gadgets
|
||||
fry assocs
|
||||
destructors sequences ui.render colors ;
|
||||
IN: opengl.gadgets
|
||||
|
||||
TUPLE: texture-gadget bytes format dim tex ;
|
||||
TUPLE: texture-gadget ;
|
||||
|
||||
GENERIC: render* ( gadget -- texture dims )
|
||||
GENERIC: cache-key* ( gadget -- key )
|
||||
|
||||
M: texture-gadget cache-key* ;
|
||||
|
||||
SYMBOL: textures
|
||||
SYMBOL: refcounts
|
||||
|
||||
: init-cache ( symbol -- )
|
||||
dup get [ drop ] [ H{ } clone swap set-global ] if ;
|
||||
|
||||
textures init-cache
|
||||
refcounts init-cache
|
||||
|
||||
: refcount-change ( gadget quot -- )
|
||||
>r cache-key* refcounts get
|
||||
[ [ 0 ] unless* ] r> compose change-at ;
|
||||
|
||||
TUPLE: cache-entry tex dims ;
|
||||
C: <entry> cache-entry
|
||||
|
||||
: make-entry ( gadget -- entry )
|
||||
dup render* <entry>
|
||||
[ swap cache-key* textures get set-at ] keep ;
|
||||
|
||||
: get-entry ( gadget -- {texture,dims} )
|
||||
dup cache-key* textures get at
|
||||
[ nip ] [ make-entry ] if* ;
|
||||
|
||||
: get-dims ( gadget -- dims )
|
||||
get-entry dims>> ;
|
||||
|
||||
: get-texture ( gadget -- texture )
|
||||
get-entry tex>> ;
|
||||
|
||||
: release-texture ( gadget -- )
|
||||
cache-key* textures get delete-at*
|
||||
[ tex>> delete-texture ] [ drop ] if ;
|
||||
|
||||
M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
|
||||
|
||||
M: texture-gadget ungraft* ( gadget -- )
|
||||
dup [ 1- ] refcount-change
|
||||
dup cache-key* refcounts get at
|
||||
zero? [ release-texture ] [ drop ] if ;
|
||||
|
||||
: 2^-ceil ( x -- y )
|
||||
dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
|
||||
|
|
@ -13,31 +60,29 @@ TUPLE: texture-gadget bytes format dim tex ;
|
|||
: 2^-bounds ( dim -- dim' )
|
||||
[ 2^-ceil ] map ; foldable flushable
|
||||
|
||||
: <texture-gadget> ( bytes format dim -- gadget )
|
||||
texture-gadget construct-gadget
|
||||
swap >>dim
|
||||
swap >>format
|
||||
swap >>bytes ;
|
||||
|
||||
GENERIC: render* ( texture-gadget -- )
|
||||
|
||||
M:: texture-gadget render* ( gadget -- )
|
||||
:: (render-bytes) ( dims bytes format texture -- )
|
||||
GL_ENABLE_BIT [
|
||||
GL_TEXTURE_2D glEnable
|
||||
GL_TEXTURE_2D gadget tex>> glBindTexture
|
||||
GL_TEXTURE_2D texture glBindTexture
|
||||
GL_TEXTURE_2D
|
||||
0
|
||||
GL_RGBA
|
||||
gadget dim>> 2^-bounds first2
|
||||
dims 2^-bounds first2
|
||||
0
|
||||
gadget format>>
|
||||
format
|
||||
GL_UNSIGNED_BYTE
|
||||
gadget bytes>>
|
||||
bytes
|
||||
glTexImage2D
|
||||
init-texture
|
||||
GL_TEXTURE_2D 0 glBindTexture
|
||||
] do-attribs ;
|
||||
|
||||
: render-bytes ( dims bytes format -- texture )
|
||||
gen-texture [ (render-bytes) ] keep ;
|
||||
|
||||
: render-bytes* ( dims bytes format -- texture dims )
|
||||
pick >r render-bytes r> ;
|
||||
|
||||
:: four-corners ( dim -- )
|
||||
[let* | w [ dim first ]
|
||||
h [ dim second ]
|
||||
|
|
@ -56,19 +101,12 @@ M: texture-gadget draw-gadget* ( gadget -- )
|
|||
white gl-color
|
||||
1.0 -1.0 glPixelZoom
|
||||
GL_TEXTURE_2D glEnable
|
||||
GL_TEXTURE_2D over tex>> glBindTexture
|
||||
GL_TEXTURE_2D over get-texture glBindTexture
|
||||
GL_QUADS [
|
||||
dim>> four-corners
|
||||
get-dims four-corners
|
||||
] do-state
|
||||
GL_TEXTURE_2D 0 glBindTexture
|
||||
] do-attribs
|
||||
] with-translation ;
|
||||
|
||||
M: texture-gadget graft* ( gadget -- )
|
||||
gen-texture >>tex [ render* ]
|
||||
[ f >>bytes drop ] bi ;
|
||||
|
||||
M: texture-gadget ungraft* ( gadget -- )
|
||||
tex>> delete-texture ;
|
||||
|
||||
M: texture-gadget pref-dim* ( gadget -- dim ) dim>> ;
|
||||
M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;
|
||||
|
|
|
|||
|
|
@ -93,43 +93,24 @@ pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width
|
|||
! Higher level words and combinators
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: destructors accessors namespaces kernel cairo ;
|
||||
|
||||
TUPLE: pango-layout alien ;
|
||||
C: <pango-layout> pango-layout
|
||||
M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
|
||||
|
||||
: layout ( -- pango-layout ) pango-layout get ;
|
||||
USING: pango.layouts
|
||||
destructors accessors namespaces kernel cairo ;
|
||||
|
||||
: (with-pango) ( layout quot -- )
|
||||
>r alien>> pango-layout r> with-variable ; inline
|
||||
|
||||
: with-pango ( quot -- )
|
||||
cr pango_cairo_create_layout <pango-layout> swap
|
||||
[ (with-pango) ] curry with-disposal ; inline
|
||||
|
||||
: pango-layout-get-pixel-size ( layout -- width height )
|
||||
0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
|
||||
[ *int ] bi@ ;
|
||||
: with-pango-cairo ( quot -- )
|
||||
cr pango_cairo_create_layout swap with-layout ;
|
||||
|
||||
MEMO: dummy-cairo ( -- cr )
|
||||
CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create cairo_create ;
|
||||
|
||||
: dummy-pango ( quot -- )
|
||||
>r dummy-cairo cairo r> [ with-pango ] curry with-variable ; inline
|
||||
>r dummy-cairo cairo r> [ with-pango-cairo ] curry with-variable ; inline
|
||||
|
||||
: layout-size ( quot -- dim )
|
||||
[ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline
|
||||
|
||||
: layout-font ( str -- )
|
||||
pango_font_description_from_string
|
||||
dup zero? [ "pango: not a valid font." throw ] when
|
||||
layout over pango_layout_set_font_description
|
||||
pango_font_description_free ;
|
||||
|
||||
: layout-text ( str -- )
|
||||
layout swap -1 pango_layout_set_text ;
|
||||
|
||||
: show-layout ( -- )
|
||||
cr layout pango_cairo_show_layout ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,64 +1,27 @@
|
|||
! Copyright (C) 2008 Matthew Willis.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: pango.cairo cairo cairo.ffi
|
||||
cairo.gadgets namespaces arrays
|
||||
fry accessors ui.gadgets assocs
|
||||
sequences shuffle opengl opengl.gadgets
|
||||
alien.c-types kernel math ;
|
||||
USING: pango.cairo pango.gadgets
|
||||
cairo.gadgets arrays namespaces
|
||||
fry accessors ui.gadgets
|
||||
sequences opengl.gadgets
|
||||
kernel pango.layouts ;
|
||||
|
||||
IN: pango.cairo.gadgets
|
||||
|
||||
SYMBOL: textures
|
||||
SYMBOL: dims
|
||||
SYMBOL: refcounts
|
||||
TUPLE: pango-cairo-gadget < pango-gadget ;
|
||||
|
||||
: init-cache ( symbol -- )
|
||||
dup get [ drop ] [ H{ } clone swap set-global ] if ;
|
||||
SINGLETON: pango-cairo-backend
|
||||
pango-cairo-backend pango-backend set-global
|
||||
|
||||
textures init-cache
|
||||
dims init-cache
|
||||
refcounts init-cache
|
||||
M: pango-cairo-backend construct-pango
|
||||
pango-cairo-gadget construct-gadget ;
|
||||
|
||||
TUPLE: pango-gadget < cairo-gadget text font ;
|
||||
: setup-layout ( gadget -- quot )
|
||||
[ font>> ] [ text>> ] bi
|
||||
'[ , layout-font , layout-text ] ;
|
||||
|
||||
: cache-key ( gadget -- key )
|
||||
[ font>> ] [ text>> ] bi 2array ;
|
||||
|
||||
: refcount-change ( gadget quot -- )
|
||||
>r cache-key refcounts get
|
||||
[ [ 0 ] unless* ] r> compose change-at ;
|
||||
|
||||
: <pango-gadget> ( font text -- gadget )
|
||||
pango-gadget construct-gadget
|
||||
swap >>text
|
||||
swap >>font ;
|
||||
|
||||
: setup-layout ( {font,text} -- quot )
|
||||
first2 '[ , layout-font , layout-text ] ;
|
||||
|
||||
M: pango-gadget quot>> ( gadget -- quot )
|
||||
cache-key setup-layout [ show-layout ] compose
|
||||
[ with-pango ] curry ;
|
||||
|
||||
M: pango-gadget dim>> ( gadget -- dim )
|
||||
cache-key dims get [ setup-layout layout-size ] cache ;
|
||||
|
||||
M: pango-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
|
||||
|
||||
: release-texture ( gadget -- )
|
||||
cache-key textures get delete-at* [ delete-texture ] [ drop ] if ;
|
||||
|
||||
M: pango-gadget ungraft* ( gadget -- )
|
||||
dup [ 1- ] refcount-change
|
||||
dup cache-key refcounts get at
|
||||
zero? [ release-texture ] [ drop ] if ;
|
||||
|
||||
M: pango-gadget render* ( gadget -- )
|
||||
[ gen-texture ] [ cache-key textures get set-at ] bi
|
||||
call-next-method ;
|
||||
|
||||
M: pango-gadget tex>> ( gadget -- texture )
|
||||
dup cache-key textures get at
|
||||
[ nip ] [ dup render* tex>> ] if* ;
|
||||
|
||||
USE: ui.gadgets.panes
|
||||
: hello "Sans 50" "hello" <pango-gadget> gadget. ;
|
||||
M: pango-cairo-gadget render* ( gadget -- )
|
||||
setup-layout [ layout-size dup ]
|
||||
[
|
||||
'[ [ @ show-layout ] with-pango-cairo ]
|
||||
] bi render-cairo render-bytes* ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,56 @@
|
|||
USING: alien alien.c-types
|
||||
math kernel byte-arrays freetype
|
||||
opengl.gadgets accessors pango
|
||||
ui.gadgets memoize
|
||||
arrays sequences libc opengl.gl
|
||||
system combinators alien.syntax
|
||||
pango.layouts ;
|
||||
IN: pango.ft2
|
||||
|
||||
<< "pangoft2" {
|
||||
! { [ os winnt? ] [ "libpangocairo-1.dll" ] }
|
||||
! { [ os macosx? ] [ "libpangocairo.dylib" ] }
|
||||
{ [ os unix? ] [ "libpangoft2-1.0.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
LIBRARY: pangoft2
|
||||
|
||||
FUNCTION: PangoFontMap*
|
||||
pango_ft2_font_map_new ( ) ;
|
||||
|
||||
FUNCTION: PangoContext*
|
||||
pango_ft2_font_map_create_context ( PangoFT2FontMap* fontmap ) ;
|
||||
|
||||
FUNCTION: void
|
||||
pango_ft2_render_layout ( FT_Bitmap* bitmap, PangoLayout* layout, int x, int y ) ;
|
||||
|
||||
: 4*-ceil ( n -- k*4 )
|
||||
3 + 4 /i 4 * ;
|
||||
|
||||
: <ft-bitmap> ( width height -- ft-bitmap )
|
||||
swap dup
|
||||
2dup * 4*-ceil
|
||||
"uchar" malloc-array
|
||||
256
|
||||
FT_PIXEL_MODE_GRAY
|
||||
"FT_Bitmap" <c-object> dup >r
|
||||
{
|
||||
set-FT_Bitmap-rows
|
||||
set-FT_Bitmap-width
|
||||
set-FT_Bitmap-pitch
|
||||
set-FT_Bitmap-buffer
|
||||
set-FT_Bitmap-num_grays
|
||||
set-FT_Bitmap-pixel_mode
|
||||
} set-slots r> ;
|
||||
|
||||
: render-layout ( layout -- dims alien )
|
||||
[
|
||||
pango-layout-get-pixel-size
|
||||
2array dup 2^-bounds first2 <ft-bitmap> dup
|
||||
] [ 0 0 pango_ft2_render_layout ] bi FT_Bitmap-buffer ;
|
||||
|
||||
MEMO: ft2-context ( -- PangoContext* )
|
||||
pango_ft2_font_map_new pango_ft2_font_map_create_context ;
|
||||
|
||||
: with-ft2-layout ( quot -- )
|
||||
ft2-context pango_layout_new swap with-layout ; inline
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
! Copyright (C) 2008 Matthew Willis.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: pango.ft2 pango.gadgets opengl.gadgets
|
||||
accessors kernel opengl.gl libc
|
||||
sequences namespaces ui.gadgets pango.layouts ;
|
||||
IN: pango.ft2.gadgets
|
||||
|
||||
TUPLE: pango-ft2-gadget < pango-gadget ;
|
||||
|
||||
SINGLETON: pango-ft2-backend
|
||||
pango-ft2-backend pango-backend set-global
|
||||
|
||||
M: pango-ft2-backend construct-pango
|
||||
pango-ft2-gadget construct-gadget ;
|
||||
|
||||
M: pango-ft2-gadget render*
|
||||
[
|
||||
[ text>> layout-text ] [ font>> layout-font ] bi
|
||||
layout render-layout
|
||||
] with-ft2-layout [ GL_ALPHA render-bytes* ] keep free ;
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
! Copyright (C) 2008 Matthew Willis.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: opengl.gadgets kernel
|
||||
arrays
|
||||
accessors ;
|
||||
|
||||
IN: pango.gadgets
|
||||
|
||||
TUPLE: pango-gadget < texture-gadget text font ;
|
||||
|
||||
M: pango-gadget cache-key* [ font>> ] [ text>> ] bi 2array ;
|
||||
|
||||
SYMBOL: pango-backend
|
||||
HOOK: construct-pango pango-backend ( -- gadget )
|
||||
|
||||
: <pango> ( font text -- gadget )
|
||||
construct-pango
|
||||
swap >>text
|
||||
swap >>font ;
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
USING: alien alien.c-types
|
||||
math
|
||||
destructors accessors namespaces
|
||||
pango kernel ;
|
||||
IN: pango.layouts
|
||||
|
||||
: pango-layout-get-pixel-size ( layout -- width height )
|
||||
0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
|
||||
[ *int ] bi@ ;
|
||||
|
||||
TUPLE: pango-layout alien ;
|
||||
C: <pango-layout> pango-layout
|
||||
M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
|
||||
|
||||
: layout ( -- pango-layout ) pango-layout get ;
|
||||
|
||||
: (with-layout) ( pango-layout quot -- )
|
||||
>r alien>> pango-layout r> with-variable ; inline
|
||||
|
||||
: with-layout ( layout quot -- )
|
||||
>r <pango-layout> r> [ (with-layout) ] curry with-disposal ; inline
|
||||
|
||||
: layout-font ( str -- )
|
||||
pango_font_description_from_string
|
||||
dup zero? [ "pango: not a valid font." throw ] when
|
||||
layout over pango_layout_set_font_description
|
||||
pango_font_description_free ;
|
||||
|
||||
: layout-text ( str -- )
|
||||
layout swap -1 pango_layout_set_text ;
|
||||
|
|
@ -18,6 +18,9 @@ LIBRARY: pango
|
|||
|
||||
: PANGO_SCALE 1024 ;
|
||||
|
||||
FUNCTION: PangoLayout*
|
||||
pango_layout_new ( PangoContext* context ) ;
|
||||
|
||||
FUNCTION: void
|
||||
pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue