steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactoring

db4
Slava Pestov 2009-02-21 00:40:03 -06:00
parent 7fddef29da
commit 89f1ac4afd
1 changed files with 35 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
basis/images/images.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors grouping sequences combinators USING: kernel accessors grouping sequences combinators
math specialized-arrays.direct.uint byte-arrays math specialized-arrays.direct.uint byte-arrays fry
specialized-arrays.direct.ushort specialized-arrays.uint specialized-arrays.direct.ushort specialized-arrays.uint
specialized-arrays.ushort specialized-arrays.float ; specialized-arrays.ushort specialized-arrays.float ;
IN: images IN: images
@ -34,46 +34,47 @@ TUPLE: image dim component-order bitmap ;
GENERIC: load-image* ( path tuple -- image ) GENERIC: load-image* ( path tuple -- image )
: add-dummy-alpha ( seq -- seq' ) : add-dummy-alpha ( seq -- seq' )
3 <sliced-groups> 3 <sliced-groups> [ 255 suffix ] map concat ;
[ 255 suffix ] map concat ;
: normalize-floats ( byte-array -- byte-array ) : normalize-floats ( byte-array -- byte-array )
byte-array>float-array [ 255.0 * >integer ] B{ } map-as ; byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
GENERIC: normalize-component-order* ( image component-order -- image )
: normalize-component-order ( image -- image ) : normalize-component-order ( image -- image )
dup component-order>> dup component-order>> '[ _ normalize-component-order* ] change-bitmap
{
{ RGBA [ ] }
{ R32G32B32A32 [
[ normalize-floats ] change-bitmap
] }
{ R32G32B32 [
[ normalize-floats add-dummy-alpha ] change-bitmap
] }
{ R16G16B16A16 [
[ byte-array>ushort-array [ -8 shift ] B{ } map-as ] change-bitmap
] }
{ R16G16B16 [
[
byte-array>ushort-array [ -8 shift ] B{ } map-as add-dummy-alpha
] change-bitmap
] }
{ BGRA [
[
4 <sliced-groups> dup [ 3 head-slice reverse-here ] each
] change-bitmap
] }
{ RGB [ [ add-dummy-alpha ] change-bitmap ] }
{ BGR [
[
3 <sliced-groups>
[ [ 3 head-slice reverse-here ] each ]
[ add-dummy-alpha ] bi
] change-bitmap
] }
} case
RGBA >>component-order ; RGBA >>component-order ;
M: RGBA normalize-component-order* drop ;
M: R32G32B32A32 normalize-component-order*
drop normalize-floats ;
M: R32G32B32 normalize-component-order*
drop normalize-floats add-dummy-alpha ;
: RGB16>8 ( bitmap -- bitmap' )
byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
M: R16G16B16A16 normalize-component-order*
drop RGB16>8 ;
M: R16G16B16 normalize-component-order*
drop RGB16>8 add-dummy-alpha ;
: BGR>RGB ( bitmap bytes-per-pixel -- pixels )
dup <sliced-groups>
[ 3 head-slice reverse-here ] each ; inline
M: BGRA normalize-component-order*
drop 4 BGR>RGB ;
M: RGB normalize-component-order*
drop add-dummy-alpha ;
M: BGR normalize-component-order*
drop 3 BGR>RGB add-dummy-alpha ;
GENERIC: normalize-scan-line-order ( image -- image ) GENERIC: normalize-scan-line-order ( image -- image )
M: image normalize-scan-line-order ; M: image normalize-scan-line-order ;