Move normalize-scanline-order implementation from images.bitmap to images

Add upside-down? slot to image tuple
Update cap for recent changes
db4
Slava Pestov 2009-03-10 16:35:47 -05:00
parent 073333f245
commit ff3c5b28bd
4 changed files with 26 additions and 24 deletions

View File

@ -108,11 +108,6 @@ M: bitmap-image load-image* ( path bitmap -- bitmap )
load-bitmap-data process-bitmap-data
fill-image-slots ;
M: bitmap-image normalize-scan-line-order
dup dim>> '[
_ first 4 * <sliced-groups> reverse concat
] change-bitmap ;
MACRO: (nbits>bitmap) ( bits -- )
[ -3 shift ] keep '[
bitmap-image new
@ -121,6 +116,7 @@ MACRO: (nbits>bitmap) ( bits -- )
swap >>width
swap array-copy [ >>bitmap ] [ >>color-index ] bi
_ >>bit-count fill-image-slots
t >>upside-down?
] ;
: bgr>bitmap ( array height width -- bitmap )

View File

@ -27,7 +27,7 @@ R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
{ R32G32B32A32 [ 16 ] }
} case ;
TUPLE: image dim component-order bitmap ;
TUPLE: image dim component-order upside-down? bitmap ;
: <image> ( -- image ) image new ; inline
@ -82,11 +82,16 @@ M: ARGB normalize-component-order*
M: ABGR normalize-component-order*
drop ARGB>RGBA 4 BGR>RGB ;
GENERIC: normalize-scan-line-order ( image -- image )
M: image normalize-scan-line-order ;
: normalize-scan-line-order ( image -- image )
dup upside-down?>> [
dup dim>> first 4 * '[
_ <groups> reverse concat
] change-bitmap
f >>upside-down?
] when ;
: normalize-image ( image -- image )
[ >byte-array ] change-bitmap
normalize-component-order
normalize-scan-line-order ;
normalize-scan-line-order
RGBA >>component-order ;

View File

@ -503,7 +503,7 @@ ERROR: unknown-component-order ifd ;
: ifd>image ( ifd -- image )
{
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
[ ifd-component-order ]
[ ifd-component-order f ]
[ bitmap>> ]
} cleave tiff-image boa ;

View File

@ -1,30 +1,31 @@
! Copyright (C) 2008 Doug Coleman, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays kernel math namespaces
opengl.gl sequences math.vectors ui images.bitmap images.viewer
opengl.gl sequences math.vectors ui images images.viewer
models ui.gadgets.worlds ui.gadgets fry alien.syntax ;
IN: cap
: screenshot-array ( world -- byte-array )
dim>> [ first 3 * 4 align ] [ second ] bi * <byte-array> ;
dim>> [ first 4 * ] [ second ] bi * <byte-array> ;
: gl-screenshot ( gadget -- byte-array )
[
GL_BACK glReadBuffer
GL_PACK_ALIGNMENT 4 glPixelStorei
0 0
] dip
[ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
[
GL_BACK glReadBuffer
GL_PACK_ALIGNMENT 4 glPixelStorei
0 0
] dip
dim>> first2 GL_RGBA GL_UNSIGNED_BYTE
]
[ screenshot-array ] bi
[ glReadPixels ] keep ;
: screenshot ( window -- bitmap )
[ gl-screenshot ]
[ dim>> first2 ] bi
bgr>bitmap ;
: save-screenshot ( window path -- )
[ screenshot ] dip save-bitmap ;
[ <image> ] dip
[ gl-screenshot >>bitmap ] [ dim>> >>dim ] bi
RGBA >>component-order
t >>upside-down?
normalize-image ;
: screenshot. ( window -- )
[ screenshot <image-gadget> ] [ title>> ] bi open-window ;