Add byte-order slot to image tuple; rename <image> to load-image, add <image> for making images from scratch

db4
Slava Pestov 2009-02-12 04:25:33 -06:00
parent a550c9874c
commit cf9e7d1e75
5 changed files with 14 additions and 20 deletions

View File

@ -1,10 +1,9 @@
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays byte-arrays columns
combinators fry grouping io io.binary io.encodings.binary
io.files kernel libc macros math math.bitwise math.functions
namespaces opengl opengl.gl prettyprint sequences strings
summary ui ui.gadgets.panes images ;
combinators fry grouping io io.binary io.encodings.binary io.files
kernel macros math math.bitwise math.functions namespaces sequences
strings images endian summary ;
IN: images.bitmap
TUPLE: bitmap-image < image ;
@ -106,8 +105,9 @@ ERROR: unknown-component-order bitmap ;
{
[ [ width>> ] [ height>> ] bi 2array ]
[ bitmap>component-order ]
[ drop little-endian ] ! XXX
[ buffer>> ]
} cleave bitmap-image new-image ;
} cleave bitmap-image boa ;
M: bitmap-image load-image* ( path bitmap -- bitmap-image )
drop load-bitmap >image ;

View File

@ -5,7 +5,9 @@ IN: images
SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
TUPLE: image dim component-order bitmap ;
TUPLE: image dim component-order byte-order bitmap ;
: <image> ( -- image ) image new ; inline
GENERIC: load-image* ( path tuple -- image )
@ -38,9 +40,3 @@ M: image normalize-scan-line-order ;
: normalize-image ( image -- image )
normalize-component-order
normalize-scan-line-order ;
: new-image ( dim component-order bitmap class -- image )
new
swap >>bitmap
swap >>component-order
swap >>dim ; inline

View File

@ -15,7 +15,4 @@ ERROR: unknown-image-extension extension ;
} case ;
: load-image ( path -- image )
dup image-class new load-image* ;
: <image> ( path -- image )
load-image normalize-image ;
dup image-class new load-image* normalize-image ;

View File

@ -272,8 +272,9 @@ ERROR: unknown-component-order ifd ;
{
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
[ ifd-component-order ]
[ drop big-endian ] ! XXX
[ bitmap>> ]
} cleave tiff-image new-image ;
} cleave tiff-image boa ;
: tiff>image ( image -- image )
ifds>> [ ifd>image ] map first ;

View File

@ -23,15 +23,15 @@ M: image-gadget draw-gadget* ( gadget -- )
swap >>image ;
: image-window ( path -- gadget )
[ <image> <image-gadget> dup ] [ open-window ] bi ;
[ load-image <image-gadget> dup ] [ open-window ] bi ;
GENERIC: image. ( object -- )
: default-image. ( path -- )
<image-gadget> gadget. ;
M: string image. ( image -- ) <image> default-image. ;
M: string image. ( image -- ) load-image default-image. ;
M: pathname image. ( image -- ) <image> default-image. ;
M: pathname image. ( image -- ) load-image default-image. ;
M: image image. ( image -- ) default-image. ;