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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-03-15 17:11:37 -05:00
parent 07a5a46009 3a0b0aff79
commit cb9adb2436
1 changed files with 22 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/images/bitmap/bitmap.factor
View File

@ -3,7 +3,7 @@
USING: accessors alien alien.c-types arrays byte-arrays columns USING: accessors alien alien.c-types arrays byte-arrays columns
combinators fry grouping io io.binary io.encodings.binary io.files combinators fry grouping io io.binary io.encodings.binary io.files
kernel macros math math.bitwise math.functions namespaces sequences kernel macros math math.bitwise math.functions namespaces sequences
strings images endian summary ; strings images endian summary locals ;
IN: images.bitmap IN: images.bitmap
: assert-sequence= ( a b -- ) : assert-sequence= ( a b -- )
@ -78,9 +78,28 @@ ERROR: bmp-not-supported n ;
[ height>> abs * ] [ height>> abs * ]
} cleave ; } cleave ;
: image-size ( loading-bitmap -- n )
[ [ width>> ] [ height>> ] bi * ] [ bit-count>> 8 /i ] bi * abs ;
:: fixup-color-index ( loading-bitmap -- loading-bitmap )
loading-bitmap width>> :> width
loading-bitmap height>> abs :> height
loading-bitmap color-index>> length :> color-index-length
height 3 * :> height*3
color-index-length width height*3 * - height*3 /i :> misaligned
misaligned 0 > [
loading-bitmap [
loading-bitmap width>> misaligned + 3 * <sliced-groups>
[ 3 misaligned * head* ] map concat
] change-color-index
] [
loading-bitmap
] if ;
: parse-bitmap ( loading-bitmap -- loading-bitmap ) : parse-bitmap ( loading-bitmap -- loading-bitmap )
dup rgb-quads-length read >>rgb-quads dup rgb-quads-length read >>rgb-quads
dup color-index-length read >>color-index ; dup color-index-length read >>color-index
fixup-color-index ;
: load-bitmap-data ( path loading-bitmap -- loading-bitmap ) : load-bitmap-data ( path loading-bitmap -- loading-bitmap )
[ binary ] dip '[ [ binary ] dip '[
@ -102,6 +121,7 @@ ERROR: unknown-component-order bitmap ;
{ {
[ raw-bitmap>seq >>bitmap ] [ raw-bitmap>seq >>bitmap ]
[ [ width>> ] [ height>> abs ] bi 2array >>dim ] [ [ width>> ] [ height>> abs ] bi 2array >>dim ]
[ height>> 0 < [ t >>upside-down? ] when ]
[ bitmap>component-order >>component-order ] [ bitmap>component-order >>component-order ]
} cleave ; } cleave ;