1 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators kernel locals accessors sequences math arrays ;
7 A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
8 INTENSITY DEPTH DEPTH-STENCIL R RG
9 ubyte-components ushort-components uint-components
10 half-components float-components
11 byte-integer-components ubyte-integer-components
12 short-integer-components ushort-integer-components
13 int-integer-components uint-integer-components
14 u-5-5-5-1-components u-5-6-5-components
15 u-10-10-10-2-components
16 u-24-components u-24-8-components
17 float-32-u-8-components
19 float-11-11-10-components ;
21 UNION: component-order
22 A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
23 INTENSITY DEPTH DEPTH-STENCIL R RG ;
26 ubyte-components ushort-components uint-components
27 half-components float-components
28 byte-integer-components ubyte-integer-components
29 short-integer-components ushort-integer-components
30 int-integer-components uint-integer-components
31 u-5-5-5-1-components u-5-6-5-components
32 u-10-10-10-2-components
33 u-24-components u-24-8-components
34 float-32-u-8-components
36 float-11-11-10-components ;
38 UNION: unnormalized-integer-components
39 byte-integer-components ubyte-integer-components
40 short-integer-components ushort-integer-components
41 int-integer-components uint-integer-components ;
43 UNION: signed-unnormalized-integer-components
44 byte-integer-components
45 short-integer-components
46 int-integer-components ;
48 UNION: unsigned-unnormalized-integer-components
49 ubyte-integer-components
50 ushort-integer-components
51 uint-integer-components ;
53 UNION: packed-components
54 u-5-5-5-1-components u-5-6-5-components
55 u-10-10-10-2-components
56 u-24-components u-24-8-components
57 float-32-u-8-components
59 float-11-11-10-components ;
61 UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
63 UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
66 dim component-order component-type
67 upside-down? premultiplied-alpha?
70 : <image> ( -- image ) image new ; inline
72 : image-dim ( image -- dim )
73 [ dim>> ] [ 2x?>> ] bi [ [ 2.0 / ] map ] when ;
75 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
77 : bytes-per-component ( component-type -- n )
79 { ubyte-components [ 1 ] }
80 { ushort-components [ 2 ] }
81 { uint-components [ 4 ] }
82 { half-components [ 2 ] }
83 { float-components [ 4 ] }
84 { byte-integer-components [ 1 ] }
85 { ubyte-integer-components [ 1 ] }
86 { short-integer-components [ 2 ] }
87 { ushort-integer-components [ 2 ] }
88 { int-integer-components [ 4 ] }
89 { uint-integer-components [ 4 ] }
92 : bytes-per-packed-pixel ( component-type -- n )
94 { u-5-5-5-1-components [ 2 ] }
95 { u-5-6-5-components [ 2 ] }
96 { u-10-10-10-2-components [ 4 ] }
97 { u-24-components [ 4 ] }
98 { u-24-8-components [ 4 ] }
99 { u-9-9-9-e5-components [ 4 ] }
100 { float-11-11-10-components [ 4 ] }
101 { float-32-u-8-components [ 8 ] }
104 : component-count ( component-order -- n )
121 { DEPTH-STENCIL [ 1 ] }
126 : (bytes-per-pixel) ( component-order component-type -- n )
127 dup packed-components?
128 [ nip bytes-per-packed-pixel ] [
129 [ component-count ] [ bytes-per-component ] bi* *
132 : bytes-per-pixel ( image -- n )
133 [ component-order>> ] [ component-type>> ] bi (bytes-per-pixel) ;
135 : bytes-per-image ( image -- n )
136 [ dim>> product ] [ bytes-per-pixel ] bi * ;
140 :: pixel@ ( x y w image -- start end bitmap )
141 image dim>> first y * x + :> start
142 start w [ image bytes-per-pixel * ] bi@ :> ( start' w' )
143 start' start' w' + image bitmap>> ; inline
145 : set-subseq ( new-value from to victim -- )
146 <slice> 0 swap copy ; inline
150 : pixel-row-at ( x y w image -- pixels )
151 pixel@ subseq ; inline
153 : pixel-row-slice-at ( x y w image -- pixels )
154 pixel@ <slice> ; inline
156 : set-pixel-row-at ( pixel x y w image -- )
157 pixel@ set-subseq ; inline
159 : pixel-at ( x y image -- pixel )
160 [ 1 ] dip pixel-row-at ; inline
162 : pixel-slice-at ( x y image -- pixels )
163 [ 1 ] dip pixel-row-slice-at ; inline
165 : set-pixel-at ( pixel x y image -- )
166 [ 1 ] dip set-pixel-row-at ; inline