{ V{ { red 0 } { green 3 } { blue 4 } } }
[ color_t "c-type" word-prop members>> ] unit-test
+
+ENUM: colores { rojo red } { verde green } { azul blue } { colorado rojo } ;
+
+[ { 0 3 4 0 } ] [ { rojo verde azul colorado } [ enum>number ] map ] unit-test
+
+SYMBOLS: couleurs rouge vert bleu jaune azure ;
+
+<< \ couleurs int {
+ { rouge red }
+ { vert green }
+ { bleu blue }
+ { jaune 14 }
+ { azure bleu }
+} define-enum >>
+
+[ { 0 3 4 14 4 } ] [ { rouge vert bleu jaune azure } [ enum>number ] map ] unit-test
M: enum-c-type c-type-setter
[ enum>number ] swap base-type>> c-type-setter '[ _ 2dip @ ] ;
-<PRIVATE
-
: define-enum-value ( class value -- )
- "enum-value" set-word-prop ;
+ enum>number "enum-value" set-word-prop ;
+
+<PRIVATE
: define-enum-members ( members -- )
- [
- [ drop define-singleton-class ]
- [ define-enum-value ] 2bi
- ] assoc-each ;
+ [ first define-singleton-class ] each ;
: define-enum-constructor ( word -- )
[ name>> "<" ">" surround create-in ] keep
PRIVATE>
-: define-enum ( word base-type members -- )
+: (define-enum) ( word base-type members -- )
[ dup define-enum-constructor ] 2dip
[ define-enum-members ]
[ <enum-c-type> swap typedef ] bi ;
+
+: define-enum ( word base-type members -- )
+ [ (define-enum) ]
+ [ [ define-enum-value ] assoc-each ] bi ;
PREDICATE: enum-c-type-word < c-type-word
"c-type" word-prop enum-c-type? ;
assocs classes combinators combinators.short-circuit
compiler.units effects grouping kernel parser sequences
splitting words fry locals lexer namespaces summary math
-vocabs.parser words.constant classes.parser ;
+vocabs.parser words.constant classes.parser alien.enums ;
IN: alien.parser
SYMBOL: current-library
[ [ <pointer> ] dip parse-pointers ] when ;
: next-enum-member ( members name value -- members value' )
- [ 2array suffix! ] [ 1 + ] bi ;
+ [ define-enum-value ]
+ [ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ;
: parse-enum-name ( -- name )
scan (CREATE-C-TYPE) dup save-location ;
scan-c-type CREATE-C-TYPE dup save-location typedef ;
SYNTAX: ENUM:
- parse-enum define-enum ;
+ parse-enum (define-enum) ;
SYNTAX: C-TYPE:
void CREATE-C-TYPE typedef ;
tools.test math random ;
IN: bit-arrays.tests
+[ -1 <bit-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
+
[ 100 ] [ 100 <bit-array> length ] unit-test
[
-! Copyright (C) 2007, 2010 Slava Pestov.
+! Copyright (C) 2007, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.data accessors io.binary math math.bitwise
alien.accessors kernel kernel.private sequences
PRIVATE>
+ERROR: bad-array-length n ;
+
: <bit-array> ( n -- bit-array )
- dup bits>bytes <byte-array> bit-array boa ; inline
+ dup 0 < [ bad-array-length ] when
+ dup bits>bytes <byte-array>
+ bit-array boa ; inline
M: bit-array length length>> ; inline
"NSApplication"
"NSArray"
"NSAutoreleasePool"
+ "NSBitmapImageRep"
"NSBundle"
+ "NSColorSpace"
"NSData"
"NSDictionary"
"NSError"
{ "d" c:double }
{ "B" c:bool }
{ "v" c:void }
- { "*" c:c-string }
+ { "*" c:void* }
{ "?" unknown_type }
{ "@" id }
{ "#" Class }
CTLineCreateWithAttributedString
] with-destructors ;
-TUPLE: line < disposable line metrics image loc dim ;
+TUPLE: line < disposable line metrics image loc dim rendered-line ;
+
+TUPLE: rendered-line font string loc dim ;
+C: <rendered-line> rendered-line
: typographic-bounds ( line -- width ascent descent leading )
{ CGFloat CGFloat CGFloat }
line >>line
- metrics >>metrics
+ font string loc dim <rendered-line> >>rendered-line
- dim [
- {
- [ font dim fill-background ]
- [ loc dim line string fill-selection-background ]
- [ loc set-text-position ]
- [ [ line ] dip CTLineDraw ]
- } cleave
- ] make-bitmap-image >>image
+ metrics >>metrics
metrics loc dim line-loc >>loc
metrics metrics>dim >>dim
] with-destructors ;
+:: render ( line -- line image )
+ line line>> :> ctline
+ line rendered-line>> string>> :> string
+ line rendered-line>> font>> :> font
+ line rendered-line>> loc>> :> loc
+ line rendered-line>> dim>> :> dim
+
+ line dim [
+ {
+ [ font dim fill-background ]
+ [ loc dim ctline string fill-selection-background ]
+ [ loc set-text-position ]
+ [ [ ctline ] dip CTLineDraw ]
+ } cleave
+ ] make-bitmap-image ;
+
+: line>image ( line -- image )
+ dup image>> [ render >>image ] unless image>> ;
+
M: line dispose* line>> CFRelease ;
SYMBOL: cached-lines
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.libraries alien.syntax combinators
-gobject-introspection kernel system vocabs.loader ;
+USING: alien alien.data alien.libraries alien.syntax
+combinators gio.ffi glib.ffi gmodule.ffi gobject-introspection
+gobject.ffi kernel libc sequences system ;
+EXCLUDE: alien.c-types => pointer ;
IN: gdk.pixbuf.ffi
-<<
"gio.ffi" require
->>
LIBRARY: gdk.pixbuf
>>
GIR: vocab:gdk/pixbuf/GdkPixbuf-2.0.gir
+
+: data>GInputStream ( data -- GInputStream )
+ [ malloc-byte-array &free ] [ length ] bi
+ f g_memory_input_stream_new_from_data ;
+
+: GInputStream>GdkPixbuf ( GInputStream -- GdkPixbuf )
+ f { { pointer: GError initial: f } }
+ [ gdk_pixbuf_new_from_stream ] with-out-parameters
+ handle-GError ;
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.destructors alien.libraries alien.syntax
-combinators kernel gobject-introspection
-gobject-introspection.standard-types system ;
+USING: accessors alien alien.c-types alien.destructors
+alien.libraries alien.strings alien.syntax combinators
+gobject-introspection gobject-introspection.standard-types
+io.encodings.utf8 kernel system vocabs.parser words ;
IN: glib.ffi
LIBRARY: glib
} cond
>>
-IMPLEMENT-STRUCTS: GPollFD GSource GSourceFuncs ;
+
+TYPEDEF: char gchar
+TYPEDEF: uchar guchar
+TYPEDEF: short gshort
+TYPEDEF: ushort gushort
+TYPEDEF: long glong
+TYPEDEF: ulong gulong
+TYPEDEF: int gint
+TYPEDEF: uint guint
+
+<<
+int c-type clone
+ [ >c-bool ] >>unboxer-quot
+ [ c-bool> ] >>boxer-quot
+ object >>boxed-class
+"gboolean" current-vocab create typedef
+>>
+
+TYPEDEF: char gint8
+TYPEDEF: uchar guint8
+TYPEDEF: short gint16
+TYPEDEF: ushort guint16
+TYPEDEF: int gint32
+TYPEDEF: uint guint32
+TYPEDEF: longlong gint64
+TYPEDEF: ulonglong guint64
+
+TYPEDEF: float gfloat
+TYPEDEF: double gdouble
+
+TYPEDEF: long ssize_t
+TYPEDEF: long time_t
+TYPEDEF: size_t gsize
+TYPEDEF: ssize_t gssize
+TYPEDEF: size_t GType
+
+TYPEDEF: void* gpointer
+TYPEDEF: void* gconstpointer
+
+TYPEDEF: guint8 GDateDay
+TYPEDEF: guint16 GDateYear
+TYPEDEF: gint GPid
+TYPEDEF: guint32 GQuark
+TYPEDEF: gint32 GTime
+TYPEDEF: glong gintptr
+TYPEDEF: gint64 goffset
+TYPEDEF: gulong guintptr
+TYPEDEF: guint32 gunichar
+TYPEDEF: guint16 gunichar2
+
+TYPEDEF: gpointer pointer
+
+REPLACE-C-TYPE: long\sdouble double
+REPLACE-C-TYPE: any gpointer
+
+IMPLEMENT-STRUCTS: GError GPollFD GSource GSourceFuncs ;
CONSTANT: G_MININT8 HEX: -80
CONSTANT: G_MAXINT8 HEX: 7f
CALLBACK: gboolean GSourceFuncsPrepareFunc ( GSource* source, gint* timeout_ ) ;
CALLBACK: gboolean GSourceFuncsCheckFunc ( GSource* source ) ;
CALLBACK: gboolean GSourceFuncsDispatchFunc ( GSource* source, GSourceFunc callback, gpointer user_data ) ;
+
+ERROR: g-error domain code message ;
+
+: GError>g-error ( GError -- g-error )
+ [ domain>> g_quark_to_string utf8 alien>string ]
+ [ code>> ]
+ [ message>> utf8 alien>string ] tri
+ \ g-error boa ;
+
+: handle-GError ( GError/f -- )
+ [
+ [ GError>g-error ]
+ [ g_error_free ] bi
+ throw
+ ] when* ;
+++ /dev/null
-Doug Coleman
+++ /dev/null
-USING: images.bitmap images.testing kernel ;
-IN: images.bitmap.tests
-
-! "vocab:images/testing/bmp/1bit.bmp" decode-test
-! "vocab:images/testing/bmp/rgb_4bit.bmp" decode-test
-
-"vocab:images/testing/bmp/rgb_8bit.bmp"
-[ decode-test ] [ bmp-image encode-test ] bi
-
-"vocab:images/testing/bmp/42red_24bit.bmp"
-[ decode-test ] [ bmp-image encode-test ] bi
+++ /dev/null
-! Copyright (C) 2007, 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays byte-arrays combinators
-compression.run-length fry grouping images images.loader
-images.normalization io io.binary io.encodings.8-bit.latin1
-io.encodings.string kernel math math.bitwise sequences
-specialized-arrays summary io.streams.throwing ;
-QUALIFIED-WITH: bitstreams b
-SPECIALIZED-ARRAYS: uint ushort ;
-IN: images.bitmap
-
-! http://www.fileformat.info/format/bmp/egff.htm
-! http://www.digicamsoft.com/bmp/bmp.html
-
-SINGLETON: bmp-image
-"bmp" bmp-image register-image-class
-
-: write2 ( n -- ) 2 >le write ;
-: write4 ( n -- ) 4 >le write ;
-
-ERROR: unknown-component-order bitmap ;
-ERROR: unknown-bitmap-header n ;
-
-: read2 ( -- n ) 2 read le> ;
-: read4 ( -- n ) 4 read le> ;
-
-TUPLE: loading-bitmap
- file-header header
- color-palette color-index bitfields ;
-
-TUPLE: file-header
- { magic initial: "BM" }
- { size }
- { reserved1 initial: 0 }
- { reserved2 initial: 0 }
- { offset }
- { header-length } ;
-
-TUPLE: v3-header
- { width initial: 0 }
- { height initial: 0 }
- { planes initial: 0 }
- { bit-count initial: 0 }
- { compression initial: 0 }
- { image-size initial: 0 }
- { x-resolution initial: 0 }
- { y-resolution initial: 0 }
- { colors-used initial: 0 }
- { colors-important initial: 0 } ;
-
-TUPLE: v4-header < v3-header
- { red-mask initial: 0 }
- { green-mask initial: 0 }
- { blue-mask initial: 0 }
- { alpha-mask initial: 0 }
- { cs-type initial: 0 }
- { end-points initial: 0 }
- { gamma-red initial: 0 }
- { gamma-green initial: 0 }
- { gamma-blue initial: 0 } ;
-
-TUPLE: v5-header < v4-header
- { intent initial: 0 }
- { profile-data initial: 0 }
- { profile-size initial: 0 }
- { reserved3 initial: 0 } ;
-
-TUPLE: os2v1-header
- { width initial: 0 }
- { height initial: 0 }
- { planes initial: 0 }
- { bit-count initial: 0 } ;
-
-TUPLE: os2v2-header < os2v1-header
- { compression initial: 0 }
- { image-size initial: 0 }
- { x-resolution initial: 0 }
- { y-resolution initial: 0 }
- { colors-used initial: 0 }
- { colors-important initial: 0 }
- { units initial: 0 }
- { reserved initial: 0 }
- { recording initial: 0 }
- { rendering initial: 0 }
- { size1 initial: 0 }
- { size2 initial: 0 }
- { color-encoding initial: 0 }
- { identifier initial: 0 } ;
-
-UNION: v-header v3-header v4-header v5-header ;
-UNION: os2-header os2v1-header os2v2-header ;
-
-: parse-file-header ( -- file-header )
- \ file-header new
- 2 read latin1 decode >>magic
- read4 >>size
- read2 >>reserved1
- read2 >>reserved2
- read4 >>offset
- read4 >>header-length ;
-
-: read-v3-header-data ( header -- header )
- read4 >>width
- read4 32 >signed >>height
- read2 >>planes
- read2 >>bit-count
- read4 >>compression
- read4 >>image-size
- read4 >>x-resolution
- read4 >>y-resolution
- read4 >>colors-used
- read4 >>colors-important ;
-
-: read-v3-header ( -- header )
- \ v3-header new
- read-v3-header-data ;
-
-: read-v4-header-data ( header -- header )
- read4 >>red-mask
- read4 >>green-mask
- read4 >>blue-mask
- read4 >>alpha-mask
- read4 >>cs-type
- read4 read4 read4 3array >>end-points
- read4 >>gamma-red
- read4 >>gamma-green
- read4 >>gamma-blue ;
-
-: read-v4-header ( -- v4-header )
- \ v4-header new
- read-v3-header-data
- read-v4-header-data ;
-
-: read-v5-header-data ( v5-header -- v5-header )
- read4 >>intent
- read4 >>profile-data
- read4 >>profile-size
- read4 >>reserved3 ;
-
-: read-v5-header ( -- loading-bitmap )
- \ v5-header new
- read-v3-header-data
- read-v4-header-data
- read-v5-header-data ;
-
-: read-os2v1-header ( -- os2v1-header )
- \ os2v1-header new
- read2 >>width
- read2 16 >signed >>height
- read2 >>planes
- read2 >>bit-count ;
-
-: read-os2v2-header-data ( os2v2-header -- os2v2-header )
- read4 >>width
- read4 32 >signed >>height
- read2 >>planes
- read2 >>bit-count
- read4 >>compression
- read4 >>image-size
- read4 >>x-resolution
- read4 >>y-resolution
- read4 >>colors-used
- read4 >>colors-important
- read2 >>units
- read2 >>reserved
- read2 >>recording
- read2 >>rendering
- read4 >>size1
- read4 >>size2
- read4 >>color-encoding
- read4 >>identifier ;
-
-: read-os2v2-header ( -- os2v2-header )
- \ os2v2-header new
- read-os2v2-header-data ;
-
-: parse-header ( n -- header )
- {
- { 12 [ read-os2v1-header ] }
- { 64 [ read-os2v2-header ] }
- { 40 [ read-v3-header ] }
- { 108 [ read-v4-header ] }
- { 124 [ read-v5-header ] }
- [ unknown-bitmap-header ]
- } case ;
-
-: color-index-length ( header -- n )
- {
- [ width>> ]
- [ planes>> * ]
- [ bit-count>> * 31 + 32 /i 4 * ]
- [ height>> abs * ]
- } cleave ;
-
-: color-palette-length ( loading-bitmap -- n )
- file-header>>
- [ offset>> 14 - ] [ header-length>> ] bi - ;
-
-: parse-color-palette ( loading-bitmap -- loading-bitmap )
- dup color-palette-length read >>color-palette ;
-
-GENERIC: parse-color-data* ( loading-bitmap header -- loading-bitmap )
-
-: parse-color-data ( loading-bitmap -- loading-bitmap )
- dup header>> parse-color-data* ;
-
-M: os2v1-header parse-color-data* ( loading-bitmap header -- loading-bitmap )
- color-index-length read >>color-index ;
-
-M: object parse-color-data* ( loading-bitmap header -- loading-bitmap )
- dup image-size>> [ 0 ] unless* dup 0 >
- [ nip ] [ drop color-index-length ] if read >>color-index ;
-
-: alpha-used? ( loading-bitmap -- ? )
- color-index>> 4 <sliced-groups> [ fourth 0 = ] all? not ;
-
-GENERIC: bitmap>component-order* ( loading-bitmap header -- object )
-
-: bitmap>component-order ( loading-bitmap -- object )
- dup header>> bitmap>component-order* ;
-
-: simple-bitmap>component-order ( loading-bitamp -- object )
- header>> bit-count>> {
- { 32 [ BGRX ] }
- { 24 [ BGR ] }
- { 16 [ BGR ] }
- { 8 [ BGR ] }
- { 4 [ BGR ] }
- { 1 [ BGR ] }
- [ unknown-component-order ]
- } case ;
-
-: advanced-bitmap>component-order ( loading-bitmap -- object )
- [ ] [ header>> bit-count>> ] [ alpha-used? ] tri 2array {
- { { 32 t } [ drop BGRA ] }
- { { 32 f } [ drop BGRX ] }
- [ drop simple-bitmap>component-order ]
- } case ;
-
-: color-lookup3 ( loading-bitmap -- seq )
- [ color-index>> >array ]
- [ color-palette>> 3 <sliced-groups> ] bi
- '[ _ nth ] map concat ;
-
-: color-lookup4 ( loading-bitmap -- seq )
- [ color-index>> >array ]
- [ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ] bi
- '[ _ nth ] map concat ;
-
-! os2v1 is 3bytes each, all others are 3 + 1 unused
-: color-lookup ( loading-bitmap -- seq )
- dup file-header>> header-length>> {
- { 12 [ color-lookup3 ] }
- { 64 [ color-lookup4 ] }
- { 40 [ color-lookup4 ] }
- { 108 [ color-lookup4 ] }
- { 124 [ color-lookup4 ] }
- } case ;
-
-M: os2v1-header bitmap>component-order* drop simple-bitmap>component-order ;
-M: os2v2-header bitmap>component-order* drop simple-bitmap>component-order ;
-M: v3-header bitmap>component-order* drop simple-bitmap>component-order ;
-M: v4-header bitmap>component-order* drop advanced-bitmap>component-order ;
-M: v5-header bitmap>component-order* drop advanced-bitmap>component-order ;
-
-: uncompress-bitfield ( seq masks -- bytes' )
- '[
- _ [
- [ bitand ] [ bit-count ] [ log2 ] tri - shift
- ] with map
- ] { } map-as B{ } concat-as ;
-
-ERROR: bmp-not-supported n ;
-
-: bitmap>bytes ( loading-bitmap -- byte-array )
- dup header>> bit-count>>
- {
- { 32 [ color-index>> ] }
- { 24 [ color-index>> ] }
- { 16 [
- [
- ! ushort-array-cast
- 2 group [ le> ] map
- ! 5 6 5
- ! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
- ! 5 5 5
- { HEX: 7c00 HEX: 3e0 HEX: 1f } uncompress-bitfield
- ] change-color-index
- color-index>>
- ] }
- { 8 [ color-lookup ] }
- { 4 [ [ 4 b:byte-array-n>seq ] change-color-index color-lookup ] }
- { 1 [ [ 1 b:byte-array-n>seq ] change-color-index color-lookup ] }
- [ bmp-not-supported ]
- } case >byte-array ;
-
-: set-bitfield-widths ( loading-bitmap -- loading-bitmap' )
- dup header>> bit-count>> {
- { 16 [ dup color-palette>> 4 group [ le> ] map ] }
- { 32 [ { HEX: ff0000 HEX: ff00 HEX: ff } ] }
- } case reverse >>bitfields ;
-
-ERROR: unsupported-bitfield-widths n ;
-
-M: unsupported-bitfield-widths summary
- drop "Bitmaps only support bitfield compression in 16/32bit images" ;
-
-: uncompress-bitfield-widths ( loading-bitmap -- loading-bitmap' )
- set-bitfield-widths
- dup header>> bit-count>> {
- { 16 [
- dup bitfields>> '[
- ushort-array-cast _ uncompress-bitfield
- ] change-color-index
- ] }
- { 32 [ ] }
- [ unsupported-bitfield-widths ]
- } case ;
-
-ERROR: unsupported-bitmap-compression compression ;
-
-GENERIC: uncompress-bitmap* ( loading-bitmap header -- loading-bitmap )
-
-: uncompress-bitmap ( loading-bitmap -- loading-bitmap )
- dup header>> uncompress-bitmap* ;
-
-M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
- drop ;
-
-: do-run-length-uncompress ( loading-bitmap word -- loading-bitmap )
- dupd '[
- _ header>> [ width>> ] [ height>> ] bi
- _ execute
- ] change-color-index ; inline
-
-M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
- compression>> {
- { f [ ] }
- { 0 [ ] }
- { 1 [ \ run-length-uncompress-bitmap8 do-run-length-uncompress ] }
- { 2 [ \ run-length-uncompress-bitmap4 do-run-length-uncompress ] }
- { 3 [ uncompress-bitfield-widths ] }
- { 4 [ "jpeg" unsupported-bitmap-compression ] }
- { 5 [ "png" unsupported-bitmap-compression ] }
- } case ;
-
-ERROR: unsupported-bitmap-file magic ;
-
-: load-bitmap ( stream -- loading-bitmap )
- [
- [
- \ loading-bitmap new
- parse-file-header [ >>file-header ] [ ] bi magic>> {
- { "BM" [
- dup file-header>> header-length>> parse-header >>header
- parse-color-palette
- parse-color-data
- ] }
- ! { "BA" [ parse-os2-bitmap-array ] }
- ! { "CI" [ parse-os2-color-icon ] }
- ! { "CP" [ parse-os2-color-pointer ] }
- ! { "IC" [ parse-os2-icon ] }
- ! { "PT" [ parse-os2-pointer ] }
- [ unsupported-bitmap-file ]
- } case
- ] throw-on-eof
- ] with-input-stream ;
-
-: loading-bitmap>bytes ( loading-bitmap -- byte-array )
- uncompress-bitmap bitmap>bytes ;
-
-M: bmp-image stream>image ( stream bmp-image -- bitmap )
- drop load-bitmap
- [ image new ] dip
- {
- [ loading-bitmap>bytes >>bitmap ]
- [ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ]
- [ header>> height>> 0 < not >>upside-down? ]
- [ bitmap>component-order >>component-order ubyte-components >>component-type ]
- } cleave ;
-
-: output-width-and-height ( image -- )
- [ dim>> first write4 ]
- [
- [ dim>> second ] [ upside-down?>> ] bi
- [ neg ] unless write4
- ] bi ;
-
-: output-bmp ( image -- )
- B{ CHAR: B CHAR: M } write
- [
- bitmap>> length 14 + 40 + write4
- 0 write4
- 54 write4
- 40 write4
- ] [
- {
- [ output-width-and-height ]
-
- ! planes
- [ drop 1 write2 ]
-
- ! bit-count
- [ drop 24 write2 ]
-
- ! compression
- [ drop 0 write4 ]
-
- ! image-size
- [ bitmap>> length write4 ]
-
- ! x-pels
- [ drop 0 write4 ]
-
- ! y-pels
- [ drop 0 write4 ]
-
- ! color-used
- [ drop 0 write4 ]
-
- ! color-important
- [ drop 0 write4 ]
-
- ! color-palette
- [ bitmap>> write ]
- } cleave
- ] bi ;
-
-M: bmp-image image>stream
- drop BGR reorder-components output-bmp ;
-
+++ /dev/null
-Windows BMP image loader
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: accessors alien.data cocoa cocoa.classes cocoa.messages
+combinators core-foundation.data core-graphics.types fry images
+images.loader io kernel literals math sequences ;
+IN: images.cocoa
+
+SINGLETON: ns-image
+"png" ns-image register-image-class
+"tif" ns-image register-image-class
+"tiff" ns-image register-image-class
+"gif" ns-image register-image-class
+"jpg" ns-image register-image-class
+"jpeg" ns-image register-image-class
+"bmp" ns-image register-image-class
+"ico" ns-image register-image-class
+
+CONSTANT: NSImageRepLoadStatusUnknownType -1
+CONSTANT: NSImageRepLoadStatusReadingHeader -2
+CONSTANT: NSImageRepLoadStatusWillNeedAllData -3
+CONSTANT: NSImageRepLoadStatusInvalidData -4
+CONSTANT: NSImageRepLoadStatusUnexpectedEOF -5
+CONSTANT: NSImageRepLoadStatusCompleted -6
+
+CONSTANT: NSColorRenderingIntentDefault 0
+CONSTANT: NSColorRenderingIntentAbsoluteColorimetric 1
+CONSTANT: NSColorRenderingIntentRelativeColorimetric 2
+CONSTANT: NSColorRenderingIntentPerceptual 3
+CONSTANT: NSColorRenderingIntentSaturation 4
+
+ERROR: ns-image-unknown-type ;
+ERROR: ns-image-invalid-data ;
+ERROR: ns-image-unexpected-eof ;
+ERROR: ns-image-planar-images-not-supported ;
+
+<PRIVATE
+
+: check-return ( n -- )
+ {
+ { $ NSImageRepLoadStatusUnknownType [ ns-image-unknown-type ] }
+ { $ NSImageRepLoadStatusInvalidData [ ns-image-invalid-data ] }
+ { $ NSImageRepLoadStatusUnexpectedEOF [ ns-image-unexpected-eof ] }
+ [ drop ]
+ } case ;
+
+PRIVATE>
+
+: load-image-rep ( -- image-rep )
+ NSBitmapImageRep contents <CFData> -> autorelease -> imageRepWithData:
+ NSColorSpace -> genericRGBColorSpace
+ NSColorRenderingIntentDefault
+ -> bitmapImageRepByConvertingToColorSpace:renderingIntent: ;
+
+: image-rep>image ( image-rep -- image )
+ image new swap {
+ [ -> size CGSize>dim [ >integer ] map >>dim ]
+ [ -> bitmapData ]
+ [ -> bytesPerPlane memory>byte-array >>bitmap ]
+ } cleave
+ RGBA >>component-order
+ ubyte-components >>component-type
+ t >>premultiplied-alpha?
+ f >>upside-down? ;
+
+M: ns-image stream>image
+ drop
+ [ load-image-rep ] with-input-stream image-rep>image ;
--- /dev/null
+Image loading using MacOS X's native Cocoa APIs
--- /dev/null
+! (c)2010 Joe Groff bsd license\r
+USING: accessors alien.c-types alien.data alien.enums\r
+classes.struct destructors images images.loader\r
+io.streams.limited kernel locals math windows.com\r
+windows.gdiplus windows.streams windows.types typed\r
+byte-arrays grouping sequences ;\r
+IN: images.gdiplus\r
+\r
+SINGLETON: gdi+-image\r
+"png" gdi+-image register-image-class\r
+"tif" gdi+-image register-image-class\r
+"tiff" gdi+-image register-image-class\r
+"gif" gdi+-image register-image-class\r
+"jpg" gdi+-image register-image-class\r
+"jpeg" gdi+-image register-image-class\r
+"bmp" gdi+-image register-image-class\r
+"ico" gdi+-image register-image-class\r
+\r
+<PRIVATE\r
+: <GpRect> ( x y w h -- rect )\r
+ GpRect <struct-boa> ; inline\r
+\r
+: stream>gdi+-bitmap ( stream -- bitmap )\r
+ stream>IStream &com-release\r
+ { void* } [ GdipCreateBitmapFromStream check-gdi+-status ]\r
+ [ ] with-out-parameters &GdipFree ;\r
+\r
+: gdi+-bitmap-width ( bitmap -- w )\r
+ { UINT } [ GdipGetImageWidth check-gdi+-status ]\r
+ [ ] with-out-parameters ;\r
+: gdi+-bitmap-height ( bitmap -- w )\r
+ { UINT } [ GdipGetImageHeight check-gdi+-status ]\r
+ [ ] with-out-parameters ;\r
+: gdi+-lock-bitmap ( bitmap rect mode format -- data )\r
+ { BitmapData } [ GdipBitmapLockBits check-gdi+-status ]\r
+ [ clone ] with-out-parameters ;\r
+\r
+:: gdi+-bitmap>data ( bitmap -- w h pixels )\r
+ bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )\r
+ bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number\r
+ PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data\r
+ bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * ] tri\r
+ memory>byte-array :> pixels\r
+ bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status\r
+ w h pixels ;\r
+ \r
+:: data>image ( w h pixels -- image )\r
+ image new\r
+ { w h } >>dim\r
+ pixels >>bitmap\r
+ BGRA >>component-order\r
+ ubyte-components >>component-type\r
+ f >>upside-down? ;\r
+\r
+PRIVATE>\r
+\r
+M: gdi+-image stream>image\r
+ drop [\r
+ start-gdi+ &stop-gdi+ drop\r
+ stream>gdi+-bitmap\r
+ gdi+-bitmap>data\r
+ data>image\r
+ ] with-destructors ;\r
--- /dev/null
+Philipp Brüschweiler
--- /dev/null
+! Copyright (C) 2010 Philipp Brüschweiler.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.data arrays combinators
+destructors gdk.pixbuf.ffi gobject.ffi grouping images
+images.loader io kernel locals math sequences
+specialized-arrays ;
+IN: images.gtk
+SPECIALIZED-ARRAY: uchar
+
+SINGLETON: gtk-image
+"png" gtk-image register-image-class
+"tif" gtk-image register-image-class
+"tiff" gtk-image register-image-class
+"gif" gtk-image register-image-class
+"jpg" gtk-image register-image-class
+"jpeg" gtk-image register-image-class
+"bmp" gtk-image register-image-class
+"ico" gtk-image register-image-class
+
+<PRIVATE
+
+: image-data ( GdkPixbuf -- data )
+ {
+ [ gdk_pixbuf_get_pixels ]
+ [ gdk_pixbuf_get_width ]
+ [ gdk_pixbuf_get_height ]
+ [ gdk_pixbuf_get_rowstride ]
+ [ gdk_pixbuf_get_n_channels ]
+ [ gdk_pixbuf_get_bits_per_sample ]
+ } cleave
+ [let :> ( pixels w h rowstride channels bps )
+ bps channels * 7 + 8 /i w * :> bytes-per-row
+
+ bytes-per-row rowstride =
+ [ pixels h rowstride * memory>byte-array ]
+ [
+ pixels rowstride h * <direct-uchar-array>
+ rowstride <sliced-groups>
+ [ bytes-per-row head-slice ] map concat
+ ] if
+ ] ;
+
+: component-type ( GdkPixbuf -- component-type )
+ gdk_pixbuf_get_bits_per_sample {
+ { 8 [ ubyte-components ] }
+ { 16 [ ushort-components ] }
+ { 32 [ uint-components ] }
+ } case ;
+
+: GdkPixbuf>image ( GdkPixbuf -- image )
+ [ image new ] dip
+ {
+ [ [ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array >>dim ]
+ [ image-data >>bitmap ]
+ [ gdk_pixbuf_get_has_alpha RGBA RGB ? >>component-order ]
+ [ component-type >>component-type ]
+ } cleave
+ f >>premultiplied-alpha?
+ f >>upside-down? ;
+
+PRIVATE>
+
+M: gtk-image stream>image
+ drop [
+ stream-contents data>GInputStream &g_object_unref
+ GInputStream>GdkPixbuf &g_object_unref
+ GdkPixbuf>image
+ ] with-destructors ;
--- /dev/null
+linux
+bsd
--- /dev/null
+Image loading using GTK's GdkPixbuf API
USING: images tools.test kernel accessors ;
IN: images.tests
-[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components 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
57 57 57 255
0 0 0 0
0 0 0 0
-} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components 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
UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
-TUPLE: image dim component-order component-type upside-down? bitmap ;
+TUPLE: image
+ dim component-order component-type
+ upside-down? premultiplied-alpha?
+ bitmap ;
: <image> ( -- image ) image new ; inline
+++ /dev/null
-! Copyright (C) 2009 Marc Fauconneau.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays combinators
-compression.huffman fry grouping images images.loader
-images.processing io io.binary io.encodings.binary
-io.streams.byte-array io.streams.limited io.streams.throwing
-kernel locals math math.bitwise math.blas.matrices
-math.blas.vectors math.constants math.functions math.matrices
-math.order math.vectors memoize namespaces sequences
-sequences.deep ;
-QUALIFIED-WITH: bitstreams bs
-IN: images.jpeg
-
-SINGLETON: jpeg-image
-
-TUPLE: loading-jpeg < image
- { headers }
- { bitstream }
- { color-info initial: { f f f f } }
- { quant-tables initial: { f f } }
- { huff-tables initial: { f f f f } }
- { components } ;
-
-"jpg" jpeg-image register-image-class
-"jpeg" jpeg-image register-image-class
-
-<PRIVATE
-
-: <loading-jpeg> ( headers bitstream -- image )
- loading-jpeg new swap >>bitstream swap >>headers ;
-
-SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP
-APP JPG COM TEM RES ;
-
-! ISO/IEC 10918-1 Table B.1
-:: >marker ( byte -- marker )
- byte
- {
- { [ dup HEX: CC = ] [ { DAC } ] }
- { [ dup HEX: C4 = ] [ { DHT } ] }
- { [ dup HEX: C9 = ] [ { JPG } ] }
- { [ dup -4 shift HEX: C = ] [ SOF byte 4 bits 2array ] }
-
- { [ dup HEX: D8 = ] [ { SOI } ] }
- { [ dup HEX: D9 = ] [ { EOI } ] }
- { [ dup HEX: DA = ] [ { SOS } ] }
- { [ dup HEX: DB = ] [ { DQT } ] }
- { [ dup HEX: DC = ] [ { DNL } ] }
- { [ dup HEX: DD = ] [ { DRI } ] }
- { [ dup HEX: DE = ] [ { DHP } ] }
- { [ dup HEX: DF = ] [ { EXP } ] }
- { [ dup -4 shift HEX: D = ] [ RST byte 4 bits 2array ] }
-
- { [ dup -4 shift HEX: E = ] [ APP byte 4 bits 2array ] }
- { [ dup HEX: FE = ] [ { COM } ] }
- { [ dup -4 shift HEX: F = ] [ JPG byte 4 bits 2array ] }
-
- { [ dup HEX: 01 = ] [ { TEM } ] }
- [ { RES } ]
- }
- cond nip ;
-
-TUPLE: jpeg-chunk length type data ;
-
-: <jpeg-chunk> ( type length data -- jpeg-chunk )
- jpeg-chunk new
- swap >>data
- swap >>length
- swap >>type ;
-
-TUPLE: jpeg-color-info
- h v quant-table dc-huff-table ac-huff-table { diff initial: 0 } id ;
-
-: <jpeg-color-info> ( h v quant-table -- jpeg-color-info )
- jpeg-color-info new
- swap >>quant-table
- swap >>v
- swap >>h ;
-
-: jpeg> ( -- jpeg-image ) jpeg-image get ;
-
-: apply-diff ( dc color -- dc' )
- [ diff>> + dup ] [ diff<< ] bi ;
-
-: fetch-tables ( component -- )
- [ [ jpeg> quant-tables>> nth ] change-quant-table drop ]
- [ [ jpeg> huff-tables>> nth ] change-dc-huff-table drop ]
- [ [ 2 + jpeg> huff-tables>> nth ] change-ac-huff-table drop ] tri ;
-
-: read4/4 ( -- a b ) read1 16 /mod ;
-
-! headers
-
-: decode-frame ( header -- )
- data>>
- binary
- [
- read1 8 assert=
- 2 read be>
- 2 read be>
- swap 2array jpeg> dim<<
- read1
- [
- read1 read4/4 read1 <jpeg-color-info>
- swap [ >>id ] keep jpeg> color-info>> set-nth
- ] times
- ] with-byte-reader ;
-
-: decode-quant-table ( chunk -- )
- dup data>>
- binary
- [
- length>>
- 2 - 65 /
- [
- read4/4 [ 0 assert= ] dip
- 64 read
- swap jpeg> quant-tables>> set-nth
- ] times
- ] with-byte-reader ;
-
-: decode-huff-table ( chunk -- )
- data>> [ binary <byte-reader> ] [ length ] bi limit-stream [
- [ input-stream get stream>> [ count>> ] [ limit>> ] bi < ]
- [
- read4/4 swap 2 * +
- 16 read
- dup [ ] [ + ] map-reduce read
- binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader
- swap jpeg> huff-tables>> set-nth
- ] while
- ] stream-throw-on-eof ;
-
-: decode-scan ( chunk -- )
- data>>
- binary
- [
- read1 iota
- [ drop
- read1 jpeg> color-info>> nth clone
- read1 16 /mod [ >>dc-huff-table ] [ >>ac-huff-table ] bi*
- ] map jpeg> components<<
- read1 0 assert=
- read1 63 assert=
- read1 16 /mod [ 0 assert= ] bi@
- ] with-byte-reader ;
-
-: singleton-first ( seq -- elt )
- [ length 1 assert= ] [ first ] bi ;
-
-ERROR: not-a-baseline-jpeg-image ;
-
-: baseline-parse ( -- )
- jpeg> headers>> [ type>> { SOF 0 } = ] any? [ not-a-baseline-jpeg-image ] unless
- jpeg> headers>>
- {
- [ [ type>> { SOF 0 } = ] filter singleton-first decode-frame ]
- [ [ type>> { DQT } = ] filter [ decode-quant-table ] each ]
- [ [ type>> { DHT } = ] filter [ decode-huff-table ] each ]
- [ [ type>> { SOS } = ] filter singleton-first decode-scan ]
- } cleave ;
-
-: parse-marker ( -- marker )
- read1 HEX: FF assert=
- read1 >marker ;
-
-: parse-headers ( -- chunks )
- [ parse-marker dup { SOS } = not ]
- [
- 2 read be>
- dup 2 - read <jpeg-chunk>
- ] [ produce ] keep dip swap suffix ;
-
-MEMO: zig-zag ( -- zz )
- {
- { 0 1 5 6 14 15 27 28 }
- { 2 4 7 13 16 26 29 42 }
- { 3 8 12 17 25 30 41 43 }
- { 9 11 18 24 31 40 44 53 }
- { 10 19 23 32 39 45 52 54 }
- { 20 22 33 38 46 51 55 60 }
- { 21 34 37 47 50 56 59 61 }
- { 35 36 48 49 57 58 62 63 }
- } flatten ;
-
-MEMO: yuv>bgr-matrix ( -- m )
- {
- { 1 2.03211 0 }
- { 1 -0.39465 -0.58060 }
- { 1 0 1.13983 }
- } ;
-
-: wave ( x u -- n ) swap 2 * 1 + * pi * 16 / cos ;
-
-:: dct-vect ( u v -- basis )
- { 8 8 } coord-matrix [ { u v } [ wave ] 2map product ] map^2
- 1 u v [ 0 = [ 2 sqrt / ] when ] bi@ 4 / m*n ;
-
-MEMO: dct-matrix ( -- m ) 64 iota [ 8 /mod dct-vect flatten ] map ;
-
-: mb-dim ( component -- dim ) [ h>> ] [ v>> ] bi 2array ;
-
-! : blocks ( component -- seq )
-! mb-dim ! coord-matrix flip concat [ [ { 2 2 } v* ] [ v+ ] bi* ] with map ;
-
-: all-macroblocks ( quot: ( mb -- ) -- )
- [
- jpeg>
- [ dim>> 8 v/n ]
- [ color-info>> sift { 0 0 } [ mb-dim vmax ] reduce v/ ] bi
- [ ceiling ] map
- coord-matrix flip concat
- ]
- [ each ] bi* ; inline
-
-: reverse-zigzag ( b -- b' ) zig-zag swap [ nth ] curry map ;
-
-: idct-factor ( b -- b' ) dct-matrix v.m ;
-
-MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
-: V.M ( x A -- x.A ) Mtranspose swap M.V ;
-: idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ;
-
-: idct ( b -- b' ) idct-factor ;
-
-:: draw-block ( block x,y color-id jpeg-image -- )
- block dup length>> sqrt >fixnum group flip
- dup matrix-dim coord-matrix flip
- [
- [ '[ _ [ second ] [ first ] bi ] dip nth nth ]
- [ x,y v+ color-id jpeg-image draw-color ] bi
- ] with each^2 ;
-
-: sign-extend ( bits v -- v' )
- swap [ ] [ 1 - 2^ < ] 2bi
- [ -1 swap shift 1 + + ] [ drop ] if ;
-
-: read1-jpeg-dc ( decoder -- dc )
- [ read1-huff dup ] [ bs>> bs:read ] bi sign-extend ;
-
-: read1-jpeg-ac ( decoder -- run/ac )
- [ read1-huff 16 /mod dup ] [ bs>> bs:read ] bi sign-extend 2array ;
-
-:: decode-block ( color -- pixels )
- color dc-huff-table>> read1-jpeg-dc color apply-diff
- 64 0 <array> :> coefs
- 0 coefs set-nth
- 0 :> k!
- [
- color ac-huff-table>> read1-jpeg-ac
- [ first 1 + k + k! ] [ second k coefs set-nth ] [ ] tri
- { 0 0 } = not
- k 63 < and
- ] loop
- coefs color quant-table>> v*
- reverse-zigzag idct ;
-
-:: draw-macroblock-yuv420 ( mb blocks -- )
- mb { 16 16 } v* :> pos
- 0 blocks nth pos { 0 0 } v+ 0 jpeg> draw-block
- 1 blocks nth pos { 8 0 } v+ 0 jpeg> draw-block
- 2 blocks nth pos { 0 8 } v+ 0 jpeg> draw-block
- 3 blocks nth pos { 8 8 } v+ 0 jpeg> draw-block
- 4 blocks nth 8 group 2 matrix-zoom concat pos 1 jpeg> draw-block
- 5 blocks nth 8 group 2 matrix-zoom concat pos 2 jpeg> draw-block ;
-
-:: draw-macroblock-yuv444 ( mb blocks -- )
- mb { 8 8 } v* :> pos
- 3 iota [ [ blocks nth pos ] [ jpeg> draw-block ] bi ] each ;
-
-:: draw-macroblock-y ( mb blocks -- )
- mb { 8 8 } v* :> pos
- 0 blocks nth pos 0 jpeg> draw-block
- 64 0 <array> pos 1 jpeg> draw-block
- 64 0 <array> pos 2 jpeg> draw-block ;
-
- ! %fixme: color hack
- ! color h>> 2 =
- ! [ 8 group 2 matrix-zoom concat ] unless
- ! pos { 8 8 } v* color jpeg> draw-block ;
-
-: decode-macroblock ( -- blocks )
- jpeg> components>>
- [
- [ mb-dim first2 * ]
- [ [ decode-block ] curry replicate ] bi
- ] map concat ;
-
-: cleanup-bitstream ( bytes -- bytes' )
- binary [
- [
- { HEX: FF } read-until
- read1 [ HEX: 00 = and ] keep swap
- ]
- [ drop ] produce
- swap >marker { EOI } assert=
- swap suffix
- { HEX: FF } join
- ] with-byte-reader ;
-
-: setup-bitmap ( image -- )
- dup dim>> 16 v/n [ ceiling ] map 16 v*n >>dim
- BGR >>component-order
- ubyte-components >>component-type
- f >>upside-down?
- dup dim>> first2 * 3 * 0 <array> >>bitmap
- drop ;
-
-ERROR: unsupported-colorspace ;
-SINGLETONS: YUV420 YUV444 Y MAGIC! ;
-
-:: detect-colorspace ( jpeg-image -- csp )
- jpeg-image color-info>> sift :> colors
- MAGIC!
- colors length 1 = [ drop Y ] when
- colors length 3 =
- [
- colors [ mb-dim { 1 1 } = ] all?
- [ drop YUV444 ] when
-
- colors unclip
- [ [ mb-dim { 1 1 } = ] all? ]
- [ mb-dim { 2 2 } = ] bi* and
- [ drop YUV420 ] when
- ] when ;
-
-! this eats ~50% cpu time
-: draw-macroblocks ( mbs -- )
- jpeg> detect-colorspace
- {
- { YUV420 [ [ first2 draw-macroblock-yuv420 ] each ] }
- { YUV444 [ [ first2 draw-macroblock-yuv444 ] each ] }
- { Y [ [ first2 draw-macroblock-y ] each ] }
- [ unsupported-colorspace ]
- } case ;
-
-! this eats ~25% cpu time
-: color-transform ( yuv -- rgb )
- { 128 0 0 } v+ yuv>bgr-matrix swap m.v
- [ 0 max 255 min >fixnum ] map ;
-
-: baseline-decompress ( -- )
- jpeg> bitstream>> cleanup-bitstream { 255 255 255 255 } append
- >byte-array bs:<msb0-bit-reader> jpeg> bitstream<<
- jpeg>
- [ bitstream>> ]
- [ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi
- jpeg> components>> [ fetch-tables ] each
- [ decode-macroblock 2array ] collector
- [ all-macroblocks ] dip
- jpeg> setup-bitmap draw-macroblocks
- jpeg> bitmap>> 3 <groups> [ color-transform ] map! drop
- jpeg> [ >byte-array ] change-bitmap drop ;
-
-ERROR: not-a-jpeg-image ;
-
-: loading-jpeg>image ( loading-jpeg -- image )
- dup jpeg-image [
- baseline-parse
- baseline-decompress
- ] with-variable ;
-
-: load-jpeg ( stream -- loading-jpeg )
- [
- parse-marker { SOI } = [ not-a-jpeg-image ] unless
- parse-headers
- contents <loading-jpeg>
- ] with-input-stream ;
-
-PRIVATE>
-
-M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
- drop load-jpeg loading-jpeg>image ;
+++ /dev/null
-Erik Charlebois
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing ;
-IN: images.pbm.tests
-
-"vocab:images/testing/pbm/test.binary.pbm" decode-test
-"vocab:images/testing/pbm/test.ascii.pbm" decode-test
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays ascii bit-arrays byte-arrays combinators
-continuations grouping images images.loader io io.encodings.ascii
-io.encodings.string kernel locals make math math.functions math.parser
-sequences io.streams.throwing ;
-IN: images.pbm
-
-SINGLETON: pbm-image
-"pbm" pbm-image register-image-class
-
-<PRIVATE
-: read-token ( -- token )
- [
- read1 dup blank?
- [ t ]
- [
- dup CHAR: # =
- [ "\n" read-until 2drop t ]
- [ f ] if
- ] if
- ] [ drop ] while
- " \n\r\t" read-until drop swap
- prefix ascii decode ;
-
-: read-number ( -- number )
- read-token string>number ;
-
-: read-ascii-bits ( -- )
- read1 {
- { CHAR: 1 [ 0 , read-ascii-bits ] }
- { CHAR: 0 [ 255 , read-ascii-bits ] }
- { f [ ] }
- [ drop read-ascii-bits ]
- } case ;
-
-:: read-binary-bits ( width height -- )
- width 8 align 8 / height * read
- width 8 align 8 / <groups> [| row |
- width iota [| n |
- n 8 / floor row nth
- n 8 mod 7 swap - bit?
- [ 0 ] [ 255 ] if ,
- ] each
- ] each ;
-
-:: write-binary-bits ( bitmap width -- )
- bitmap width <groups> [
- width 8 align 255 pad-tail
- 8 <groups> [
- [ 255 = [ f ] [ t ] if ] { } map-as
- >bit-array reverse bit-array>integer
- 1array >byte-array write
- ] each
- ] each ;
-
-:: read-pbm ( -- image )
- read-token :> type
- read-number :> width
- read-number :> height
-
- type {
- { "P1" [ [ [ read-ascii-bits ] ignore-errors ] B{ } make ] }
- { "P4" [ [ width height read-binary-bits ] B{ } make ] }
- } case :> data
-
- image new
- L >>component-order
- { width height } >>dim
- f >>upside-down?
- data >>bitmap
- ubyte-components >>component-type ;
-PRIVATE>
-
-M: pbm-image stream>image
- drop [ [ read-pbm ] throw-on-eof ] with-input-stream ;
-
-M: pbm-image image>stream
- drop {
- [ drop "P4\n" ascii encode write ]
- [ dim>> first number>string " " append ascii encode write ]
- [ dim>> second number>string "\n" append ascii encode write ]
- [ [ bitmap>> ] [ dim>> first ] bi write-binary-bits ]
- } cleave ;
+++ /dev/null
-Image loading for PBM image files.
+++ /dev/null
-Erik Charlebois
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing ;
-IN: images.pgm.tests
-
-"vocab:images/testing/pgm/radial.binary.pgm" decode-test
-"vocab:images/testing/pgm/radial.ascii.pgm" decode-test
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types ascii combinators images images.loader
-io io.encodings.ascii io.encodings.string kernel locals make math
-math.parser sequences specialized-arrays io.streams.throwing ;
-SPECIALIZED-ARRAY: ushort
-IN: images.pgm
-
-SINGLETON: pgm-image
-"pgm" pgm-image register-image-class
-
-: read-token ( -- token )
- [ read1 dup blank?
- [ t ]
- [ dup CHAR: # =
- [ "\n" read-until 2drop t ]
- [ f ] if
- ] if
- ] [ drop ] while
- " \n\r\t" read-until drop swap
- prefix ascii decode ;
-
-: read-number ( -- number )
- read-token string>number ;
-
-:: read-numbers ( n lim -- )
- n lim = [
- read-number ,
- n 1 + lim read-numbers
- ] unless ;
-
-:: read-pgm ( -- image )
- read-token :> type
- read-number :> width
- read-number :> height
- read-number :> max
- width height * :> npixels
- max 256 >= :> wide
-
- type {
- { "P2" [ [ 0 npixels read-numbers ] wide [ ushort-array{ } ] [ B{ } ] if make ] }
- { "P5" [ wide [ 2 ] [ 1 ] if npixels * read ] }
- } case :> data
-
- image new
- L >>component-order
- { width height } >>dim
- f >>upside-down?
- data >>bitmap
- wide [ ushort-components ] [ ubyte-components ] if >>component-type ;
-
-M: pgm-image stream>image
- drop [ [ read-pgm ] throw-on-eof ] with-input-stream ;
-
-M: pgm-image image>stream
- drop {
- [ drop "P5\n" ascii encode write ]
- [ dim>> first number>string " " append ascii encode write ]
- [ dim>> second number>string "\n" append ascii encode write ]
- [ component-type>> ubyte-components = [ "255\n" ] [ "65535\n" ] if ascii encode write ]
- [ bitmap>> write ]
- } cleave ;
+++ /dev/null
-Image loading for PGM image files.
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman, Keith Lazuka
-! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing io.directories ;
-IN: images.png.tests
-
-! Test files from PngSuite (http://www.libpng.org/pub/png/pngsuite.html)
-
-! The subset of the suite that should work given the current implementation.
-"vocab:images/testing/png" [
- "basi0g01.png" decode-test
- "basi0g02.png" decode-test
- "basi0g04.png" decode-test
- "basi0g08.png" decode-test
- "basi0g16.png" decode-test
- "basi2c08.png" decode-test
- "basi3p01.png" decode-test
- "basi3p02.png" decode-test
- "basi3p04.png" decode-test
- "basi3p08.png" decode-test
- "basn0g01.png" decode-test
- "basn0g02.png" decode-test
- "basn0g04.png" decode-test
- "basn0g08.png" decode-test
- "basn0g16.png" decode-test
- "basn2c08.png" decode-test
- "basn3p01.png" decode-test
- "basn3p02.png" decode-test
- "basn3p04.png" decode-test
- "basn3p08.png" decode-test
- "basn6a08.png" decode-test
- "f00n2c08.png" decode-test
- "f01n2c08.png" decode-test
- "f02n2c08.png" decode-test
- "f03n2c08.png" decode-test
- "f04n2c08.png" decode-test
- "s01i3p01.png" decode-test
- "s01n3p01.png" decode-test
- "s02i3p01.png" decode-test
- "s02n3p01.png" decode-test
- "s03i3p01.png" decode-test
- "s03n3p01.png" decode-test
- "s04i3p01.png" decode-test
- "s04n3p01.png" decode-test
- "s05i3p02.png" decode-test
- "s05n3p02.png" decode-test
- "s06i3p02.png" decode-test
- "s06n3p02.png" decode-test
- "s07i3p02.png" decode-test
- "s07n3p02.png" decode-test
- "s08i3p02.png" decode-test
- "s08n3p02.png" decode-test
- "s09i3p02.png" decode-test
- "s32n3p04.png" decode-test
- "s32i3p04.png" decode-test
- "s33n3p04.png" decode-test
- "s33i3p04.png" decode-test
- "s34n3p04.png" decode-test
- "s34i3p04.png" decode-test
- "s35n3p04.png" decode-test
- "s35i3p04.png" decode-test
- "s36n3p04.png" decode-test
- "s36i3p04.png" decode-test
- "s37n3p04.png" decode-test
- "s37i3p04.png" decode-test
- "s38n3p04.png" decode-test
- "s38i3p04.png" decode-test
- "s39n3p04.png" decode-test
- "s39i3p04.png" decode-test
- "s40n3p04.png" decode-test
- "s40i3p04.png" decode-test
- "s07n3p02.png" decode-test
- "z00n2c08.png" decode-test
- "z03n2c08.png" decode-test
- "z06n2c08.png" decode-test
- "z09n2c08.png" decode-test
-] with-directory
-
-! The current PNG decoder implementation is very limited,
-! so the entire test suite is not currently enabled.
-! "vocab:images/testing/png/suite" [
-! "basi0g01.png" decode-test
-! "basi0g02.png" decode-test
-! "basi0g04.png" decode-test
-! "basi0g08.png" decode-test
-! "basi0g16.png" decode-test
-! "basi2c08.png" decode-test
-! "basi2c16.png" decode-test
-! "basi3p01.png" decode-test
-! "basi3p02.png" decode-test
-! "basi3p04.png" decode-test
-! "basi3p08.png" decode-test
-! "basi4a08.png" decode-test
-! "basi4a16.png" decode-test
-! "basi6a08.png" decode-test
-! "basi6a16.png" decode-test
-! "basn0g01.png" decode-test
-! "basn0g02.png" decode-test
-! "basn0g04.png" decode-test
-! "basn0g08.png" decode-test
-! "basn0g16.png" decode-test
-! "basn2c08.png" decode-test
-! "basn2c16.png" decode-test
-! "basn3p01.png" decode-test
-! "basn3p02.png" decode-test
-! "basn3p04.png" decode-test
-! "basn3p08.png" decode-test
-! "basn4a08.png" decode-test
-! "basn4a16.png" decode-test
-! "basn6a08.png" decode-test
-! "basn6a16.png" decode-test
-! "bgai4a08.png" decode-test
-! "bgai4a16.png" decode-test
-! "bgan6a08.png" decode-test
-! "bgan6a16.png" decode-test
-! "bgbn4a08.png" decode-test
-! "bggn4a16.png" decode-test
-! "bgwn6a08.png" decode-test
-! "bgyn6a16.png" decode-test
-! "ccwn2c08.png" decode-test
-! "ccwn3p08.png" decode-test
-! "cdfn2c08.png" decode-test
-! "cdhn2c08.png" decode-test
-! "cdsn2c08.png" decode-test
-! "cdun2c08.png" decode-test
-! "ch1n3p04.png" decode-test
-! "ch2n3p08.png" decode-test
-! "cm0n0g04.png" decode-test
-! "cm7n0g04.png" decode-test
-! "cm9n0g04.png" decode-test
-! "cs3n2c16.png" decode-test
-! "cs3n3p08.png" decode-test
-! "cs5n2c08.png" decode-test
-! "cs5n3p08.png" decode-test
-! "cs8n2c08.png" decode-test
-! "cs8n3p08.png" decode-test
-! "ct0n0g04.png" decode-test
-! "ct1n0g04.png" decode-test
-! "ctzn0g04.png" decode-test
-! "f00n0g08.png" decode-test
-! "f00n2c08.png" decode-test
-! "f01n0g08.png" decode-test
-! "f01n2c08.png" decode-test
-! "f02n0g08.png" decode-test
-! "f02n2c08.png" decode-test
-! "f03n0g08.png" decode-test
-! "f03n2c08.png" decode-test
-! "f04n0g08.png" decode-test
-! "f04n2c08.png" decode-test
-! "g03n0g16.png" decode-test
-! "g03n2c08.png" decode-test
-! "g03n3p04.png" decode-test
-! "g04n0g16.png" decode-test
-! "g04n2c08.png" decode-test
-! "g04n3p04.png" decode-test
-! "g05n0g16.png" decode-test
-! "g05n2c08.png" decode-test
-! "g05n3p04.png" decode-test
-! "g07n0g16.png" decode-test
-! "g07n2c08.png" decode-test
-! "g07n3p04.png" decode-test
-! "g10n0g16.png" decode-test
-! "g10n2c08.png" decode-test
-! "g10n3p04.png" decode-test
-! "g25n0g16.png" decode-test
-! "g25n2c08.png" decode-test
-! "g25n3p04.png" decode-test
-! "oi1n0g16.png" decode-test
-! "oi1n2c16.png" decode-test
-! "oi2n0g16.png" decode-test
-! "oi2n2c16.png" decode-test
-! "oi4n0g16.png" decode-test
-! "oi4n2c16.png" decode-test
-! "oi9n0g16.png" decode-test
-! "oi9n2c16.png" decode-test
-! "pngsuite_logo.png" decode-test
-! "pp0n2c16.png" decode-test
-! "pp0n6a08.png" decode-test
-! "ps1n0g08.png" decode-test
-! "ps1n2c16.png" decode-test
-! "ps2n0g08.png" decode-test
-! "ps2n2c16.png" decode-test
-! "s01i3p01.png" decode-test
-! "s01n3p01.png" decode-test
-! "s02i3p01.png" decode-test
-! "s02n3p01.png" decode-test
-! "s03i3p01.png" decode-test
-! "s03n3p01.png" decode-test
-! "s04i3p01.png" decode-test
-! "s04n3p01.png" decode-test
-! "s05i3p02.png" decode-test
-! "s05n3p02.png" decode-test
-! "s06i3p02.png" decode-test
-! "s06n3p02.png" decode-test
-! "s07i3p02.png" decode-test
-! "s07n3p02.png" decode-test
-! "s08i3p02.png" decode-test
-! "s08n3p02.png" decode-test
-! "s09i3p02.png" decode-test
-! "s09n3p02.png" decode-test
-! "s32i3p04.png" decode-test
-! "s32n3p04.png" decode-test
-! "s33i3p04.png" decode-test
-! "s33n3p04.png" decode-test
-! "s34i3p04.png" decode-test
-! "s34n3p04.png" decode-test
-! "s35i3p04.png" decode-test
-! "s35n3p04.png" decode-test
-! "s36i3p04.png" decode-test
-! "s36n3p04.png" decode-test
-! "s37i3p04.png" decode-test
-! "s37n3p04.png" decode-test
-! "s38i3p04.png" decode-test
-! "s38n3p04.png" decode-test
-! "s39i3p04.png" decode-test
-! "s39n3p04.png" decode-test
-! "s40i3p04.png" decode-test
-! "s40n3p04.png" decode-test
-! "tbbn1g04.png" decode-test
-! "tbbn2c16.png" decode-test
-! "tbbn3p08.png" decode-test
-! "tbgn2c16.png" decode-test
-! "tbgn3p08.png" decode-test
-! "tbrn2c08.png" decode-test
-! "tbwn1g16.png" decode-test
-! "tbwn3p08.png" decode-test
-! "tbyn3p08.png" decode-test
-! "tp0n1g08.png" decode-test
-! "tp0n2c08.png" decode-test
-! "tp0n3p08.png" decode-test
-! "tp1n3p08.png" decode-test
-! "x00n0g01.png" decode-test
-! "xcrn0g04.png" decode-test
-! "xlfn0g04.png" decode-test
-! "z00n2c08.png" decode-test
-! "z03n2c08.png" decode-test
-! "z06n2c08.png" decode-test
-! "z09n2c08.png" decode-test
-! ] with-directory
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays checksums checksums.crc32 combinators
-compression.inflate fry grouping images images.loader io
-io.binary io.encodings.ascii io.encodings.string kernel locals
-math math.bitwise math.ranges sequences sorting assocs
-math.functions math.order byte-arrays io.streams.throwing ;
-QUALIFIED-WITH: bitstreams bs
-IN: images.png
-
-SINGLETON: png-image
-"png" png-image register-image-class
-
-TUPLE: loading-png
- chunks
- width height bit-depth color-type compression-method
- filter-method interlace-method uncompressed ;
-
-CONSTANT: filter-none 0
-CONSTANT: filter-sub 1
-CONSTANT: filter-up 2
-CONSTANT: filter-average 3
-CONSTANT: filter-paeth 4
-
-CONSTANT: greyscale 0
-CONSTANT: truecolor 2
-CONSTANT: indexed-color 3
-CONSTANT: greyscale-alpha 4
-CONSTANT: truecolor-alpha 6
-
-CONSTANT: interlace-none 0
-CONSTANT: interlace-adam7 1
-
-CONSTANT: starting-row { 0 0 4 0 2 0 1 }
-CONSTANT: starting-col { 0 4 0 2 0 1 0 }
-CONSTANT: row-increment { 8 8 8 4 4 2 2 }
-CONSTANT: col-increment { 8 8 4 4 2 2 1 }
-CONSTANT: block-height { 8 8 4 4 2 2 1 }
-CONSTANT: block-width { 8 4 4 2 2 1 1 }
-
-: <loading-png> ( -- image )
- loading-png new
- V{ } clone >>chunks ;
-
-TUPLE: png-chunk length type data ;
-
-: <png-chunk> ( -- png-chunk )
- png-chunk new ; inline
-
-CONSTANT: png-header
- B{ HEX: 89 HEX: 50 HEX: 4e HEX: 47 HEX: 0d HEX: 0a HEX: 1a HEX: 0a }
-
-ERROR: bad-png-header header ;
-
-: read-png-header ( -- )
- 8 read dup png-header sequence= [
- bad-png-header
- ] unless drop ;
-
-ERROR: bad-checksum ;
-
-: read-png-chunks ( loading-png -- loading-png )
- <png-chunk>
- 4 read be> [ >>length ] [ 4 + ] bi
- read dup crc32 checksum-bytes
- 4 read = [ bad-checksum ] unless
- 4 cut-slice
- [ ascii decode >>type ] [ B{ } like >>data ] bi*
- [ over chunks>> push ]
- [ type>> ] bi "IEND" =
- [ read-png-chunks ] unless ;
-
-: find-chunk ( loading-png string -- chunk )
- [ chunks>> ] dip '[ type>> _ = ] find nip ;
-
-: find-chunks ( loading-png string -- chunk )
- [ chunks>> ] dip '[ type>> _ = ] filter ;
-
-: parse-ihdr-chunk ( loading-png -- loading-png )
- dup "IHDR" find-chunk data>> {
- [ [ 0 4 ] dip subseq be> >>width ]
- [ [ 4 8 ] dip subseq be> >>height ]
- [ [ 8 ] dip nth >>bit-depth ]
- [ [ 9 ] dip nth >>color-type ]
- [ [ 10 ] dip nth >>compression-method ]
- [ [ 11 ] dip nth >>filter-method ]
- [ [ 12 ] dip nth >>interlace-method ]
- } cleave ;
-
-: find-compressed-bytes ( loading-png -- bytes )
- "IDAT" find-chunks [ data>> ] map concat ;
-
-ERROR: unknown-color-type n ;
-ERROR: unimplemented-color-type image ;
-
-: inflate-data ( loading-png -- bytes )
- find-compressed-bytes zlib-inflate ;
-
-: png-components-per-pixel ( loading-png -- n )
- color-type>> {
- { greyscale [ 1 ] }
- { truecolor [ 3 ] }
- { greyscale-alpha [ 2 ] }
- { indexed-color [ 1 ] }
- { truecolor-alpha [ 4 ] }
- [ unknown-color-type ]
- } case ; inline
-
-: png-group-width ( loading-png -- n )
- ! 1 + is for the filter type, 1 byte preceding each line
- [ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
- [ width>> ] bi * 1 + ;
-
-:: paeth ( a b c -- p )
- a b + c - { a b c } [ [ - abs ] keep 2array ] with map
- sort-keys first second ;
-
-:: png-unfilter-line ( width prev curr filter -- curr' )
- prev :> c
- prev width tail-slice :> b
- curr :> a
- curr width tail-slice :> x
- x length iota
- filter {
- { filter-none [ drop ] }
- { filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
- { filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
- { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
- { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
- } case
- curr width tail ;
-
-:: reverse-png-filter ( lines n -- byte-array )
- lines dup first length 0 <array> prefix
- [ n 1 - 0 <array> prepend ] map
- 2 clump [
- n swap first2
- [ ]
- [ n 1 - swap nth ]
- [ [ 0 n 1 - ] dip set-nth ] tri
- png-unfilter-line
- ] map B{ } concat-as ;
-
-:: visit ( row col height width pixel image -- )
- row image nth :> irow
- pixel col irow set-nth ;
-
-ERROR: bad-filter n ;
-
-:: read-scanlines ( bit-reader loading-png width height -- array )
- loading-png png-components-per-pixel :> #components
- loading-png bit-depth>> :> bit-depth
- bit-depth :> depth!
- #components width * :> count!
-
- ! Only read up to 8 bits at a time
- bit-depth 16 = [
- 8 depth!
- count 2 * count!
- ] when
-
- height [
- 8 bit-reader bs:read dup 0 4 between? [ bad-filter ] unless
- count [ depth bit-reader bs:read ] replicate swap prefix
- 8 bit-reader bs:align
- ] replicate
- #components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
-
-:: reverse-interlace-none ( byte-array loading-png -- array )
- byte-array bs:<msb0-bit-reader> :> bs
- loading-png width>> :> width
- loading-png height>> :> height
- bs loading-png width height read-scanlines ;
-
-:: adam7-subimage-height ( png-height pass -- subimage-height )
- pass starting-row nth png-height >= [
- 0
- ] [
- png-height 1 -
- pass block-height nth +
- pass row-increment nth /i
- ] if ;
-
-:: adam7-subimage-width ( png-width pass -- subimage-width )
- pass starting-col nth png-width >= [
- 0
- ] [
- png-width 1 -
- pass block-width nth +
- pass col-increment nth /i
- ] if ;
-
-:: read-adam7-subimage ( bit-reader loading-png pass -- lines )
- loading-png height>> pass adam7-subimage-height :> height
- loading-png width>> pass adam7-subimage-width :> width
-
- height width * zero? [
- B{ } clone
- ] [
- bit-reader loading-png width height read-scanlines
- ] if ;
-
-:: reverse-interlace-adam7 ( byte-array loading-png -- byte-array )
- byte-array bs:<msb0-bit-reader> :> bs
- loading-png height>> :> height
- loading-png width>> :> width
- loading-png bit-depth>> :> bit-depth
- loading-png png-components-per-pixel :> #bytes!
- width height * f <array> width <sliced-groups> :> image
-
- bit-depth 16 = [
- #bytes 2 * #bytes!
- ] when
-
- 0 :> row!
- 0 :> col!
-
- 0 :> pass!
- [ pass 7 < ] [
- bs loading-png pass read-adam7-subimage
-
- #bytes <sliced-groups>
-
- pass starting-row nth row!
- pass starting-col nth col!
- [
- [ row col f f ] dip image visit
-
- col pass col-increment nth + col!
- col width >= [
- pass starting-col nth col!
- row pass row-increment nth + row!
- ] when
- ] each
-
- pass 1 + pass!
- ] while
- image concat B{ } concat-as ;
-
-ERROR: unimplemented-interlace ;
-
-: uncompress-bytes ( loading-png -- bitstream )
- [ inflate-data ] [ ] [ interlace-method>> ] tri {
- { interlace-none [ reverse-interlace-none ] }
- { interlace-adam7 [ reverse-interlace-adam7 ] }
- [ unimplemented-interlace ]
- } case ;
-
-ERROR: unknown-component-type n ;
-
-: png-component ( loading-png -- obj )
- bit-depth>> {
- { 1 [ ubyte-components ] }
- { 2 [ ubyte-components ] }
- { 4 [ ubyte-components ] }
- { 8 [ ubyte-components ] }
- { 16 [ ushort-components ] }
- [ unknown-component-type ]
- } case ;
-
-: scale-factor ( n -- n' )
- {
- { 1 [ 255 ] }
- { 2 [ 85 ] }
- { 4 [ 17 ] }
- } case ;
-
-: scale-greyscale ( byte-array loading-png -- byte-array' )
- bit-depth>> {
- { 8 [ ] }
- { 16 [ 2 group [ swap ] assoc-map B{ } concat-as ] }
- [ scale-factor '[ _ * ] B{ } map-as ]
- } case ;
-
-: decode-greyscale ( loading-png -- byte-array )
- [ uncompress-bytes ] keep scale-greyscale ;
-
-: decode-greyscale-alpha ( loading-image -- byte-array )
- [ uncompress-bytes ] [ bit-depth>> ] bi 16 = [
- 4 group [ first4 [ swap ] 2dip 4array ] map B{ } concat-as
- ] when ;
-
-ERROR: invalid-PLTE array ;
-
-: verify-PLTE ( seq -- seq )
- dup length 3 divisor? [ invalid-PLTE ] unless ;
-
-: decode-indexed-color ( loading-image -- byte-array )
- [ uncompress-bytes ] keep
- "PLTE" find-chunk data>> verify-PLTE
- 3 group '[ _ nth ] { } map-as B{ } concat-as ;
-
-ERROR: invalid-color-type/bit-depth loading-png ;
-
-: validate-bit-depth ( loading-png seq -- loading-png )
- [ dup bit-depth>> ] dip member?
- [ invalid-color-type/bit-depth ] unless ;
-
-: validate-greyscale ( loading-png -- loading-png )
- { 1 2 4 8 16 } validate-bit-depth ;
-
-: validate-truecolor ( loading-png -- loading-png )
- { 8 16 } validate-bit-depth ;
-
-: validate-indexed-color ( loading-png -- loading-png )
- { 1 2 4 8 } validate-bit-depth ;
-
-: validate-greyscale-alpha ( loading-png -- loading-png )
- { 8 16 } validate-bit-depth ;
-
-: validate-truecolor-alpha ( loading-png -- loading-png )
- { 8 16 } validate-bit-depth ;
-
-: loading-png>bitmap ( loading-png -- bytes component-order )
- dup color-type>> {
- { greyscale [
- validate-greyscale decode-greyscale L
- ] }
- { truecolor [
- validate-truecolor uncompress-bytes RGB
- ] }
- { indexed-color [
- validate-indexed-color decode-indexed-color RGB
- ] }
- { greyscale-alpha [
- validate-greyscale-alpha decode-greyscale-alpha LA
- ] }
- { truecolor-alpha [
- validate-truecolor-alpha uncompress-bytes RGBA
- ] }
- [ unknown-color-type ]
- } case ;
-
-: loading-png>image ( loading-png -- image )
- [ image new ] dip {
- [ loading-png>bitmap [ >>bitmap ] [ >>component-order ] bi* ]
- [ [ width>> ] [ height>> ] bi 2array >>dim ]
- [ png-component >>component-type ]
- } cleave ;
-
-: load-png ( stream -- loading-png )
- [
- [
- <loading-png>
- read-png-header
- read-png-chunks
- parse-ihdr-chunk
- ] throw-on-eof
- ] with-input-stream ;
-
-M: png-image stream>image
- drop load-png loading-png>image ;
+++ /dev/null
-Erik Charlebois
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing ;
-IN: images.ppm.tests
-
-"vocab:images/testing/ppm/binary.ppm" decode-test
-"vocab:images/testing/ppm/ascii.ppm" decode-test
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii combinators images images.loader io
-io.encodings.ascii io.encodings.string kernel locals make math
-math.parser sequences io.streams.throwing ;
-IN: images.ppm
-
-SINGLETON: ppm-image
-"ppm" ppm-image register-image-class
-
-: read-token ( -- token )
- [ read1 dup blank?
- [ t ]
- [ dup CHAR: # =
- [ "\n" read-until 2drop t ]
- [ f ] if
- ] if
- ] [ drop ] while
- " \n\r\t" read-until drop swap
- prefix ascii decode ;
-
-: read-number ( -- number )
- read-token string>number ;
-
-:: read-numbers ( n lim -- )
- n lim = [
- read-number ,
- n 1 + lim read-numbers
- ] unless ;
-
-:: read-ppm ( -- image )
- read-token :> type
- read-number :> width
- read-number :> height
- read-number :> max
- width height 3 * * :> npixels
- type {
- { "P3" [ [ 0 npixels read-numbers ] B{ } make ] }
- { "P6" [ npixels read ] }
- } case :> data
-
- image new
- RGB >>component-order
- { width height } >>dim
- f >>upside-down?
- data >>bitmap
- ubyte-components >>component-type ;
-
-M: ppm-image stream>image
- drop [ [ read-ppm ] throw-on-eof ] with-input-stream ;
-
-M: ppm-image image>stream
- drop {
- [ drop "P6\n" ascii encode write ]
- [ dim>> first number>string " " append ascii encode write ]
- [ dim>> second number>string "\n" append ascii encode write ]
- [ drop "255\n" ascii encode write ]
- [ bitmap>> write ]
- } cleave ;
+++ /dev/null
-Image loading for PPM image files.
+++ /dev/null
-Slava Pestov
\ No newline at end of file
+++ /dev/null
-USING: images accessors kernel tools.test literals math.ranges
-byte-arrays ;
-IN: images.tesselation
-
-! Check an invariant we depend on
-[ t ] [
- <image> B{ 1 2 3 } >>bitmap dup clone [ bitmap>> ] bi@ eq?
-] unit-test
-
-[
- {
- {
- T{ image f { 2 2 } L ubyte-components f B{ 1 2 5 6 } }
- T{ image f { 2 2 } L ubyte-components f B{ 3 4 7 8 } }
- }
- {
- T{ image f { 2 2 } L ubyte-components f B{ 9 10 13 14 } }
- T{ image f { 2 2 } L ubyte-components f B{ 11 12 15 16 } }
- }
- }
-] [
- <image>
- 1 16 [a,b] >byte-array >>bitmap
- { 4 4 } >>dim
- L >>component-order
- ubyte-components >>component-type
- { 2 2 } tesselate
-] unit-test
-
-[
- {
- {
- T{ image f { 2 2 } L ubyte-components f B{ 1 2 4 5 } }
- T{ image f { 1 2 } L ubyte-components f B{ 3 6 } }
- }
- {
- T{ image f { 2 1 } L ubyte-components f B{ 7 8 } }
- T{ image f { 1 1 } L ubyte-components f B{ 9 } }
- }
- }
-] [
- <image>
- 1 9 [a,b] >byte-array >>bitmap
- { 3 3 } >>dim
- L >>component-order
- ubyte-components >>component-type
- { 2 2 } tesselate
-] unit-test
+++ /dev/null
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel math grouping fry columns locals accessors
-images math.vectors arrays ;
-IN: images.tesselation
-
-: group-rows ( bitmap bitmap-dim -- rows )
- first <sliced-groups> ; inline
-
-: tesselate-rows ( bitmap-rows tess-dim -- bitmaps )
- second <sliced-groups> ; inline
-
-: tesselate-columns ( bitmap-rows tess-dim -- bitmaps )
- first '[ _ <sliced-groups> ] map flip ; inline
-
-: tesselate-bitmap ( bitmap bitmap-dim tess-dim -- bitmap-grid )
- [ group-rows ] dip
- [ tesselate-rows ] keep
- '[ _ tesselate-columns ] map ;
-
-: tile-width ( tile-bitmap original-image -- width )
- [ first length ] [ bytes-per-pixel ] bi* /i ;
-
-: <tile-image> ( tile-bitmap original-image -- tile-image )
- clone
- swap
- [ concat >>bitmap ]
- [ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
-
-:: tesselate ( image tess-dim -- image-grid )
- image bytes-per-pixel :> bpp
- image dim>> { bpp 1 } v* :> image-dim'
- tess-dim { bpp 1 } v* :> tess-dim'
- image bitmap>> image-dim' tess-dim' tesselate-bitmap
- [ [ image <tile-image> ] map ] map ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: images accessors kernel tools.test literals math.ranges
+byte-arrays ;
+IN: images.tessellation
+
+! Check an invariant we depend on
+[ t ] [
+ <image> B{ 1 2 3 } >>bitmap dup clone [ bitmap>> ] bi@ eq?
+] unit-test
+
+[
+ {
+ {
+ T{ image f { 2 2 } L ubyte-components f f B{ 1 2 5 6 } }
+ T{ image f { 2 2 } L ubyte-components f f B{ 3 4 7 8 } }
+ }
+ {
+ T{ image f { 2 2 } L ubyte-components f f B{ 9 10 13 14 } }
+ T{ image f { 2 2 } L ubyte-components f f B{ 11 12 15 16 } }
+ }
+ }
+] [
+ <image>
+ 1 16 [a,b] >byte-array >>bitmap
+ { 4 4 } >>dim
+ L >>component-order
+ ubyte-components >>component-type
+ { 2 2 } tesselate
+] unit-test
+
+[
+ {
+ {
+ T{ image f { 2 2 } L ubyte-components f f B{ 1 2 4 5 } }
+ T{ image f { 1 2 } L ubyte-components f f B{ 3 6 } }
+ }
+ {
+ T{ image f { 2 1 } L ubyte-components f f B{ 7 8 } }
+ T{ image f { 1 1 } L ubyte-components f f B{ 9 } }
+ }
+ }
+] [
+ <image>
+ 1 9 [a,b] >byte-array >>bitmap
+ { 3 3 } >>dim
+ L >>component-order
+ ubyte-components >>component-type
+ { 2 2 } tesselate
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences kernel math grouping fry columns locals accessors
+images math.vectors arrays ;
+IN: images.tessellation
+
+: group-rows ( bitmap bitmap-dim -- rows )
+ first <sliced-groups> ; inline
+
+: tesselate-rows ( bitmap-rows tess-dim -- bitmaps )
+ second <sliced-groups> ; inline
+
+: tesselate-columns ( bitmap-rows tess-dim -- bitmaps )
+ first '[ _ <sliced-groups> ] map flip ; inline
+
+: tesselate-bitmap ( bitmap bitmap-dim tess-dim -- bitmap-grid )
+ [ group-rows ] dip
+ [ tesselate-rows ] keep
+ '[ _ tesselate-columns ] map ;
+
+: tile-width ( tile-bitmap original-image -- width )
+ [ first length ] [ bytes-per-pixel ] bi* /i ;
+
+: <tile-image> ( tile-bitmap original-image -- tile-image )
+ clone
+ swap
+ [ concat >>bitmap ]
+ [ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
+
+:: tesselate ( image tess-dim -- image-grid )
+ image bytes-per-pixel :> bpp
+ image dim>> { bpp 1 } v* :> image-dim'
+ tess-dim { bpp 1 } v* :> tess-dim'
+ image bitmap>> image-dim' tess-dim' tesselate-bitmap
+ [ [ image <tile-image> ] map ] map ;
+++ /dev/null
-Erik Charlebois
+++ /dev/null
-! Copyright (C) 2010 Erik Charlebois
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors images images.loader io io.binary kernel
-locals math sequences io.encodings.ascii io.encodings.string
-calendar math.ranges math.parser colors arrays hashtables
-ui.pixel-formats combinators continuations io.streams.throwing ;
-IN: images.tga
-
-SINGLETON: tga-image
-"tga" tga-image register-image-class
-
-ERROR: bad-tga-header ;
-ERROR: bad-tga-footer ;
-ERROR: bad-tga-extension-size ;
-ERROR: bad-tga-timestamp ;
-ERROR: bad-tga-unsupported ;
-
-: read-id-length ( -- byte )
- 1 read le> ; inline
-
-: read-color-map-type ( -- byte )
- 1 read le> dup
- { 0 1 } member? [ bad-tga-header ] unless ;
-
-: read-image-type ( -- byte )
- 1 read le> dup
- { 0 1 2 3 9 10 11 } member? [ bad-tga-header ] unless ; inline
-
-: read-color-map-first ( -- short )
- 2 read le> ; inline
-
-: read-color-map-length ( -- short )
- 2 read le> ; inline
-
-: read-color-map-entry-size ( -- byte )
- 1 read le> ; inline
-
-: read-x-origin ( -- short )
- 2 read le> ; inline
-
-: read-y-origin ( -- short )
- 2 read le> ; inline
-
-: read-image-width ( -- short )
- 2 read le> ; inline
-
-: read-image-height ( -- short )
- 2 read le> ; inline
-
-: read-pixel-depth ( -- byte )
- 1 read le> ; inline
-
-: read-image-descriptor ( -- alpha-bits pixel-order )
- 1 read le>
- [ 7 bitand ] [ 24 bitand -3 shift ] bi ; inline
-
-: read-image-id ( length -- image-id )
- read ; inline
-
-: read-color-map ( type length elt-size -- color-map )
- pick 1 = [ 8 align 8 / * read ] [ 2drop f ] if swap drop ; inline
-
-: read-image-data ( width height depth -- image-data )
- 8 align 8 / * * read ; inline
-
-: read-extension-area-offset ( -- offset )
- 4 read le> ; inline
-
-: read-developer-directory-offset ( -- offset )
- 4 read le> ; inline
-
-: read-signature ( -- )
- 18 read ascii decode "TRUEVISION-XFILE.\0" = [ bad-tga-footer ] unless ; inline
-
-: read-extension-size ( -- )
- 2 read le> 495 = [ bad-tga-extension-size ] unless ; inline
-
-: read-author-name ( -- string )
- 41 read ascii decode [ 0 = ] trim ; inline
-
-: read-author-comments ( -- string )
- 4 iota [ drop 81 read ascii decode [ 0 = ] trim ] map concat ; inline
-
-: read-date-timestamp ( -- timestamp )
- timestamp new
- 2 read le> dup 12 [1,b] member? [ bad-tga-timestamp ] unless >>month
- 2 read le> dup 31 [1,b] member? [ bad-tga-timestamp ] unless >>day
- 2 read le> >>year
- 2 read le> dup 23 [0,b] member? [ bad-tga-timestamp ] unless >>hour
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline
-
-: read-job-name ( -- string )
- 41 read ascii decode [ 0 = ] trim ; inline
-
-: read-job-time ( -- duration )
- duration new
- 2 read le> >>hour
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline
-
-: read-software-id ( -- string )
- 41 read ascii decode [ 0 = ] trim ; inline
-
-: read-software-version ( -- string )
- 2 read le> 100 /f number>string
- 1 read ascii decode append [ " " = ] trim ; inline
-
-:: read-key-color ( -- color )
- 1 read le> 255 /f :> alpha
- 1 read le> 255 /f
- 1 read le> 255 /f
- 1 read le> 255 /f
- alpha <rgba> ; inline
-
-: read-pixel-aspect-ratio ( -- aspect-ratio )
- 2 read le> 2 read le> /f ; inline
-
-: read-gamma-value ( -- gamma-value )
- 2 read le> 2 read le> /f ; inline
-
-: read-color-correction-offset ( -- offset )
- 4 read le> ; inline
-
-: read-postage-stamp-offset ( -- offset )
- 4 read le> ; inline
-
-: read-scan-line-offset ( -- offset )
- 4 read le> ; inline
-
-: read-premultiplied-alpha ( -- boolean )
- 1 read le> 4 = ; inline
-
-: read-scan-line-table ( height -- scan-offsets )
- iota [ drop 4 read le> ] map ; inline
-
-: read-postage-stamp-image ( depth -- postage-data )
- 8 align 8 / 1 read le> 1 read le> * * read ; inline
-
-:: read-color-correction-table ( -- correction-table )
- 256 iota
- [
- drop
- 4 iota
- [
- drop
- 2 read le> 65535 /f :> alpha
- 2 read le> 65535 /f
- 2 read le> 65535 /f
- 2 read le> 65535 /f
- alpha <rgba>
- ] map
- ] map ; inline
-
-: read-developer-directory ( -- developer-directory )
- 2 read le> iota
- [
- drop
- 2 read le>
- 4 read le>
- 4 read le>
- 3array
- ] map ; inline
-
-: read-developer-areas ( developer-directory -- developer-area-map )
- [
- [ first ]
- [ dup third second seek-absolute seek-input read ] bi 2array
- ] map >hashtable ; inline
-
-:: read-tga ( -- image )
- #! Read header
- read-id-length :> id-length
- read-color-map-type :> map-type
- read-image-type :> image-type
- read-color-map-first :> map-first
- read-color-map-length :> map-length
- read-color-map-entry-size :> map-entry-size
- read-x-origin :> x-origin
- read-y-origin :> y-origin
- read-image-width :> image-width
- read-image-height :> image-height
- read-pixel-depth :> pixel-depth
- read-image-descriptor :> ( alpha-bits pixel-order )
- id-length read-image-id :> image-id
- map-type map-length map-entry-size read-color-map :> color-map-data
- image-width image-height pixel-depth read-image-data :> image-data
-
- [
- #! Read optional footer
- 26 seek-end seek-input
- read-extension-area-offset :> extension-offset
- read-developer-directory-offset :> directory-offset
- read-signature
-
- #! Read optional extension section
- extension-offset 0 =
- [
- extension-offset seek-absolute seek-input
- read-extension-size
- read-author-name :> author-name
- read-author-comments :> author-comments
- read-date-timestamp :> date-timestamp
- read-job-name :> job-name
- read-job-time :> job-time
- read-software-id :> software-id
- read-software-version :> software-version
- read-key-color :> key-color
- read-pixel-aspect-ratio :> aspect-ratio
- read-gamma-value :> gamma-value
- read-color-correction-offset :> color-correction-offset
- read-postage-stamp-offset :> postage-stamp-offset
- read-scan-line-offset :> scan-line-offset
- read-premultiplied-alpha :> premultiplied-alpha
-
- color-correction-offset 0 =
- [
- color-correction-offset seek-absolute seek-input
- read-color-correction-table :> color-correction-table
- ] unless
-
- postage-stamp-offset 0 =
- [
- postage-stamp-offset seek-absolute seek-input
- pixel-depth read-postage-stamp-image :> postage-data
- ] unless
-
- scan-line-offset seek-absolute seek-input
- image-height read-scan-line-table :> scan-offsets
-
- #! Read optional developer section
- directory-offset 0 =
- [ f ]
- [
- directory-offset seek-absolute seek-input
- read-developer-directory read-developer-areas
- ] if :> developer-areas
- ] unless
- ] ignore-errors
-
- #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported.
- #! Other formats would need to be converted to work within the image class.
- map-type 0 = [ bad-tga-unsupported ] unless
- image-type 2 = [ bad-tga-unsupported ] unless
- pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless
- pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless
-
- #! Create image instance
- image new
- alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order
- { image-width image-height } >>dim
- pixel-order 0 = >>upside-down?
- image-data >>bitmap
- ubyte-components >>component-type ;
-
-M: tga-image stream>image
- drop [ [ read-tga ] throw-on-eof ] with-input-stream ;
-
-M: tga-image image>stream
- drop
- [
- component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless
- ] keep
-
- B{ 0 } write #! id-length
- B{ 0 } write #! map-type
- B{ 2 } write #! image-type
- B{ 0 0 0 0 0 } write #! color map first, length, entry size
- B{ 0 0 0 0 } write #! x-origin, y-origin
- {
- [ dim>> first 2 >le write ]
- [ dim>> second 2 >le write ]
- [ component-order>>
- {
- { BGR [ B{ 24 } write ] }
- { BGRA [ B{ 32 } write ] }
- } case
- ]
- [
- dup component-order>>
- {
- { BGR [ 0 ] }
- { BGRA [ 8 ] }
- } case swap
- upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor
- 1 >le write
- ]
- [ bitmap>> write ]
- } cleave ;
-
+++ /dev/null
-Doug Coleman
+++ /dev/null
-TIFF image loader
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing ;
-IN: images.tiff.tests
-
-"vocab:images/testing/tiff/octagon.tiff" decode-test
-! "vocab:images/testing/tiff/elephants.tiff" decode-test
-"vocab:images/testing/tiff/noise.tiff" decode-test
-"vocab:images/testing/tiff/alpha.tiff" decode-test
-"vocab:images/testing/tiff/color_spectrum.tiff" decode-test
-"vocab:images/testing/tiff/rgb.tiff" decode-test
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays classes combinators
-compression.lzw endian fry grouping images io
-io.binary io.encodings.ascii io.encodings.binary
-io.encodings.string io.encodings.utf8 io.files kernel math
-math.bitwise math.order math.parser pack sequences
-strings math.vectors specialized-arrays locals
-images.loader io.streams.throwing ;
-FROM: alien.c-types => float ;
-SPECIALIZED-ARRAY: float
-IN: images.tiff
-
-SINGLETON: tiff-image
-
-TUPLE: loading-tiff endianness the-answer ifd-offset ifds ;
-
-: <loading-tiff> ( -- tiff )
- loading-tiff new V{ } clone >>ifds ;
-
-TUPLE: ifd count ifd-entries next
-processed-tags strips bitmap ;
-
-: <ifd> ( count ifd-entries next -- ifd )
- ifd new
- swap >>next
- swap >>ifd-entries
- swap >>count ;
-
-TUPLE: ifd-entry tag type count offset/value ;
-
-: <ifd-entry> ( tag type count offset/value -- ifd-entry )
- ifd-entry new
- swap >>offset/value
- swap >>count
- swap >>type
- swap >>tag ;
-
-SINGLETONS: photometric-interpretation
-photometric-interpretation-white-is-zero
-photometric-interpretation-black-is-zero
-photometric-interpretation-rgb
-photometric-interpretation-palette-color
-photometric-interpretation-transparency-mask
-photometric-interpretation-separated
-photometric-interpretation-ycbcr
-photometric-interpretation-cielab
-photometric-interpretation-icclab
-photometric-interpretation-itulab
-photometric-interpretation-logl
-photometric-interpretation-logluv ;
-
-ERROR: bad-photometric-interpretation n ;
-: lookup-photometric-interpretation ( n -- singleton )
- {
- { 0 [ photometric-interpretation-white-is-zero ] }
- { 1 [ photometric-interpretation-black-is-zero ] }
- { 2 [ photometric-interpretation-rgb ] }
- { 3 [ photometric-interpretation-palette-color ] }
- { 4 [ photometric-interpretation-transparency-mask ] }
- { 5 [ photometric-interpretation-separated ] }
- { 6 [ photometric-interpretation-ycbcr ] }
- { 8 [ photometric-interpretation-cielab ] }
- { 9 [ photometric-interpretation-icclab ] }
- { 10 [ photometric-interpretation-itulab ] }
- { 32844 [ photometric-interpretation-logl ] }
- { 32845 [ photometric-interpretation-logluv ] }
- [ bad-photometric-interpretation ]
- } case ;
-
-SINGLETONS: compression
-compression-none
-compression-CCITT-2
-compression-CCITT-3
-compression-CCITT-4
-compression-lzw
-compression-jpeg-old
-compression-jpeg-new
-compression-adobe-deflate
-compression-9
-compression-10
-compression-deflate
-compression-next
-compression-ccittrlew
-compression-pack-bits
-compression-thunderscan
-compression-it8ctpad
-compression-it8lw
-compression-it8mp
-compression-it8bl
-compression-pixarfilm
-compression-pixarlog
-compression-dcs
-compression-jbig
-compression-sgilog
-compression-sgilog24
-compression-jp2000 ;
-ERROR: bad-compression n ;
-: lookup-compression ( n -- compression )
- {
- { 1 [ compression-none ] }
- { 2 [ compression-CCITT-2 ] }
- { 3 [ compression-CCITT-3 ] }
- { 4 [ compression-CCITT-4 ] }
- { 5 [ compression-lzw ] }
- { 6 [ compression-jpeg-old ] }
- { 7 [ compression-jpeg-new ] }
- { 8 [ compression-adobe-deflate ] }
- { 9 [ compression-9 ] }
- { 10 [ compression-10 ] }
- { 32766 [ compression-next ] }
- { 32771 [ compression-ccittrlew ] }
- { 32773 [ compression-pack-bits ] }
- { 32809 [ compression-thunderscan ] }
- { 32895 [ compression-it8ctpad ] }
- { 32896 [ compression-it8lw ] }
- { 32897 [ compression-it8mp ] }
- { 32898 [ compression-it8bl ] }
- { 32908 [ compression-pixarfilm ] }
- { 32909 [ compression-pixarlog ] }
- { 32946 [ compression-deflate ] }
- { 32947 [ compression-dcs ] }
- { 34661 [ compression-jbig ] }
- { 34676 [ compression-sgilog ] }
- { 34677 [ compression-sgilog24 ] }
- { 34712 [ compression-jp2000 ] }
- [ bad-compression ]
- } case ;
-
-SINGLETONS: resolution-unit
-resolution-unit-none
-resolution-unit-inch
-resolution-unit-centimeter ;
-ERROR: bad-resolution-unit n ;
-: lookup-resolution-unit ( n -- object )
- {
- { 1 [ resolution-unit-none ] }
- { 2 [ resolution-unit-inch ] }
- { 3 [ resolution-unit-centimeter ] }
- [ bad-resolution-unit ]
- } case ;
-
-SINGLETONS: predictor
-predictor-none
-predictor-horizontal-differencing ;
-ERROR: bad-predictor n ;
-: lookup-predictor ( n -- object )
- {
- { 1 [ predictor-none ] }
- { 2 [ predictor-horizontal-differencing ] }
- [ bad-predictor ]
- } case ;
-
-SINGLETONS: planar-configuration
-planar-configuration-chunky
-planar-configuration-planar ;
-ERROR: bad-planar-configuration n ;
-: lookup-planar-configuration ( n -- object )
- {
- { 1 [ planar-configuration-chunky ] }
- { 2 [ planar-configuration-planar ] }
- [ bad-planar-configuration ]
- } case ;
-
-SINGLETONS: sample-format
-sample-format-none
-sample-format-unsigned-integer
-sample-format-signed-integer
-sample-format-ieee-float
-sample-format-undefined-data ;
-ERROR: bad-sample-format n ;
-: lookup-sample-format ( sequence -- object )
- [
- {
- { 0 [ sample-format-none ] }
- { 1 [ sample-format-unsigned-integer ] }
- { 2 [ sample-format-signed-integer ] }
- { 3 [ sample-format-ieee-float ] }
- { 4 [ sample-format-undefined-data ] }
- [ bad-sample-format ]
- } case
- ] map ;
-
-SINGLETONS: extra-samples
-extra-samples-unspecified-alpha-data
-extra-samples-associated-alpha-data
-extra-samples-unassociated-alpha-data ;
-ERROR: bad-extra-samples n ;
-: lookup-extra-samples ( sequence -- object )
- {
- { 0 [ extra-samples-unspecified-alpha-data ] }
- { 1 [ extra-samples-associated-alpha-data ] }
- { 2 [ extra-samples-unassociated-alpha-data ] }
- [ bad-extra-samples ]
- } case ;
-
-SINGLETONS: image-length image-width x-resolution y-resolution
-rows-per-strip strip-offsets strip-byte-counts bits-per-sample
-samples-per-pixel new-subfile-type subfile-type orientation
-software date-time photoshop exif-ifd sub-ifd inter-color-profile
-xmp iptc fill-order document-name page-number page-name
-x-position y-position host-computer copyright artist
-min-sample-value max-sample-value tiff-make tiff-model cell-width cell-length
-gray-response-unit gray-response-curve color-map threshholding
-image-description free-offsets free-byte-counts tile-width tile-length
-matteing data-type image-depth tile-depth
-ycbcr-subsampling gdal-metadata
-tile-offsets tile-byte-counts jpeg-qtables jpeg-dctables jpeg-actables
-ycbcr-positioning ycbcr-coefficients reference-black-white halftone-hints
-jpeg-interchange-format
-jpeg-interchange-format-length
-jpeg-restart-interval jpeg-tables
-t4-options clean-fax-data bad-fax-lines consecutive-bad-fax-lines
-sto-nits print-image-matching-info
-unhandled-ifd-entry ;
-
-SINGLETONS: jpeg-proc
-jpeg-proc-baseline
-jpeg-proc-lossless ;
-
-ERROR: bad-jpeg-proc n ;
-
-: lookup-jpeg-proc ( sequence -- object )
- {
- { 1 [ jpeg-proc-baseline ] }
- { 14 [ jpeg-proc-lossless ] }
- [ bad-jpeg-proc ]
- } case ;
-
-ERROR: bad-tiff-magic bytes ;
-: tiff-endianness ( byte-array -- ? )
- {
- { B{ CHAR: M CHAR: M } [ big-endian ] }
- { B{ CHAR: I CHAR: I } [ little-endian ] }
- [ bad-tiff-magic ]
- } case ;
-
-: read-header ( tiff -- tiff )
- 2 read tiff-endianness [ >>endianness ] keep
- [
- 2 read endian> >>the-answer
- 4 read endian> >>ifd-offset
- ] with-endianness ;
-
-: push-ifd ( tiff ifd -- tiff ) over ifds>> push ;
-
-: read-ifd ( -- ifd )
- 2 read endian>
- 2 read endian>
- 4 read endian>
- 4 read endian> <ifd-entry> ;
-
-: read-ifds ( tiff offset -- tiff )
- seek-absolute seek-input
- 2 read endian>
- dup [ read-ifd ] replicate
- 4 read endian>
- [ <ifd> push-ifd ] [ dup 0 = [ drop ] [ read-ifds ] if ] bi ;
-
-ERROR: no-tag class ;
-
-: find-tag* ( ifd class -- tag/class ? )
- swap processed-tags>> ?at ;
-
-: find-tag ( ifd class -- tag )
- find-tag* [ no-tag ] unless ;
-
-: tag? ( ifd class -- tag )
- swap processed-tags>> key? ;
-
-: read-strips ( ifd -- ifd )
- dup
- [ strip-byte-counts find-tag ]
- [ strip-offsets find-tag ] bi
- 2dup [ integer? ] both? [
- seek-absolute seek-input read 1array
- ] [
- [ seek-absolute seek-input read ] { } 2map-as
- ] if >>strips ;
-
-ERROR: unknown-ifd-type n ;
-
-: bytes>bits ( n/byte-array -- n )
- dup byte-array? [ byte-array>bignum ] when ;
-
-: value-length ( ifd-entry -- n )
- [ count>> ] [ type>> ] bi {
- { 1 [ ] }
- { 2 [ ] }
- { 3 [ 2 * ] }
- { 4 [ 4 * ] }
- { 5 [ 8 * ] }
- { 6 [ ] }
- { 7 [ ] }
- { 8 [ 2 * ] }
- { 9 [ 4 * ] }
- { 10 [ 8 * ] }
- { 11 [ 4 * ] }
- { 12 [ 8 * ] }
- { 13 [ 4 * ] }
- [ unknown-ifd-type ]
- } case ;
-
-ERROR: bad-small-ifd-type n ;
-
-: adjust-offset/value ( ifd-entry -- obj )
- [ offset/value>> 4 >endian ] [ type>> ] bi
- {
- { 1 [ 1 head endian> ] }
- { 3 [ 2 head endian> ] }
- { 4 [ endian> ] }
- { 6 [ 1 head endian> 8 >signed ] }
- { 8 [ 2 head endian> 16 >signed ] }
- { 9 [ endian> 32 >signed ] }
- { 11 [ endian> bits>float ] }
- { 13 [ endian> 32 >signed ] }
- [ bad-small-ifd-type ]
- } case ;
-
-: offset-bytes>obj ( bytes type -- obj )
- {
- { 1 [ ] } ! blank
- { 2 [ ] } ! read c strings here
- { 3 [ 2 <sliced-groups> [ endian> ] map ] }
- { 4 [ 4 <sliced-groups> [ endian> ] map ] }
- { 5 [ 8 <sliced-groups> [ "II" unpack first2 / ] map ] }
- { 6 [ [ 8 >signed ] map ] }
- { 7 [ ] } ! blank
- { 8 [ 2 <sliced-groups> [ endian> 16 >signed ] map ] }
- { 9 [ 4 <sliced-groups> [ endian> 32 >signed ] map ] }
- { 10 [ 8 group [ "ii" unpack first2 / ] map ] }
- { 11 [ 4 group [ "f" unpack ] map ] }
- { 12 [ 8 group [ "d" unpack ] map ] }
- [ unknown-ifd-type ]
- } case ;
-
-: ifd-entry-value ( ifd-entry -- n )
- dup value-length 4 <= [
- adjust-offset/value
- ] [
- [ offset/value>> seek-absolute seek-input ]
- [ value-length read ]
- [ type>> ] tri offset-bytes>obj
- ] if ;
-
-: process-ifd-entry ( ifd-entry -- value class )
- [ ifd-entry-value ] [ tag>> ] bi {
- { 254 [ new-subfile-type ] }
- { 255 [ subfile-type ] }
- { 256 [ image-width ] }
- { 257 [ image-length ] }
- { 258 [ bits-per-sample ] }
- { 259 [ lookup-compression compression ] }
- { 262 [ lookup-photometric-interpretation photometric-interpretation ] }
- { 263 [ threshholding ] }
- { 264 [ cell-width ] }
- { 265 [ cell-length ] }
- { 266 [ fill-order ] }
- { 269 [ ascii decode document-name ] }
- { 270 [ ascii decode image-description ] }
- { 271 [ ascii decode tiff-make ] }
- { 272 [ ascii decode tiff-model ] }
- { 273 [ strip-offsets ] }
- { 274 [ orientation ] }
- { 277 [ samples-per-pixel ] }
- { 278 [ rows-per-strip ] }
- { 279 [ strip-byte-counts ] }
- { 280 [ min-sample-value ] }
- { 281 [ max-sample-value ] }
- { 282 [ first x-resolution ] }
- { 283 [ first y-resolution ] }
- { 284 [ lookup-planar-configuration planar-configuration ] }
- { 285 [ page-name ] }
- { 286 [ x-position ] }
- { 287 [ y-position ] }
- { 288 [ free-offsets ] }
- { 289 [ free-byte-counts ] }
- { 290 [ gray-response-unit ] }
- { 291 [ gray-response-curve ] }
- { 292 [ t4-options ] }
- { 296 [ lookup-resolution-unit resolution-unit ] }
- { 297 [ page-number ] }
- { 305 [ ascii decode software ] }
- { 306 [ ascii decode date-time ] }
- { 315 [ ascii decode artist ] }
- { 316 [ ascii decode host-computer ] }
- { 317 [ lookup-predictor predictor ] }
- { 320 [ color-map ] }
- { 321 [ halftone-hints ] }
- { 322 [ tile-width ] }
- { 323 [ tile-length ] }
- { 324 [ tile-offsets ] }
- { 325 [ tile-byte-counts ] }
- { 326 [ bad-fax-lines ] }
- { 327 [ clean-fax-data ] }
- { 328 [ consecutive-bad-fax-lines ] }
- { 330 [ sub-ifd ] }
- { 338 [ lookup-extra-samples extra-samples ] }
- { 339 [ lookup-sample-format sample-format ] }
- { 347 [ jpeg-tables ] }
- { 512 [ lookup-jpeg-proc jpeg-proc ] }
- { 513 [ jpeg-interchange-format ] }
- { 514 [ jpeg-interchange-format-length ] }
- { 515 [ jpeg-restart-interval ] }
- { 519 [ jpeg-qtables ] }
- { 520 [ jpeg-dctables ] }
- { 521 [ jpeg-actables ] }
- { 529 [ ycbcr-coefficients ] }
- { 530 [ ycbcr-subsampling ] }
- { 531 [ ycbcr-positioning ] }
- { 532 [ reference-black-white ] }
- { 700 [ utf8 decode xmp ] }
- { 32995 [ matteing ] }
- { 32996 [ data-type ] }
- { 32997 [ image-depth ] }
- { 32998 [ tile-depth ] }
- { 33432 [ copyright ] }
- { 33723 [ iptc ] }
- { 34377 [ photoshop ] }
- { 34665 [ exif-ifd ] }
- { 34675 [ inter-color-profile ] }
- { 37439 [ sto-nits ] }
- { 42112 [ gdal-metadata ] }
- { 50341 [ print-image-matching-info ] }
- [ nip unhandled-ifd-entry swap ]
- } case ;
-
-: process-ifds ( loading-tiff -- loading-tiff )
- [
- [
- dup ifd-entries>>
- [ process-ifd-entry swap ] H{ } map>assoc >>processed-tags
- ] map
- ] change-ifds ;
-
-ERROR: unhandled-compression compression ;
-
-: (uncompress-strips) ( strips compression -- uncompressed-strips )
- {
- { compression-none [ ] }
- { compression-lzw [ [ tiff-lzw-uncompress ] map ] }
- [ unhandled-compression ]
- } case ;
-
-: uncompress-strips ( ifd -- ifd )
- dup '[
- _ compression find-tag (uncompress-strips)
- ] change-strips ;
-
-: strips>bitmap ( ifd -- ifd )
- dup strips>> concat >>bitmap ;
-
-: (strips-predictor) ( ifd -- ifd )
- [ ]
- [ image-width find-tag ]
- [ samples-per-pixel find-tag ] tri
- [ * ] keep
- '[
- _ group
- [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
- B{ } concat-as
- ] change-bitmap ;
-
-: strips-predictor ( ifd -- ifd )
- dup predictor tag? [
- dup predictor find-tag
- {
- { predictor-none [ ] }
- { predictor-horizontal-differencing [ (strips-predictor) ] }
- [ bad-predictor ]
- } case
- ] when ;
-
-ERROR: unknown-component-order ifd ;
-
-: fix-bitmap-endianness ( ifd -- ifd )
- dup [ bitmap>> ] [ bits-per-sample find-tag ] bi
- {
- { { 32 32 32 32 } [ 4 seq>native-endianness ] }
- { { 32 32 32 } [ 4 seq>native-endianness ] }
- { { 16 16 16 16 } [ 2 seq>native-endianness ] }
- { { 16 16 16 } [ 2 seq>native-endianness ] }
- { { 8 8 8 8 } [ ] }
- { { 8 8 8 } [ ] }
- { 8 [ ] }
- [ unknown-component-order ]
- } case >>bitmap ;
-
-: ifd-component-order ( ifd -- component-order component-type )
- bits-per-sample find-tag {
- { { 32 32 32 32 } [ RGBA float-components ] }
- { { 32 32 32 } [ RGB float-components ] }
- { { 16 16 16 16 } [ RGBA ushort-components ] }
- { { 16 16 16 } [ RGB ushort-components ] }
- { { 8 8 8 8 } [ RGBA ubyte-components ] }
- { { 8 8 8 } [ RGB ubyte-components ] }
- { 8 [ LA ubyte-components ] }
- [ unknown-component-order ]
- } case ;
-
-: handle-alpha-data ( ifd -- ifd )
- dup extra-samples find-tag {
- { extra-samples-associated-alpha-data [ ] }
- { extra-samples-unspecified-alpha-data [ ] }
- { extra-samples-unassociated-alpha-data [ ] }
- [ bad-extra-samples ]
- } case ;
-
-: ifd>image ( ifd -- image )
- [ <image> ] dip {
- [ [ image-width find-tag ] [ image-length find-tag ] bi 2array >>dim ]
- [ ifd-component-order [ >>component-order ] [ >>component-type ] bi* ]
- [ bitmap>> >>bitmap ]
- } cleave ;
-
-: tiff>image ( image -- image )
- ifds>> [ ifd>image ] map first ;
-
-: with-tiff-endianness ( loading-tiff quot -- )
- [ dup endianness>> ] dip with-endianness ; inline
-
-: load-tiff-ifds ( -- loading-tiff )
- <loading-tiff>
- read-header [
- dup ifd-offset>> read-ifds
- process-ifds
- ] with-tiff-endianness ;
-
-: process-chunky-ifd ( ifd -- )
- read-strips
- uncompress-strips
- strips>bitmap
- fix-bitmap-endianness
- strips-predictor
- dup extra-samples tag? [ handle-alpha-data ] when
- drop ;
-
-: process-planar-ifd ( ifd -- )
- "planar ifd not supported" throw ;
-
-: dispatch-planar-configuration ( ifd planar-configuration -- )
- {
- { planar-configuration-chunky [ process-chunky-ifd ] }
- { planar-configuration-planar [ process-planar-ifd ] }
- } case ;
-
-: process-ifd ( ifd -- )
- dup planar-configuration find-tag* [
- dispatch-planar-configuration
- ] [
- drop "no planar configuration" throw
- ] if ;
-
-: process-tif-ifds ( loading-tiff -- )
- ifds>> [ process-ifd ] each ;
-
-: load-tiff ( -- loading-tiff )
- load-tiff-ifds dup
- 0 seek-absolute seek-input
- [ process-tif-ifds ] with-tiff-endianness ;
-
-! tiff files can store several images -- we just take the first for now
-M: tiff-image stream>image ( stream tiff-image -- image )
- drop [ [ load-tiff tiff>image ] throw-on-eof ] with-input-stream ;
-
-{ "tif" "tiff" } [ tiff-image register-image-class ] each
USING: nibble-arrays tools.test sequences kernel math ;
IN: nibble-arrays.tests
+[ -1 <nibble-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
+
[ t ] [ 16 iota dup >nibble-array sequence= ] unit-test
[ N{ 4 2 1 3 } ] [ N{ 3 1 2 4 } reverse ] unit-test
[ N{ 1 4 9 0 9 4 } ] [ N{ 1 2 3 4 5 6 } [ sq ] map ] unit-test
PRIVATE>
+ERROR: bad-array-length n ;
+
: <nibble-array> ( n -- nibble-array )
+ dup 0 < [ bad-array-length ] when
dup nibbles>bytes <byte-array> nibble-array boa ; inline
M: nibble-array length length>> ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data assocs cache colors.constants
destructors kernel opengl opengl.gl opengl.capabilities
-combinators images images.tesselation grouping sequences math
+combinators images images.tessellation grouping sequences math
math.vectors generalizations fry arrays namespaces system locals
literals specialized-arrays ;
FROM: alien.c-types => int float ;
[ init-texture texture-coords>> gl-texture-coord-pointer ] tri
swap gl-fill-rect ;
+: set-blend-mode ( texture -- )
+ image>> dup has-alpha?
+ [ premultiplied-alpha?>> [ GL_ONE GL_ONE_MINUS_SRC_ALPHA glBlendFunc ] when ]
+ [ drop GL_BLEND glDisable ] if ;
+
+: reset-blend-mode ( texture -- )
+ image>> dup has-alpha?
+ [ premultiplied-alpha?>> [ GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc ] when ]
+ [ drop GL_BLEND glEnable ] if ;
+
: draw-textured-rect ( dim texture -- )
[
- [ image>> has-alpha? [ GL_BLEND glDisable ] unless ]
+ [ set-blend-mode ]
[ (draw-textured-rect) GL_TEXTURE_2D 0 glBindTexture ]
- [ image>> has-alpha? [ GL_BLEND glEnable ] unless ]
- tri
+ [ reset-blend-mode ] tri
] with-texturing ;
: texture-coords ( texture -- coords )
run-file
] when ;
+: strip-gtk-icon ( -- )
+ "ui.backend.gtk" vocab [
+ "Stripping GTK icon loading code" show
+ "vocab:tools/deploy/shaker/strip-gtk-icon.factor"
+ run-file
+ ] when ;
+
: strip-specialized-arrays ( -- )
strip-dictionary? "specialized-arrays" vocab and [
"Stripping specialized arrays" show
strip-call
strip-cocoa
strip-gobject
+ strip-gtk-icon
strip-debugger
strip-ui-error-hook
strip-specialized-arrays
--- /dev/null
+! Copyright (C) 2010 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel tools.deploy.shaker literals namespaces
+vocabs.loader io.pathnames io.files io.encodings.binary ;
+IN: ui.backend.gtk
+
+CONSTANT: get-icon-data
+ $[
+ deploy-vocab get
+ dup vocab-dir "icon.png" append-path vocab-append-path
+ [ exists? ] keep "resource:misc/icons/Factor_48x48.png" ?
+ binary file-contents
+ ]
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.pathnames io.directories io.files
-io.files.info.unix io.backend kernel namespaces make sequences
-system tools.deploy.backend tools.deploy.config
-tools.deploy.config.editor assocs hashtables prettyprint ;
+USING: io io.backend io.directories io.files.info.unix kernel
+namespaces sequences system tools.deploy.backend
+tools.deploy.config tools.deploy.config.editor ;
IN: tools.deploy.unix
: create-app-dir ( vocab bundle-name -- vm )
deploy-name get ;
M: unix deploy* ( vocab -- )
- "." resource-path [
+ "resource:" [
dup deploy-config [
[ bundle-name create-app-dir ] keep
[ bundle-name image-name ] keep
namespace make-deploy-image
bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
- bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
+ bundle-name normalize-path "Binary deployed to " "." surround print
] bind
] with-directory ;
USING: accessors alien.accessors alien.c-types alien.data
alien.strings arrays assocs classes.struct command-line
continuations destructors environment gdk.ffi gdk.gl.ffi
-glib.ffi gobject-introspection.standard-types gobject.ffi
-gtk.ffi gtk.gl.ffi io.encodings.utf8 kernel libc literals locals
-math math.bitwise math.order math.vectors namespaces sequences
-strings system threads ui ui.backend ui.backend.gtk.input-methods
-ui.backend.gtk.io ui.clipboards ui.event-loop ui.gadgets
-ui.gadgets.private ui.gadgets.worlds ui.gestures
-ui.pixel-formats ui.pixel-formats.private ui.private
-vocabs.loader combinators prettyprint io ;
+gdk.pixbuf.ffi glib.ffi
+gobject-introspection.standard-types
+gobject.ffi gtk.ffi gtk.gl.ffi io.backend
+io.backend.unix.multiplexers io.encodings.binary
+io.encodings.utf8 io.files io.thread kernel libc literals
+locals math math.bitwise math.order math.vectors namespaces
+sequences strings system threads ui ui.backend ui.backend.gtk.input-methods
+ui.backend.gtk.io ui.clipboards
+ui.commands ui.event-loop ui.gadgets ui.gadgets.editors
+ui.gadgets.menus ui.gadgets.private ui.gadgets.worlds
+ui.gestures ui.pixel-formats ui.pixel-formats.private
+ui.private vocabs.loader combinators io ;
IN: ui.backend.gtk
SINGLETON: gtk-ui-backend
{ $ GDK_SCROLL_RIGHT { 1 0 } }
} at ;
-: mouse-event>gesture ( event -- modifiers button loc )
- [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
-
: on-motion ( win event user-data -- ? )
drop swap
[ event-loc ] dip window
:: on-button-press ( win event user-data -- ? )
win window :> world
- event mouse-event>gesture :> ( modifiers button loc )
- button {
- { 8 [ ] }
- { 9 [ ] }
- [ modifiers swap <button-down> loc world
- send-button-down ]
- } case t ;
+ event type>> GDK_BUTTON_PRESS = [
+ event button>> {
+ { 8 [ ] }
+ { 9 [ ] }
+ [
+ event event-modifiers swap <button-down>
+ event event-loc
+ world
+ send-button-down
+ ]
+ } case
+ ] when t ;
:: on-button-release ( win event user-data -- ? )
win window :> world
- event mouse-event>gesture :> ( modifiers button loc )
- button {
- { 8 [ world left-action send-action ] }
- { 9 [ world right-action send-action ] }
- [ modifiers swap <button-up> loc world
- send-button-up ]
- } case t ;
+ event type>> GDK_BUTTON_RELEASE = [
+ event button>> {
+ { 8 [ world left-action send-action ] }
+ { 9 [ world right-action send-action ] }
+ [
+ event event-modifiers swap <button-up>
+ event event-loc
+ world
+ send-button-up
+ ]
+ } case
+ ] when t ;
: on-scroll ( win event user-data -- ? )
drop swap [
: key-event>gesture ( event -- mods sym/f action? )
[ event-modifiers ] [ key-sym ] bi ;
-
+
: on-key-press ( win event user-data -- ? )
drop swap [ key-event>gesture <key-down> ] [ window ] bi*
propagate-key-gesture t ;
: on-focus-out ( win event user-data -- ? )
2drop window unfocus-world t ;
+! This word gets replaced when deploying. See 'Vocabulary icons'
+! in the docs and tools.deploy.shaker.gtk-icon
+: get-icon-data ( -- byte-array )
+ "resource:misc/icons/Factor_48x48.png" binary file-contents ;
+
+: load-icon ( -- )
+ get-icon-data [
+ data>GInputStream &g_object_unref
+ GInputStream>GdkPixbuf gtk_window_set_default_icon
+ ] with-destructors ;
+
:: connect-user-input-signals ( win -- )
win events-mask gtk_widget_add_events
win "motion-notify-event" [ on-motion yield ]
:: configure-im ( win im -- )
im win gtk_widget_get_window gtk_im_context_set_client_window
im f gtk_im_context_set_use_preedit
-
+
im "commit" [ on-commit yield ]
GtkIMContext:commit win connect-signal-with-data
im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
{ normal-title-bar $ GDK_DECOR_TITLE }
{ textured-background 0 }
}
-
+
CONSTANT: window-controls>func-flags
H{
{ close-button $ GDK_FUNC_CLOSE }
win im <window-handle> world handle<<
world win register-window
-
+
win world [ window-loc>> auto-position ]
[ dim>> first2 gtk_window_set_default_size ] 2bi
win "factor" "Factor" [ utf8 string>alien ] bi@
gtk_window_set_wmclass
-
+
world configure-gl
win gtk_widget_realize
win world window-controls>> configure-window-controls
-
+
win im configure-im
win connect-user-input-signals
win connect-win-state-signals
M: gtk-ui-backend (fullscreen?)
handle>> fullscreen?>> ;
-
+
M: gtk-ui-backend raise-window*
handle>> window>> gtk_window_present ;
[
0 gint <ref> f void* <ref> gtk_init
0 gint <ref> f void* <ref> gtk_gl_init
+ load-icon
init-clipboard
start-ui
[
: show-glass ( owner child visible-rect -- )
<glass>
- dup gadget-child hand-clicked set
+ dup gadget-child hand-clicked set-global
dup owner>> find-world add-glass ;
\ glass H{
: row-action ( table -- )
dup selected-row
- [ swap [ action>> call( value -- ) ] [ dup hook>> call( table -- ) ] bi ]
+ [ swap [ dup hook>> call( table -- ) ] [ action>> call( value -- ) ] bi ]
[ 2drop ]
if ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces cache images images.loader accessors assocs
-kernel opengl opengl.gl opengl.textures ui.gadgets.worlds
-memoize images.png images.tiff ;
+USING: accessors assocs cache combinators images images.loader
+kernel memoize namespaces opengl opengl.gl opengl.textures system
+ui.gadgets.worlds vocabs.loader ;
IN: ui.images
TUPLE: image-name path ;
: image-dim ( image-name -- dim )
cached-image dim>> ;
+
+<<
+{
+ { [ os macosx? ] [ "images.cocoa" require ] }
+ { [ os winnt? ] [ "images.gdiplus" require ] }
+ [ "images.gtk" require ]
+} cond
+>>
cached-lines get purge-cache ;
M: core-text-renderer string>image ( font string -- image loc )
- cached-line [ image>> ] [ loc>> ] bi ;
+ cached-line [ line>image ] [ loc>> ] bi ;
M: core-text-renderer x>offset ( x font string -- n )
[ 2drop 0 ] [
[ cached-line metrics>> ]
if-empty ;
-core-text-renderer font-renderer set-global
\ No newline at end of file
+core-text-renderer font-renderer set-global
USING: alien alien.c-types alien.destructors windows.com.syntax
windows.ole32 windows.types continuations kernel alien.syntax
-libc destructors accessors alien.data ;
+libc destructors accessors alien.data classes.struct windows.kernel32 ;
IN: windows.com
LIBRARY: ole32
HRESULT DragLeave ( )
HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;
+COM-INTERFACE: ISequentialStream IUnknown {0C733A30-2A1C-11CE-ADE5-00AA0044773D}
+ HRESULT Read ( void* pv, ULONG cb, ULONG* pcbRead )
+ HRESULT Write ( void* pv, ULONG cb, ULONG* pcbWritten ) ;
+
+STRUCT: STATSTG
+ { pwcsName LPOLESTR }
+ { type DWORD }
+ { cbSize ULARGE_INTEGER }
+ { mtime FILETIME }
+ { ctime FILETIME }
+ { atime FILETIME }
+ { grfMode DWORD }
+ { grfLocksSupported DWORD }
+ { clsid CLSID }
+ { grfStateBits DWORD }
+ { reserved DWORD } ;
+
+CONSTANT: STGM_READ 0
+CONSTANT: STGM_WRITE 1
+CONSTANT: STGM_READWRITE 2
+
+CONSTANT: STG_E_INVALIDFUNCTION HEX: 80030001
+
+CONSTANT: STGTY_STORAGE 1
+CONSTANT: STGTY_STREAM 2
+CONSTANT: STGTY_LOCKBYTES 3
+CONSTANT: STGTY_PROPERTY 4
+
+CONSTANT: STREAM_SEEK_SET 0
+CONSTANT: STREAM_SEEK_CUR 1
+CONSTANT: STREAM_SEEK_END 2
+
+CONSTANT: LOCK_WRITE 1
+CONSTANT: LOCK_EXCLUSIVE 2
+CONSTANT: LOCK_ONLYONCE 4
+
+CONSTANT: GUID_NULL GUID: {00000000-0000-0000-0000-000000000000}
+
+COM-INTERFACE: IStream ISequentialStream {0000000C-0000-0000-C000-000000000046}
+ HRESULT Seek ( LARGE_INTEGER dlibMove, DWORD dwOrigin, ULARGE_INTEGER* plibNewPosition )
+ HRESULT SetSize ( ULARGE_INTEGER* libNewSize )
+ HRESULT CopyTo ( IStream* pstm, ULARGE_INTEGER cb, ULARGE_INTEGER* pcbRead, ULARGE_INTEGER* pcbWritten )
+ HRESULT Commit ( DWORD grfCommitFlags )
+ HRESULT Revert ( )
+ HRESULT LockRegion ( ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType )
+ HRESULT UnlockRegion ( ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType )
+ HRESULT Stat ( STATSTG* pstatstg, DWORD grfStatFlag )
+ HRESULT Clone ( IStream** ppstm ) ;
+
FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
over [ com-release ] curry [ ] cleanup ; inline
DESTRUCTOR: com-release
+
+
--- /dev/null
+! (c)2010 Joe Groff bsd license
+USING: alien.c-types alien.data alien.destructors alien.syntax
+classes.struct kernel math windows.com windows.com.syntax
+windows.kernel32 windows.ole32 windows.types ;
+FROM: alien.c-types => float ;
+IN: windows.gdiplus
+
+LIBRARY: gdiplus
+
+FUNCTION: void* GdipAlloc ( SIZE_T size ) ;
+FUNCTION: void GdipFree ( void* mem ) ;
+
+DESTRUCTOR: GdipFree
+
+TYPEDEF: float REAL
+
+ENUM: GpStatus
+ { Ok 0 }
+ { GenericError 1 }
+ { InvalidParameter 2 }
+ { OutOfMemory 3 }
+ { ObjectBusy 4 }
+ { InsufficientBuffer 5 }
+ { NotImplemented 6 }
+ { Win32Error 7 }
+ { WrongState 8 }
+ { Aborted 9 }
+ { FileNotFound 10 }
+ { ValueOverflow 11 }
+ { AccessDenied 12 }
+ { UnknownImageFormat 13 }
+ { FontFamilyNotFound 14 }
+ { FontStyleNotFound 15 }
+ { NotTrueTypeFont 16 }
+ { UnsupportedGdiplusVersion 17 }
+ { GdiplusNotInitialized 18 }
+ { PropertyNotFound 19 }
+ { PropertyNotSupported 20 }
+ { ProfileNotFound 21 } ;
+
+CALLBACK: BOOL ImageAbort ( void* data ) ;
+TYPEDEF: ImageAbort DrawImageAbort
+TYPEDEF: ImageAbort GetThumbnailImageAbort
+
+STRUCT: GpPoint
+ { X INT }
+ { Y INT } ;
+
+STRUCT: GpPointF
+ { X REAL }
+ { Y REAL } ;
+
+STRUCT: GpPathData
+ { Count INT }
+ { Points GpPointF* }
+ { Types BYTE* } ;
+
+STRUCT: GpRectF
+ { X REAL }
+ { Y REAL }
+ { Width REAL }
+ { Height REAL } ;
+
+STRUCT: GpRect
+ { X INT }
+ { Y INT }
+ { Width INT }
+ { Height INT } ;
+
+STRUCT: CharacterRange
+ { First INT }
+ { Length INT } ;
+
+TYPEDEF: UINT GraphicsState
+TYPEDEF: UINT GraphicsContainer
+
+ENUM: GpUnit
+ { UnitWorld 0 }
+ { UnitDisplay 1 }
+ { UnitPixel 2 }
+ { UnitPoint 3 }
+ { UnitInch 4 }
+ { UnitDocument 5 }
+ { UnitMillimeter 6 } ;
+
+ENUM: GpBrushType
+ { BrushTypeSolidColor 0 }
+ { BrushTypeHatchFill 1 }
+ { BrushTypeTextureFill 2 }
+ { BrushTypePathGradient 3 }
+ { BrushTypeLinearGradient 4 } ;
+
+ENUM: GpFillMode
+ { FillModeAlternate 0 }
+ { FillModeWinding 1 } ;
+
+ENUM: GpLineCap
+ { LineCapFlat HEX: 00 }
+ { LineCapSquare HEX: 01 }
+ { LineCapRound HEX: 02 }
+ { LineCapTriangle HEX: 03 }
+
+ { LineCapNoAnchor HEX: 10 }
+ { LineCapSquareAnchor HEX: 11 }
+ { LineCapRoundAnchor HEX: 12 }
+ { LineCapDiamondAnchor HEX: 13 }
+ { LineCapArrowAnchor HEX: 14 }
+
+ { LineCapCustom HEX: ff }
+ { LineCapAnchorMask HEX: f0 } ;
+
+ENUM: PathPointType
+ { PathPointTypeStart 0 }
+ { PathPointTypeLine 1 }
+ { PathPointTypeBezier 3 }
+ { PathPointTypePathTypeMask 7 }
+ { PathPointTypePathDashMode 16 }
+ { PathPointTypePathMarker 32 }
+ { PathPointTypeCloseSubpath 128 }
+ { PathPointTypeBezier3 3 } ;
+
+ENUM: GpPenType
+ { PenTypeSolidColor BrushTypeSolidColor }
+ { PenTypeHatchFill BrushTypeHatchFill }
+ { PenTypeTextureFill BrushTypeTextureFill }
+ { PenTypePathGradient BrushTypePathGradient }
+ { PenTypeLinearGradient BrushTypeLinearGradient }
+ { PenTypeUnknown -1 } ;
+
+ENUM: GpLineJoin
+ { LineJoinMiter 0 }
+ { LineJoinBevel 1 }
+ { LineJoinRound 2 }
+ { LineJoinMiterClipped 3 } ;
+
+ENUM: QualityMode
+ { QualityModeInvalid -1 }
+ { QualityModeDefault 0 }
+ { QualityModeLow 1 }
+ { QualityModeHigh 2 } ;
+
+ENUM: SmoothingMode
+ { SmoothingModeInvalid QualityModeInvalid }
+ { SmoothingModeDefault QualityModeDefault }
+ { SmoothingModeHighSpeed QualityModeLow }
+ { SmoothingModeHighQuality QualityModeHigh }
+ SmoothingModeNone
+ SmoothingModeAntiAlias ;
+
+ENUM: CompositingQuality
+ { CompositingQualityInvalid QualityModeInvalid }
+ { CompositingQualityDefault QualityModeDefault }
+ { CompositingQualityHighSpeed QualityModeLow }
+ { CompositingQualityHighQuality QualityModeHigh }
+ CompositingQualityGammaCorrected
+ CompositingQualityAssumeLinear ;
+
+ENUM: InterpolationMode
+ { InterpolationModeInvalid QualityModeInvalid }
+ { InterpolationModeDefault QualityModeDefault }
+ { InterpolationModeLowQuality QualityModeLow }
+ { InterpolationModeHighQuality QualityModeHigh }
+ InterpolationModeBilinear
+ InterpolationModeBicubic
+ InterpolationModeNearestNeighbor
+ InterpolationModeHighQualityBilinear
+ InterpolationModeHighQualityBicubic ;
+
+ENUM: GpPenAlignment
+ { PenAlignmentCenter 0 }
+ { PenAlignmentInset 1 } ;
+
+ENUM: PixelOffsetMode
+ { PixelOffsetModeInvalid QualityModeInvalid }
+ { PixelOffsetModeDefault QualityModeDefault }
+ { PixelOffsetModeHighSpeed QualityModeLow }
+ { PixelOffsetModeHighQuality QualityModeHigh }
+ PixelOffsetModeNone
+ PixelOffsetModeHalf ;
+
+ENUM: GpDashCap
+ { DashCapFlat 0 }
+ { DashCapRound 2 }
+ { DashCapTriangle 3 } ;
+
+ENUM: GpDashStyle
+ DashStyleSolid
+ DashStyleDash
+ DashStyleDot
+ DashStyleDashDot
+ DashStyleDashDotDot
+ DashStyleCustom ;
+
+ENUM: GpMatrixOrder
+ { MatrixOrderPrepend 0 }
+ { MatrixOrderAppend 1 } ;
+
+ENUM: ImageType
+ ImageTypeUnknown
+ ImageTypeBitmap
+ ImageTypeMetafile ;
+
+ENUM: WarpMode
+ WarpModePerspective
+ WarpModeBilinear ;
+
+ENUM: GpWrapMode
+ WrapModeTile
+ WrapModeTileFlipX
+ WrapModeTileFlipY
+ WrapModeTileFlipXY
+ WrapModeClamp ;
+
+ENUM: MetafileType
+ MetafileTypeInvalid
+ MetafileTypeWmf
+ MetafileTypeWmfPlaceable
+ MetafileTypeEmf
+ MetafileTypeEmfPlusOnly
+ MetafileTypeEmfPlusDual ;
+
+ENUM: LinearGradientMode
+ LinearGradientModeHorizontal
+ LinearGradientModeVertical
+ LinearGradientModeForwardDiagonal
+ LinearGradientModeBackwardDiagonal ;
+
+ENUM: EmfType
+ { EmfTypeEmfOnly MetafileTypeEmf }
+ { EmfTypeEmfPlusOnly MetafileTypeEmfPlusOnly }
+ { EmfTypeEmfPlusDual MetafileTypeEmfPlusDual } ;
+
+ENUM: CompositingMode
+ CompositingModeSourceOver
+ CompositingModeSourceCopy ;
+
+ENUM: TextRenderingHint
+ { TextRenderingHintSystemDefault 0 }
+ TextRenderingHintSingleBitPerPixelGridFit
+ TextRenderingHintSingleBitPerPixel
+ TextRenderingHintAntiAliasGridFit
+ TextRenderingHintAntiAlias
+ TextRenderingHintClearTypeGridFit ;
+
+ENUM: StringAlignment
+ { StringAlignmentNear 0 }
+ { StringAlignmentCenter 1 }
+ { StringAlignmentFar 2 } ;
+
+ENUM: StringDigitSubstitute
+ { StringDigitSubstituteUser 0 }
+ { StringDigitSubstituteNone 1 }
+ { StringDigitSubstituteNational 2 }
+ { StringDigitSubstituteTraditional 3 } ;
+
+ENUM: StringFormatFlags
+ { StringFormatFlagsDirectionRightToLeft HEX: 00000001 }
+ { StringFormatFlagsDirectionVertical HEX: 00000002 }
+ { StringFormatFlagsNoFitBlackBox HEX: 00000004 }
+ { StringFormatFlagsDisplayFormatControl HEX: 00000020 }
+ { StringFormatFlagsNoFontFallback HEX: 00000400 }
+ { StringFormatFlagsMeasureTrailingSpaces HEX: 00000800 }
+ { StringFormatFlagsNoWrap HEX: 00001000 }
+ { StringFormatFlagsLineLimit HEX: 00002000 }
+ { StringFormatFlagsNoClip HEX: 00004000 } ;
+
+ENUM: StringTrimming
+ { StringTrimmingNone 0 }
+ { StringTrimmingCharacter 1 }
+ { StringTrimmingWord 2 }
+ { StringTrimmingEllipsisCharacter 3 }
+ { StringTrimmingEllipsisWord 4 }
+ { StringTrimmingEllipsisPath 5 } ;
+
+ENUM: FontStyle
+ { FontStyleRegular 0 }
+ { FontStyleBold 1 }
+ { FontStyleItalic 2 }
+ { FontStyleBoldItalic 3 }
+ { FontStyleUnderline 4 }
+ { FontStyleStrikeout 8 } ;
+
+ENUM: HotkeyPrefix
+ { HotkeyPrefixNone 0 }
+ { HotkeyPrefixShow 1 }
+ { HotkeyPrefixHide 2 } ;
+
+ENUM: PaletteFlags
+ { PaletteFlagsHasAlpha 1 }
+ { PaletteFlagsGrayScale 2 }
+ { PaletteFlagsHalftone 4 } ;
+
+ENUM: ImageCodecFlags
+ { ImageCodecFlagsEncoder 1 }
+ { ImageCodecFlagsDecoder 2 }
+ { ImageCodecFlagsSupportBitmap 4 }
+ { ImageCodecFlagsSupportVector 8 }
+ { ImageCodecFlagsSeekableEncode 16 }
+ { ImageCodecFlagsBlockingDecode 32 }
+ { ImageCodecFlagsBuiltin 65536 }
+ { ImageCodecFlagsSystem 131072 }
+ { ImageCodecFlagsUser 262144 } ;
+
+ENUM: ImageFlags
+ { ImageFlagsNone 0 }
+ { ImageFlagsScalable HEX: 0001 }
+ { ImageFlagsHasAlpha HEX: 0002 }
+ { ImageFlagsHasTranslucent HEX: 0004 }
+ { ImageFlagsPartiallyScalable HEX: 0008 }
+ { ImageFlagsColorSpaceRGB HEX: 0010 }
+ { ImageFlagsColorSpaceCMYK HEX: 0020 }
+ { ImageFlagsColorSpaceGRAY HEX: 0040 }
+ { ImageFlagsColorSpaceYCBCR HEX: 0080 }
+ { ImageFlagsColorSpaceYCCK HEX: 0100 }
+ { ImageFlagsHasRealDPI HEX: 1000 }
+ { ImageFlagsHasRealPixelSize HEX: 2000 }
+ { ImageFlagsReadOnly HEX: 00010000 }
+ { ImageFlagsCaching HEX: 00020000 } ;
+
+ENUM: CombineMode
+ CombineModeReplace
+ CombineModeIntersect
+ CombineModeUnion
+ CombineModeXor
+ CombineModeExclude
+ CombineModeComplement ;
+
+ENUM: GpFlushIntention
+ { FlushIntentionFlush 0 }
+ { FlushIntentionSync 1 } ;
+
+ENUM: GpCoordinateSpace
+ CoordinateSpaceWorld
+ CoordinateSpacePage
+ CoordinateSpaceDevice ;
+
+ENUM: GpTestControlEnum
+ { TestControlForceBilinear 0 }
+ { TestControlNoICM 1 }
+ { TestControlGetBuildNumber 2 } ;
+
+ENUM: MetafileFrameUnit
+ { MetafileFrameUnitPixel UnitPixel }
+ { MetafileFrameUnitPoint UnitPoint }
+ { MetafileFrameUnitInch UnitInch }
+ { MetafileFrameUnitDocument UnitDocument }
+ { MetafileFrameUnitMillimeter UnitMillimeter }
+ MetafileFrameUnitGdi ;
+
+ENUM: HatchStyle
+ { HatchStyleHorizontal 0 }
+ { HatchStyleVertical 1 }
+ { HatchStyleForwardDiagonal 2 }
+ { HatchStyleBackwardDiagonal 3 }
+ { HatchStyleCross 4 }
+ { HatchStyleDiagonalCross 5 }
+ { HatchStyle05Percent 6 }
+ { HatchStyle10Percent 7 }
+ { HatchStyle20Percent 8 }
+ { HatchStyle25Percent 9 }
+ { HatchStyle30Percent 10 }
+ { HatchStyle40Percent 11 }
+ { HatchStyle50Percent 12 }
+ { HatchStyle60Percent 13 }
+ { HatchStyle70Percent 14 }
+ { HatchStyle75Percent 15 }
+ { HatchStyle80Percent 16 }
+ { HatchStyle90Percent 17 }
+ { HatchStyleLightDownwardDiagonal 18 }
+ { HatchStyleLightUpwardDiagonal 19 }
+ { HatchStyleDarkDownwardDiagonal 20 }
+ { HatchStyleDarkUpwardDiagonal 21 }
+ { HatchStyleWideDownwardDiagonal 22 }
+ { HatchStyleWideUpwardDiagonal 23 }
+ { HatchStyleLightVertical 24 }
+ { HatchStyleLightHorizontal 25 }
+ { HatchStyleNarrowVertical 26 }
+ { HatchStyleNarrowHorizontal 27 }
+ { HatchStyleDarkVertical 28 }
+ { HatchStyleDarkHorizontal 29 }
+ { HatchStyleDashedDownwardDiagonal 30 }
+ { HatchStyleDashedUpwardDiagonal 31 }
+ { HatchStyleDashedHorizontal 32 }
+ { HatchStyleDashedVertical 33 }
+ { HatchStyleSmallConfetti 34 }
+ { HatchStyleLargeConfetti 35 }
+ { HatchStyleZigZag 36 }
+ { HatchStyleWave 37 }
+ { HatchStyleDiagonalBrick 38 }
+ { HatchStyleHorizontalBrick 39 }
+ { HatchStyleWeave 40 }
+ { HatchStylePlaid 41 }
+ { HatchStyleDivot 42 }
+ { HatchStyleDottedGrid 43 }
+ { HatchStyleDottedDiamond 44 }
+ { HatchStyleShingle 45 }
+ { HatchStyleTrellis 46 }
+ { HatchStyleSphere 47 }
+ { HatchStyleSmallGrid 48 }
+ { HatchStyleSmallCheckerBoard 49 }
+ { HatchStyleLargeCheckerBoard 50 }
+ { HatchStyleOutlinedDiamond 51 }
+ { HatchStyleSolidDiamond 52 }
+ { HatchStyleTotal 53 }
+ { HatchStyleLargeGrid 4 }
+ { HatchStyleMin 0 }
+ { HatchStyleMax 52 } ;
+
+ENUM: DebugEventLevel
+ DebugEventLevelFatal
+ DebugEventLevelWarning ;
+
+CALLBACK: void DebugEventProc ( DebugEventLevel level, c-string msg ) ;
+CALLBACK: GpStatus NotificationHookProc ( ULONG_PTR* x ) ;
+CALLBACK: void NotificationUnhookProc ( ULONG_PTR x ) ;
+
+STRUCT: GdiplusStartupInput
+ { GdiplusVersion UINT32 }
+ { DebugEventCallback DebugEventProc }
+ { SuppressBackgroundThread BOOL }
+ { SuppressExternalCodecs BOOL } ;
+
+STRUCT: GdiplusStartupOutput
+ { NotificationHook NotificationHookProc }
+ { NotificationUnhook NotificationUnhookProc } ;
+
+FUNCTION: GpStatus GdiplusStartup ( ULONG_PTR* x, GdiplusStartupInput* in, GdiplusStartupOutput* out ) ;
+FUNCTION: void GdiplusShutdown ( ULONG_PTR x ) ;
+
+TYPEDEF: DWORD ARGB
+TYPEDEF: INT PixelFormat
+
+<PRIVATE
+: pixel-format-constant ( n m l -- format )
+ [ ] [ 8 shift ] [ ] tri* bitor bitor ; inline
+PRIVATE>
+
+CONSTANT: PixelFormatIndexed HEX: 00010000
+CONSTANT: PixelFormatGDI HEX: 00020000
+CONSTANT: PixelFormatAlpha HEX: 00040000
+CONSTANT: PixelFormatPAlpha HEX: 00080000
+CONSTANT: PixelFormatExtended HEX: 00100000
+CONSTANT: PixelFormatCanonical HEX: 00200000
+
+CONSTANT: PixelFormatUndefined 0
+CONSTANT: PixelFormatDontCare 0
+CONSTANT: PixelFormatMax 15
+
+: PixelFormat1bppIndexed ( -- x )
+ 1 1 PixelFormatIndexed PixelFormatGDI bitor pixel-format-constant ; inline
+: PixelFormat4bppIndexed ( -- x )
+ 2 4 PixelFormatIndexed PixelFormatGDI bitor pixel-format-constant ; inline
+: PixelFormat8bppIndexed ( -- x )
+ 3 8 PixelFormatIndexed PixelFormatGDI bitor pixel-format-constant ; inline
+: PixelFormat16bppGrayScale ( -- x )
+ 4 16 PixelFormatExtended pixel-format-constant ; inline
+: PixelFormat16bppRGB555 ( -- x )
+ 5 16 PixelFormatGDI pixel-format-constant ; inline
+: PixelFormat16bppRGB565 ( -- x )
+ 6 16 PixelFormatGDI pixel-format-constant ; inline
+: PixelFormat16bppARGB1555 ( -- x )
+ 7 16 PixelFormatAlpha PixelFormatGDI bitor pixel-format-constant ; inline
+: PixelFormat24bppRGB ( -- x )
+ 8 24 PixelFormatGDI pixel-format-constant ; inline
+: PixelFormat32bppRGB ( -- x )
+ 9 32 PixelFormatGDI pixel-format-constant ; inline
+: PixelFormat32bppARGB ( -- x )
+ 10 32 PixelFormatAlpha PixelFormatGDI PixelFormatCanonical bitor bitor pixel-format-constant ; inline
+: PixelFormat32bppPARGB ( -- x )
+ 11 32 PixelFormatAlpha PixelFormatPAlpha PixelFormatGDI bitor bitor pixel-format-constant ; inline
+: PixelFormat48bppRGB ( -- x )
+ 12 48 PixelFormatExtended pixel-format-constant ; inline
+: PixelFormat64bppARGB ( -- x )
+ 13 64 PixelFormatAlpha PixelFormatCanonical PixelFormatExtended bitor bitor pixel-format-constant ; inline
+: PixelFormat64bppPARGB ( -- x )
+ 14 64 PixelFormatAlpha PixelFormatPAlpha PixelFormatExtended bitor bitor pixel-format-constant ; inline
+
+STRUCT: ColorPalette
+ { Flags UINT }
+ { Count UINT }
+ { Entries ARGB[1] } ;
+
+! XXX RECTL and SIZEL should go with other metafile definitions if we add them
+STRUCT: RECTL
+ { left LONG }
+ { top LONG }
+ { right LONG }
+ { bottom LONG } ;
+
+STRUCT: SIZEL
+ { width LONG }
+ { height LONG } ;
+
+STRUCT: ENHMETAHEADER3
+ { iType DWORD }
+ { nSize DWORD }
+ { rclBounds RECTL }
+ { rclFrame RECTL }
+ { dSignature DWORD }
+ { nVersion DWORD }
+ { nBytes DWORD }
+ { nRecords DWORD }
+ { nHandles WORD }
+ { sReserved WORD }
+ { nDescription DWORD }
+ { offDescription DWORD }
+ { nPalEntries DWORD }
+ { szlDevice SIZEL }
+ { szlMillimeters SIZEL } ;
+
+STRUCT: PWMFRect16
+ { Left INT16 }
+ { Top INT16 }
+ { Right INT16 }
+ { Bottom INT16 } ;
+
+STRUCT: WmfPlaceableFileHeader
+ { Key UINT32 }
+ { Hmf INT16 }
+ { BoundingBox PWMFRect16 }
+ { Inch INT16 }
+ { Reserved INT16[2] }
+ { Checksum INT16 } ;
+
+CONSTANT: GDIP_EMFPLUSFLAGS_DISPLAY 1
+
+! XXX we don't have a METAHEADER struct defined
+! UNION-STRUCT: MetafileHeader-union
+! { WmfHeader METAHEADER }
+! { EmfHeader ENHMETAHEADER3 } ;
+
+UNION-STRUCT: MetafileHeader-union
+ { EmfHeader ENHMETAHEADER3 } ;
+
+STRUCT: MetafileHeader
+ { Type MetafileType }
+ { Size UINT }
+ { Version UINT }
+ { EmfPlusFlags UINT }
+ { DpiX REAL }
+ { DpiY REAL }
+ { X INT }
+ { Y INT }
+ { Width INT }
+ { Height INT }
+ { Header-union MetafileHeader-union }
+ { EmfPlusHeaderSize INT }
+ { LogicalDpiX INT }
+ { LogicalDpiY INT } ;
+
+CONSTANT: ImageFormatUndefined GUID: {b96b3ca9-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatMemoryBMP GUID: {b96b3caa-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatBMP GUID: {b96b3cab-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatEMF GUID: {b96b3cac-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatWMF GUID: {b96b3cad-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatJPEG GUID: {b96b3cae-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatPNG GUID: {b96b3caf-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatGIF GUID: {b96b3cb0-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatTIFF GUID: {b96b3cb1-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatEXIF GUID: {b96b3cb2-0728-11d3-9d7b-0000f81ef32e}
+CONSTANT: ImageFormatIcon GUID: {b96b3cb5-0728-11d3-9d7b-0000f81ef32e}
+
+CONSTANT: FrameDimensionTime GUID: {6aedbd6d-3fb5-418a-83a6-7f45229dc872}
+CONSTANT: FrameDimensionPage GUID: {7462dc86-6180-4c7e-8e3f-ee7333a7a483}
+CONSTANT: FrameDimensionResolution GUID: {84236f7b-3bd3-428f-8dab-4ea1439ca315}
+
+ENUM: ImageLockMode
+ { ImageLockModeRead 1 }
+ { ImageLockModeWrite 2 }
+ { ImageLockModeUserInputBuf 4 } ;
+
+ENUM: RotateFlipType
+ { RotateNoneFlipNone 0 }
+ { Rotate180FlipXY RotateNoneFlipNone }
+
+ { Rotate90FlipNone 1 }
+ { Rotate270FlipXY Rotate90FlipNone }
+
+ { Rotate180FlipNone 2 }
+ { RotateNoneFlipXY Rotate180FlipNone }
+
+ { Rotate270FlipNone 3 }
+ { Rotate90FlipXY Rotate270FlipNone }
+
+ { RotateNoneFlipX 4 }
+ { Rotate180FlipY RotateNoneFlipX }
+
+ { Rotate90FlipX 5 }
+ { Rotate270FlipY Rotate90FlipX }
+
+ { Rotate180FlipX 6 }
+ { RotateNoneFlipY Rotate180FlipX }
+
+ { Rotate270FlipX 7 }
+ { Rotate90FlipY Rotate270FlipX } ;
+
+STRUCT: EncoderParameter
+ { Guid GUID }
+ { NumberOfValues ULONG }
+ { Type ULONG }
+ { Value void* } ;
+
+STRUCT: EncoderParameters
+ { Count UINT }
+ { Parameter EncoderParameter[1] } ;
+
+STRUCT: ImageCodecInfo
+ { Clsid CLSID }
+ { FormatID GUID }
+ { CodecName WCHAR* }
+ { DllName WCHAR* }
+ { FormatDescription WCHAR* }
+ { FilenameExtension WCHAR* }
+ { MimeType WCHAR* }
+ { Flags DWORD }
+ { Version DWORD }
+ { SigCount DWORD }
+ { SigSize DWORD }
+ { SigPattern BYTE* }
+ { SigMask BYTE* } ;
+
+STRUCT: BitmapData
+ { Width UINT }
+ { Height UINT }
+ { Stride INT }
+ { PixelFormat PixelFormat }
+ { Scan0 void* }
+ { Reserved UINT_PTR } ;
+
+STRUCT: ImageItemData
+ { Size UINT }
+ { Position UINT }
+ { Desc void* }
+ { DescSize UINT }
+ { Data void* }
+ { DataSize UINT }
+ { Cookie UINT } ;
+
+STRUCT: PropertyItem
+ { id PROPID }
+ { length ULONG }
+ { type WORD }
+ { value void* } ;
+
+CONSTANT: PropertyTagTypeByte 1
+CONSTANT: PropertyTagTypeASCII 2
+CONSTANT: PropertyTagTypeShort 3
+CONSTANT: PropertyTagTypeLong 4
+CONSTANT: PropertyTagTypeRational 5
+CONSTANT: PropertyTagTypeUndefined 7
+CONSTANT: PropertyTagTypeSLONG 9
+CONSTANT: PropertyTagTypeSRational 10
+
+CONSTANT: PropertyTagExifIFD HEX: 8769
+CONSTANT: PropertyTagGpsIFD HEX: 8825
+
+CONSTANT: PropertyTagNewSubfileType HEX: 00FE
+CONSTANT: PropertyTagSubfileType HEX: 00FF
+CONSTANT: PropertyTagImageWidth HEX: 0100
+CONSTANT: PropertyTagImageHeight HEX: 0101
+CONSTANT: PropertyTagBitsPerSample HEX: 0102
+CONSTANT: PropertyTagCompression HEX: 0103
+CONSTANT: PropertyTagPhotometricInterp HEX: 0106
+CONSTANT: PropertyTagThreshHolding HEX: 0107
+CONSTANT: PropertyTagCellWidth HEX: 0108
+CONSTANT: PropertyTagCellHeight HEX: 0109
+CONSTANT: PropertyTagFillOrder HEX: 010A
+CONSTANT: PropertyTagDocumentName HEX: 010D
+CONSTANT: PropertyTagImageDescription HEX: 010E
+CONSTANT: PropertyTagEquipMake HEX: 010F
+CONSTANT: PropertyTagEquipModel HEX: 0110
+CONSTANT: PropertyTagStripOffsets HEX: 0111
+CONSTANT: PropertyTagOrientation HEX: 0112
+CONSTANT: PropertyTagSamplesPerPixel HEX: 0115
+CONSTANT: PropertyTagRowsPerStrip HEX: 0116
+CONSTANT: PropertyTagStripBytesCount HEX: 0117
+CONSTANT: PropertyTagMinSampleValue HEX: 0118
+CONSTANT: PropertyTagMaxSampleValue HEX: 0119
+CONSTANT: PropertyTagXResolution HEX: 011A
+CONSTANT: PropertyTagYResolution HEX: 011B
+CONSTANT: PropertyTagPlanarConfig HEX: 011C
+CONSTANT: PropertyTagPageName HEX: 011D
+CONSTANT: PropertyTagXPosition HEX: 011E
+CONSTANT: PropertyTagYPosition HEX: 011F
+CONSTANT: PropertyTagFreeOffset HEX: 0120
+CONSTANT: PropertyTagFreeByteCounts HEX: 0121
+CONSTANT: PropertyTagGrayResponseUnit HEX: 0122
+CONSTANT: PropertyTagGrayResponseCurve HEX: 0123
+CONSTANT: PropertyTagT4Option HEX: 0124
+CONSTANT: PropertyTagT6Option HEX: 0125
+CONSTANT: PropertyTagResolutionUnit HEX: 0128
+CONSTANT: PropertyTagPageNumber HEX: 0129
+CONSTANT: PropertyTagTransferFuncition HEX: 012D
+CONSTANT: PropertyTagSoftwareUsed HEX: 0131
+CONSTANT: PropertyTagDateTime HEX: 0132
+CONSTANT: PropertyTagArtist HEX: 013B
+CONSTANT: PropertyTagHostComputer HEX: 013C
+CONSTANT: PropertyTagPredictor HEX: 013D
+CONSTANT: PropertyTagWhitePoint HEX: 013E
+CONSTANT: PropertyTagPrimaryChromaticities HEX: 013F
+CONSTANT: PropertyTagColorMap HEX: 0140
+CONSTANT: PropertyTagHalftoneHints HEX: 0141
+CONSTANT: PropertyTagTileWidth HEX: 0142
+CONSTANT: PropertyTagTileLength HEX: 0143
+CONSTANT: PropertyTagTileOffset HEX: 0144
+CONSTANT: PropertyTagTileByteCounts HEX: 0145
+CONSTANT: PropertyTagInkSet HEX: 014C
+CONSTANT: PropertyTagInkNames HEX: 014D
+CONSTANT: PropertyTagNumberOfInks HEX: 014E
+CONSTANT: PropertyTagDotRange HEX: 0150
+CONSTANT: PropertyTagTargetPrinter HEX: 0151
+CONSTANT: PropertyTagExtraSamples HEX: 0152
+CONSTANT: PropertyTagSampleFormat HEX: 0153
+CONSTANT: PropertyTagSMinSampleValue HEX: 0154
+CONSTANT: PropertyTagSMaxSampleValue HEX: 0155
+CONSTANT: PropertyTagTransferRange HEX: 0156
+
+CONSTANT: PropertyTagJPEGProc HEX: 0200
+CONSTANT: PropertyTagJPEGInterFormat HEX: 0201
+CONSTANT: PropertyTagJPEGInterLength HEX: 0202
+CONSTANT: PropertyTagJPEGRestartInterval HEX: 0203
+CONSTANT: PropertyTagJPEGLosslessPredictors HEX: 0205
+CONSTANT: PropertyTagJPEGPointTransforms HEX: 0206
+CONSTANT: PropertyTagJPEGQTables HEX: 0207
+CONSTANT: PropertyTagJPEGDCTables HEX: 0208
+CONSTANT: PropertyTagJPEGACTables HEX: 0209
+
+CONSTANT: PropertyTagYCbCrCoefficients HEX: 0211
+CONSTANT: PropertyTagYCbCrSubsampling HEX: 0212
+CONSTANT: PropertyTagYCbCrPositioning HEX: 0213
+CONSTANT: PropertyTagREFBlackWhite HEX: 0214
+
+CONSTANT: PropertyTagICCProfile HEX: 8773
+
+CONSTANT: PropertyTagGamma HEX: 0301
+CONSTANT: PropertyTagICCProfileDescriptor HEX: 0302
+CONSTANT: PropertyTagSRGBRenderingIntent HEX: 0303
+
+CONSTANT: PropertyTagImageTitle HEX: 0320
+CONSTANT: PropertyTagCopyright HEX: 8298
+
+CONSTANT: PropertyTagResolutionXUnit HEX: 5001
+CONSTANT: PropertyTagResolutionYUnit HEX: 5002
+CONSTANT: PropertyTagResolutionXLengthUnit HEX: 5003
+CONSTANT: PropertyTagResolutionYLengthUnit HEX: 5004
+CONSTANT: PropertyTagPrintFlags HEX: 5005
+CONSTANT: PropertyTagPrintFlagsVersion HEX: 5006
+CONSTANT: PropertyTagPrintFlagsCrop HEX: 5007
+CONSTANT: PropertyTagPrintFlagsBleedWidth HEX: 5008
+CONSTANT: PropertyTagPrintFlagsBleedWidthScale HEX: 5009
+CONSTANT: PropertyTagHalftoneLPI HEX: 500A
+CONSTANT: PropertyTagHalftoneLPIUnit HEX: 500B
+CONSTANT: PropertyTagHalftoneDegree HEX: 500C
+CONSTANT: PropertyTagHalftoneShape HEX: 500D
+CONSTANT: PropertyTagHalftoneMisc HEX: 500E
+CONSTANT: PropertyTagHalftoneScreen HEX: 500F
+CONSTANT: PropertyTagJPEGQuality HEX: 5010
+CONSTANT: PropertyTagGridSize HEX: 5011
+CONSTANT: PropertyTagThumbnailFormat HEX: 5012
+CONSTANT: PropertyTagThumbnailWidth HEX: 5013
+CONSTANT: PropertyTagThumbnailHeight HEX: 5014
+CONSTANT: PropertyTagThumbnailColorDepth HEX: 5015
+CONSTANT: PropertyTagThumbnailPlanes HEX: 5016
+CONSTANT: PropertyTagThumbnailRawBytes HEX: 5017
+CONSTANT: PropertyTagThumbnailSize HEX: 5018
+CONSTANT: PropertyTagThumbnailCompressedSize HEX: 5019
+CONSTANT: PropertyTagColorTransferFunction HEX: 501A
+CONSTANT: PropertyTagThumbnailData HEX: 501B
+
+CONSTANT: PropertyTagThumbnailImageWidth HEX: 5020
+CONSTANT: PropertyTagThumbnailImageHeight HEX: 5021
+CONSTANT: PropertyTagThumbnailBitsPerSample HEX: 5022
+CONSTANT: PropertyTagThumbnailCompression HEX: 5023
+CONSTANT: PropertyTagThumbnailPhotometricInterp HEX: 5024
+CONSTANT: PropertyTagThumbnailImageDescription HEX: 5025
+CONSTANT: PropertyTagThumbnailEquipMake HEX: 5026
+CONSTANT: PropertyTagThumbnailEquipModel HEX: 5027
+CONSTANT: PropertyTagThumbnailStripOffsets HEX: 5028
+CONSTANT: PropertyTagThumbnailOrientation HEX: 5029
+CONSTANT: PropertyTagThumbnailSamplesPerPixel HEX: 502A
+CONSTANT: PropertyTagThumbnailRowsPerStrip HEX: 502B
+CONSTANT: PropertyTagThumbnailStripBytesCount HEX: 502C
+CONSTANT: PropertyTagThumbnailResolutionX HEX: 502D
+CONSTANT: PropertyTagThumbnailResolutionY HEX: 502E
+CONSTANT: PropertyTagThumbnailPlanarConfig HEX: 502F
+CONSTANT: PropertyTagThumbnailResolutionUnit HEX: 5030
+CONSTANT: PropertyTagThumbnailTransferFunction HEX: 5031
+CONSTANT: PropertyTagThumbnailSoftwareUsed HEX: 5032
+CONSTANT: PropertyTagThumbnailDateTime HEX: 5033
+CONSTANT: PropertyTagThumbnailArtist HEX: 5034
+CONSTANT: PropertyTagThumbnailWhitePoint HEX: 5035
+CONSTANT: PropertyTagThumbnailPrimaryChromaticities HEX: 5036
+CONSTANT: PropertyTagThumbnailYCbCrCoefficients HEX: 5037
+CONSTANT: PropertyTagThumbnailYCbCrSubsampling HEX: 5038
+CONSTANT: PropertyTagThumbnailYCbCrPositioning HEX: 5039
+CONSTANT: PropertyTagThumbnailRefBlackWhite HEX: 503A
+CONSTANT: PropertyTagThumbnailCopyRight HEX: 503B
+
+CONSTANT: PropertyTagLuminanceTable HEX: 5090
+CONSTANT: PropertyTagChrominanceTable HEX: 5091
+
+CONSTANT: PropertyTagFrameDelay HEX: 5100
+CONSTANT: PropertyTagLoopCount HEX: 5101
+
+CONSTANT: PropertyTagPixelUnit HEX: 5110
+CONSTANT: PropertyTagPixelPerUnitX HEX: 5111
+CONSTANT: PropertyTagPixelPerUnitY HEX: 5112
+CONSTANT: PropertyTagPaletteHistogram HEX: 5113
+
+CONSTANT: PropertyTagExifExposureTime HEX: 829A
+CONSTANT: PropertyTagExifFNumber HEX: 829D
+
+CONSTANT: PropertyTagExifExposureProg HEX: 8822
+CONSTANT: PropertyTagExifSpectralSense HEX: 8824
+CONSTANT: PropertyTagExifISOSpeed HEX: 8827
+CONSTANT: PropertyTagExifOECF HEX: 8828
+
+CONSTANT: PropertyTagExifVer HEX: 9000
+CONSTANT: PropertyTagExifDTOrig HEX: 9003
+CONSTANT: PropertyTagExifDTDigitized HEX: 9004
+
+CONSTANT: PropertyTagExifCompConfig HEX: 9101
+CONSTANT: PropertyTagExifCompBPP HEX: 9102
+
+CONSTANT: PropertyTagExifShutterSpeed HEX: 9201
+CONSTANT: PropertyTagExifAperture HEX: 9202
+CONSTANT: PropertyTagExifBrightness HEX: 9203
+CONSTANT: PropertyTagExifExposureBias HEX: 9204
+CONSTANT: PropertyTagExifMaxAperture HEX: 9205
+CONSTANT: PropertyTagExifSubjectDist HEX: 9206
+CONSTANT: PropertyTagExifMeteringMode HEX: 9207
+CONSTANT: PropertyTagExifLightSource HEX: 9208
+CONSTANT: PropertyTagExifFlash HEX: 9209
+CONSTANT: PropertyTagExifFocalLength HEX: 920A
+CONSTANT: PropertyTagExifMakerNote HEX: 927C
+CONSTANT: PropertyTagExifUserComment HEX: 9286
+CONSTANT: PropertyTagExifDTSubsec HEX: 9290
+CONSTANT: PropertyTagExifDTOrigSS HEX: 9291
+CONSTANT: PropertyTagExifDTDigSS HEX: 9292
+
+CONSTANT: PropertyTagExifFPXVer HEX: A000
+CONSTANT: PropertyTagExifColorSpace HEX: A001
+CONSTANT: PropertyTagExifPixXDim HEX: A002
+CONSTANT: PropertyTagExifPixYDim HEX: A003
+CONSTANT: PropertyTagExifRelatedWav HEX: A004
+CONSTANT: PropertyTagExifInterop HEX: A005
+CONSTANT: PropertyTagExifFlashEnergy HEX: A20B
+CONSTANT: PropertyTagExifSpatialFR HEX: A20C
+CONSTANT: PropertyTagExifFocalXRes HEX: A20E
+CONSTANT: PropertyTagExifFocalYRes HEX: A20F
+CONSTANT: PropertyTagExifFocalResUnit HEX: A210
+CONSTANT: PropertyTagExifSubjectLoc HEX: A214
+CONSTANT: PropertyTagExifExposureIndex HEX: A215
+CONSTANT: PropertyTagExifSensingMethod HEX: A217
+CONSTANT: PropertyTagExifFileSource HEX: A300
+CONSTANT: PropertyTagExifSceneType HEX: A301
+CONSTANT: PropertyTagExifCfaPattern HEX: A302
+
+CONSTANT: PropertyTagGpsVer HEX: 0000
+CONSTANT: PropertyTagGpsLatitudeRef HEX: 0001
+CONSTANT: PropertyTagGpsLatitude HEX: 0002
+CONSTANT: PropertyTagGpsLongitudeRef HEX: 0003
+CONSTANT: PropertyTagGpsLongitude HEX: 0004
+CONSTANT: PropertyTagGpsAltitudeRef HEX: 0005
+CONSTANT: PropertyTagGpsAltitude HEX: 0006
+CONSTANT: PropertyTagGpsGpsTime HEX: 0007
+CONSTANT: PropertyTagGpsGpsSatellites HEX: 0008
+CONSTANT: PropertyTagGpsGpsStatus HEX: 0009
+CONSTANT: PropertyTagGpsGpsMeasureMode HEX: 000A
+CONSTANT: PropertyTagGpsGpsDop HEX: 000B
+CONSTANT: PropertyTagGpsSpeedRef HEX: 000C
+CONSTANT: PropertyTagGpsSpeed HEX: 000D
+CONSTANT: PropertyTagGpsTrackRef HEX: 000E
+CONSTANT: PropertyTagGpsTrack HEX: 000F
+CONSTANT: PropertyTagGpsImgDirRef HEX: 0010
+CONSTANT: PropertyTagGpsImgDir HEX: 0011
+CONSTANT: PropertyTagGpsMapDatum HEX: 0012
+CONSTANT: PropertyTagGpsDestLatRef HEX: 0013
+CONSTANT: PropertyTagGpsDestLat HEX: 0014
+CONSTANT: PropertyTagGpsDestLongRef HEX: 0015
+CONSTANT: PropertyTagGpsDestLong HEX: 0016
+CONSTANT: PropertyTagGpsDestBearRef HEX: 0017
+CONSTANT: PropertyTagGpsDestBear HEX: 0018
+CONSTANT: PropertyTagGpsDestDistRef HEX: 0019
+CONSTANT: PropertyTagGpsDestDist HEX: 001A
+
+ENUM: ColorChannelFlags
+ ColorChannelFlagsC
+ ColorChannelFlagsM
+ ColorChannelFlagsY
+ ColorChannelFlagsK
+ ColorChannelFlagsLast ;
+
+STRUCT: GpColor
+ { Argb ARGB } ;
+
+STRUCT: ColorMatrix
+ { m REAL[5][5] } ;
+
+ENUM: ColorMatrixFlags
+ { ColorMatrixFlagsDefault 0 }
+ { ColorMatrixFlagsSkipGrays 1 }
+ { ColorMatrixFlagsAltGray 2 } ;
+
+ENUM: ColorAdjustType
+ ColorAdjustTypeDefault
+ ColorAdjustTypeBitmap
+ ColorAdjustTypeBrush
+ ColorAdjustTypePen
+ ColorAdjustTypeText
+ ColorAdjustTypeCount
+ ColorAdjustTypeAny ;
+
+STRUCT: ColorMap
+ { oldColor GpColor }
+ { newColor GpColor } ;
+
+C-TYPE: GpGraphics
+C-TYPE: GpPen
+C-TYPE: GpBrush
+C-TYPE: GpHatch
+C-TYPE: GpSolidFill
+C-TYPE: GpPath
+C-TYPE: GpMatrix
+C-TYPE: GpPathIterator
+C-TYPE: GpCustomLineCap
+C-TYPE: GpAdjustableArrowCap
+C-TYPE: GpImage
+C-TYPE: GpMetafile
+C-TYPE: GpImageAttributes
+C-TYPE: GpCachedBitmap
+C-TYPE: GpBitmap
+C-TYPE: GpPathGradient
+C-TYPE: GpLineGradient
+C-TYPE: GpTexture
+C-TYPE: GpFont
+C-TYPE: GpFontCollection
+C-TYPE: GpFontFamily
+C-TYPE: GpStringFormat
+C-TYPE: GpRegion
+C-TYPE: CGpEffect
+
+! dummy out other windows types we don't care to define yet
+C-TYPE: LOGFONTA
+C-TYPE: LOGFONTW
+
+FUNCTION: GpStatus GdipCreateAdjustableArrowCap ( REAL x, REAL x, BOOL x, GpAdjustableArrowCap** x ) ;
+FUNCTION: GpStatus GdipGetAdjustableArrowCapFillState ( GpAdjustableArrowCap* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipGetAdjustableArrowCapHeight ( GpAdjustableArrowCap* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetAdjustableArrowCapMiddleInset ( GpAdjustableArrowCap* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetAdjustableArrowCapWidth ( GpAdjustableArrowCap* x, REAL* x ) ;
+FUNCTION: GpStatus GdipSetAdjustableArrowCapFillState ( GpAdjustableArrowCap* x, BOOL x ) ;
+FUNCTION: GpStatus GdipSetAdjustableArrowCapHeight ( GpAdjustableArrowCap* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetAdjustableArrowCapMiddleInset ( GpAdjustableArrowCap* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetAdjustableArrowCapWidth ( GpAdjustableArrowCap* x, REAL x ) ;
+
+FUNCTION: GpStatus GdipBitmapApplyEffect ( GpBitmap* x, CGpEffect* x, RECT* x, BOOL x, VOID** x, INT* x ) ;
+FUNCTION: GpStatus GdipBitmapCreateApplyEffect ( GpBitmap** x, INT x, CGpEffect* x, RECT* x, RECT* x, GpBitmap** x, BOOL x, VOID** x, INT* x ) ;
+FUNCTION: GpStatus GdipBitmapGetPixel ( GpBitmap* x, INT x, INT x, ARGB* x ) ;
+FUNCTION: GpStatus GdipBitmapLockBits ( GpBitmap* x, GpRect* x, UINT x,
+ PixelFormat x, BitmapData* x ) ;
+FUNCTION: GpStatus GdipBitmapSetPixel ( GpBitmap* x, INT x, INT x, ARGB x ) ;
+FUNCTION: GpStatus GdipBitmapSetResolution ( GpBitmap* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipBitmapUnlockBits ( GpBitmap* x, BitmapData* x ) ;
+FUNCTION: GpStatus GdipCloneBitmapArea ( REAL x, REAL x, REAL x, REAL x, PixelFormat x, GpBitmap* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCloneBitmapAreaI ( INT x, INT x, INT x, INT x, PixelFormat x, GpBitmap* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromFile ( WCHAR* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromFileICM ( WCHAR* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromGdiDib ( BITMAPINFO* x, VOID* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromGraphics ( INT x, INT x, GpGraphics* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromHBITMAP ( HBITMAP x, HPALETTE x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromHICON ( HICON x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromResource ( HINSTANCE x, WCHAR* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromScan0 ( INT x, INT x, INT x, PixelFormat x, BYTE* x,
+ GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromStream ( IStream* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateBitmapFromStreamICM ( IStream* x, GpBitmap** x ) ;
+FUNCTION: GpStatus GdipCreateHBITMAPFromBitmap ( GpBitmap* x, HBITMAP* x, ARGB x ) ;
+FUNCTION: GpStatus GdipCreateHICONFromBitmap ( GpBitmap* x, HICON* x ) ;
+FUNCTION: GpStatus GdipDeleteEffect ( CGpEffect* x ) ;
+FUNCTION: GpStatus GdipSetEffectParameters ( CGpEffect* x, VOID* x, UINT x ) ;
+
+
+FUNCTION: GpStatus GdipCloneBrush ( GpBrush* x, GpBrush** x ) ;
+FUNCTION: GpStatus GdipDeleteBrush ( GpBrush* x ) ;
+FUNCTION: GpStatus GdipGetBrushType ( GpBrush* x, GpBrushType* x ) ;
+
+
+FUNCTION: GpStatus GdipCreateCachedBitmap ( GpBitmap* x, GpGraphics* x,
+ GpCachedBitmap** x ) ;
+FUNCTION: GpStatus GdipDeleteCachedBitmap ( GpCachedBitmap* x ) ;
+FUNCTION: GpStatus GdipDrawCachedBitmap ( GpGraphics* x, GpCachedBitmap* x, INT x, INT x ) ;
+
+
+FUNCTION: GpStatus GdipCloneCustomLineCap ( GpCustomLineCap* x, GpCustomLineCap** x ) ;
+FUNCTION: GpStatus GdipCreateCustomLineCap ( GpPath* x, GpPath* x, GpLineCap x, REAL x,
+ GpCustomLineCap** x ) ;
+FUNCTION: GpStatus GdipDeleteCustomLineCap ( GpCustomLineCap* x ) ;
+FUNCTION: GpStatus GdipGetCustomLineCapBaseCap ( GpCustomLineCap* x, GpLineCap* x ) ;
+FUNCTION: GpStatus GdipSetCustomLineCapBaseCap ( GpCustomLineCap* x, GpLineCap x ) ;
+FUNCTION: GpStatus GdipGetCustomLineCapBaseInset ( GpCustomLineCap* x, REAL* x ) ;
+FUNCTION: GpStatus GdipSetCustomLineCapBaseInset ( GpCustomLineCap* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetCustomLineCapStrokeCaps ( GpCustomLineCap* x, GpLineCap x,
+ GpLineCap x ) ;
+FUNCTION: GpStatus GdipGetCustomLineCapStrokeJoin ( GpCustomLineCap* x, GpLineJoin* x ) ;
+FUNCTION: GpStatus GdipSetCustomLineCapStrokeJoin ( GpCustomLineCap* x, GpLineJoin x ) ;
+FUNCTION: GpStatus GdipGetCustomLineCapWidthScale ( GpCustomLineCap* x, REAL* x ) ;
+FUNCTION: GpStatus GdipSetCustomLineCapWidthScale ( GpCustomLineCap* x, REAL x ) ;
+
+FUNCTION: GpStatus GdipCloneFont ( GpFont* x, GpFont** x ) ;
+FUNCTION: GpStatus GdipCreateFont ( GpFontFamily* x, REAL x, INT x, GpUnit x,
+ GpFont** x ) ;
+FUNCTION: GpStatus GdipCreateFontFromDC ( HDC x, GpFont** x ) ;
+FUNCTION: GpStatus GdipCreateFontFromLogfontA ( HDC x, LOGFONTA* x, GpFont** x ) ;
+FUNCTION: GpStatus GdipCreateFontFromLogfontW ( HDC x, LOGFONTW* x, GpFont** x ) ;
+FUNCTION: GpStatus GdipDeleteFont ( GpFont* x ) ;
+FUNCTION: GpStatus GdipGetLogFontA ( GpFont* x, GpGraphics* x, LOGFONTA* x ) ;
+FUNCTION: GpStatus GdipGetLogFontW ( GpFont* x, GpGraphics* x, LOGFONTW* x ) ;
+FUNCTION: GpStatus GdipGetFamily ( GpFont* x, GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipGetFontUnit ( GpFont* x, GpUnit* x ) ;
+FUNCTION: GpStatus GdipGetFontSize ( GpFont* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetFontStyle ( GpFont* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetFontHeight ( GpFont* x, GpGraphics* x,
+ REAL* x ) ;
+FUNCTION: GpStatus GdipGetFontHeightGivenDPI ( GpFont* x, REAL x, REAL* x ) ;
+
+
+FUNCTION: GpStatus GdipNewInstalledFontCollection ( GpFontCollection** x ) ;
+FUNCTION: GpStatus GdipNewPrivateFontCollection ( GpFontCollection** x ) ;
+FUNCTION: GpStatus GdipDeletePrivateFontCollection ( GpFontCollection** x ) ;
+FUNCTION: GpStatus GdipPrivateAddFontFile ( GpFontCollection* x, WCHAR* x ) ;
+FUNCTION: GpStatus GdipPrivateAddMemoryFont ( GpFontCollection* x,
+ void* x, INT x ) ;
+FUNCTION: GpStatus GdipGetFontCollectionFamilyCount ( GpFontCollection* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetFontCollectionFamilyList ( GpFontCollection* x, INT x,
+ GpFontFamily** x, INT* x ) ;
+
+
+FUNCTION: GpStatus GdipCloneFontFamily ( GpFontFamily* x, GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipCreateFontFamilyFromName ( WCHAR* x,
+ GpFontCollection* x, GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipDeleteFontFamily ( GpFontFamily* x ) ;
+FUNCTION: GpStatus GdipGetFamilyName ( GpFontFamily* x, WCHAR* x, LANGID x ) ;
+FUNCTION: GpStatus GdipGetCellAscent ( GpFontFamily* x, INT x, UINT16* x ) ;
+FUNCTION: GpStatus GdipGetCellDescent ( GpFontFamily* x, INT x, UINT16* x ) ;
+FUNCTION: GpStatus GdipGetEmHeight ( GpFontFamily* x, INT x, UINT16* x ) ;
+FUNCTION: GpStatus GdipGetGenericFontFamilySansSerif ( GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipGetGenericFontFamilySerif ( GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipGetGenericFontFamilyMonospace ( GpFontFamily** x ) ;
+FUNCTION: GpStatus GdipGetLineSpacing ( GpFontFamily* x, INT x, UINT16* x ) ;
+FUNCTION: GpStatus GdipIsStyleAvailable ( GpFontFamily* x, INT x, BOOL* x ) ;
+
+
+FUNCTION: GpStatus GdipFlush ( GpGraphics* x, GpFlushIntention x ) ;
+FUNCTION: GpStatus GdipBeginContainer ( GpGraphics* x, GpRectF* x, GpRectF* x, GpUnit x, GraphicsContainer* x ) ;
+FUNCTION: GpStatus GdipBeginContainer2 ( GpGraphics* x, GraphicsContainer* x ) ;
+FUNCTION: GpStatus GdipBeginContainerI ( GpGraphics* x, GpRect* x, GpRect* x, GpUnit x, GraphicsContainer* x ) ;
+FUNCTION: GpStatus GdipEndContainer ( GpGraphics* x, GraphicsContainer x ) ;
+FUNCTION: GpStatus GdipComment ( GpGraphics* x, UINT x, BYTE* x ) ;
+FUNCTION: GpStatus GdipCreateFromHDC ( HDC x, GpGraphics** x ) ;
+FUNCTION: GpStatus GdipCreateFromHDC2 ( HDC x, HANDLE x, GpGraphics** x ) ;
+FUNCTION: GpStatus GdipCreateFromHWND ( HWND x, GpGraphics** x ) ;
+FUNCTION: GpStatus GdipCreateFromHWNDICM ( HWND x, GpGraphics** x ) ;
+FUNCTION: HPALETTE GdipCreateHalftonePalette ( ) ;
+FUNCTION: GpStatus GdipDeleteGraphics ( GpGraphics* x ) ;
+FUNCTION: GpStatus GdipDrawArc ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawArcI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawBezier ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawBezierI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawBeziers ( GpGraphics* x, GpPen* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawBeziersI ( GpGraphics* x, GpPen* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawClosedCurve ( GpGraphics* x, GpPen* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawClosedCurveI ( GpGraphics* x, GpPen* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawClosedCurve2 ( GpGraphics* x, GpPen* x, GpPointF* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawClosedCurve2I ( GpGraphics* x, GpPen* x, GpPoint* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawCurve ( GpGraphics* x, GpPen* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawCurveI ( GpGraphics* x, GpPen* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawCurve2 ( GpGraphics* x, GpPen* x, GpPointF* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawCurve2I ( GpGraphics* x, GpPen* x, GpPoint* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawCurve3 ( GpGraphics* x, GpPen* x, GpPointF* x, INT x, INT x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawCurve3I ( GpGraphics* x, GpPen* x, GpPoint* x, INT x, INT x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawDriverString ( GpGraphics* x, UINT16* x, INT x,
+ GpFont* x, GpBrush* x, GpPointF* x, INT x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipDrawEllipse ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawEllipseI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawImage ( GpGraphics* x, GpImage* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawImageI ( GpGraphics* x, GpImage* x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawImagePointRect ( GpGraphics* x, GpImage* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, GpUnit x ) ;
+FUNCTION: GpStatus GdipDrawImagePointRectI ( GpGraphics* x, GpImage* x, INT x, INT x, INT x, INT x, INT x, INT x, GpUnit x ) ;
+FUNCTION: GpStatus GdipDrawImagePoints ( GpGraphics* x, GpImage* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawImagePointsI ( GpGraphics* x, GpImage* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawImagePointsRect ( GpGraphics* x, GpImage* x,
+ GpPointF* x, INT x, REAL x, REAL x, REAL x, REAL x, GpUnit x,
+ GpImageAttributes* x, DrawImageAbort x, VOID* x ) ;
+FUNCTION: GpStatus GdipDrawImagePointsRectI ( GpGraphics* x, GpImage* x,
+ GpPoint* x, INT x, INT x, INT x, INT x, INT x, GpUnit x,
+ GpImageAttributes* x, DrawImageAbort x, VOID* x ) ;
+FUNCTION: GpStatus GdipDrawImageRect ( GpGraphics* x, GpImage* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawImageRectI ( GpGraphics* x, GpImage* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawImageRectRect ( GpGraphics* x, GpImage* x, REAL x, REAL x, REAL x,
+ REAL x, REAL x, REAL x, REAL x, REAL x, GpUnit x, GpImageAttributes* x, DrawImageAbort x,
+ VOID* x ) ;
+FUNCTION: GpStatus GdipDrawImageRectRectI ( GpGraphics* x, GpImage* x, INT x, INT x, INT x,
+ INT x, INT x, INT x, INT x, INT x, GpUnit x, GpImageAttributes* x, DrawImageAbort x,
+ VOID* x ) ;
+FUNCTION: GpStatus GdipDrawLine ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawLineI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawLines ( GpGraphics* x, GpPen* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawLinesI ( GpGraphics* x, GpPen* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawPath ( GpGraphics* x, GpPen* x, GpPath* x ) ;
+FUNCTION: GpStatus GdipDrawPie ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawPieI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawPolygon ( GpGraphics* x, GpPen* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawPolygonI ( GpGraphics* x, GpPen* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawRectangle ( GpGraphics* x, GpPen* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipDrawRectangleI ( GpGraphics* x, GpPen* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipDrawRectangles ( GpGraphics* x, GpPen* x, GpRectF* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawRectanglesI ( GpGraphics* x, GpPen* x, GpRect* x, INT x ) ;
+FUNCTION: GpStatus GdipDrawString ( GpGraphics* x, WCHAR* x, INT x,
+ GpFont* x, GpRectF* x, GpStringFormat* x,
+ GpBrush* x ) ;
+FUNCTION: GpStatus GdipFillClosedCurve2 ( GpGraphics* x, GpBrush* x, GpPointF* x, INT x,
+ REAL x, GpFillMode x ) ;
+FUNCTION: GpStatus GdipFillClosedCurve2I ( GpGraphics* x, GpBrush* x, GpPoint* x, INT x,
+ REAL x, GpFillMode x ) ;
+FUNCTION: GpStatus GdipFillEllipse ( GpGraphics* x, GpBrush* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipFillEllipseI ( GpGraphics* x, GpBrush* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipFillPath ( GpGraphics* x, GpBrush* x, GpPath* x ) ;
+FUNCTION: GpStatus GdipFillPie ( GpGraphics* x, GpBrush* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipFillPieI ( GpGraphics* x, GpBrush* x, INT x, INT x, INT x, INT x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipFillPolygon ( GpGraphics* x, GpBrush* x, GpPointF* x,
+ INT x, GpFillMode x ) ;
+FUNCTION: GpStatus GdipFillPolygonI ( GpGraphics* x, GpBrush* x, GpPoint* x,
+ INT x, GpFillMode x ) ;
+FUNCTION: GpStatus GdipFillPolygon2 ( GpGraphics* x, GpBrush* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipFillPolygon2I ( GpGraphics* x, GpBrush* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipFillRectangle ( GpGraphics* x, GpBrush* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipFillRectangleI ( GpGraphics* x, GpBrush* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipFillRectangles ( GpGraphics* x, GpBrush* x, GpRectF* x, INT x ) ;
+FUNCTION: GpStatus GdipFillRectanglesI ( GpGraphics* x, GpBrush* x, GpRect* x, INT x ) ;
+FUNCTION: GpStatus GdipFillRegion ( GpGraphics* x, GpBrush* x, GpRegion* x ) ;
+FUNCTION: GpStatus GdipGetClip ( GpGraphics* x, GpRegion* x ) ;
+FUNCTION: GpStatus GdipGetClipBounds ( GpGraphics* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipGetClipBoundsI ( GpGraphics* x, GpRect* x ) ;
+FUNCTION: GpStatus GdipGetCompositingMode ( GpGraphics* x, CompositingMode* x ) ;
+FUNCTION: GpStatus GdipGetCompositingQuality ( GpGraphics* x, CompositingQuality* x ) ;
+FUNCTION: GpStatus GdipGetDC ( GpGraphics* x, HDC* x ) ;
+FUNCTION: GpStatus GdipGetDpiX ( GpGraphics* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetDpiY ( GpGraphics* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetImageDecoders ( UINT x, UINT x, ImageCodecInfo* x ) ;
+FUNCTION: GpStatus GdipGetImageDecodersSize ( UINT* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetImageGraphicsContext ( GpImage* x, GpGraphics** x ) ;
+FUNCTION: GpStatus GdipGetInterpolationMode ( GpGraphics* x, InterpolationMode* x ) ;
+FUNCTION: GpStatus GdipGetNearestColor ( GpGraphics* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetPageScale ( GpGraphics* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetPageUnit ( GpGraphics* x, GpUnit* x ) ;
+FUNCTION: GpStatus GdipGetPixelOffsetMode ( GpGraphics* x, PixelOffsetMode* x ) ;
+FUNCTION: GpStatus GdipGetSmoothingMode ( GpGraphics* x, SmoothingMode* x ) ;
+FUNCTION: GpStatus GdipGetTextContrast ( GpGraphics* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetTextRenderingHint ( GpGraphics* x, TextRenderingHint* x ) ;
+FUNCTION: GpStatus GdipGetWorldTransform ( GpGraphics* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipGraphicsClear ( GpGraphics* x, ARGB x ) ;
+FUNCTION: GpStatus GdipGetVisibleClipBounds ( GpGraphics* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipGetVisibleClipBoundsI ( GpGraphics* x, GpRect* x ) ;
+FUNCTION: GpStatus GdipIsClipEmpty ( GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisiblePoint ( GpGraphics* x, REAL x, REAL x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisiblePointI ( GpGraphics* x, INT x, INT x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRect ( GpGraphics* x, REAL x, REAL x, REAL x, REAL x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRectI ( GpGraphics* x, INT x, INT x, INT x, INT x, BOOL* x ) ;
+FUNCTION: GpStatus GdipMeasureCharacterRanges ( GpGraphics* x, WCHAR* x,
+ INT x, GpFont* x, GpRectF* x, GpStringFormat* x, INT x,
+ GpRegion** x ) ;
+FUNCTION: GpStatus GdipMeasureDriverString ( GpGraphics* x, UINT16* x, INT x,
+ GpFont* x, GpPointF* x, INT x, GpMatrix* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipMeasureString ( GpGraphics* x, WCHAR* x, INT x,
+ GpFont* x, GpRectF* x, GpStringFormat* x, GpRectF* x, INT* x, INT* x ) ;
+FUNCTION: GpStatus GdipMultiplyWorldTransform ( GpGraphics* x, GpMatrix* x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipRecordMetafileFileName ( WCHAR* x, HDC x, EmfType x,
+ GpRectF* x, MetafileFrameUnit x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipRecordMetafileFileNameI ( WCHAR* x, HDC x, EmfType x,
+ GpRect* x, MetafileFrameUnit x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipRecordMetafileI ( HDC x, EmfType x, GpRect* x,
+ MetafileFrameUnit x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipReleaseDC ( GpGraphics* x, HDC x ) ;
+FUNCTION: GpStatus GdipResetClip ( GpGraphics* x ) ;
+FUNCTION: GpStatus GdipResetWorldTransform ( GpGraphics* x ) ;
+FUNCTION: GpStatus GdipRestoreGraphics ( GpGraphics* x, GraphicsState x ) ;
+FUNCTION: GpStatus GdipRotateWorldTransform ( GpGraphics* x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSaveGraphics ( GpGraphics* x, GraphicsState* x ) ;
+FUNCTION: GpStatus GdipScaleWorldTransform ( GpGraphics* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSetClipHrgn ( GpGraphics* x, HRGN x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetClipGraphics ( GpGraphics* x, GpGraphics* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetClipPath ( GpGraphics* x, GpPath* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetClipRect ( GpGraphics* x, REAL x, REAL x, REAL x, REAL x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetClipRectI ( GpGraphics* x, INT x, INT x, INT x, INT x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetClipRegion ( GpGraphics* x, GpRegion* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipSetCompositingMode ( GpGraphics* x, CompositingMode x ) ;
+FUNCTION: GpStatus GdipSetCompositingQuality ( GpGraphics* x, CompositingQuality x ) ;
+FUNCTION: GpStatus GdipSetInterpolationMode ( GpGraphics* x, InterpolationMode x ) ;
+FUNCTION: GpStatus GdipSetPageScale ( GpGraphics* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetPageUnit ( GpGraphics* x, GpUnit x ) ;
+FUNCTION: GpStatus GdipSetPixelOffsetMode ( GpGraphics* x, PixelOffsetMode x ) ;
+FUNCTION: GpStatus GdipSetRenderingOrigin ( GpGraphics* x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipSetSmoothingMode ( GpGraphics* x, SmoothingMode x ) ;
+FUNCTION: GpStatus GdipSetTextContrast ( GpGraphics* x, UINT x ) ;
+FUNCTION: GpStatus GdipSetTextRenderingHint ( GpGraphics* x, TextRenderingHint x ) ;
+FUNCTION: GpStatus GdipSetWorldTransform ( GpGraphics* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipTransformPoints ( GpGraphics* x, GpCoordinateSpace x, GpCoordinateSpace x,
+ GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipTransformPointsI ( GpGraphics* x, GpCoordinateSpace x, GpCoordinateSpace x,
+ GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipTranslateClip ( GpGraphics* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipTranslateClipI ( GpGraphics* x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipTranslateWorldTransform ( GpGraphics* x, REAL x, REAL x, GpMatrixOrder x ) ;
+
+
+FUNCTION: GpStatus GdipAddPathArc ( GpPath* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathArcI ( GpPath* x, INT x, INT x, INT x, INT x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathBezier ( GpPath* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathBezierI ( GpPath* x, INT x, INT x, INT x, INT x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathBeziers ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathBeziersI ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathClosedCurve ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathClosedCurveI ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathClosedCurve2 ( GpPath* x, GpPointF* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathClosedCurve2I ( GpPath* x, GpPoint* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathCurve ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathCurveI ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathCurve2 ( GpPath* x, GpPointF* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathCurve2I ( GpPath* x, GpPoint* x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathCurve3 ( GpPath* x, GpPointF* x, INT x, INT x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathCurve3I ( GpPath* x, GpPoint* x, INT x, INT x, INT x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathEllipse ( GpPath* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathEllipseI ( GpPath* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathLine ( GpPath* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathLineI ( GpPath* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathLine2 ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathLine2I ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathPath ( GpPath* x, GpPath* x, BOOL x ) ;
+FUNCTION: GpStatus GdipAddPathPie ( GpPath* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathPieI ( GpPath* x, INT x, INT x, INT x, INT x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathPolygon ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathPolygonI ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathRectangle ( GpPath* x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipAddPathRectangleI ( GpPath* x, INT x, INT x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathRectangles ( GpPath* x, GpRectF* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathRectanglesI ( GpPath* x, GpRect* x, INT x ) ;
+FUNCTION: GpStatus GdipAddPathString ( GpPath* x, WCHAR* x, INT x, GpFontFamily* x, INT x, REAL x, GpRectF* x, GpStringFormat* x ) ;
+FUNCTION: GpStatus GdipAddPathStringI ( GpPath* x, WCHAR* x, INT x, GpFontFamily* x, INT x, REAL x, GpRect* x, GpStringFormat* x ) ;
+FUNCTION: GpStatus GdipClearPathMarkers ( GpPath* x ) ;
+FUNCTION: GpStatus GdipClonePath ( GpPath* x, GpPath** x ) ;
+FUNCTION: GpStatus GdipClosePathFigure ( GpPath* x ) ;
+FUNCTION: GpStatus GdipClosePathFigures ( GpPath* x ) ;
+FUNCTION: GpStatus GdipCreatePath ( GpFillMode x, GpPath** x ) ;
+FUNCTION: GpStatus GdipCreatePath2 ( GpPointF* x, BYTE* x, INT x,
+ GpFillMode x, GpPath** x ) ;
+FUNCTION: GpStatus GdipCreatePath2I ( GpPoint* x, BYTE* x, INT x, GpFillMode x, GpPath** x ) ;
+FUNCTION: GpStatus GdipDeletePath ( GpPath* x ) ;
+FUNCTION: GpStatus GdipFlattenPath ( GpPath* x, GpMatrix* x, REAL x ) ;
+FUNCTION: GpStatus GdipIsOutlineVisiblePathPoint ( GpPath* x, REAL x, REAL x, GpPen* x,
+ GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsOutlineVisiblePathPointI ( GpPath* x, INT x, INT x, GpPen* x,
+ GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisiblePathPoint ( GpPath* x, REAL x, REAL x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisiblePathPointI ( GpPath* x, INT x, INT x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipGetPathData ( GpPath* x, GpPathData* x ) ;
+FUNCTION: GpStatus GdipGetPathFillMode ( GpPath* x, GpFillMode* x ) ;
+FUNCTION: GpStatus GdipGetPathLastPoint ( GpPath* x, GpPointF* x ) ;
+FUNCTION: GpStatus GdipGetPathPoints ( GpPath* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPathPointsI ( GpPath* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPathTypes ( GpPath* x, BYTE* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPathWorldBounds ( GpPath* x, GpRectF* x, GpMatrix* x, GpPen* x ) ;
+FUNCTION: GpStatus GdipGetPathWorldBoundsI ( GpPath* x, GpRect* x, GpMatrix* x, GpPen* x ) ;
+FUNCTION: GpStatus GdipGetPointCount ( GpPath* x, INT* x ) ;
+FUNCTION: GpStatus GdipResetPath ( GpPath* x ) ;
+FUNCTION: GpStatus GdipReversePath ( GpPath* x ) ;
+FUNCTION: GpStatus GdipSetPathFillMode ( GpPath* x, GpFillMode x ) ;
+FUNCTION: GpStatus GdipSetPathMarker ( GpPath* x ) ;
+FUNCTION: GpStatus GdipStartPathFigure ( GpPath* x ) ;
+FUNCTION: GpStatus GdipTransformPath ( GpPath* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipWarpPath ( GpPath* x, GpMatrix* x, GpPointF* x, INT x, REAL x,
+ REAL x, REAL x, REAL x, WarpMode x, REAL x ) ;
+FUNCTION: GpStatus GdipWidenPath ( GpPath* x, GpPen* x, GpMatrix* x, REAL x ) ;
+
+
+FUNCTION: GpStatus GdipCreateHatchBrush ( HatchStyle x, ARGB x, ARGB x, GpHatch** x ) ;
+FUNCTION: GpStatus GdipGetHatchBackgroundColor ( GpHatch* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetHatchForegroundColor ( GpHatch* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetHatchStyle ( GpHatch* x, HatchStyle* x ) ;
+
+
+FUNCTION: GpStatus GdipCloneImage ( GpImage* x, GpImage** x ) ;
+FUNCTION: GpStatus GdipCloneImageAttributes ( GpImageAttributes* x, GpImageAttributes** x ) ;
+FUNCTION: GpStatus GdipDisposeImage ( GpImage* x ) ;
+FUNCTION: GpStatus GdipEmfToWmfBits ( HENHMETAFILE x, UINT x, LPBYTE x, INT x, INT x ) ;
+FUNCTION: GpStatus GdipFindFirstImageItem ( GpImage* x, ImageItemData* x ) ;
+FUNCTION: GpStatus GdipFindNextImageItem ( GpImage* x, ImageItemData* x ) ;
+FUNCTION: GpStatus GdipGetAllPropertyItems ( GpImage* x, UINT x, UINT x, PropertyItem* x ) ;
+FUNCTION: GpStatus GdipGetImageBounds ( GpImage* x, GpRectF* x, GpUnit* x ) ;
+FUNCTION: GpStatus GdipGetImageDimension ( GpImage* x, REAL* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetImageFlags ( GpImage* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetImageHeight ( GpImage* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetImageHorizontalResolution ( GpImage* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetImageItemData ( GpImage* x, ImageItemData* x ) ;
+FUNCTION: GpStatus GdipGetImagePalette ( GpImage* x, ColorPalette* x, INT x ) ;
+FUNCTION: GpStatus GdipGetImagePaletteSize ( GpImage* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetImagePixelFormat ( GpImage* x, PixelFormat* x ) ;
+FUNCTION: GpStatus GdipGetImageRawFormat ( GpImage* x, GUID* x ) ;
+FUNCTION: GpStatus GdipGetImageThumbnail ( GpImage* x, UINT x, UINT x, GpImage** x, GetThumbnailImageAbort x, VOID* x ) ;
+FUNCTION: GpStatus GdipGetImageType ( GpImage* x, ImageType* x ) ;
+FUNCTION: GpStatus GdipGetImageVerticalResolution ( GpImage* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetImageWidth ( GpImage* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetPropertyCount ( GpImage* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetPropertyIdList ( GpImage* x, UINT x, PROPID* x ) ;
+FUNCTION: GpStatus GdipGetPropertyItem ( GpImage* x, PROPID x, UINT x, PropertyItem* x ) ;
+FUNCTION: GpStatus GdipGetPropertyItemSize ( GpImage* x, PROPID x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetPropertySize ( GpImage* x, UINT* x, UINT* x ) ;
+FUNCTION: GpStatus GdipImageForceValidation ( GpImage* x ) ;
+FUNCTION: GpStatus GdipImageGetFrameCount ( GpImage* x, GUID* x, UINT* x ) ;
+FUNCTION: GpStatus GdipImageGetFrameDimensionsCount ( GpImage* x, UINT* x ) ;
+FUNCTION: GpStatus GdipImageGetFrameDimensionsList ( GpImage* x, GUID* x, UINT x ) ;
+FUNCTION: GpStatus GdipImageRotateFlip ( GpImage* x, RotateFlipType x ) ;
+FUNCTION: GpStatus GdipImageSelectActiveFrame ( GpImage* x, GUID* x, UINT x ) ;
+FUNCTION: GpStatus GdipLoadImageFromFile ( WCHAR* x, GpImage** x ) ;
+FUNCTION: GpStatus GdipLoadImageFromFileICM ( WCHAR* x, GpImage** x ) ;
+FUNCTION: GpStatus GdipLoadImageFromStream ( IStream* x, GpImage** x ) ;
+FUNCTION: GpStatus GdipLoadImageFromStreamICM ( IStream* x, GpImage** x ) ;
+FUNCTION: GpStatus GdipRemovePropertyItem ( GpImage* x, PROPID x ) ;
+FUNCTION: GpStatus GdipSaveImageToFile ( GpImage* x, WCHAR* x, CLSID* x, EncoderParameters* x ) ;
+FUNCTION: GpStatus GdipSaveImageToStream ( GpImage* x, IStream* x,
+ CLSID* x, EncoderParameters* x ) ;
+FUNCTION: GpStatus GdipSetImagePalette ( GpImage* x, ColorPalette* x ) ;
+FUNCTION: GpStatus GdipSetPropertyItem ( GpImage* x, PropertyItem* x ) ;
+
+
+FUNCTION: GpStatus GdipCreateImageAttributes ( GpImageAttributes** x ) ;
+FUNCTION: GpStatus GdipDisposeImageAttributes ( GpImageAttributes* x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesCachedBackground ( GpImageAttributes* x,
+ BOOL x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesColorKeys ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, ARGB x, ARGB x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesColorMatrix ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, ColorMatrix* x, ColorMatrix* x,
+ ColorMatrixFlags x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesGamma ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesNoOp ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesOutputChannel ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, ColorChannelFlags x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesOutputChannelColorProfile (
+ GpImageAttributes* x, ColorAdjustType x, BOOL x, WCHAR* x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesRemapTable ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, UINT x, ColorMap* x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesThreshold ( GpImageAttributes* x,
+ ColorAdjustType x, BOOL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesToIdentity ( GpImageAttributes* x,
+ ColorAdjustType x ) ;
+FUNCTION: GpStatus GdipSetImageAttributesWrapMode ( GpImageAttributes* x, GpWrapMode x,
+ ARGB x, BOOL x ) ;
+
+
+FUNCTION: GpStatus GdipCreateLineBrush ( GpPointF* x, GpPointF* x,
+ ARGB x, ARGB x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipCreateLineBrushI ( GpPoint* x, GpPoint* x,
+ ARGB x, ARGB x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipCreateLineBrushFromRect ( GpRectF* x, ARGB x, ARGB x,
+ LinearGradientMode x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipCreateLineBrushFromRectI ( GpRect* x, ARGB x, ARGB x,
+ LinearGradientMode x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipCreateLineBrushFromRectWithAngle ( GpRectF* x,
+ ARGB x, ARGB x, REAL x, BOOL x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipCreateLineBrushFromRectWithAngleI ( GpRect* x,
+ ARGB x, ARGB x, REAL x, BOOL x, GpWrapMode x, GpLineGradient** x ) ;
+FUNCTION: GpStatus GdipGetLineColors ( GpLineGradient* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetLineGammaCorrection ( GpLineGradient* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipGetLineRect ( GpLineGradient* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipGetLineRectI ( GpLineGradient* x, GpRect* x ) ;
+FUNCTION: GpStatus GdipGetLineWrapMode ( GpLineGradient* x, GpWrapMode* x ) ;
+FUNCTION: GpStatus GdipSetLineBlend ( GpLineGradient* x, REAL* x,
+ REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetLineBlend ( GpLineGradient* x, REAL* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetLineBlendCount ( GpLineGradient* x, INT* x ) ;
+FUNCTION: GpStatus GdipSetLinePresetBlend ( GpLineGradient* x, ARGB* x,
+ REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetLinePresetBlend ( GpLineGradient* x, ARGB* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetLinePresetBlendCount ( GpLineGradient* x, INT* x ) ;
+FUNCTION: GpStatus GdipResetLineTransform ( GpLineGradient* x ) ;
+FUNCTION: GpStatus GdipRotateLineTransform ( GpLineGradient* x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipScaleLineTransform ( GpLineGradient* x, REAL x, REAL x,
+ GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSetLineColors ( GpLineGradient* x, ARGB x, ARGB x ) ;
+FUNCTION: GpStatus GdipSetLineGammaCorrection ( GpLineGradient* x, BOOL x ) ;
+FUNCTION: GpStatus GdipSetLineSigmaBlend ( GpLineGradient* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetLineTransform ( GpLineGradient* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipSetLineLinearBlend ( GpLineGradient* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetLineWrapMode ( GpLineGradient* x, GpWrapMode x ) ;
+FUNCTION: GpStatus GdipTranslateLineTransform ( GpLineGradient* x, REAL x, REAL x,
+ GpMatrixOrder x ) ;
+
+
+FUNCTION: GpStatus GdipCloneMatrix ( GpMatrix* x, GpMatrix** x ) ;
+FUNCTION: GpStatus GdipCreateMatrix ( GpMatrix** x ) ;
+FUNCTION: GpStatus GdipCreateMatrix2 ( REAL x, REAL x, REAL x, REAL x, REAL x, REAL x, GpMatrix** x ) ;
+FUNCTION: GpStatus GdipCreateMatrix3 ( GpRectF* x, GpPointF* x, GpMatrix** x ) ;
+FUNCTION: GpStatus GdipCreateMatrix3I ( GpRect* x, GpPoint* x, GpMatrix** x ) ;
+FUNCTION: GpStatus GdipDeleteMatrix ( GpMatrix* x ) ;
+FUNCTION: GpStatus GdipGetMatrixElements ( GpMatrix* x, REAL* x ) ;
+FUNCTION: GpStatus GdipInvertMatrix ( GpMatrix* x ) ;
+FUNCTION: GpStatus GdipIsMatrixEqual ( GpMatrix* x, GpMatrix* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsMatrixIdentity ( GpMatrix* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsMatrixInvertible ( GpMatrix* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipMultiplyMatrix ( GpMatrix* x, GpMatrix* x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipRotateMatrix ( GpMatrix* x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipShearMatrix ( GpMatrix* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipScaleMatrix ( GpMatrix* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSetMatrixElements ( GpMatrix* x, REAL x, REAL x, REAL x, REAL x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipTransformMatrixPoints ( GpMatrix* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipTransformMatrixPointsI ( GpMatrix* x, GpPoint* x, INT x ) ;
+FUNCTION: GpStatus GdipTranslateMatrix ( GpMatrix* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipVectorTransformMatrixPoints ( GpMatrix* x, GpPointF* x, INT x ) ;
+FUNCTION: GpStatus GdipVectorTransformMatrixPointsI ( GpMatrix* x, GpPoint* x, INT x ) ;
+
+
+FUNCTION: GpStatus GdipConvertToEmfPlus ( GpGraphics* x, GpMetafile* x, INT* x,
+ EmfType x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipConvertToEmfPlusToFile ( GpGraphics* x, GpMetafile* x, INT* x, WCHAR* x, EmfType x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipConvertToEmfPlusToStream ( GpGraphics* x, GpMetafile* x, INT* x, IStream* x, EmfType x, WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipCreateMetafileFromEmf ( HENHMETAFILE x, BOOL x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipCreateMetafileFromWmf ( HMETAFILE x, BOOL x,
+ WmfPlaceableFileHeader* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipCreateMetafileFromWmfFile ( WCHAR* x, WmfPlaceableFileHeader* x,
+ GpMetafile** x ) ;
+FUNCTION: GpStatus GdipCreateMetafileFromFile ( WCHAR* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipCreateMetafileFromStream ( IStream* x, GpMetafile** x ) ;
+FUNCTION: GpStatus GdipSetMetafileDownLevelRasterizationLimit ( GpMetafile* x, UINT x ) ;
+
+
+FUNCTION: GpStatus GdipGetMetafileHeaderFromEmf ( HENHMETAFILE x, MetafileHeader* x ) ;
+FUNCTION: GpStatus GdipGetMetafileHeaderFromFile ( WCHAR* x, MetafileHeader* x ) ;
+FUNCTION: GpStatus GdipGetMetafileHeaderFromMetafile ( GpMetafile* x, MetafileHeader* x ) ;
+FUNCTION: GpStatus GdipGetMetafileHeaderFromStream ( IStream* x, MetafileHeader* x ) ;
+FUNCTION: GpStatus GdipGetMetafileHeaderFromWmf ( HMETAFILE x, WmfPlaceableFileHeader* x, MetafileHeader* x ) ;
+
+
+FUNCTION: GpStatus GdiplusNotificationHook ( ULONG_PTR* x ) ;
+FUNCTION: void GdiplusNotificationUnhook ( ULONG_PTR x ) ;
+
+
+FUNCTION: GpStatus GdipCreatePathGradient ( GpPointF* x, INT x, GpWrapMode x, GpPathGradient** x ) ;
+FUNCTION: GpStatus GdipCreatePathGradientI ( GpPoint* x, INT x, GpWrapMode x, GpPathGradient** x ) ;
+FUNCTION: GpStatus GdipCreatePathGradientFromPath ( GpPath* x,
+ GpPathGradient** x ) ;
+FUNCTION: GpStatus GdipGetPathGradientBlend ( GpPathGradient* x, REAL* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPathGradientBlendCount ( GpPathGradient* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientCenterColor ( GpPathGradient* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientCenterPoint ( GpPathGradient* x, GpPointF* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientCenterPointI ( GpPathGradient* x, GpPoint* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientFocusScales ( GpPathGradient* x, REAL* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientGammaCorrection ( GpPathGradient* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientPointCount ( GpPathGradient* x, INT* x ) ;
+FUNCTION: GpStatus GdipSetPathGradientPresetBlend ( GpPathGradient* x,
+ ARGB* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPathGradientRect ( GpPathGradient* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientRectI ( GpPathGradient* x, GpRect* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientSurroundColorsWithCount ( GpPathGradient* x,
+ ARGB* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetPathGradientWrapMode ( GpPathGradient* x, GpWrapMode* x ) ;
+FUNCTION: GpStatus GdipSetPathGradientBlend ( GpPathGradient* x, REAL* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipSetPathGradientCenterColor ( GpPathGradient* x, ARGB x ) ;
+FUNCTION: GpStatus GdipSetPathGradientCenterPoint ( GpPathGradient* x, GpPointF* x ) ;
+FUNCTION: GpStatus GdipSetPathGradientCenterPointI ( GpPathGradient* x, GpPoint* x ) ;
+FUNCTION: GpStatus GdipSetPathGradientFocusScales ( GpPathGradient* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetPathGradientGammaCorrection ( GpPathGradient* x, BOOL x ) ;
+FUNCTION: GpStatus GdipSetPathGradientSigmaBlend ( GpPathGradient* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipSetPathGradientSurroundColorsWithCount ( GpPathGradient* x,
+ ARGB* x, INT* x ) ;
+FUNCTION: GpStatus GdipSetPathGradientWrapMode ( GpPathGradient* x, GpWrapMode x ) ;
+FUNCTION: GpStatus GdipGetPathGradientSurroundColorCount ( GpPathGradient* x, INT* x ) ;
+
+
+FUNCTION: GpStatus GdipCreatePathIter ( GpPathIterator** x, GpPath* x ) ;
+FUNCTION: GpStatus GdipDeletePathIter ( GpPathIterator* x ) ;
+FUNCTION: GpStatus GdipPathIterCopyData ( GpPathIterator* x, INT* x, GpPointF* x, BYTE* x,
+ INT x, INT x ) ;
+FUNCTION: GpStatus GdipPathIterGetCount ( GpPathIterator* x, INT* x ) ;
+FUNCTION: GpStatus GdipPathIterGetSubpathCount ( GpPathIterator* x, INT* x ) ;
+FUNCTION: GpStatus GdipPathIterEnumerate ( GpPathIterator* x, INT* x, GpPointF* x, BYTE* x, INT x ) ;
+FUNCTION: GpStatus GdipPathIterHasCurve ( GpPathIterator* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipPathIterIsValid ( GpPathIterator* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipPathIterNextMarker ( GpPathIterator* x, INT* x, INT* x, INT* x ) ;
+FUNCTION: GpStatus GdipPathIterNextMarkerPath ( GpPathIterator* x, INT* x, GpPath* x ) ;
+FUNCTION: GpStatus GdipPathIterNextPathType ( GpPathIterator* x, INT* x, BYTE* x, INT* x, INT* x ) ;
+FUNCTION: GpStatus GdipPathIterNextSubpath ( GpPathIterator* x, INT* x, INT* x, INT* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipPathIterNextSubpathPath ( GpPathIterator* x, INT* x, GpPath* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipPathIterRewind ( GpPathIterator* x ) ;
+
+
+FUNCTION: GpStatus GdipClonePen ( GpPen* x, GpPen** x ) ;
+FUNCTION: GpStatus GdipCreatePen1 ( ARGB x, REAL x, GpUnit x, GpPen** x ) ;
+FUNCTION: GpStatus GdipCreatePen2 ( GpBrush* x, REAL x, GpUnit x, GpPen** x ) ;
+FUNCTION: GpStatus GdipDeletePen ( GpPen* x ) ;
+FUNCTION: GpStatus GdipGetPenBrushFill ( GpPen* x, GpBrush** x ) ;
+FUNCTION: GpStatus GdipGetPenColor ( GpPen* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipGetPenCustomStartCap ( GpPen* x, GpCustomLineCap** x ) ;
+FUNCTION: GpStatus GdipGetPenCustomEndCap ( GpPen* x, GpCustomLineCap** x ) ;
+FUNCTION: GpStatus GdipGetPenDashArray ( GpPen* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipGetPenDashCount ( GpPen* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetPenDashOffset ( GpPen* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetPenDashStyle ( GpPen* x, GpDashStyle* x ) ;
+FUNCTION: GpStatus GdipGetPenMode ( GpPen* x, GpPenAlignment* x ) ;
+FUNCTION: GpStatus GdipResetPenTransform ( GpPen* x ) ;
+FUNCTION: GpStatus GdipScalePenTransform ( GpPen* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSetPenBrushFill ( GpPen* x, GpBrush* x ) ;
+FUNCTION: GpStatus GdipSetPenColor ( GpPen* x, ARGB x ) ;
+FUNCTION: GpStatus GdipSetPenCompoundArray ( GpPen* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipSetPenCustomEndCap ( GpPen* x, GpCustomLineCap* x ) ;
+FUNCTION: GpStatus GdipSetPenCustomStartCap ( GpPen* x, GpCustomLineCap* x ) ;
+FUNCTION: GpStatus GdipSetPenDashArray ( GpPen* x, REAL* x, INT x ) ;
+FUNCTION: GpStatus GdipSetPenDashCap197819 ( GpPen* x, GpDashCap x ) ;
+FUNCTION: GpStatus GdipSetPenDashOffset ( GpPen* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetPenDashStyle ( GpPen* x, GpDashStyle x ) ;
+FUNCTION: GpStatus GdipSetPenEndCap ( GpPen* x, GpLineCap x ) ;
+FUNCTION: GpStatus GdipGetPenFillType ( GpPen* x, GpPenType* x ) ;
+FUNCTION: GpStatus GdipSetPenLineCap197819 ( GpPen* x, GpLineCap x, GpLineCap x, GpDashCap x ) ;
+FUNCTION: GpStatus GdipSetPenLineJoin ( GpPen* x, GpLineJoin x ) ;
+FUNCTION: GpStatus GdipSetPenMode ( GpPen* x, GpPenAlignment x ) ;
+FUNCTION: GpStatus GdipSetPenMiterLimit ( GpPen* x, REAL x ) ;
+FUNCTION: GpStatus GdipSetPenStartCap ( GpPen* x, GpLineCap x ) ;
+FUNCTION: GpStatus GdipSetPenWidth ( GpPen* x, REAL x ) ;
+FUNCTION: GpStatus GdipGetPenDashCap197819 ( GpPen* x, GpDashCap* x ) ;
+FUNCTION: GpStatus GdipGetPenEndCap ( GpPen* x, GpLineCap* x ) ;
+FUNCTION: GpStatus GdipGetPenLineJoin ( GpPen* x, GpLineJoin* x ) ;
+FUNCTION: GpStatus GdipGetPenMiterLimit ( GpPen* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetPenStartCap ( GpPen* x, GpLineCap* x ) ;
+FUNCTION: GpStatus GdipGetPenUnit ( GpPen* x, GpUnit* x ) ;
+FUNCTION: GpStatus GdipGetPenWidth ( GpPen* x, REAL* x ) ;
+
+
+FUNCTION: GpStatus GdipCloneRegion ( GpRegion* x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipCombineRegionPath ( GpRegion* x, GpPath* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipCombineRegionRect ( GpRegion* x, GpRectF* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipCombineRegionRectI ( GpRegion* x, GpRect* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipCombineRegionRegion ( GpRegion* x, GpRegion* x, CombineMode x ) ;
+FUNCTION: GpStatus GdipCreateRegion ( GpRegion** x ) ;
+FUNCTION: GpStatus GdipCreateRegionPath ( GpPath* x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipCreateRegionRect ( GpRectF* x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipCreateRegionRectI ( GpRect* x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipCreateRegionRgnData ( BYTE* x, INT x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipCreateRegionHrgn ( HRGN x, GpRegion** x ) ;
+FUNCTION: GpStatus GdipDeleteRegion ( GpRegion* x ) ;
+FUNCTION: GpStatus GdipGetRegionBounds ( GpRegion* x, GpGraphics* x, GpRectF* x ) ;
+FUNCTION: GpStatus GdipGetRegionBoundsI ( GpRegion* x, GpGraphics* x, GpRect* x ) ;
+FUNCTION: GpStatus GdipGetRegionData ( GpRegion* x, BYTE* x, UINT x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetRegionDataSize ( GpRegion* x, UINT* x ) ;
+FUNCTION: GpStatus GdipGetRegionHRgn ( GpRegion* x, GpGraphics* x, HRGN* x ) ;
+FUNCTION: GpStatus GdipIsEmptyRegion ( GpRegion* x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsEqualRegion ( GpRegion* x, GpRegion* x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsInfiniteRegion ( GpRegion* x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRegionPoint ( GpRegion* x, REAL x, REAL x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRegionPointI ( GpRegion* x, INT x, INT x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRegionRect ( GpRegion* x, REAL x, REAL x, REAL x, REAL x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipIsVisibleRegionRectI ( GpRegion* x, INT x, INT x, INT x, INT x, GpGraphics* x, BOOL* x ) ;
+FUNCTION: GpStatus GdipSetEmpty ( GpRegion* x ) ;
+FUNCTION: GpStatus GdipSetInfinite ( GpRegion* x ) ;
+FUNCTION: GpStatus GdipTransformRegion ( GpRegion* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipTranslateRegion ( GpRegion* x, REAL x, REAL x ) ;
+FUNCTION: GpStatus GdipTranslateRegionI ( GpRegion* x, INT x, INT x ) ;
+
+
+FUNCTION: GpStatus GdipCreateSolidFill ( ARGB x, GpSolidFill** x ) ;
+FUNCTION: GpStatus GdipGetSolidFillColor ( GpSolidFill* x, ARGB* x ) ;
+FUNCTION: GpStatus GdipSetSolidFillColor ( GpSolidFill* x, ARGB x ) ;
+
+
+FUNCTION: GpStatus GdipCloneStringFormat ( GpStringFormat* x, GpStringFormat** x ) ;
+FUNCTION: GpStatus GdipCreateStringFormat ( INT x, LANGID x, GpStringFormat** x ) ;
+FUNCTION: GpStatus GdipDeleteStringFormat ( GpStringFormat* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatAlign ( GpStringFormat* x, StringAlignment* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatDigitSubstitution ( GpStringFormat* x, LANGID* x,
+ StringDigitSubstitute* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatFlags ( GpStringFormat* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatHotkeyPrefix ( GpStringFormat* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatLineAlign ( GpStringFormat* x, StringAlignment* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatMeasurableCharacterRangeCount (
+ GpStringFormat* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatTabStopCount ( GpStringFormat* x, INT* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatTabStops ( GpStringFormat* x, INT x, REAL* x, REAL* x ) ;
+FUNCTION: GpStatus GdipGetStringFormatTrimming ( GpStringFormat* x, StringTrimming* x ) ;
+FUNCTION: GpStatus GdipSetStringFormatAlign ( GpStringFormat* x, StringAlignment x ) ;
+FUNCTION: GpStatus GdipSetStringFormatDigitSubstitution ( GpStringFormat* x, LANGID x, StringDigitSubstitute x ) ;
+FUNCTION: GpStatus GdipSetStringFormatHotkeyPrefix ( GpStringFormat* x, INT x ) ;
+FUNCTION: GpStatus GdipSetStringFormatLineAlign ( GpStringFormat* x, StringAlignment x ) ;
+FUNCTION: GpStatus GdipSetStringFormatMeasurableCharacterRanges (
+ GpStringFormat* x, INT x, CharacterRange* x ) ;
+FUNCTION: GpStatus GdipSetStringFormatTabStops ( GpStringFormat* x, REAL x, INT x, REAL* x ) ;
+FUNCTION: GpStatus GdipSetStringFormatTrimming ( GpStringFormat* x, StringTrimming x ) ;
+FUNCTION: GpStatus GdipSetStringFormatFlags ( GpStringFormat* x, INT x ) ;
+FUNCTION: GpStatus GdipStringFormatGetGenericDefault ( GpStringFormat** x ) ;
+FUNCTION: GpStatus GdipStringFormatGetGenericTypographic ( GpStringFormat** x ) ;
+
+
+FUNCTION: GpStatus GdipCreateTexture ( GpImage* x, GpWrapMode x, GpTexture** x ) ;
+FUNCTION: GpStatus GdipCreateTexture2 ( GpImage* x, GpWrapMode x, REAL x, REAL x, REAL x, REAL x, GpTexture** x ) ;
+FUNCTION: GpStatus GdipCreateTexture2I ( GpImage* x, GpWrapMode x, INT x, INT x, INT x, INT x, GpTexture** x ) ;
+FUNCTION: GpStatus GdipCreateTextureIA ( GpImage* x, GpImageAttributes* x,
+ REAL x, REAL x, REAL x, REAL x, GpTexture** x ) ;
+FUNCTION: GpStatus GdipCreateTextureIAI ( GpImage* x, GpImageAttributes* x,
+ INT x, INT x, INT x, INT x, GpTexture** x ) ;
+FUNCTION: GpStatus GdipGetTextureTransform ( GpTexture* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipGetTextureWrapMode ( GpTexture* x, GpWrapMode* x ) ;
+FUNCTION: GpStatus GdipMultiplyTextureTransform ( GpTexture* x,
+ GpMatrix* x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipResetTextureTransform ( GpTexture* x ) ;
+FUNCTION: GpStatus GdipRotateTextureTransform ( GpTexture* x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipScaleTextureTransform ( GpTexture* x, REAL x, REAL x, GpMatrixOrder x ) ;
+FUNCTION: GpStatus GdipSetTextureTransform ( GpTexture* x, GpMatrix* x ) ;
+FUNCTION: GpStatus GdipSetTextureWrapMode ( GpTexture* x, GpWrapMode x ) ;
+FUNCTION: GpStatus GdipTranslateTextureTransform ( GpTexture* x, REAL x, REAL x,
+ GpMatrixOrder x ) ;
+
+
+FUNCTION: GpStatus GdipCreateStreamOnFile ( WCHAR* x, UINT x, IStream** x ) ;
+FUNCTION: GpStatus GdipGetImageEncodersSize ( UINT* numEncoders, UINT* size ) ;
+FUNCTION: GpStatus GdipGetImageEncoders ( UINT numEncoders, UINT size, ImageCodecInfo* encoders ) ;
+FUNCTION: GpStatus GdipTestControl ( GpTestControlEnum x, void* x ) ;
+
+ERROR: gdi+-error status ;
+
+: check-gdi+-status ( GpStatus -- )
+ dup Ok = [ drop ] [ gdi+-error ] if ;
+
+CONSTANT: standard-gdi+-startup-input
+ S{ GdiplusStartupInput
+ { GdiplusVersion 1 }
+ { DebugEventCallback f }
+ { SuppressBackgroundThread 0 }
+ { SuppressExternalCodecs 0 }
+ }
+
+: (start-gdi+) ( startup-input -- token startup-output )
+ { ULONG_PTR GdiplusStartupOutput }
+ [ swapd GdiplusStartup check-gdi+-status ] [ ] with-out-parameters ;
+: start-gdi+ ( -- token )
+ standard-gdi+-startup-input (start-gdi+) drop ; inline
+: stop-gdi+ ( token -- )
+ GdiplusShutdown ;
+
+DESTRUCTOR: stop-gdi+
TYPEDEF: LPWSTR LPOLESTR
TYPEDEF: LPWSTR LPCOLESTR
+TYPEDEF: GUID IID
+TYPEDEF: GUID CLSID
+
TYPEDEF: REFGUID LPGUID
TYPEDEF: REFGUID REFIID
TYPEDEF: REFGUID REFCLSID
--- /dev/null
+USING: accessors alien.c-types classes.struct combinators\r
+continuations io kernel libc literals locals sequences\r
+specialized-arrays windows.com memoize\r
+windows.com.wrapper windows.kernel32 windows.ole32\r
+windows.types ;\r
+IN: windows.streams\r
+\r
+SPECIALIZED-ARRAY: uchar\r
+\r
+<PRIVATE\r
+\r
+: with-hresult ( quot: ( -- result ) -- result )\r
+ [ drop E_FAIL ] recover ; inline\r
+\r
+:: IStream-read ( stream pv cb out-read -- hresult )\r
+ [\r
+ cb stream stream-read :> buf\r
+ buf length :> bytes\r
+ pv buf bytes memcpy\r
+ out-read [ bytes out-read 0 ULONG set-alien-value ] when\r
+\r
+ cb bytes = [ S_OK ] [ S_FALSE ] if\r
+ ] with-hresult ; inline\r
+\r
+:: IStream-write ( stream pv cb out-written -- hresult )\r
+ [\r
+ pv cb <direct-uchar-array> stream stream-write\r
+ out-written [ cb out-written 0 ULONG set-alien-value ] when\r
+ S_OK\r
+ ] with-hresult ; inline\r
+\r
+: origin>seek-type ( origin -- seek-type )\r
+ {\r
+ { $ STREAM_SEEK_SET [ seek-absolute ] }\r
+ { $ STREAM_SEEK_CUR [ seek-relative ] }\r
+ { $ STREAM_SEEK_END [ seek-end ] }\r
+ } case ;\r
+\r
+:: IStream-seek ( stream move origin new-position -- hresult )\r
+ [\r
+ move origin origin>seek-type stream stream-seek\r
+ new-position [\r
+ stream stream-tell new-position 0 ULARGE_INTEGER set-alien-value\r
+ ] when\r
+ S_OK\r
+ ] with-hresult ; inline\r
+\r
+:: IStream-set-size ( stream new-size -- hresult )\r
+ STG_E_INVALIDFUNCTION ;\r
+\r
+:: IStream-copy-to ( stream other-stream cb out-read out-written -- hresult )\r
+ [\r
+ cb stream stream-read :> buf\r
+ buf length :> bytes\r
+ out-read [ bytes out-read 0 ULONG set-alien-value ] when\r
+\r
+ other-stream buf bytes out-written IStream::Write\r
+ ] with-hresult ; inline\r
+\r
+:: IStream-commit ( stream flags -- hresult )\r
+ stream stream-flush S_OK ;\r
+\r
+:: IStream-revert ( stream -- hresult )\r
+ STG_E_INVALIDFUNCTION ;\r
+\r
+:: IStream-lock-region ( stream offset cb lock-type -- hresult )\r
+ STG_E_INVALIDFUNCTION ;\r
+\r
+:: IStream-unlock-region ( stream offset cb lock-type -- hresult )\r
+ STG_E_INVALIDFUNCTION ;\r
+\r
+:: stream-size ( stream -- size )\r
+ stream stream-tell :> old-pos\r
+ 0 seek-end stream stream-seek\r
+ stream stream-tell :> size\r
+ old-pos seek-absolute stream stream-seek\r
+ size ;\r
+\r
+:: IStream-stat ( stream out-stat stat-flag -- hresult )\r
+ [\r
+ out-stat\r
+ f >>pwcsName\r
+ STGTY_STREAM >>type\r
+ stream stream-size >>cbSize\r
+ FILETIME <struct> >>mtime\r
+ FILETIME <struct> >>ctime\r
+ FILETIME <struct> >>atime\r
+ STGM_READWRITE >>grfMode\r
+ 0 >>grfLocksSupported\r
+ GUID_NULL >>clsid\r
+ 0 >>grfStateBits\r
+ 0 >>reserved\r
+ drop\r
+ S_OK\r
+ ] with-hresult ;\r
+\r
+:: IStream-clone ( out-clone-stream -- hresult )\r
+ f out-clone-stream 0 void* set-alien-value\r
+ STG_E_INVALIDFUNCTION ;\r
+\r
+CONSTANT: stream-wrapper\r
+ $[\r
+ {\r
+ { IStream {\r
+ [ IStream-read ]\r
+ [ IStream-write ]\r
+ [ IStream-seek ]\r
+ [ IStream-set-size ]\r
+ [ IStream-copy-to ]\r
+ [ IStream-commit ]\r
+ [ IStream-revert ]\r
+ [ IStream-lock-region ]\r
+ [ IStream-unlock-region ]\r
+ [ IStream-stat ]\r
+ [ IStream-clone ]\r
+ } }\r
+ } <com-wrapper>\r
+ ]\r
+\r
+PRIVATE>\r
+\r
+: stream>IStream ( stream -- IStream )\r
+ stream-wrapper com-wrap ;\r
--- /dev/null
+IStream interface wrapper for Factor stream objects\r
TYPEDEF: short SHORT
TYPEDEF: ushort USHORT
+TYPEDEF: short INT16
+TYPEDEF: ushort UINT16
TYPEDEF: ushort WORD
TYPEDEF: ulong DWORD
TYPEDEF: HANDLE HDESK
TYPEDEF: HANDLE HDROP
TYPEDEF: HANDLE HDWP
-TYPEDEF: HANDLE HENMETAFILE
+TYPEDEF: HANDLE HENHMETAFILE
TYPEDEF: HANDLE HFONT
TYPEDEF: HANDLE HGDIOBJ
TYPEDEF: HANDLE HGLOBAL
{ tmCharSet BYTE } ;
TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
+
+TYPEDEF: ULONG PROPID
{ "iphlpapi" "iphlpapi.dll" stdcall }
{ "libc" "msvcrt.dll" cdecl }
{ "libm" "msvcrt.dll" cdecl }
+ { "gdiplus" "gdiplus.dll" stdcall }
{ "gl" "opengl32.dll" stdcall }
{ "glu" "glu32.dll" stdcall }
{ "ole32" "ole32.dll" stdcall }
HELP: filter-moved
{ $values { "assoc1" assoc } { "assoc2" assoc } { "seq" "an sequence of definitions" } }
-{ $description "Removes all definitions from " { $snippet "assoc2" } " which are in " { $snippet "assoc1" } " or are are no longer present in the current " { $link file } "." } ;
+{ $description "Removes all definitions from " { $snippet "assoc2" } " which are in " { $snippet "assoc1" } " or are no longer present in the current " { $link file } "." } ;
HELP: forget-smudged
{ $description "Forgets removed definitions." } ;
{ $subsections "add-vocab-roots" } ;
ARTICLE: "vocabs.icons" "Vocabulary icons"
-"An icon file representing the vocabulary can be provided for use by " { $link "tools.deploy" } ". A file named " { $snippet "icon.ico" } " will be used as the application icon when the application is deployed on Windows. A file named " { $snippet "icon.icns" } " will be used when the application is deployed on MacOS X." ;
+"An icon file representing the vocabulary can be provided for use by " { $link "tools.deploy" } ". If any of the following files exist inside the vocabulary directory, they will be used as icons when the application is deployed."
+{ $list
+ { { $snippet "icon.ico" } " on Windows" }
+ { { $snippet "icon.icns" } " on MacOS X" }
+ { { $snippet "icon.png" } " on Linux and *BSD" }
+} ;
ARTICLE: "vocabs.loader" "Vocabulary loader"
"The " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " words load vocabularies using the vocabulary loader. The vocabulary loader is implemented in the " { $vocab-link "vocabs.loader" } " vocabulary."
: read-texture-image ( tdt level -- image )
[ texture-dim ]
- [ drop texture-object [ component-order>> ] [ component-type>> ] bi f ]
+ [ drop texture-object [ component-order>> ] [ component-type>> ] bi f f ]
[ read-texture ] 2tri
image boa ; inline
HELP: supported-engines
{ $values
- { "value" array }
+ { "seq" array }
}
{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout engines" } ". For example, the " { $emphasis "dot" } " engine is typically included in a Graphviz installation, so " { $snippet "\"dot\"" } " will be an element of " { $link supported-engines } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what engines are supported." }
HELP: supported-formats
{ $values
- { "value" array }
+ { "seq" array }
}
{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout formats" } ". For example, Graphviz can typically render using the Postscript format, in which case " { $snippet "\"ps\"" } " will be an element of " { $link supported-formats } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what formats are supported."
USING: accessors alien alien.c-types alien.destructors
alien.libraries alien.syntax combinators debugger destructors
fry io kernel literals math prettyprint sequences splitting
-system words.constant
-graphviz
-;
+system memoize graphviz ;
IN: graphviz.ffi
<<
LIBRARY: libgvc
! Graphviz contexts
-! This must be wrapped in << >> so that GVC_t*, gvContext, and
-! &gvFreeContext can be used to compute the supported-engines
-! and supported-formats constants below.
-<<
C-TYPE: GVC_t
FUNCTION: GVC_t* gvContext ( ) ;
int-gvFreeContext dup zero? [ drop ] [ ffi-errors ] if ;
DESTRUCTOR: gvFreeContext
->>
! Layout
! Supported layout engines (dot, neato, etc.) and output
! formats (png, jpg, etc.)
-
-<<
<PRIVATE
ENUM: api_t
] with-destructors ;
PRIVATE>
->>
-CONSTANT: supported-engines $[ API_layout plugin-list ]
-CONSTANT: supported-formats $[ API_device plugin-list ]
+MEMO: supported-engines ( -- seq ) API_layout plugin-list ;
+MEMO: supported-formats ( -- seq ) API_device plugin-list ;
! Copyright (C) 2011 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators continuations destructors
-images.viewer io.backend io.files.unique kernel locals
-namespaces parser sequences summary unicode.case words
-graphviz.ffi
-graphviz.builder
-;
+USING: accessors combinators compiler.units continuations
+destructors images.viewer io.backend io.files.unique kernel
+locals namespaces parser sequences summary unicode.case words
+graphviz.ffi graphviz.builder ;
IN: graphviz.render
SYMBOL: default-layout
: preview-window ( graph -- )
(preview) image-window ; inline
-<<
-
<PRIVATE
: define-graphviz-by-engine ( -K -- )
- [ create-in dup make-inline ]
+ [ "graphviz.render" create dup make-inline ]
[ [ graphviz ] curry ] bi
(( graph -O -T -- ))
define-declared ;
: define-graphviz-by-format ( -T -- )
[
dup supported-engines member? [ "-file" append ] when
- create-in dup make-inline
+ "graphviz.render" create dup make-inline
]
[ [ graphviz* ] curry ] bi
(( graph -O -- ))
PRIVATE>
-supported-engines [ define-graphviz-by-engine ] each
-supported-formats [ define-graphviz-by-format ] each
-
->>
+[
+ supported-engines [ define-graphviz-by-engine ] each
+ supported-formats [ define-graphviz-by-format ] each
+] with-compilation-unit
--- /dev/null
+Doug Coleman
--- /dev/null
+USING: images.bitmap images.testing kernel ;
+IN: images.bitmap.tests
+
+! "vocab:images/testing/bmp/1bit.bmp" decode-test
+! "vocab:images/testing/bmp/rgb_4bit.bmp" decode-test
+
+"vocab:images/testing/bmp/rgb_8bit.bmp"
+[ decode-test ] [ bmp-image encode-test ] bi
+
+"vocab:images/testing/bmp/42red_24bit.bmp"
+[ decode-test ] [ bmp-image encode-test ] bi
--- /dev/null
+! Copyright (C) 2007, 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types arrays byte-arrays combinators
+compression.run-length fry grouping images images.loader
+images.normalization io io.binary io.encodings.8-bit.latin1
+io.encodings.string kernel math math.bitwise sequences
+specialized-arrays summary io.streams.throwing ;
+QUALIFIED-WITH: bitstreams b
+SPECIALIZED-ARRAYS: uint ushort ;
+IN: images.bitmap
+
+! http://www.fileformat.info/format/bmp/egff.htm
+! http://www.digicamsoft.com/bmp/bmp.html
+
+SINGLETON: bmp-image
+"bmp" bmp-image register-image-class
+
+: write2 ( n -- ) 2 >le write ;
+: write4 ( n -- ) 4 >le write ;
+
+ERROR: unknown-component-order bitmap ;
+ERROR: unknown-bitmap-header n ;
+
+: read2 ( -- n ) 2 read le> ;
+: read4 ( -- n ) 4 read le> ;
+
+TUPLE: loading-bitmap
+ file-header header
+ color-palette color-index bitfields ;
+
+TUPLE: file-header
+ { magic initial: "BM" }
+ { size }
+ { reserved1 initial: 0 }
+ { reserved2 initial: 0 }
+ { offset }
+ { header-length } ;
+
+TUPLE: v3-header
+ { width initial: 0 }
+ { height initial: 0 }
+ { planes initial: 0 }
+ { bit-count initial: 0 }
+ { compression initial: 0 }
+ { image-size initial: 0 }
+ { x-resolution initial: 0 }
+ { y-resolution initial: 0 }
+ { colors-used initial: 0 }
+ { colors-important initial: 0 } ;
+
+TUPLE: v4-header < v3-header
+ { red-mask initial: 0 }
+ { green-mask initial: 0 }
+ { blue-mask initial: 0 }
+ { alpha-mask initial: 0 }
+ { cs-type initial: 0 }
+ { end-points initial: 0 }
+ { gamma-red initial: 0 }
+ { gamma-green initial: 0 }
+ { gamma-blue initial: 0 } ;
+
+TUPLE: v5-header < v4-header
+ { intent initial: 0 }
+ { profile-data initial: 0 }
+ { profile-size initial: 0 }
+ { reserved3 initial: 0 } ;
+
+TUPLE: os2v1-header
+ { width initial: 0 }
+ { height initial: 0 }
+ { planes initial: 0 }
+ { bit-count initial: 0 } ;
+
+TUPLE: os2v2-header < os2v1-header
+ { compression initial: 0 }
+ { image-size initial: 0 }
+ { x-resolution initial: 0 }
+ { y-resolution initial: 0 }
+ { colors-used initial: 0 }
+ { colors-important initial: 0 }
+ { units initial: 0 }
+ { reserved initial: 0 }
+ { recording initial: 0 }
+ { rendering initial: 0 }
+ { size1 initial: 0 }
+ { size2 initial: 0 }
+ { color-encoding initial: 0 }
+ { identifier initial: 0 } ;
+
+UNION: v-header v3-header v4-header v5-header ;
+UNION: os2-header os2v1-header os2v2-header ;
+
+: parse-file-header ( -- file-header )
+ \ file-header new
+ 2 read latin1 decode >>magic
+ read4 >>size
+ read2 >>reserved1
+ read2 >>reserved2
+ read4 >>offset
+ read4 >>header-length ;
+
+: read-v3-header-data ( header -- header )
+ read4 >>width
+ read4 32 >signed >>height
+ read2 >>planes
+ read2 >>bit-count
+ read4 >>compression
+ read4 >>image-size
+ read4 >>x-resolution
+ read4 >>y-resolution
+ read4 >>colors-used
+ read4 >>colors-important ;
+
+: read-v3-header ( -- header )
+ \ v3-header new
+ read-v3-header-data ;
+
+: read-v4-header-data ( header -- header )
+ read4 >>red-mask
+ read4 >>green-mask
+ read4 >>blue-mask
+ read4 >>alpha-mask
+ read4 >>cs-type
+ read4 read4 read4 3array >>end-points
+ read4 >>gamma-red
+ read4 >>gamma-green
+ read4 >>gamma-blue ;
+
+: read-v4-header ( -- v4-header )
+ \ v4-header new
+ read-v3-header-data
+ read-v4-header-data ;
+
+: read-v5-header-data ( v5-header -- v5-header )
+ read4 >>intent
+ read4 >>profile-data
+ read4 >>profile-size
+ read4 >>reserved3 ;
+
+: read-v5-header ( -- loading-bitmap )
+ \ v5-header new
+ read-v3-header-data
+ read-v4-header-data
+ read-v5-header-data ;
+
+: read-os2v1-header ( -- os2v1-header )
+ \ os2v1-header new
+ read2 >>width
+ read2 16 >signed >>height
+ read2 >>planes
+ read2 >>bit-count ;
+
+: read-os2v2-header-data ( os2v2-header -- os2v2-header )
+ read4 >>width
+ read4 32 >signed >>height
+ read2 >>planes
+ read2 >>bit-count
+ read4 >>compression
+ read4 >>image-size
+ read4 >>x-resolution
+ read4 >>y-resolution
+ read4 >>colors-used
+ read4 >>colors-important
+ read2 >>units
+ read2 >>reserved
+ read2 >>recording
+ read2 >>rendering
+ read4 >>size1
+ read4 >>size2
+ read4 >>color-encoding
+ read4 >>identifier ;
+
+: read-os2v2-header ( -- os2v2-header )
+ \ os2v2-header new
+ read-os2v2-header-data ;
+
+: parse-header ( n -- header )
+ {
+ { 12 [ read-os2v1-header ] }
+ { 64 [ read-os2v2-header ] }
+ { 40 [ read-v3-header ] }
+ { 108 [ read-v4-header ] }
+ { 124 [ read-v5-header ] }
+ [ unknown-bitmap-header ]
+ } case ;
+
+: color-index-length ( header -- n )
+ {
+ [ width>> ]
+ [ planes>> * ]
+ [ bit-count>> * 31 + 32 /i 4 * ]
+ [ height>> abs * ]
+ } cleave ;
+
+: color-palette-length ( loading-bitmap -- n )
+ file-header>>
+ [ offset>> 14 - ] [ header-length>> ] bi - ;
+
+: parse-color-palette ( loading-bitmap -- loading-bitmap )
+ dup color-palette-length read >>color-palette ;
+
+GENERIC: parse-color-data* ( loading-bitmap header -- loading-bitmap )
+
+: parse-color-data ( loading-bitmap -- loading-bitmap )
+ dup header>> parse-color-data* ;
+
+M: os2v1-header parse-color-data* ( loading-bitmap header -- loading-bitmap )
+ color-index-length read >>color-index ;
+
+M: object parse-color-data* ( loading-bitmap header -- loading-bitmap )
+ dup image-size>> [ 0 ] unless* dup 0 >
+ [ nip ] [ drop color-index-length ] if read >>color-index ;
+
+: alpha-used? ( loading-bitmap -- ? )
+ color-index>> 4 <sliced-groups> [ fourth 0 = ] all? not ;
+
+GENERIC: bitmap>component-order* ( loading-bitmap header -- object )
+
+: bitmap>component-order ( loading-bitmap -- object )
+ dup header>> bitmap>component-order* ;
+
+: simple-bitmap>component-order ( loading-bitamp -- object )
+ header>> bit-count>> {
+ { 32 [ BGRX ] }
+ { 24 [ BGR ] }
+ { 16 [ BGR ] }
+ { 8 [ BGR ] }
+ { 4 [ BGR ] }
+ { 1 [ BGR ] }
+ [ unknown-component-order ]
+ } case ;
+
+: advanced-bitmap>component-order ( loading-bitmap -- object )
+ [ ] [ header>> bit-count>> ] [ alpha-used? ] tri 2array {
+ { { 32 t } [ drop BGRA ] }
+ { { 32 f } [ drop BGRX ] }
+ [ drop simple-bitmap>component-order ]
+ } case ;
+
+: color-lookup3 ( loading-bitmap -- seq )
+ [ color-index>> >array ]
+ [ color-palette>> 3 <sliced-groups> ] bi
+ '[ _ nth ] map concat ;
+
+: color-lookup4 ( loading-bitmap -- seq )
+ [ color-index>> >array ]
+ [ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ] bi
+ '[ _ nth ] map concat ;
+
+! os2v1 is 3bytes each, all others are 3 + 1 unused
+: color-lookup ( loading-bitmap -- seq )
+ dup file-header>> header-length>> {
+ { 12 [ color-lookup3 ] }
+ { 64 [ color-lookup4 ] }
+ { 40 [ color-lookup4 ] }
+ { 108 [ color-lookup4 ] }
+ { 124 [ color-lookup4 ] }
+ } case ;
+
+M: os2v1-header bitmap>component-order* drop simple-bitmap>component-order ;
+M: os2v2-header bitmap>component-order* drop simple-bitmap>component-order ;
+M: v3-header bitmap>component-order* drop simple-bitmap>component-order ;
+M: v4-header bitmap>component-order* drop advanced-bitmap>component-order ;
+M: v5-header bitmap>component-order* drop advanced-bitmap>component-order ;
+
+: uncompress-bitfield ( seq masks -- bytes' )
+ '[
+ _ [
+ [ bitand ] [ bit-count ] [ log2 ] tri - shift
+ ] with map
+ ] { } map-as B{ } concat-as ;
+
+ERROR: bmp-not-supported n ;
+
+: bitmap>bytes ( loading-bitmap -- byte-array )
+ dup header>> bit-count>>
+ {
+ { 32 [ color-index>> ] }
+ { 24 [ color-index>> ] }
+ { 16 [
+ [
+ ! ushort-array-cast
+ 2 group [ le> ] map
+ ! 5 6 5
+ ! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
+ ! 5 5 5
+ { HEX: 7c00 HEX: 3e0 HEX: 1f } uncompress-bitfield
+ ] change-color-index
+ color-index>>
+ ] }
+ { 8 [ color-lookup ] }
+ { 4 [ [ 4 b:byte-array-n>seq ] change-color-index color-lookup ] }
+ { 1 [ [ 1 b:byte-array-n>seq ] change-color-index color-lookup ] }
+ [ bmp-not-supported ]
+ } case >byte-array ;
+
+: set-bitfield-widths ( loading-bitmap -- loading-bitmap' )
+ dup header>> bit-count>> {
+ { 16 [ dup color-palette>> 4 group [ le> ] map ] }
+ { 32 [ { HEX: ff0000 HEX: ff00 HEX: ff } ] }
+ } case reverse >>bitfields ;
+
+ERROR: unsupported-bitfield-widths n ;
+
+M: unsupported-bitfield-widths summary
+ drop "Bitmaps only support bitfield compression in 16/32bit images" ;
+
+: uncompress-bitfield-widths ( loading-bitmap -- loading-bitmap' )
+ set-bitfield-widths
+ dup header>> bit-count>> {
+ { 16 [
+ dup bitfields>> '[
+ ushort-array-cast _ uncompress-bitfield
+ ] change-color-index
+ ] }
+ { 32 [ ] }
+ [ unsupported-bitfield-widths ]
+ } case ;
+
+ERROR: unsupported-bitmap-compression compression ;
+
+GENERIC: uncompress-bitmap* ( loading-bitmap header -- loading-bitmap )
+
+: uncompress-bitmap ( loading-bitmap -- loading-bitmap )
+ dup header>> uncompress-bitmap* ;
+
+M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
+ drop ;
+
+: do-run-length-uncompress ( loading-bitmap word -- loading-bitmap )
+ dupd '[
+ _ header>> [ width>> ] [ height>> ] bi
+ _ execute
+ ] change-color-index ; inline
+
+M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
+ compression>> {
+ { f [ ] }
+ { 0 [ ] }
+ { 1 [ \ run-length-uncompress-bitmap8 do-run-length-uncompress ] }
+ { 2 [ \ run-length-uncompress-bitmap4 do-run-length-uncompress ] }
+ { 3 [ uncompress-bitfield-widths ] }
+ { 4 [ "jpeg" unsupported-bitmap-compression ] }
+ { 5 [ "png" unsupported-bitmap-compression ] }
+ } case ;
+
+ERROR: unsupported-bitmap-file magic ;
+
+: load-bitmap ( stream -- loading-bitmap )
+ [
+ [
+ \ loading-bitmap new
+ parse-file-header [ >>file-header ] [ ] bi magic>> {
+ { "BM" [
+ dup file-header>> header-length>> parse-header >>header
+ parse-color-palette
+ parse-color-data
+ ] }
+ ! { "BA" [ parse-os2-bitmap-array ] }
+ ! { "CI" [ parse-os2-color-icon ] }
+ ! { "CP" [ parse-os2-color-pointer ] }
+ ! { "IC" [ parse-os2-icon ] }
+ ! { "PT" [ parse-os2-pointer ] }
+ [ unsupported-bitmap-file ]
+ } case
+ ] throw-on-eof
+ ] with-input-stream ;
+
+: loading-bitmap>bytes ( loading-bitmap -- byte-array )
+ uncompress-bitmap bitmap>bytes ;
+
+M: bmp-image stream>image ( stream bmp-image -- bitmap )
+ drop load-bitmap
+ [ image new ] dip
+ {
+ [ loading-bitmap>bytes >>bitmap ]
+ [ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ]
+ [ header>> height>> 0 < not >>upside-down? ]
+ [ bitmap>component-order >>component-order ubyte-components >>component-type ]
+ } cleave ;
+
+: output-width-and-height ( image -- )
+ [ dim>> first write4 ]
+ [
+ [ dim>> second ] [ upside-down?>> ] bi
+ [ neg ] unless write4
+ ] bi ;
+
+: output-bmp ( image -- )
+ B{ CHAR: B CHAR: M } write
+ [
+ bitmap>> length 14 + 40 + write4
+ 0 write4
+ 54 write4
+ 40 write4
+ ] [
+ {
+ [ output-width-and-height ]
+
+ ! planes
+ [ drop 1 write2 ]
+
+ ! bit-count
+ [ drop 24 write2 ]
+
+ ! compression
+ [ drop 0 write4 ]
+
+ ! image-size
+ [ bitmap>> length write4 ]
+
+ ! x-pels
+ [ drop 0 write4 ]
+
+ ! y-pels
+ [ drop 0 write4 ]
+
+ ! color-used
+ [ drop 0 write4 ]
+
+ ! color-important
+ [ drop 0 write4 ]
+
+ ! color-palette
+ [ bitmap>> write ]
+ } cleave
+ ] bi ;
+
+M: bmp-image image>stream
+ drop BGR reorder-components output-bmp ;
+
--- /dev/null
+Windows BMP image loader
--- /dev/null
+! Copyright (C) 2009 Marc Fauconneau.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays byte-arrays combinators
+compression.huffman fry grouping images images.loader
+images.processing io io.binary io.encodings.binary
+io.streams.byte-array io.streams.limited io.streams.throwing
+kernel locals math math.bitwise math.blas.matrices
+math.blas.vectors math.constants math.functions math.matrices
+math.order math.vectors memoize namespaces sequences
+sequences.deep ;
+QUALIFIED-WITH: bitstreams bs
+IN: images.jpeg
+
+SINGLETON: jpeg-image
+
+TUPLE: loading-jpeg < image
+ { headers }
+ { bitstream }
+ { color-info initial: { f f f f } }
+ { quant-tables initial: { f f } }
+ { huff-tables initial: { f f f f } }
+ { components } ;
+
+"jpg" jpeg-image register-image-class
+"jpeg" jpeg-image register-image-class
+
+<PRIVATE
+
+: <loading-jpeg> ( headers bitstream -- image )
+ loading-jpeg new swap >>bitstream swap >>headers ;
+
+SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP
+APP JPG COM TEM RES ;
+
+! ISO/IEC 10918-1 Table B.1
+:: >marker ( byte -- marker )
+ byte
+ {
+ { [ dup HEX: CC = ] [ { DAC } ] }
+ { [ dup HEX: C4 = ] [ { DHT } ] }
+ { [ dup HEX: C9 = ] [ { JPG } ] }
+ { [ dup -4 shift HEX: C = ] [ SOF byte 4 bits 2array ] }
+
+ { [ dup HEX: D8 = ] [ { SOI } ] }
+ { [ dup HEX: D9 = ] [ { EOI } ] }
+ { [ dup HEX: DA = ] [ { SOS } ] }
+ { [ dup HEX: DB = ] [ { DQT } ] }
+ { [ dup HEX: DC = ] [ { DNL } ] }
+ { [ dup HEX: DD = ] [ { DRI } ] }
+ { [ dup HEX: DE = ] [ { DHP } ] }
+ { [ dup HEX: DF = ] [ { EXP } ] }
+ { [ dup -4 shift HEX: D = ] [ RST byte 4 bits 2array ] }
+
+ { [ dup -4 shift HEX: E = ] [ APP byte 4 bits 2array ] }
+ { [ dup HEX: FE = ] [ { COM } ] }
+ { [ dup -4 shift HEX: F = ] [ JPG byte 4 bits 2array ] }
+
+ { [ dup HEX: 01 = ] [ { TEM } ] }
+ [ { RES } ]
+ }
+ cond nip ;
+
+TUPLE: jpeg-chunk length type data ;
+
+: <jpeg-chunk> ( type length data -- jpeg-chunk )
+ jpeg-chunk new
+ swap >>data
+ swap >>length
+ swap >>type ;
+
+TUPLE: jpeg-color-info
+ h v quant-table dc-huff-table ac-huff-table { diff initial: 0 } id ;
+
+: <jpeg-color-info> ( h v quant-table -- jpeg-color-info )
+ jpeg-color-info new
+ swap >>quant-table
+ swap >>v
+ swap >>h ;
+
+: jpeg> ( -- jpeg-image ) jpeg-image get ;
+
+: apply-diff ( dc color -- dc' )
+ [ diff>> + dup ] [ diff<< ] bi ;
+
+: fetch-tables ( component -- )
+ [ [ jpeg> quant-tables>> nth ] change-quant-table drop ]
+ [ [ jpeg> huff-tables>> nth ] change-dc-huff-table drop ]
+ [ [ 2 + jpeg> huff-tables>> nth ] change-ac-huff-table drop ] tri ;
+
+: read4/4 ( -- a b ) read1 16 /mod ;
+
+! headers
+
+: decode-frame ( header -- )
+ data>>
+ binary
+ [
+ read1 8 assert=
+ 2 read be>
+ 2 read be>
+ swap 2array jpeg> dim<<
+ read1
+ [
+ read1 read4/4 read1 <jpeg-color-info>
+ swap [ >>id ] keep jpeg> color-info>> set-nth
+ ] times
+ ] with-byte-reader ;
+
+: decode-quant-table ( chunk -- )
+ dup data>>
+ binary
+ [
+ length>>
+ 2 - 65 /
+ [
+ read4/4 [ 0 assert= ] dip
+ 64 read
+ swap jpeg> quant-tables>> set-nth
+ ] times
+ ] with-byte-reader ;
+
+: decode-huff-table ( chunk -- )
+ data>> [ binary <byte-reader> ] [ length ] bi limit-stream [
+ [ input-stream get stream>> [ count>> ] [ limit>> ] bi < ]
+ [
+ read4/4 swap 2 * +
+ 16 read
+ dup [ ] [ + ] map-reduce read
+ binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader
+ swap jpeg> huff-tables>> set-nth
+ ] while
+ ] stream-throw-on-eof ;
+
+: decode-scan ( chunk -- )
+ data>>
+ binary
+ [
+ read1 iota
+ [ drop
+ read1 jpeg> color-info>> nth clone
+ read1 16 /mod [ >>dc-huff-table ] [ >>ac-huff-table ] bi*
+ ] map jpeg> components<<
+ read1 0 assert=
+ read1 63 assert=
+ read1 16 /mod [ 0 assert= ] bi@
+ ] with-byte-reader ;
+
+: singleton-first ( seq -- elt )
+ [ length 1 assert= ] [ first ] bi ;
+
+ERROR: not-a-baseline-jpeg-image ;
+
+: baseline-parse ( -- )
+ jpeg> headers>> [ type>> { SOF 0 } = ] any? [ not-a-baseline-jpeg-image ] unless
+ jpeg> headers>>
+ {
+ [ [ type>> { SOF 0 } = ] filter singleton-first decode-frame ]
+ [ [ type>> { DQT } = ] filter [ decode-quant-table ] each ]
+ [ [ type>> { DHT } = ] filter [ decode-huff-table ] each ]
+ [ [ type>> { SOS } = ] filter singleton-first decode-scan ]
+ } cleave ;
+
+: parse-marker ( -- marker )
+ read1 HEX: FF assert=
+ read1 >marker ;
+
+: parse-headers ( -- chunks )
+ [ parse-marker dup { SOS } = not ]
+ [
+ 2 read be>
+ dup 2 - read <jpeg-chunk>
+ ] [ produce ] keep dip swap suffix ;
+
+MEMO: zig-zag ( -- zz )
+ {
+ { 0 1 5 6 14 15 27 28 }
+ { 2 4 7 13 16 26 29 42 }
+ { 3 8 12 17 25 30 41 43 }
+ { 9 11 18 24 31 40 44 53 }
+ { 10 19 23 32 39 45 52 54 }
+ { 20 22 33 38 46 51 55 60 }
+ { 21 34 37 47 50 56 59 61 }
+ { 35 36 48 49 57 58 62 63 }
+ } flatten ;
+
+MEMO: yuv>bgr-matrix ( -- m )
+ {
+ { 1 2.03211 0 }
+ { 1 -0.39465 -0.58060 }
+ { 1 0 1.13983 }
+ } ;
+
+: wave ( x u -- n ) swap 2 * 1 + * pi * 16 / cos ;
+
+:: dct-vect ( u v -- basis )
+ { 8 8 } coord-matrix [ { u v } [ wave ] 2map product ] map^2
+ 1 u v [ 0 = [ 2 sqrt / ] when ] bi@ 4 / m*n ;
+
+MEMO: dct-matrix ( -- m ) 64 iota [ 8 /mod dct-vect flatten ] map ;
+
+: mb-dim ( component -- dim ) [ h>> ] [ v>> ] bi 2array ;
+
+! : blocks ( component -- seq )
+! mb-dim ! coord-matrix flip concat [ [ { 2 2 } v* ] [ v+ ] bi* ] with map ;
+
+: all-macroblocks ( quot: ( mb -- ) -- )
+ [
+ jpeg>
+ [ dim>> 8 v/n ]
+ [ color-info>> sift { 0 0 } [ mb-dim vmax ] reduce v/ ] bi
+ [ ceiling ] map
+ coord-matrix flip concat
+ ]
+ [ each ] bi* ; inline
+
+: reverse-zigzag ( b -- b' ) zig-zag swap [ nth ] curry map ;
+
+: idct-factor ( b -- b' ) dct-matrix v.m ;
+
+MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
+: V.M ( x A -- x.A ) Mtranspose swap M.V ;
+: idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ;
+
+: idct ( b -- b' ) idct-factor ;
+
+:: draw-block ( block x,y color-id jpeg-image -- )
+ block dup length>> sqrt >fixnum group flip
+ dup matrix-dim coord-matrix flip
+ [
+ [ '[ _ [ second ] [ first ] bi ] dip nth nth ]
+ [ x,y v+ color-id jpeg-image draw-color ] bi
+ ] with each^2 ;
+
+: sign-extend ( bits v -- v' )
+ swap [ ] [ 1 - 2^ < ] 2bi
+ [ -1 swap shift 1 + + ] [ drop ] if ;
+
+: read1-jpeg-dc ( decoder -- dc )
+ [ read1-huff dup ] [ bs>> bs:read ] bi sign-extend ;
+
+: read1-jpeg-ac ( decoder -- run/ac )
+ [ read1-huff 16 /mod dup ] [ bs>> bs:read ] bi sign-extend 2array ;
+
+:: decode-block ( color -- pixels )
+ color dc-huff-table>> read1-jpeg-dc color apply-diff
+ 64 0 <array> :> coefs
+ 0 coefs set-nth
+ 0 :> k!
+ [
+ color ac-huff-table>> read1-jpeg-ac
+ [ first 1 + k + k! ] [ second k coefs set-nth ] [ ] tri
+ { 0 0 } = not
+ k 63 < and
+ ] loop
+ coefs color quant-table>> v*
+ reverse-zigzag idct ;
+
+:: draw-macroblock-yuv420 ( mb blocks -- )
+ mb { 16 16 } v* :> pos
+ 0 blocks nth pos { 0 0 } v+ 0 jpeg> draw-block
+ 1 blocks nth pos { 8 0 } v+ 0 jpeg> draw-block
+ 2 blocks nth pos { 0 8 } v+ 0 jpeg> draw-block
+ 3 blocks nth pos { 8 8 } v+ 0 jpeg> draw-block
+ 4 blocks nth 8 group 2 matrix-zoom concat pos 1 jpeg> draw-block
+ 5 blocks nth 8 group 2 matrix-zoom concat pos 2 jpeg> draw-block ;
+
+:: draw-macroblock-yuv444 ( mb blocks -- )
+ mb { 8 8 } v* :> pos
+ 3 iota [ [ blocks nth pos ] [ jpeg> draw-block ] bi ] each ;
+
+:: draw-macroblock-y ( mb blocks -- )
+ mb { 8 8 } v* :> pos
+ 0 blocks nth pos 0 jpeg> draw-block
+ 64 0 <array> pos 1 jpeg> draw-block
+ 64 0 <array> pos 2 jpeg> draw-block ;
+
+ ! %fixme: color hack
+ ! color h>> 2 =
+ ! [ 8 group 2 matrix-zoom concat ] unless
+ ! pos { 8 8 } v* color jpeg> draw-block ;
+
+: decode-macroblock ( -- blocks )
+ jpeg> components>>
+ [
+ [ mb-dim first2 * ]
+ [ [ decode-block ] curry replicate ] bi
+ ] map concat ;
+
+: cleanup-bitstream ( bytes -- bytes' )
+ binary [
+ [
+ { HEX: FF } read-until
+ read1 [ HEX: 00 = and ] keep swap
+ ]
+ [ drop ] produce
+ swap >marker { EOI } assert=
+ swap suffix
+ { HEX: FF } join
+ ] with-byte-reader ;
+
+: setup-bitmap ( image -- )
+ dup dim>> 16 v/n [ ceiling ] map 16 v*n >>dim
+ BGR >>component-order
+ ubyte-components >>component-type
+ f >>upside-down?
+ dup dim>> first2 * 3 * 0 <array> >>bitmap
+ drop ;
+
+ERROR: unsupported-colorspace ;
+SINGLETONS: YUV420 YUV444 Y MAGIC! ;
+
+:: detect-colorspace ( jpeg-image -- csp )
+ jpeg-image color-info>> sift :> colors
+ MAGIC!
+ colors length 1 = [ drop Y ] when
+ colors length 3 =
+ [
+ colors [ mb-dim { 1 1 } = ] all?
+ [ drop YUV444 ] when
+
+ colors unclip
+ [ [ mb-dim { 1 1 } = ] all? ]
+ [ mb-dim { 2 2 } = ] bi* and
+ [ drop YUV420 ] when
+ ] when ;
+
+! this eats ~50% cpu time
+: draw-macroblocks ( mbs -- )
+ jpeg> detect-colorspace
+ {
+ { YUV420 [ [ first2 draw-macroblock-yuv420 ] each ] }
+ { YUV444 [ [ first2 draw-macroblock-yuv444 ] each ] }
+ { Y [ [ first2 draw-macroblock-y ] each ] }
+ [ unsupported-colorspace ]
+ } case ;
+
+! this eats ~25% cpu time
+: color-transform ( yuv -- rgb )
+ { 128 0 0 } v+ yuv>bgr-matrix swap m.v
+ [ 0 max 255 min >fixnum ] map ;
+
+: baseline-decompress ( -- )
+ jpeg> bitstream>> cleanup-bitstream { 255 255 255 255 } append
+ >byte-array bs:<msb0-bit-reader> jpeg> bitstream<<
+ jpeg>
+ [ bitstream>> ]
+ [ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi
+ jpeg> components>> [ fetch-tables ] each
+ [ decode-macroblock 2array ] collector
+ [ all-macroblocks ] dip
+ jpeg> setup-bitmap draw-macroblocks
+ jpeg> bitmap>> 3 <groups> [ color-transform ] map! drop
+ jpeg> [ >byte-array ] change-bitmap drop ;
+
+ERROR: not-a-jpeg-image ;
+
+: loading-jpeg>image ( loading-jpeg -- image )
+ dup jpeg-image [
+ baseline-parse
+ baseline-decompress
+ ] with-variable ;
+
+: load-jpeg ( stream -- loading-jpeg )
+ [
+ parse-marker { SOI } = [ not-a-jpeg-image ] unless
+ parse-headers
+ contents <loading-jpeg>
+ ] with-input-stream ;
+
+PRIVATE>
+
+M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
+ drop load-jpeg loading-jpeg>image ;
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing ;
+IN: images.pbm.tests
+
+"vocab:images/testing/pbm/test.binary.pbm" decode-test
+"vocab:images/testing/pbm/test.ascii.pbm" decode-test
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays ascii bit-arrays byte-arrays combinators
+continuations grouping images images.loader io io.encodings.ascii
+io.encodings.string kernel locals make math math.functions math.parser
+sequences io.streams.throwing ;
+IN: images.pbm
+
+SINGLETON: pbm-image
+"pbm" pbm-image register-image-class
+
+<PRIVATE
+: read-token ( -- token )
+ [
+ read1 dup blank?
+ [ t ]
+ [
+ dup CHAR: # =
+ [ "\n" read-until 2drop t ]
+ [ f ] if
+ ] if
+ ] [ drop ] while
+ " \n\r\t" read-until drop swap
+ prefix ascii decode ;
+
+: read-number ( -- number )
+ read-token string>number ;
+
+: read-ascii-bits ( -- )
+ read1 {
+ { CHAR: 1 [ 0 , read-ascii-bits ] }
+ { CHAR: 0 [ 255 , read-ascii-bits ] }
+ { f [ ] }
+ [ drop read-ascii-bits ]
+ } case ;
+
+:: read-binary-bits ( width height -- )
+ width 8 align 8 / height * read
+ width 8 align 8 / <groups> [| row |
+ width iota [| n |
+ n 8 / floor row nth
+ n 8 mod 7 swap - bit?
+ [ 0 ] [ 255 ] if ,
+ ] each
+ ] each ;
+
+:: write-binary-bits ( bitmap width -- )
+ bitmap width <groups> [
+ width 8 align 255 pad-tail
+ 8 <groups> [
+ [ 255 = [ f ] [ t ] if ] { } map-as
+ >bit-array reverse bit-array>integer
+ 1array >byte-array write
+ ] each
+ ] each ;
+
+:: read-pbm ( -- image )
+ read-token :> type
+ read-number :> width
+ read-number :> height
+
+ type {
+ { "P1" [ [ [ read-ascii-bits ] ignore-errors ] B{ } make ] }
+ { "P4" [ [ width height read-binary-bits ] B{ } make ] }
+ } case :> data
+
+ image new
+ L >>component-order
+ { width height } >>dim
+ f >>upside-down?
+ data >>bitmap
+ ubyte-components >>component-type ;
+PRIVATE>
+
+M: pbm-image stream>image
+ drop [ [ read-pbm ] throw-on-eof ] with-input-stream ;
+
+M: pbm-image image>stream
+ drop {
+ [ drop "P4\n" ascii encode write ]
+ [ dim>> first number>string " " append ascii encode write ]
+ [ dim>> second number>string "\n" append ascii encode write ]
+ [ [ bitmap>> ] [ dim>> first ] bi write-binary-bits ]
+ } cleave ;
--- /dev/null
+Image loading for PBM image files.
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing ;
+IN: images.pgm.tests
+
+"vocab:images/testing/pgm/radial.binary.pgm" decode-test
+"vocab:images/testing/pgm/radial.ascii.pgm" decode-test
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types ascii combinators images images.loader
+io io.encodings.ascii io.encodings.string kernel locals make math
+math.parser sequences specialized-arrays io.streams.throwing ;
+SPECIALIZED-ARRAY: ushort
+IN: images.pgm
+
+SINGLETON: pgm-image
+"pgm" pgm-image register-image-class
+
+: read-token ( -- token )
+ [ read1 dup blank?
+ [ t ]
+ [ dup CHAR: # =
+ [ "\n" read-until 2drop t ]
+ [ f ] if
+ ] if
+ ] [ drop ] while
+ " \n\r\t" read-until drop swap
+ prefix ascii decode ;
+
+: read-number ( -- number )
+ read-token string>number ;
+
+:: read-numbers ( n lim -- )
+ n lim = [
+ read-number ,
+ n 1 + lim read-numbers
+ ] unless ;
+
+:: read-pgm ( -- image )
+ read-token :> type
+ read-number :> width
+ read-number :> height
+ read-number :> max
+ width height * :> npixels
+ max 256 >= :> wide
+
+ type {
+ { "P2" [ [ 0 npixels read-numbers ] wide [ ushort-array{ } ] [ B{ } ] if make ] }
+ { "P5" [ wide [ 2 ] [ 1 ] if npixels * read ] }
+ } case :> data
+
+ image new
+ L >>component-order
+ { width height } >>dim
+ f >>upside-down?
+ data >>bitmap
+ wide [ ushort-components ] [ ubyte-components ] if >>component-type ;
+
+M: pgm-image stream>image
+ drop [ [ read-pgm ] throw-on-eof ] with-input-stream ;
+
+M: pgm-image image>stream
+ drop {
+ [ drop "P5\n" ascii encode write ]
+ [ dim>> first number>string " " append ascii encode write ]
+ [ dim>> second number>string "\n" append ascii encode write ]
+ [ component-type>> ubyte-components = [ "255\n" ] [ "65535\n" ] if ascii encode write ]
+ [ bitmap>> write ]
+ } cleave ;
--- /dev/null
+Image loading for PGM image files.
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2009 Doug Coleman, Keith Lazuka
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing io.directories ;
+IN: images.png.tests
+
+! Test files from PngSuite (http://www.libpng.org/pub/png/pngsuite.html)
+
+! The subset of the suite that should work given the current implementation.
+"vocab:images/testing/png" [
+ "basi0g01.png" decode-test
+ "basi0g02.png" decode-test
+ "basi0g04.png" decode-test
+ "basi0g08.png" decode-test
+ "basi0g16.png" decode-test
+ "basi2c08.png" decode-test
+ "basi3p01.png" decode-test
+ "basi3p02.png" decode-test
+ "basi3p04.png" decode-test
+ "basi3p08.png" decode-test
+ "basn0g01.png" decode-test
+ "basn0g02.png" decode-test
+ "basn0g04.png" decode-test
+ "basn0g08.png" decode-test
+ "basn0g16.png" decode-test
+ "basn2c08.png" decode-test
+ "basn3p01.png" decode-test
+ "basn3p02.png" decode-test
+ "basn3p04.png" decode-test
+ "basn3p08.png" decode-test
+ "basn6a08.png" decode-test
+ "f00n2c08.png" decode-test
+ "f01n2c08.png" decode-test
+ "f02n2c08.png" decode-test
+ "f03n2c08.png" decode-test
+ "f04n2c08.png" decode-test
+ "s01i3p01.png" decode-test
+ "s01n3p01.png" decode-test
+ "s02i3p01.png" decode-test
+ "s02n3p01.png" decode-test
+ "s03i3p01.png" decode-test
+ "s03n3p01.png" decode-test
+ "s04i3p01.png" decode-test
+ "s04n3p01.png" decode-test
+ "s05i3p02.png" decode-test
+ "s05n3p02.png" decode-test
+ "s06i3p02.png" decode-test
+ "s06n3p02.png" decode-test
+ "s07i3p02.png" decode-test
+ "s07n3p02.png" decode-test
+ "s08i3p02.png" decode-test
+ "s08n3p02.png" decode-test
+ "s09i3p02.png" decode-test
+ "s32n3p04.png" decode-test
+ "s32i3p04.png" decode-test
+ "s33n3p04.png" decode-test
+ "s33i3p04.png" decode-test
+ "s34n3p04.png" decode-test
+ "s34i3p04.png" decode-test
+ "s35n3p04.png" decode-test
+ "s35i3p04.png" decode-test
+ "s36n3p04.png" decode-test
+ "s36i3p04.png" decode-test
+ "s37n3p04.png" decode-test
+ "s37i3p04.png" decode-test
+ "s38n3p04.png" decode-test
+ "s38i3p04.png" decode-test
+ "s39n3p04.png" decode-test
+ "s39i3p04.png" decode-test
+ "s40n3p04.png" decode-test
+ "s40i3p04.png" decode-test
+ "s07n3p02.png" decode-test
+ "z00n2c08.png" decode-test
+ "z03n2c08.png" decode-test
+ "z06n2c08.png" decode-test
+ "z09n2c08.png" decode-test
+] with-directory
+
+! The current PNG decoder implementation is very limited,
+! so the entire test suite is not currently enabled.
+! "vocab:images/testing/png/suite" [
+! "basi0g01.png" decode-test
+! "basi0g02.png" decode-test
+! "basi0g04.png" decode-test
+! "basi0g08.png" decode-test
+! "basi0g16.png" decode-test
+! "basi2c08.png" decode-test
+! "basi2c16.png" decode-test
+! "basi3p01.png" decode-test
+! "basi3p02.png" decode-test
+! "basi3p04.png" decode-test
+! "basi3p08.png" decode-test
+! "basi4a08.png" decode-test
+! "basi4a16.png" decode-test
+! "basi6a08.png" decode-test
+! "basi6a16.png" decode-test
+! "basn0g01.png" decode-test
+! "basn0g02.png" decode-test
+! "basn0g04.png" decode-test
+! "basn0g08.png" decode-test
+! "basn0g16.png" decode-test
+! "basn2c08.png" decode-test
+! "basn2c16.png" decode-test
+! "basn3p01.png" decode-test
+! "basn3p02.png" decode-test
+! "basn3p04.png" decode-test
+! "basn3p08.png" decode-test
+! "basn4a08.png" decode-test
+! "basn4a16.png" decode-test
+! "basn6a08.png" decode-test
+! "basn6a16.png" decode-test
+! "bgai4a08.png" decode-test
+! "bgai4a16.png" decode-test
+! "bgan6a08.png" decode-test
+! "bgan6a16.png" decode-test
+! "bgbn4a08.png" decode-test
+! "bggn4a16.png" decode-test
+! "bgwn6a08.png" decode-test
+! "bgyn6a16.png" decode-test
+! "ccwn2c08.png" decode-test
+! "ccwn3p08.png" decode-test
+! "cdfn2c08.png" decode-test
+! "cdhn2c08.png" decode-test
+! "cdsn2c08.png" decode-test
+! "cdun2c08.png" decode-test
+! "ch1n3p04.png" decode-test
+! "ch2n3p08.png" decode-test
+! "cm0n0g04.png" decode-test
+! "cm7n0g04.png" decode-test
+! "cm9n0g04.png" decode-test
+! "cs3n2c16.png" decode-test
+! "cs3n3p08.png" decode-test
+! "cs5n2c08.png" decode-test
+! "cs5n3p08.png" decode-test
+! "cs8n2c08.png" decode-test
+! "cs8n3p08.png" decode-test
+! "ct0n0g04.png" decode-test
+! "ct1n0g04.png" decode-test
+! "ctzn0g04.png" decode-test
+! "f00n0g08.png" decode-test
+! "f00n2c08.png" decode-test
+! "f01n0g08.png" decode-test
+! "f01n2c08.png" decode-test
+! "f02n0g08.png" decode-test
+! "f02n2c08.png" decode-test
+! "f03n0g08.png" decode-test
+! "f03n2c08.png" decode-test
+! "f04n0g08.png" decode-test
+! "f04n2c08.png" decode-test
+! "g03n0g16.png" decode-test
+! "g03n2c08.png" decode-test
+! "g03n3p04.png" decode-test
+! "g04n0g16.png" decode-test
+! "g04n2c08.png" decode-test
+! "g04n3p04.png" decode-test
+! "g05n0g16.png" decode-test
+! "g05n2c08.png" decode-test
+! "g05n3p04.png" decode-test
+! "g07n0g16.png" decode-test
+! "g07n2c08.png" decode-test
+! "g07n3p04.png" decode-test
+! "g10n0g16.png" decode-test
+! "g10n2c08.png" decode-test
+! "g10n3p04.png" decode-test
+! "g25n0g16.png" decode-test
+! "g25n2c08.png" decode-test
+! "g25n3p04.png" decode-test
+! "oi1n0g16.png" decode-test
+! "oi1n2c16.png" decode-test
+! "oi2n0g16.png" decode-test
+! "oi2n2c16.png" decode-test
+! "oi4n0g16.png" decode-test
+! "oi4n2c16.png" decode-test
+! "oi9n0g16.png" decode-test
+! "oi9n2c16.png" decode-test
+! "pngsuite_logo.png" decode-test
+! "pp0n2c16.png" decode-test
+! "pp0n6a08.png" decode-test
+! "ps1n0g08.png" decode-test
+! "ps1n2c16.png" decode-test
+! "ps2n0g08.png" decode-test
+! "ps2n2c16.png" decode-test
+! "s01i3p01.png" decode-test
+! "s01n3p01.png" decode-test
+! "s02i3p01.png" decode-test
+! "s02n3p01.png" decode-test
+! "s03i3p01.png" decode-test
+! "s03n3p01.png" decode-test
+! "s04i3p01.png" decode-test
+! "s04n3p01.png" decode-test
+! "s05i3p02.png" decode-test
+! "s05n3p02.png" decode-test
+! "s06i3p02.png" decode-test
+! "s06n3p02.png" decode-test
+! "s07i3p02.png" decode-test
+! "s07n3p02.png" decode-test
+! "s08i3p02.png" decode-test
+! "s08n3p02.png" decode-test
+! "s09i3p02.png" decode-test
+! "s09n3p02.png" decode-test
+! "s32i3p04.png" decode-test
+! "s32n3p04.png" decode-test
+! "s33i3p04.png" decode-test
+! "s33n3p04.png" decode-test
+! "s34i3p04.png" decode-test
+! "s34n3p04.png" decode-test
+! "s35i3p04.png" decode-test
+! "s35n3p04.png" decode-test
+! "s36i3p04.png" decode-test
+! "s36n3p04.png" decode-test
+! "s37i3p04.png" decode-test
+! "s37n3p04.png" decode-test
+! "s38i3p04.png" decode-test
+! "s38n3p04.png" decode-test
+! "s39i3p04.png" decode-test
+! "s39n3p04.png" decode-test
+! "s40i3p04.png" decode-test
+! "s40n3p04.png" decode-test
+! "tbbn1g04.png" decode-test
+! "tbbn2c16.png" decode-test
+! "tbbn3p08.png" decode-test
+! "tbgn2c16.png" decode-test
+! "tbgn3p08.png" decode-test
+! "tbrn2c08.png" decode-test
+! "tbwn1g16.png" decode-test
+! "tbwn3p08.png" decode-test
+! "tbyn3p08.png" decode-test
+! "tp0n1g08.png" decode-test
+! "tp0n2c08.png" decode-test
+! "tp0n3p08.png" decode-test
+! "tp1n3p08.png" decode-test
+! "x00n0g01.png" decode-test
+! "xcrn0g04.png" decode-test
+! "xlfn0g04.png" decode-test
+! "z00n2c08.png" decode-test
+! "z03n2c08.png" decode-test
+! "z06n2c08.png" decode-test
+! "z09n2c08.png" decode-test
+! ] with-directory
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays checksums checksums.crc32 combinators
+compression.inflate fry grouping images images.loader io
+io.binary io.encodings.ascii io.encodings.string kernel locals
+math math.bitwise math.ranges sequences sorting assocs
+math.functions math.order byte-arrays io.streams.throwing ;
+QUALIFIED-WITH: bitstreams bs
+IN: images.png
+
+SINGLETON: png-image
+"png" png-image register-image-class
+
+TUPLE: loading-png
+ chunks
+ width height bit-depth color-type compression-method
+ filter-method interlace-method uncompressed ;
+
+CONSTANT: filter-none 0
+CONSTANT: filter-sub 1
+CONSTANT: filter-up 2
+CONSTANT: filter-average 3
+CONSTANT: filter-paeth 4
+
+CONSTANT: greyscale 0
+CONSTANT: truecolor 2
+CONSTANT: indexed-color 3
+CONSTANT: greyscale-alpha 4
+CONSTANT: truecolor-alpha 6
+
+CONSTANT: interlace-none 0
+CONSTANT: interlace-adam7 1
+
+CONSTANT: starting-row { 0 0 4 0 2 0 1 }
+CONSTANT: starting-col { 0 4 0 2 0 1 0 }
+CONSTANT: row-increment { 8 8 8 4 4 2 2 }
+CONSTANT: col-increment { 8 8 4 4 2 2 1 }
+CONSTANT: block-height { 8 8 4 4 2 2 1 }
+CONSTANT: block-width { 8 4 4 2 2 1 1 }
+
+: <loading-png> ( -- image )
+ loading-png new
+ V{ } clone >>chunks ;
+
+TUPLE: png-chunk length type data ;
+
+: <png-chunk> ( -- png-chunk )
+ png-chunk new ; inline
+
+CONSTANT: png-header
+ B{ HEX: 89 HEX: 50 HEX: 4e HEX: 47 HEX: 0d HEX: 0a HEX: 1a HEX: 0a }
+
+ERROR: bad-png-header header ;
+
+: read-png-header ( -- )
+ 8 read dup png-header sequence= [
+ bad-png-header
+ ] unless drop ;
+
+ERROR: bad-checksum ;
+
+: read-png-chunks ( loading-png -- loading-png )
+ <png-chunk>
+ 4 read be> [ >>length ] [ 4 + ] bi
+ read dup crc32 checksum-bytes
+ 4 read = [ bad-checksum ] unless
+ 4 cut-slice
+ [ ascii decode >>type ] [ B{ } like >>data ] bi*
+ [ over chunks>> push ]
+ [ type>> ] bi "IEND" =
+ [ read-png-chunks ] unless ;
+
+: find-chunk ( loading-png string -- chunk )
+ [ chunks>> ] dip '[ type>> _ = ] find nip ;
+
+: find-chunks ( loading-png string -- chunk )
+ [ chunks>> ] dip '[ type>> _ = ] filter ;
+
+: parse-ihdr-chunk ( loading-png -- loading-png )
+ dup "IHDR" find-chunk data>> {
+ [ [ 0 4 ] dip subseq be> >>width ]
+ [ [ 4 8 ] dip subseq be> >>height ]
+ [ [ 8 ] dip nth >>bit-depth ]
+ [ [ 9 ] dip nth >>color-type ]
+ [ [ 10 ] dip nth >>compression-method ]
+ [ [ 11 ] dip nth >>filter-method ]
+ [ [ 12 ] dip nth >>interlace-method ]
+ } cleave ;
+
+: find-compressed-bytes ( loading-png -- bytes )
+ "IDAT" find-chunks [ data>> ] map concat ;
+
+ERROR: unknown-color-type n ;
+ERROR: unimplemented-color-type image ;
+
+: inflate-data ( loading-png -- bytes )
+ find-compressed-bytes zlib-inflate ;
+
+: png-components-per-pixel ( loading-png -- n )
+ color-type>> {
+ { greyscale [ 1 ] }
+ { truecolor [ 3 ] }
+ { greyscale-alpha [ 2 ] }
+ { indexed-color [ 1 ] }
+ { truecolor-alpha [ 4 ] }
+ [ unknown-color-type ]
+ } case ; inline
+
+: png-group-width ( loading-png -- n )
+ ! 1 + is for the filter type, 1 byte preceding each line
+ [ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
+ [ width>> ] bi * 1 + ;
+
+:: paeth ( a b c -- p )
+ a b + c - { a b c } [ [ - abs ] keep 2array ] with map
+ sort-keys first second ;
+
+:: png-unfilter-line ( width prev curr filter -- curr' )
+ prev :> c
+ prev width tail-slice :> b
+ curr :> a
+ curr width tail-slice :> x
+ x length iota
+ filter {
+ { filter-none [ drop ] }
+ { filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
+ { filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
+ { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
+ { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
+ } case
+ curr width tail ;
+
+:: reverse-png-filter ( lines n -- byte-array )
+ lines dup first length 0 <array> prefix
+ [ n 1 - 0 <array> prepend ] map
+ 2 clump [
+ n swap first2
+ [ ]
+ [ n 1 - swap nth ]
+ [ [ 0 n 1 - ] dip set-nth ] tri
+ png-unfilter-line
+ ] map B{ } concat-as ;
+
+:: visit ( row col height width pixel image -- )
+ row image nth :> irow
+ pixel col irow set-nth ;
+
+ERROR: bad-filter n ;
+
+:: read-scanlines ( bit-reader loading-png width height -- array )
+ loading-png png-components-per-pixel :> #components
+ loading-png bit-depth>> :> bit-depth
+ bit-depth :> depth!
+ #components width * :> count!
+
+ ! Only read up to 8 bits at a time
+ bit-depth 16 = [
+ 8 depth!
+ count 2 * count!
+ ] when
+
+ height [
+ 8 bit-reader bs:read dup 0 4 between? [ bad-filter ] unless
+ count [ depth bit-reader bs:read ] replicate swap prefix
+ 8 bit-reader bs:align
+ ] replicate
+ #components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
+
+:: reverse-interlace-none ( byte-array loading-png -- array )
+ byte-array bs:<msb0-bit-reader> :> bs
+ loading-png width>> :> width
+ loading-png height>> :> height
+ bs loading-png width height read-scanlines ;
+
+:: adam7-subimage-height ( png-height pass -- subimage-height )
+ pass starting-row nth png-height >= [
+ 0
+ ] [
+ png-height 1 -
+ pass block-height nth +
+ pass row-increment nth /i
+ ] if ;
+
+:: adam7-subimage-width ( png-width pass -- subimage-width )
+ pass starting-col nth png-width >= [
+ 0
+ ] [
+ png-width 1 -
+ pass block-width nth +
+ pass col-increment nth /i
+ ] if ;
+
+:: read-adam7-subimage ( bit-reader loading-png pass -- lines )
+ loading-png height>> pass adam7-subimage-height :> height
+ loading-png width>> pass adam7-subimage-width :> width
+
+ height width * zero? [
+ B{ } clone
+ ] [
+ bit-reader loading-png width height read-scanlines
+ ] if ;
+
+:: reverse-interlace-adam7 ( byte-array loading-png -- byte-array )
+ byte-array bs:<msb0-bit-reader> :> bs
+ loading-png height>> :> height
+ loading-png width>> :> width
+ loading-png bit-depth>> :> bit-depth
+ loading-png png-components-per-pixel :> #bytes!
+ width height * f <array> width <sliced-groups> :> image
+
+ bit-depth 16 = [
+ #bytes 2 * #bytes!
+ ] when
+
+ 0 :> row!
+ 0 :> col!
+
+ 0 :> pass!
+ [ pass 7 < ] [
+ bs loading-png pass read-adam7-subimage
+
+ #bytes <sliced-groups>
+
+ pass starting-row nth row!
+ pass starting-col nth col!
+ [
+ [ row col f f ] dip image visit
+
+ col pass col-increment nth + col!
+ col width >= [
+ pass starting-col nth col!
+ row pass row-increment nth + row!
+ ] when
+ ] each
+
+ pass 1 + pass!
+ ] while
+ image concat B{ } concat-as ;
+
+ERROR: unimplemented-interlace ;
+
+: uncompress-bytes ( loading-png -- bitstream )
+ [ inflate-data ] [ ] [ interlace-method>> ] tri {
+ { interlace-none [ reverse-interlace-none ] }
+ { interlace-adam7 [ reverse-interlace-adam7 ] }
+ [ unimplemented-interlace ]
+ } case ;
+
+ERROR: unknown-component-type n ;
+
+: png-component ( loading-png -- obj )
+ bit-depth>> {
+ { 1 [ ubyte-components ] }
+ { 2 [ ubyte-components ] }
+ { 4 [ ubyte-components ] }
+ { 8 [ ubyte-components ] }
+ { 16 [ ushort-components ] }
+ [ unknown-component-type ]
+ } case ;
+
+: scale-factor ( n -- n' )
+ {
+ { 1 [ 255 ] }
+ { 2 [ 85 ] }
+ { 4 [ 17 ] }
+ } case ;
+
+: scale-greyscale ( byte-array loading-png -- byte-array' )
+ bit-depth>> {
+ { 8 [ ] }
+ { 16 [ 2 group [ swap ] assoc-map B{ } concat-as ] }
+ [ scale-factor '[ _ * ] B{ } map-as ]
+ } case ;
+
+: decode-greyscale ( loading-png -- byte-array )
+ [ uncompress-bytes ] keep scale-greyscale ;
+
+: decode-greyscale-alpha ( loading-image -- byte-array )
+ [ uncompress-bytes ] [ bit-depth>> ] bi 16 = [
+ 4 group [ first4 [ swap ] 2dip 4array ] map B{ } concat-as
+ ] when ;
+
+ERROR: invalid-PLTE array ;
+
+: verify-PLTE ( seq -- seq )
+ dup length 3 divisor? [ invalid-PLTE ] unless ;
+
+: decode-indexed-color ( loading-image -- byte-array )
+ [ uncompress-bytes ] keep
+ "PLTE" find-chunk data>> verify-PLTE
+ 3 group '[ _ nth ] { } map-as B{ } concat-as ;
+
+ERROR: invalid-color-type/bit-depth loading-png ;
+
+: validate-bit-depth ( loading-png seq -- loading-png )
+ [ dup bit-depth>> ] dip member?
+ [ invalid-color-type/bit-depth ] unless ;
+
+: validate-greyscale ( loading-png -- loading-png )
+ { 1 2 4 8 16 } validate-bit-depth ;
+
+: validate-truecolor ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
+
+: validate-indexed-color ( loading-png -- loading-png )
+ { 1 2 4 8 } validate-bit-depth ;
+
+: validate-greyscale-alpha ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
+
+: validate-truecolor-alpha ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
+
+: loading-png>bitmap ( loading-png -- bytes component-order )
+ dup color-type>> {
+ { greyscale [
+ validate-greyscale decode-greyscale L
+ ] }
+ { truecolor [
+ validate-truecolor uncompress-bytes RGB
+ ] }
+ { indexed-color [
+ validate-indexed-color decode-indexed-color RGB
+ ] }
+ { greyscale-alpha [
+ validate-greyscale-alpha decode-greyscale-alpha LA
+ ] }
+ { truecolor-alpha [
+ validate-truecolor-alpha uncompress-bytes RGBA
+ ] }
+ [ unknown-color-type ]
+ } case ;
+
+: loading-png>image ( loading-png -- image )
+ [ image new ] dip {
+ [ loading-png>bitmap [ >>bitmap ] [ >>component-order ] bi* ]
+ [ [ width>> ] [ height>> ] bi 2array >>dim ]
+ [ png-component >>component-type ]
+ } cleave ;
+
+: load-png ( stream -- loading-png )
+ [
+ [
+ <loading-png>
+ read-png-header
+ read-png-chunks
+ parse-ihdr-chunk
+ ] throw-on-eof
+ ] with-input-stream ;
+
+M: png-image stream>image
+ drop load-png loading-png>image ;
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing ;
+IN: images.ppm.tests
+
+"vocab:images/testing/ppm/binary.ppm" decode-test
+"vocab:images/testing/ppm/ascii.ppm" decode-test
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors ascii combinators images images.loader io
+io.encodings.ascii io.encodings.string kernel locals make math
+math.parser sequences io.streams.throwing ;
+IN: images.ppm
+
+SINGLETON: ppm-image
+"ppm" ppm-image register-image-class
+
+: read-token ( -- token )
+ [ read1 dup blank?
+ [ t ]
+ [ dup CHAR: # =
+ [ "\n" read-until 2drop t ]
+ [ f ] if
+ ] if
+ ] [ drop ] while
+ " \n\r\t" read-until drop swap
+ prefix ascii decode ;
+
+: read-number ( -- number )
+ read-token string>number ;
+
+:: read-numbers ( n lim -- )
+ n lim = [
+ read-number ,
+ n 1 + lim read-numbers
+ ] unless ;
+
+:: read-ppm ( -- image )
+ read-token :> type
+ read-number :> width
+ read-number :> height
+ read-number :> max
+ width height 3 * * :> npixels
+ type {
+ { "P3" [ [ 0 npixels read-numbers ] B{ } make ] }
+ { "P6" [ npixels read ] }
+ } case :> data
+
+ image new
+ RGB >>component-order
+ { width height } >>dim
+ f >>upside-down?
+ data >>bitmap
+ ubyte-components >>component-type ;
+
+M: ppm-image stream>image
+ drop [ [ read-ppm ] throw-on-eof ] with-input-stream ;
+
+M: ppm-image image>stream
+ drop {
+ [ drop "P6\n" ascii encode write ]
+ [ dim>> first number>string " " append ascii encode write ]
+ [ dim>> second number>string "\n" append ascii encode write ]
+ [ drop "255\n" ascii encode write ]
+ [ bitmap>> write ]
+ } cleave ;
--- /dev/null
+Image loading for PPM image files.
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors images images.loader io io.binary kernel
+locals math sequences io.encodings.ascii io.encodings.string
+calendar math.ranges math.parser colors arrays hashtables
+ui.pixel-formats combinators continuations io.streams.throwing ;
+IN: images.tga
+
+SINGLETON: tga-image
+"tga" tga-image register-image-class
+
+ERROR: bad-tga-header ;
+ERROR: bad-tga-footer ;
+ERROR: bad-tga-extension-size ;
+ERROR: bad-tga-timestamp ;
+ERROR: bad-tga-unsupported ;
+
+: read-id-length ( -- byte )
+ 1 read le> ; inline
+
+: read-color-map-type ( -- byte )
+ 1 read le> dup
+ { 0 1 } member? [ bad-tga-header ] unless ;
+
+: read-image-type ( -- byte )
+ 1 read le> dup
+ { 0 1 2 3 9 10 11 } member? [ bad-tga-header ] unless ; inline
+
+: read-color-map-first ( -- short )
+ 2 read le> ; inline
+
+: read-color-map-length ( -- short )
+ 2 read le> ; inline
+
+: read-color-map-entry-size ( -- byte )
+ 1 read le> ; inline
+
+: read-x-origin ( -- short )
+ 2 read le> ; inline
+
+: read-y-origin ( -- short )
+ 2 read le> ; inline
+
+: read-image-width ( -- short )
+ 2 read le> ; inline
+
+: read-image-height ( -- short )
+ 2 read le> ; inline
+
+: read-pixel-depth ( -- byte )
+ 1 read le> ; inline
+
+: read-image-descriptor ( -- alpha-bits pixel-order )
+ 1 read le>
+ [ 7 bitand ] [ 24 bitand -3 shift ] bi ; inline
+
+: read-image-id ( length -- image-id )
+ read ; inline
+
+: read-color-map ( type length elt-size -- color-map )
+ pick 1 = [ 8 align 8 / * read ] [ 2drop f ] if swap drop ; inline
+
+: read-image-data ( width height depth -- image-data )
+ 8 align 8 / * * read ; inline
+
+: read-extension-area-offset ( -- offset )
+ 4 read le> ; inline
+
+: read-developer-directory-offset ( -- offset )
+ 4 read le> ; inline
+
+: read-signature ( -- )
+ 18 read ascii decode "TRUEVISION-XFILE.\0" = [ bad-tga-footer ] unless ; inline
+
+: read-extension-size ( -- )
+ 2 read le> 495 = [ bad-tga-extension-size ] unless ; inline
+
+: read-author-name ( -- string )
+ 41 read ascii decode [ 0 = ] trim ; inline
+
+: read-author-comments ( -- string )
+ 4 iota [ drop 81 read ascii decode [ 0 = ] trim ] map concat ; inline
+
+: read-date-timestamp ( -- timestamp )
+ timestamp new
+ 2 read le> dup 12 [1,b] member? [ bad-tga-timestamp ] unless >>month
+ 2 read le> dup 31 [1,b] member? [ bad-tga-timestamp ] unless >>day
+ 2 read le> >>year
+ 2 read le> dup 23 [0,b] member? [ bad-tga-timestamp ] unless >>hour
+ 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute
+ 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline
+
+: read-job-name ( -- string )
+ 41 read ascii decode [ 0 = ] trim ; inline
+
+: read-job-time ( -- duration )
+ duration new
+ 2 read le> >>hour
+ 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute
+ 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline
+
+: read-software-id ( -- string )
+ 41 read ascii decode [ 0 = ] trim ; inline
+
+: read-software-version ( -- string )
+ 2 read le> 100 /f number>string
+ 1 read ascii decode append [ " " = ] trim ; inline
+
+:: read-key-color ( -- color )
+ 1 read le> 255 /f :> alpha
+ 1 read le> 255 /f
+ 1 read le> 255 /f
+ 1 read le> 255 /f
+ alpha <rgba> ; inline
+
+: read-pixel-aspect-ratio ( -- aspect-ratio )
+ 2 read le> 2 read le> /f ; inline
+
+: read-gamma-value ( -- gamma-value )
+ 2 read le> 2 read le> /f ; inline
+
+: read-color-correction-offset ( -- offset )
+ 4 read le> ; inline
+
+: read-postage-stamp-offset ( -- offset )
+ 4 read le> ; inline
+
+: read-scan-line-offset ( -- offset )
+ 4 read le> ; inline
+
+: read-premultiplied-alpha ( -- boolean )
+ 1 read le> 4 = ; inline
+
+: read-scan-line-table ( height -- scan-offsets )
+ iota [ drop 4 read le> ] map ; inline
+
+: read-postage-stamp-image ( depth -- postage-data )
+ 8 align 8 / 1 read le> 1 read le> * * read ; inline
+
+:: read-color-correction-table ( -- correction-table )
+ 256 iota
+ [
+ drop
+ 4 iota
+ [
+ drop
+ 2 read le> 65535 /f :> alpha
+ 2 read le> 65535 /f
+ 2 read le> 65535 /f
+ 2 read le> 65535 /f
+ alpha <rgba>
+ ] map
+ ] map ; inline
+
+: read-developer-directory ( -- developer-directory )
+ 2 read le> iota
+ [
+ drop
+ 2 read le>
+ 4 read le>
+ 4 read le>
+ 3array
+ ] map ; inline
+
+: read-developer-areas ( developer-directory -- developer-area-map )
+ [
+ [ first ]
+ [ dup third second seek-absolute seek-input read ] bi 2array
+ ] map >hashtable ; inline
+
+:: read-tga ( -- image )
+ #! Read header
+ read-id-length :> id-length
+ read-color-map-type :> map-type
+ read-image-type :> image-type
+ read-color-map-first :> map-first
+ read-color-map-length :> map-length
+ read-color-map-entry-size :> map-entry-size
+ read-x-origin :> x-origin
+ read-y-origin :> y-origin
+ read-image-width :> image-width
+ read-image-height :> image-height
+ read-pixel-depth :> pixel-depth
+ read-image-descriptor :> ( alpha-bits pixel-order )
+ id-length read-image-id :> image-id
+ map-type map-length map-entry-size read-color-map :> color-map-data
+ image-width image-height pixel-depth read-image-data :> image-data
+
+ [
+ #! Read optional footer
+ 26 seek-end seek-input
+ read-extension-area-offset :> extension-offset
+ read-developer-directory-offset :> directory-offset
+ read-signature
+
+ #! Read optional extension section
+ extension-offset 0 =
+ [
+ extension-offset seek-absolute seek-input
+ read-extension-size
+ read-author-name :> author-name
+ read-author-comments :> author-comments
+ read-date-timestamp :> date-timestamp
+ read-job-name :> job-name
+ read-job-time :> job-time
+ read-software-id :> software-id
+ read-software-version :> software-version
+ read-key-color :> key-color
+ read-pixel-aspect-ratio :> aspect-ratio
+ read-gamma-value :> gamma-value
+ read-color-correction-offset :> color-correction-offset
+ read-postage-stamp-offset :> postage-stamp-offset
+ read-scan-line-offset :> scan-line-offset
+ read-premultiplied-alpha :> premultiplied-alpha
+
+ color-correction-offset 0 =
+ [
+ color-correction-offset seek-absolute seek-input
+ read-color-correction-table :> color-correction-table
+ ] unless
+
+ postage-stamp-offset 0 =
+ [
+ postage-stamp-offset seek-absolute seek-input
+ pixel-depth read-postage-stamp-image :> postage-data
+ ] unless
+
+ scan-line-offset seek-absolute seek-input
+ image-height read-scan-line-table :> scan-offsets
+
+ #! Read optional developer section
+ directory-offset 0 =
+ [ f ]
+ [
+ directory-offset seek-absolute seek-input
+ read-developer-directory read-developer-areas
+ ] if :> developer-areas
+ ] unless
+ ] ignore-errors
+
+ #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported.
+ #! Other formats would need to be converted to work within the image class.
+ map-type 0 = [ bad-tga-unsupported ] unless
+ image-type 2 = [ bad-tga-unsupported ] unless
+ pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless
+ pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless
+
+ #! Create image instance
+ image new
+ alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order
+ { image-width image-height } >>dim
+ pixel-order 0 = >>upside-down?
+ image-data >>bitmap
+ ubyte-components >>component-type ;
+
+M: tga-image stream>image
+ drop [ [ read-tga ] throw-on-eof ] with-input-stream ;
+
+M: tga-image image>stream
+ drop
+ [
+ component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless
+ ] keep
+
+ B{ 0 } write #! id-length
+ B{ 0 } write #! map-type
+ B{ 2 } write #! image-type
+ B{ 0 0 0 0 0 } write #! color map first, length, entry size
+ B{ 0 0 0 0 } write #! x-origin, y-origin
+ {
+ [ dim>> first 2 >le write ]
+ [ dim>> second 2 >le write ]
+ [ component-order>>
+ {
+ { BGR [ B{ 24 } write ] }
+ { BGRA [ B{ 32 } write ] }
+ } case
+ ]
+ [
+ dup component-order>>
+ {
+ { BGR [ 0 ] }
+ { BGRA [ 8 ] }
+ } case swap
+ upside-down?>> [ 0 ] [ 2 ] if 3 shift bitor
+ 1 >le write
+ ]
+ [ bitmap>> write ]
+ } cleave ;
+
--- /dev/null
+Doug Coleman
--- /dev/null
+TIFF image loader
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing ;
+IN: images.tiff.tests
+
+"vocab:images/testing/tiff/octagon.tiff" decode-test
+! "vocab:images/testing/tiff/elephants.tiff" decode-test
+"vocab:images/testing/tiff/noise.tiff" decode-test
+"vocab:images/testing/tiff/alpha.tiff" decode-test
+"vocab:images/testing/tiff/color_spectrum.tiff" decode-test
+"vocab:images/testing/tiff/rgb.tiff" decode-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs byte-arrays classes combinators
+compression.lzw endian fry grouping images io
+io.binary io.encodings.ascii io.encodings.binary
+io.encodings.string io.encodings.utf8 io.files kernel math
+math.bitwise math.order math.parser pack sequences
+strings math.vectors specialized-arrays locals
+images.loader io.streams.throwing ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+IN: images.tiff
+
+SINGLETON: tiff-image
+
+TUPLE: loading-tiff endianness the-answer ifd-offset ifds ;
+
+: <loading-tiff> ( -- tiff )
+ loading-tiff new V{ } clone >>ifds ;
+
+TUPLE: ifd count ifd-entries next
+processed-tags strips bitmap ;
+
+: <ifd> ( count ifd-entries next -- ifd )
+ ifd new
+ swap >>next
+ swap >>ifd-entries
+ swap >>count ;
+
+TUPLE: ifd-entry tag type count offset/value ;
+
+: <ifd-entry> ( tag type count offset/value -- ifd-entry )
+ ifd-entry new
+ swap >>offset/value
+ swap >>count
+ swap >>type
+ swap >>tag ;
+
+SINGLETONS: photometric-interpretation
+photometric-interpretation-white-is-zero
+photometric-interpretation-black-is-zero
+photometric-interpretation-rgb
+photometric-interpretation-palette-color
+photometric-interpretation-transparency-mask
+photometric-interpretation-separated
+photometric-interpretation-ycbcr
+photometric-interpretation-cielab
+photometric-interpretation-icclab
+photometric-interpretation-itulab
+photometric-interpretation-logl
+photometric-interpretation-logluv ;
+
+ERROR: bad-photometric-interpretation n ;
+: lookup-photometric-interpretation ( n -- singleton )
+ {
+ { 0 [ photometric-interpretation-white-is-zero ] }
+ { 1 [ photometric-interpretation-black-is-zero ] }
+ { 2 [ photometric-interpretation-rgb ] }
+ { 3 [ photometric-interpretation-palette-color ] }
+ { 4 [ photometric-interpretation-transparency-mask ] }
+ { 5 [ photometric-interpretation-separated ] }
+ { 6 [ photometric-interpretation-ycbcr ] }
+ { 8 [ photometric-interpretation-cielab ] }
+ { 9 [ photometric-interpretation-icclab ] }
+ { 10 [ photometric-interpretation-itulab ] }
+ { 32844 [ photometric-interpretation-logl ] }
+ { 32845 [ photometric-interpretation-logluv ] }
+ [ bad-photometric-interpretation ]
+ } case ;
+
+SINGLETONS: compression
+compression-none
+compression-CCITT-2
+compression-CCITT-3
+compression-CCITT-4
+compression-lzw
+compression-jpeg-old
+compression-jpeg-new
+compression-adobe-deflate
+compression-9
+compression-10
+compression-deflate
+compression-next
+compression-ccittrlew
+compression-pack-bits
+compression-thunderscan
+compression-it8ctpad
+compression-it8lw
+compression-it8mp
+compression-it8bl
+compression-pixarfilm
+compression-pixarlog
+compression-dcs
+compression-jbig
+compression-sgilog
+compression-sgilog24
+compression-jp2000 ;
+ERROR: bad-compression n ;
+: lookup-compression ( n -- compression )
+ {
+ { 1 [ compression-none ] }
+ { 2 [ compression-CCITT-2 ] }
+ { 3 [ compression-CCITT-3 ] }
+ { 4 [ compression-CCITT-4 ] }
+ { 5 [ compression-lzw ] }
+ { 6 [ compression-jpeg-old ] }
+ { 7 [ compression-jpeg-new ] }
+ { 8 [ compression-adobe-deflate ] }
+ { 9 [ compression-9 ] }
+ { 10 [ compression-10 ] }
+ { 32766 [ compression-next ] }
+ { 32771 [ compression-ccittrlew ] }
+ { 32773 [ compression-pack-bits ] }
+ { 32809 [ compression-thunderscan ] }
+ { 32895 [ compression-it8ctpad ] }
+ { 32896 [ compression-it8lw ] }
+ { 32897 [ compression-it8mp ] }
+ { 32898 [ compression-it8bl ] }
+ { 32908 [ compression-pixarfilm ] }
+ { 32909 [ compression-pixarlog ] }
+ { 32946 [ compression-deflate ] }
+ { 32947 [ compression-dcs ] }
+ { 34661 [ compression-jbig ] }
+ { 34676 [ compression-sgilog ] }
+ { 34677 [ compression-sgilog24 ] }
+ { 34712 [ compression-jp2000 ] }
+ [ bad-compression ]
+ } case ;
+
+SINGLETONS: resolution-unit
+resolution-unit-none
+resolution-unit-inch
+resolution-unit-centimeter ;
+ERROR: bad-resolution-unit n ;
+: lookup-resolution-unit ( n -- object )
+ {
+ { 1 [ resolution-unit-none ] }
+ { 2 [ resolution-unit-inch ] }
+ { 3 [ resolution-unit-centimeter ] }
+ [ bad-resolution-unit ]
+ } case ;
+
+SINGLETONS: predictor
+predictor-none
+predictor-horizontal-differencing ;
+ERROR: bad-predictor n ;
+: lookup-predictor ( n -- object )
+ {
+ { 1 [ predictor-none ] }
+ { 2 [ predictor-horizontal-differencing ] }
+ [ bad-predictor ]
+ } case ;
+
+SINGLETONS: planar-configuration
+planar-configuration-chunky
+planar-configuration-planar ;
+ERROR: bad-planar-configuration n ;
+: lookup-planar-configuration ( n -- object )
+ {
+ { 1 [ planar-configuration-chunky ] }
+ { 2 [ planar-configuration-planar ] }
+ [ bad-planar-configuration ]
+ } case ;
+
+SINGLETONS: sample-format
+sample-format-none
+sample-format-unsigned-integer
+sample-format-signed-integer
+sample-format-ieee-float
+sample-format-undefined-data ;
+ERROR: bad-sample-format n ;
+: lookup-sample-format ( sequence -- object )
+ [
+ {
+ { 0 [ sample-format-none ] }
+ { 1 [ sample-format-unsigned-integer ] }
+ { 2 [ sample-format-signed-integer ] }
+ { 3 [ sample-format-ieee-float ] }
+ { 4 [ sample-format-undefined-data ] }
+ [ bad-sample-format ]
+ } case
+ ] map ;
+
+SINGLETONS: extra-samples
+extra-samples-unspecified-alpha-data
+extra-samples-associated-alpha-data
+extra-samples-unassociated-alpha-data ;
+ERROR: bad-extra-samples n ;
+: lookup-extra-samples ( sequence -- object )
+ {
+ { 0 [ extra-samples-unspecified-alpha-data ] }
+ { 1 [ extra-samples-associated-alpha-data ] }
+ { 2 [ extra-samples-unassociated-alpha-data ] }
+ [ bad-extra-samples ]
+ } case ;
+
+SINGLETONS: image-length image-width x-resolution y-resolution
+rows-per-strip strip-offsets strip-byte-counts bits-per-sample
+samples-per-pixel new-subfile-type subfile-type orientation
+software date-time photoshop exif-ifd sub-ifd inter-color-profile
+xmp iptc fill-order document-name page-number page-name
+x-position y-position host-computer copyright artist
+min-sample-value max-sample-value tiff-make tiff-model cell-width cell-length
+gray-response-unit gray-response-curve color-map threshholding
+image-description free-offsets free-byte-counts tile-width tile-length
+matteing data-type image-depth tile-depth
+ycbcr-subsampling gdal-metadata
+tile-offsets tile-byte-counts jpeg-qtables jpeg-dctables jpeg-actables
+ycbcr-positioning ycbcr-coefficients reference-black-white halftone-hints
+jpeg-interchange-format
+jpeg-interchange-format-length
+jpeg-restart-interval jpeg-tables
+t4-options clean-fax-data bad-fax-lines consecutive-bad-fax-lines
+sto-nits print-image-matching-info
+unhandled-ifd-entry ;
+
+SINGLETONS: jpeg-proc
+jpeg-proc-baseline
+jpeg-proc-lossless ;
+
+ERROR: bad-jpeg-proc n ;
+
+: lookup-jpeg-proc ( sequence -- object )
+ {
+ { 1 [ jpeg-proc-baseline ] }
+ { 14 [ jpeg-proc-lossless ] }
+ [ bad-jpeg-proc ]
+ } case ;
+
+ERROR: bad-tiff-magic bytes ;
+: tiff-endianness ( byte-array -- ? )
+ {
+ { B{ CHAR: M CHAR: M } [ big-endian ] }
+ { B{ CHAR: I CHAR: I } [ little-endian ] }
+ [ bad-tiff-magic ]
+ } case ;
+
+: read-header ( tiff -- tiff )
+ 2 read tiff-endianness [ >>endianness ] keep
+ [
+ 2 read endian> >>the-answer
+ 4 read endian> >>ifd-offset
+ ] with-endianness ;
+
+: push-ifd ( tiff ifd -- tiff ) over ifds>> push ;
+
+: read-ifd ( -- ifd )
+ 2 read endian>
+ 2 read endian>
+ 4 read endian>
+ 4 read endian> <ifd-entry> ;
+
+: read-ifds ( tiff offset -- tiff )
+ seek-absolute seek-input
+ 2 read endian>
+ dup [ read-ifd ] replicate
+ 4 read endian>
+ [ <ifd> push-ifd ] [ dup 0 = [ drop ] [ read-ifds ] if ] bi ;
+
+ERROR: no-tag class ;
+
+: find-tag* ( ifd class -- tag/class ? )
+ swap processed-tags>> ?at ;
+
+: find-tag ( ifd class -- tag )
+ find-tag* [ no-tag ] unless ;
+
+: tag? ( ifd class -- tag )
+ swap processed-tags>> key? ;
+
+: read-strips ( ifd -- ifd )
+ dup
+ [ strip-byte-counts find-tag ]
+ [ strip-offsets find-tag ] bi
+ 2dup [ integer? ] both? [
+ seek-absolute seek-input read 1array
+ ] [
+ [ seek-absolute seek-input read ] { } 2map-as
+ ] if >>strips ;
+
+ERROR: unknown-ifd-type n ;
+
+: bytes>bits ( n/byte-array -- n )
+ dup byte-array? [ byte-array>bignum ] when ;
+
+: value-length ( ifd-entry -- n )
+ [ count>> ] [ type>> ] bi {
+ { 1 [ ] }
+ { 2 [ ] }
+ { 3 [ 2 * ] }
+ { 4 [ 4 * ] }
+ { 5 [ 8 * ] }
+ { 6 [ ] }
+ { 7 [ ] }
+ { 8 [ 2 * ] }
+ { 9 [ 4 * ] }
+ { 10 [ 8 * ] }
+ { 11 [ 4 * ] }
+ { 12 [ 8 * ] }
+ { 13 [ 4 * ] }
+ [ unknown-ifd-type ]
+ } case ;
+
+ERROR: bad-small-ifd-type n ;
+
+: adjust-offset/value ( ifd-entry -- obj )
+ [ offset/value>> 4 >endian ] [ type>> ] bi
+ {
+ { 1 [ 1 head endian> ] }
+ { 3 [ 2 head endian> ] }
+ { 4 [ endian> ] }
+ { 6 [ 1 head endian> 8 >signed ] }
+ { 8 [ 2 head endian> 16 >signed ] }
+ { 9 [ endian> 32 >signed ] }
+ { 11 [ endian> bits>float ] }
+ { 13 [ endian> 32 >signed ] }
+ [ bad-small-ifd-type ]
+ } case ;
+
+: offset-bytes>obj ( bytes type -- obj )
+ {
+ { 1 [ ] } ! blank
+ { 2 [ ] } ! read c strings here
+ { 3 [ 2 <sliced-groups> [ endian> ] map ] }
+ { 4 [ 4 <sliced-groups> [ endian> ] map ] }
+ { 5 [ 8 <sliced-groups> [ "II" unpack first2 / ] map ] }
+ { 6 [ [ 8 >signed ] map ] }
+ { 7 [ ] } ! blank
+ { 8 [ 2 <sliced-groups> [ endian> 16 >signed ] map ] }
+ { 9 [ 4 <sliced-groups> [ endian> 32 >signed ] map ] }
+ { 10 [ 8 group [ "ii" unpack first2 / ] map ] }
+ { 11 [ 4 group [ "f" unpack ] map ] }
+ { 12 [ 8 group [ "d" unpack ] map ] }
+ [ unknown-ifd-type ]
+ } case ;
+
+: ifd-entry-value ( ifd-entry -- n )
+ dup value-length 4 <= [
+ adjust-offset/value
+ ] [
+ [ offset/value>> seek-absolute seek-input ]
+ [ value-length read ]
+ [ type>> ] tri offset-bytes>obj
+ ] if ;
+
+: process-ifd-entry ( ifd-entry -- value class )
+ [ ifd-entry-value ] [ tag>> ] bi {
+ { 254 [ new-subfile-type ] }
+ { 255 [ subfile-type ] }
+ { 256 [ image-width ] }
+ { 257 [ image-length ] }
+ { 258 [ bits-per-sample ] }
+ { 259 [ lookup-compression compression ] }
+ { 262 [ lookup-photometric-interpretation photometric-interpretation ] }
+ { 263 [ threshholding ] }
+ { 264 [ cell-width ] }
+ { 265 [ cell-length ] }
+ { 266 [ fill-order ] }
+ { 269 [ ascii decode document-name ] }
+ { 270 [ ascii decode image-description ] }
+ { 271 [ ascii decode tiff-make ] }
+ { 272 [ ascii decode tiff-model ] }
+ { 273 [ strip-offsets ] }
+ { 274 [ orientation ] }
+ { 277 [ samples-per-pixel ] }
+ { 278 [ rows-per-strip ] }
+ { 279 [ strip-byte-counts ] }
+ { 280 [ min-sample-value ] }
+ { 281 [ max-sample-value ] }
+ { 282 [ first x-resolution ] }
+ { 283 [ first y-resolution ] }
+ { 284 [ lookup-planar-configuration planar-configuration ] }
+ { 285 [ page-name ] }
+ { 286 [ x-position ] }
+ { 287 [ y-position ] }
+ { 288 [ free-offsets ] }
+ { 289 [ free-byte-counts ] }
+ { 290 [ gray-response-unit ] }
+ { 291 [ gray-response-curve ] }
+ { 292 [ t4-options ] }
+ { 296 [ lookup-resolution-unit resolution-unit ] }
+ { 297 [ page-number ] }
+ { 305 [ ascii decode software ] }
+ { 306 [ ascii decode date-time ] }
+ { 315 [ ascii decode artist ] }
+ { 316 [ ascii decode host-computer ] }
+ { 317 [ lookup-predictor predictor ] }
+ { 320 [ color-map ] }
+ { 321 [ halftone-hints ] }
+ { 322 [ tile-width ] }
+ { 323 [ tile-length ] }
+ { 324 [ tile-offsets ] }
+ { 325 [ tile-byte-counts ] }
+ { 326 [ bad-fax-lines ] }
+ { 327 [ clean-fax-data ] }
+ { 328 [ consecutive-bad-fax-lines ] }
+ { 330 [ sub-ifd ] }
+ { 338 [ lookup-extra-samples extra-samples ] }
+ { 339 [ lookup-sample-format sample-format ] }
+ { 347 [ jpeg-tables ] }
+ { 512 [ lookup-jpeg-proc jpeg-proc ] }
+ { 513 [ jpeg-interchange-format ] }
+ { 514 [ jpeg-interchange-format-length ] }
+ { 515 [ jpeg-restart-interval ] }
+ { 519 [ jpeg-qtables ] }
+ { 520 [ jpeg-dctables ] }
+ { 521 [ jpeg-actables ] }
+ { 529 [ ycbcr-coefficients ] }
+ { 530 [ ycbcr-subsampling ] }
+ { 531 [ ycbcr-positioning ] }
+ { 532 [ reference-black-white ] }
+ { 700 [ utf8 decode xmp ] }
+ { 32995 [ matteing ] }
+ { 32996 [ data-type ] }
+ { 32997 [ image-depth ] }
+ { 32998 [ tile-depth ] }
+ { 33432 [ copyright ] }
+ { 33723 [ iptc ] }
+ { 34377 [ photoshop ] }
+ { 34665 [ exif-ifd ] }
+ { 34675 [ inter-color-profile ] }
+ { 37439 [ sto-nits ] }
+ { 42112 [ gdal-metadata ] }
+ { 50341 [ print-image-matching-info ] }
+ [ nip unhandled-ifd-entry swap ]
+ } case ;
+
+: process-ifds ( loading-tiff -- loading-tiff )
+ [
+ [
+ dup ifd-entries>>
+ [ process-ifd-entry swap ] H{ } map>assoc >>processed-tags
+ ] map
+ ] change-ifds ;
+
+ERROR: unhandled-compression compression ;
+
+: (uncompress-strips) ( strips compression -- uncompressed-strips )
+ {
+ { compression-none [ ] }
+ { compression-lzw [ [ tiff-lzw-uncompress ] map ] }
+ [ unhandled-compression ]
+ } case ;
+
+: uncompress-strips ( ifd -- ifd )
+ dup '[
+ _ compression find-tag (uncompress-strips)
+ ] change-strips ;
+
+: strips>bitmap ( ifd -- ifd )
+ dup strips>> concat >>bitmap ;
+
+: (strips-predictor) ( ifd -- ifd )
+ [ ]
+ [ image-width find-tag ]
+ [ samples-per-pixel find-tag ] tri
+ [ * ] keep
+ '[
+ _ group
+ [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
+ B{ } concat-as
+ ] change-bitmap ;
+
+: strips-predictor ( ifd -- ifd )
+ dup predictor tag? [
+ dup predictor find-tag
+ {
+ { predictor-none [ ] }
+ { predictor-horizontal-differencing [ (strips-predictor) ] }
+ [ bad-predictor ]
+ } case
+ ] when ;
+
+ERROR: unknown-component-order ifd ;
+
+: fix-bitmap-endianness ( ifd -- ifd )
+ dup [ bitmap>> ] [ bits-per-sample find-tag ] bi
+ {
+ { { 32 32 32 32 } [ 4 seq>native-endianness ] }
+ { { 32 32 32 } [ 4 seq>native-endianness ] }
+ { { 16 16 16 16 } [ 2 seq>native-endianness ] }
+ { { 16 16 16 } [ 2 seq>native-endianness ] }
+ { { 8 8 8 8 } [ ] }
+ { { 8 8 8 } [ ] }
+ { 8 [ ] }
+ [ unknown-component-order ]
+ } case >>bitmap ;
+
+: ifd-component-order ( ifd -- component-order component-type )
+ bits-per-sample find-tag {
+ { { 32 32 32 32 } [ RGBA float-components ] }
+ { { 32 32 32 } [ RGB float-components ] }
+ { { 16 16 16 16 } [ RGBA ushort-components ] }
+ { { 16 16 16 } [ RGB ushort-components ] }
+ { { 8 8 8 8 } [ RGBA ubyte-components ] }
+ { { 8 8 8 } [ RGB ubyte-components ] }
+ { 8 [ LA ubyte-components ] }
+ [ unknown-component-order ]
+ } case ;
+
+: handle-alpha-data ( ifd -- ifd )
+ dup extra-samples find-tag {
+ { extra-samples-associated-alpha-data [ ] }
+ { extra-samples-unspecified-alpha-data [ ] }
+ { extra-samples-unassociated-alpha-data [ ] }
+ [ bad-extra-samples ]
+ } case ;
+
+: ifd>image ( ifd -- image )
+ [ <image> ] dip {
+ [ [ image-width find-tag ] [ image-length find-tag ] bi 2array >>dim ]
+ [ ifd-component-order [ >>component-order ] [ >>component-type ] bi* ]
+ [ bitmap>> >>bitmap ]
+ } cleave ;
+
+: tiff>image ( image -- image )
+ ifds>> [ ifd>image ] map first ;
+
+: with-tiff-endianness ( loading-tiff quot -- )
+ [ dup endianness>> ] dip with-endianness ; inline
+
+: load-tiff-ifds ( -- loading-tiff )
+ <loading-tiff>
+ read-header [
+ dup ifd-offset>> read-ifds
+ process-ifds
+ ] with-tiff-endianness ;
+
+: process-chunky-ifd ( ifd -- )
+ read-strips
+ uncompress-strips
+ strips>bitmap
+ fix-bitmap-endianness
+ strips-predictor
+ dup extra-samples tag? [ handle-alpha-data ] when
+ drop ;
+
+: process-planar-ifd ( ifd -- )
+ "planar ifd not supported" throw ;
+
+: dispatch-planar-configuration ( ifd planar-configuration -- )
+ {
+ { planar-configuration-chunky [ process-chunky-ifd ] }
+ { planar-configuration-planar [ process-planar-ifd ] }
+ } case ;
+
+: process-ifd ( ifd -- )
+ dup planar-configuration find-tag* [
+ dispatch-planar-configuration
+ ] [
+ drop "no planar configuration" throw
+ ] if ;
+
+: process-tif-ifds ( loading-tiff -- )
+ ifds>> [ process-ifd ] each ;
+
+: load-tiff ( -- loading-tiff )
+ load-tiff-ifds dup
+ 0 seek-absolute seek-input
+ [ process-tif-ifds ] with-tiff-endianness ;
+
+! tiff files can store several images -- we just take the first for now
+M: tiff-image stream>image ( stream tiff-image -- image )
+ drop [ [ load-tiff tiff>image ] throw-on-eof ] with-input-stream ;
+
+{ "tif" "tiff" } [ tiff-image register-image-class ] each
index-buffer index-count vertex-format texture bump ka ;
: white-image ( -- image )
- { 1 1 } BGR ubyte-components f
- B{ 255 255 255 } image boa ;
+ <image>
+ { 1 1 } >>dim
+ BGR >>component-order
+ ubyte-components >>component-type
+ B{ 255 255 255 } >>bitmap ;
: up-image ( -- image )
- { 1 1 } BGR ubyte-components f
- B{ 0 0 0 } image boa ;
+ <image>
+ { 1 1 } >>dim
+ BGR >>component-order
+ ubyte-components >>component-type
+ B{ 0 0 0 } >>bitmap ;
: make-texture ( pathname alt -- texture )
swap [ nip load-image ] [ ] if*
--- /dev/null
+Maximilian Lupke
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Maximilian Lupke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays help.markup help.syntax kernel strings ;
+IN: semantic-versioning
+
+HELP: split-version
+{ $values
+ { "string" string }
+ { "array" array }
+}
+{ $description "Splits the version string into a sequnece of major version, minor version, patch level and an alphanumeric identifier if given. See " { $url "http://semver.org/" } " for a detailed description." } ;
+
+HELP: version<
+{ $values
+ { "version1" string } { "version2" string }
+ { "?" boolean }
+} ;
+
+HELP: version<=
+{ $values
+ { "version1" string } { "version2" string }
+ { "?" boolean }
+} ;
+
+HELP: version<=>
+{ $values
+ { "version1" string } { "version2" string }
+ { "<=>" string }
+} ;
+
+HELP: version=
+{ $values
+ { "version1" string } { "version2" string }
+ { "?" boolean }
+} ;
+
+HELP: version>
+{ $values
+ { "version1" string } { "version2" string }
+ { "?" boolean }
+} ;
+
+HELP: version>=
+{ $values
+ { "version1" string } { "version2" string }
+ { "?" boolean }
+} ;
+
+ARTICLE: { "Versioning" "Semantic Versioning" } "Semantic Versioning"
+{ $vocab-link "semantic-versioning" }
+$nl
+{ "See " { $url "http://semver.org/" } " for a detailed description of semantic versioning." }
+;
+
+ABOUT: { "Versioning" "Semantic Versioning" }
--- /dev/null
+USING: math.order semantic-versioning tools.test ;
+IN: semantic-versioning.tests
+
+[ { 1 0 0 "dev1" } ] [ "1.0.0dev1" split-version ] unit-test
+[ { 1 2 3 } ] [ "1.2.3" split-version ] unit-test
+
+[ +gt+ ] [ "1.2.0dev1" "0.12.1dev2" version<=> ] unit-test
+[ +eq+ ] [ "2.0.0rc1" "2.0.0rc1" version<=> ] unit-test
+[ +lt+ ] [ "1.0.0rc1" "1.0.0" version<=> ] unit-test
+[ +lt+ ] [ "1.0.0rc1" "1.0.0rc2" version<=> ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Maximilian Lupke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays ascii kernel math.order math.parser sequences splitting
+;
+IN: semantic-versioning
+
+: split-version ( string -- array )
+ "." split first3 dup [ digit? not ] find
+ [ cut [ [ string>number ] tri@ ] dip 4array ]
+ [ drop [ string>number ] tri@ 3array ]
+ if ;
+
+: version<=> ( version1 version2 -- <=> )
+ [ split-version ] bi@ drop-prefix
+ 2dup [ length 0 = ] either?
+ [ [ length ] bi@ >=< ] [ [ first ] bi@ <=> ] if ;
+
+: version< ( version1 version2 -- ? )
+ version<=> +lt+ = ;
+
+: version<= ( version1 version2 -- ? )
+ version<=> [ +lt+ = ] [ +eq+ = ] either? ;
+
+: version= ( version1 version2 -- ? )
+ version<=> +eq+ = ;
+
+: version>= ( version1 version2 -- ? )
+ version<=> [ +gt+ = ] [ +eq+ = ] either? ;
+
+: version> ( version1 version2 -- ? )
+ version<=> +gt+ = ;
projects / factor.git / commitdiff