! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel locals accessors sequences math arrays ;
+USING: accessors combinators kernel math sequences ;
IN: images
SINGLETONS:
u-9-9-9-e5-components
float-11-11-10-components ;
-UNION: component-order
+UNION: component-order
A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
INTENSITY DEPTH DEPTH-STENCIL R RG ;
int-integer-components uint-integer-components ;
UNION: signed-unnormalized-integer-components
- byte-integer-components
- short-integer-components
+ byte-integer-components
+ short-integer-components
int-integer-components ;
UNION: unsigned-unnormalized-integer-components
UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
-TUPLE: image dim component-order component-type upside-down? bitmap ;
+TUPLE: image
+ dim component-order component-type
+ upside-down? premultiplied-alpha?
+ bitmap 2x? ;
: <image> ( -- image ) image new ; inline
+: image-dim ( image -- dim )
+ [ dim>> ] [ 2x?>> ] bi [ [ 2.0 / ] map ] when ;
+
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
: bytes-per-component ( component-type -- n )
: bytes-per-pixel ( image -- n )
[ component-order>> ] [ component-type>> ] bi (bytes-per-pixel) ;
-
+
: bytes-per-image ( image -- n )
[ dim>> product ] [ bytes-per-pixel ] bi * ;
+: rowstride ( image -- n )
+ [ dim>> first ] [ bytes-per-pixel ] bi * ;
+
<PRIVATE
:: pixel@ ( x y w image -- start end bitmap )
: set-pixel-at ( pixel x y image -- )
[ 1 ] dip set-pixel-row-at ; inline
+:: each-pixel ( ... image quot: ( ... x y pixel -- ... ) -- ... )
+ image dim>> first2 :> ( width height )
+ image bytes-per-pixel :> n
+ height width [ <iota> ] bi@ [| y x |
+ y width * x + :> start
+ start n * :> from
+ from n + :> to
+ x y from to image bitmap>> <slice> quot call
+ ] cartesian-each ; inline