Update core-graphics, core-text, opengl.textures for Doug's images API change; core-graphics:with-bitmap-context is now core-graphics:make-bitmap-image
parent
056e7aa442
commit
f0bc2e1176
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: tools.test core-graphics kernel byte-arrays ;
|
USING: tools.test core-graphics kernel images ;
|
||||||
IN: core-graphics.tests
|
IN: core-graphics.tests
|
||||||
|
|
||||||
[ t ] [ { 100 200 } [ drop ] with-bitmap-context byte-array? ] unit-test
|
[ t ] [ { 100 200 } [ drop ] make-bitmap-image image? ] unit-test
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types alien.destructors alien.syntax
|
USING: alien.c-types alien.destructors alien.syntax accessors
|
||||||
destructors fry kernel math math.bitwise sequences libc colors
|
destructors fry kernel math math.bitwise sequences libc colors
|
||||||
core-graphics.types core-foundation.utilities ;
|
images core-graphics.types core-foundation.utilities ;
|
||||||
IN: core-graphics
|
IN: core-graphics
|
||||||
|
|
||||||
! CGImageAlphaInfo
|
! CGImageAlphaInfo
|
||||||
|
@ -126,10 +126,16 @@ FUNCTION: void* CGBitmapContextGetData ( CGContextRef c ) ;
|
||||||
[ CGBitmapContextGetData ] [ bitmap-size ] bi*
|
[ CGBitmapContextGetData ] [ bitmap-size ] bi*
|
||||||
memory>byte-array ;
|
memory>byte-array ;
|
||||||
|
|
||||||
|
: <bitmap-image> ( bitmap dim -- image )
|
||||||
|
<image>
|
||||||
|
swap >>dim
|
||||||
|
swap >>bitmap
|
||||||
|
little-endian? ARGB BGRA ? >>component-order ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: with-bitmap-context ( dim quot -- data )
|
: make-bitmap-image ( dim quot -- image )
|
||||||
[
|
[
|
||||||
[ [ <CGBitmapContext> &CGContextRelease ] keep ] dip
|
[ [ <CGBitmapContext> &CGContextRelease ] keep ] dip
|
||||||
[ nip call ] [ drop bitmap-data ] 3bi
|
[ nip call ] [ drop [ bitmap-data ] keep <bitmap-image> ] 3bi
|
||||||
] with-destructors ; inline
|
] with-destructors ; inline
|
||||||
|
|
|
@ -3,9 +3,9 @@
|
||||||
USING: arrays alien alien.c-types alien.syntax kernel destructors
|
USING: arrays alien alien.c-types alien.syntax kernel destructors
|
||||||
accessors fry words hashtables strings sequences memoize assocs math
|
accessors fry words hashtables strings sequences memoize assocs math
|
||||||
math.functions locals init namespaces combinators fonts colors cache
|
math.functions locals init namespaces combinators fonts colors cache
|
||||||
images endian core-foundation core-foundation.strings
|
core-foundation core-foundation.strings core-foundation.attributed-strings
|
||||||
core-foundation.attributed-strings core-foundation.utilities
|
core-foundation.utilities core-graphics core-graphics.types
|
||||||
core-graphics core-graphics.types core-text.fonts core-text.utilities ;
|
core-text.fonts core-text.utilities ;
|
||||||
IN: core-text
|
IN: core-text
|
||||||
|
|
||||||
TYPEDEF: void* CTLineRef
|
TYPEDEF: void* CTLineRef
|
||||||
|
@ -77,19 +77,13 @@ TUPLE: line font line metrics image disposed ;
|
||||||
: set-text-position ( context metrics -- )
|
: set-text-position ( context metrics -- )
|
||||||
[ 0 ] dip descent>> ceiling CGContextSetTextPosition ;
|
[ 0 ] dip descent>> ceiling CGContextSetTextPosition ;
|
||||||
|
|
||||||
: <line-image> ( dim bitmap -- image )
|
|
||||||
<image>
|
|
||||||
swap >>bitmap
|
|
||||||
swap >>dim
|
|
||||||
BGRA >>component-order
|
|
||||||
native-endianness >>byte-order ;
|
|
||||||
|
|
||||||
:: <line> ( font string -- line )
|
:: <line> ( font string -- line )
|
||||||
[
|
[
|
||||||
[let* | open-font [ font cache-font CFRetain |CFRelease ]
|
[let* | open-font [ font cache-font CFRetain |CFRelease ]
|
||||||
line [ string open-font font foreground>> <CTLine> |CFRelease ]
|
line [ string open-font font foreground>> <CTLine> |CFRelease ]
|
||||||
metrics [ line compute-line-metrics ]
|
metrics [ line compute-line-metrics ]
|
||||||
dim [ metrics bounds>dim ] |
|
dim [ metrics bounds>dim ] |
|
||||||
|
open-font line metrics
|
||||||
dim [
|
dim [
|
||||||
{
|
{
|
||||||
[ font dim fill-background ]
|
[ font dim fill-background ]
|
||||||
|
@ -97,8 +91,7 @@ TUPLE: line font line metrics image disposed ;
|
||||||
[ metrics set-text-position ]
|
[ metrics set-text-position ]
|
||||||
[ [ line ] dip CTLineDraw ]
|
[ [ line ] dip CTLineDraw ]
|
||||||
} cleave
|
} cleave
|
||||||
] with-bitmap-context
|
] make-bitmap-image
|
||||||
[ open-font line metrics dim ] dip <line-image>
|
|
||||||
]
|
]
|
||||||
f line boa
|
f line boa
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
|
@ -54,25 +54,18 @@ TUPLE: texture texture display-list disposed ;
|
||||||
: make-texture-display-list ( dim texture -- dlist )
|
: make-texture-display-list ( dim texture -- dlist )
|
||||||
GL_COMPILE [ draw-textured-rect ] make-dlist ;
|
GL_COMPILE [ draw-textured-rect ] make-dlist ;
|
||||||
|
|
||||||
GENERIC: component-order>format ( component-order -- format )
|
GENERIC: component-order>format ( component-order -- format type )
|
||||||
|
|
||||||
M: RGBA component-order>format drop GL_RGBA ;
|
M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
|
||||||
M: BGRA component-order>format drop GL_BGRA_EXT ;
|
M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
|
||||||
|
M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8 ;
|
||||||
: byte-order>type ( byte-order -- format )
|
|
||||||
native-endianness eq?
|
|
||||||
GL_UNSIGNED_INT_8_8_8_8_REV
|
|
||||||
GL_UNSIGNED_BYTE
|
|
||||||
? ;
|
|
||||||
|
|
||||||
: <texture> ( image -- texture )
|
: <texture> ( image -- texture )
|
||||||
[
|
[
|
||||||
{
|
|
||||||
[ dim>> ]
|
[ dim>> ]
|
||||||
[ bitmap>> ]
|
[ bitmap>> ]
|
||||||
[ component-order>> component-order>format ]
|
[ component-order>> component-order>format ]
|
||||||
[ byte-order>> byte-order>type ]
|
tri make-texture
|
||||||
} cleave make-texture
|
|
||||||
] [ dim>> ] bi
|
] [ dim>> ] bi
|
||||||
over make-texture-display-list f texture boa ;
|
over make-texture-display-list f texture boa ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue