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

images: move rowstride to the images vocab because it will be used by 

gdi too
db4
Björn Lindqvist 2014-10-07 17:33:30 +02:00 committed by John Benediktsson
parent 56217afcbb
commit c10c5f5736
4 changed files with 35 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/images/images-docs.factor Normal file
View File

@ -0,0 +1,6 @@
USING: help.markup help.syntax math ;
IN: images
HELP: rowstride
{ $values { "image" image } { "n" integer } }
{ $description "Returns an images rowstride metric." } ;

37
basis/images/images-tests.factor
View File

@ -4,26 +4,31 @@ USING: images tools.test kernel accessors ;
IN: images.tests IN: images.tests
[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{ [ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
57 57 57 255 57 57 57 255
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
} } pixel-at ] unit-test } } pixel-at ] unit-test
[ B{ [ B{
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
57 57 57 255 57 57 57 255
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{ } ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
} } [ set-pixel-at ] keep bitmap>> ] unit-test } } [ set-pixel-at ] keep bitmap>> ] unit-test
{ 40 30 } [
T{ image f { 10 3 } RGBA ubyte-components f f } rowstride
T{ image f { 10 3 } RGB ubyte-components f f } rowstride
] unit-test

12
basis/images/images.factor
View File

@ -18,7 +18,7 @@ SINGLETONS:
u-9-9-9-e5-components u-9-9-9-e5-components
float-11-11-10-components ; float-11-11-10-components ;
UNION: component-order UNION: component-order
A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
INTENSITY DEPTH DEPTH-STENCIL R RG ; INTENSITY DEPTH DEPTH-STENCIL R RG ;
@ -41,8 +41,8 @@ UNION: unnormalized-integer-components
int-integer-components uint-integer-components ; int-integer-components uint-integer-components ;
UNION: signed-unnormalized-integer-components UNION: signed-unnormalized-integer-components
byte-integer-components byte-integer-components
short-integer-components short-integer-components
int-integer-components ; int-integer-components ;
UNION: unsigned-unnormalized-integer-components UNION: unsigned-unnormalized-integer-components
@ -131,10 +131,13 @@ TUPLE: image
: bytes-per-pixel ( image -- n ) : bytes-per-pixel ( image -- n )
[ component-order>> ] [ component-type>> ] bi (bytes-per-pixel) ; [ component-order>> ] [ component-type>> ] bi (bytes-per-pixel) ;
: bytes-per-image ( image -- n ) : bytes-per-image ( image -- n )
[ dim>> product ] [ bytes-per-pixel ] bi * ; [ dim>> product ] [ bytes-per-pixel ] bi * ;
: rowstride ( image -- n )
[ dim>> first ] [ bytes-per-pixel ] bi * ;
<PRIVATE <PRIVATE
:: pixel@ ( x y w image -- start end bitmap ) :: pixel@ ( x y w image -- start end bitmap )
@ -164,4 +167,3 @@ PRIVATE>
: set-pixel-at ( pixel x y image -- ) : set-pixel-at ( pixel x y image -- )
[ 1 ] dip set-pixel-row-at ; inline [ 1 ] dip set-pixel-row-at ; inline

8
basis/images/loader/gtk/gtk.factor
View File

@ -60,18 +60,12 @@ CONSTANT: bits>components {
f >>premultiplied-alpha? f >>premultiplied-alpha?
f >>upside-down? ; f >>upside-down? ;
: bits-per-sample ( image -- bits )
component-type>> bits>components value-at ;
: rowstride ( image -- rowstride )
[ dim>> first ] [ bits-per-sample 8 / ] [ has-alpha? 4 3 ? ] tri * * ;
: image>GdkPixbuf ( image -- GdkPixbuf ) : image>GdkPixbuf ( image -- GdkPixbuf )
{ {
[ bitmap>> ] [ bitmap>> ]
[ drop GDK_COLORSPACE_RGB ] [ drop GDK_COLORSPACE_RGB ]
[ has-alpha? ] [ has-alpha? ]
[ bits-per-sample ] [ bytes-per-component 8 * ]
[ dim>> first2 ] [ dim>> first2 ]
[ rowstride ] [ rowstride ]
} cleave f f gdk_pixbuf_new_from_data ; } cleave f f gdk_pixbuf_new_from_data ;