Move normalize-scanline-order implementation from images.bitmap to images
Add upside-down? slot to image tuple Update cap for recent changesdb4
parent
073333f245
commit
ff3c5b28bd
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue