1 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators kernel accessors sequences math arrays ;
6 SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
7 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
9 UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
11 : bytes-per-pixel ( component-order -- n )
27 { R16G16B16A16 [ 8 ] }
28 { R32G32B32A32 [ 16 ] }
31 TUPLE: image dim component-order upside-down? bitmap ;
33 : <image> ( -- image ) image new ; inline
35 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
37 GENERIC: load-image* ( path tuple -- image )
39 : make-image ( bitmap -- image )
40 ! bitmap is a sequence of sequences of pixels which are RGBA
42 over [ first length ] [ length ] bi 2array >>dim
43 RGBA >>component-order
44 swap concat concat B{ } like >>bitmap ;
48 : pixel@ ( x y image -- start end bitmap )
50 [ component-order>> bytes-per-pixel [ * dup ] keep + ]
53 : set-subseq ( new-value from to victim -- )
54 <slice> 0 swap copy ; inline
58 : pixel-at ( x y image -- pixel )
61 : set-pixel-at ( pixel x y image -- )