Merge remote branch 'origin/native-image-loader' into gtk-image-loader

Raytrace.app/Contents/Info.plist

@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+	<key>CFBundleExecutable</key>
+	<string>gpu.demos.raytrace</string>
+	<key>CFBundleIconFile</key>
+	<string>Icon.icns</string>
+	<key>CFBundleIdentifier</key>
+	<string>org.factor.gpu.demos.raytrace</string>
+	<key>CFBundleInfoDictionaryVersion</key>
+	<string>6.0</string>
+	<key>CFBundleName</key>
+	<string>Raytrace.app</string>
+	<key>CFBundlePackageType</key>
+	<string>APPL</string>
+</dict>
+</plist>

basis/alien/enums/enums-tests.factor

@@ -33,3 +33,19 @@ ENUM: instrument_t < ushort trombone trumpet ;
 
 { 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

basis/alien/enums/enums.factor

@@ -12,7 +12,7 @@ PRIVATE>
 
 GENERIC: enum>number ( enum -- number ) foldable
 M: integer enum>number ;
-M: symbol enum>number "enum-value" word-prop ;
+M: word enum>number "enum-value" word-prop ;
 
 <PRIVATE
 : enum-boxer ( members -- quot )
@@ -29,16 +29,13 @@ M: enum-c-type c-type-unboxer-quot drop [ enum>number ] ;
 M: enum-c-type c-type-setter
    [ enum>number ] swap base-type>> c-type-setter '[ _ 2dip @ ] ;
 
+: define-enum-value ( class value -- )
+    enum>number "enum-value" set-word-prop ;
+
 <PRIVATE
 
-: define-enum-value ( class value -- )
-    "enum-value" set-word-prop ;
-
 : define-enum-members ( member-names -- )
-    [
+    [ first define-symbol ] each ;
-        [ first define-symbol ]
-        [ first2 define-enum-value ] bi
-    ] each ;
 
 : define-enum-constructor ( word -- )
     [ name>> "<" ">" surround create-in ] keep
@@ -46,10 +43,14 @@ M: enum-c-type c-type-setter
 
 PRIVATE>
 
-: define-enum ( word base-type members -- )
+: (define-enum) ( word base-type members -- )
     [ dup define-enum-constructor ] 2dip
     dup define-enum-members
     <enum-c-type> swap typedef ;
 
+: define-enum ( word base-type members -- )
+    [ (define-enum) ]
+    [ [ first2 define-enum-value ] each ] bi ;
+    
 PREDICATE: enum-c-type-word < c-type-word
     "c-type" word-prop enum-c-type? ;

basis/alien/parser/parser.factor

@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.libraries arrays
 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 ;
+vocabs.parser words.constant alien.enums ;
 IN: alien.parser
 
 SYMBOL: current-library
@@ -75,8 +75,12 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
     "*" ?head
     [ [ <pointer> ] dip parse-pointers ] when ;
 
+: define-enum-value ( class value -- )
+    enum>number "enum-value" set-word-prop ;
+
 : 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 ;

basis/alien/syntax/syntax.factor

@@ -29,7 +29,7 @@ SYNTAX: TYPEDEF:
     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 ;

basis/cocoa/cocoa.factor

@@ -43,7 +43,9 @@ SYNTAX: IMPORT: scan [ ] import-objc-class ;
         "NSApplication"
         "NSArray"
         "NSAutoreleasePool"
+        "NSBitmapImageRep"
         "NSBundle"
+        "NSColorSpace"
         "NSData"
         "NSDictionary"
         "NSError"

basis/cocoa/messages/messages.factor

@@ -109,7 +109,7 @@ H{
     { "d" c:double }
     { "B" c:bool }
     { "v" c:void }
-    { "*" c:c-string }
+    { "*" c:void* }
     { "?" unknown_type }
     { "@" id }
     { "#" Class }

basis/images/cocoa/authors.txt

@@ -0,0 +1 @@
+Joe Groff

basis/images/cocoa/cocoa.factor

@@ -0,0 +1,66 @@
+! (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 ;

basis/images/cocoa/platforms.txt

@@ -0,0 +1 @@
+macosx

basis/images/cocoa/summary.txt

@@ -0,0 +1 @@
+Image loading using MacOS X's native Cocoa APIs

basis/images/gdiplus/gdiplus.factor

@@ -0,0 +1,63 @@
+! (c)2010 Joe Groff bsd license
+USING: accessors alien.c-types alien.data alien.enums
+classes.struct destructors images images.loader
+io.streams.limited kernel locals math windows.com
+windows.gdiplus windows.streams windows.types typed
+byte-arrays grouping sequences ;
+IN: images.gdiplus
+
+SINGLETON: gdi+-image
+"png" gdi+-image register-image-class
+"tif" gdi+-image register-image-class
+"tiff" gdi+-image register-image-class
+"gif" gdi+-image register-image-class
+"jpg" gdi+-image register-image-class
+"jpeg" gdi+-image register-image-class
+"bmp" gdi+-image register-image-class
+"ico" gdi+-image register-image-class
+
+<PRIVATE
+: <GpRect> ( x y w h -- rect )
+    GpRect <struct-boa> ; inline
+
+: stream>gdi+-bitmap ( stream -- bitmap )
+    stream>IStream &com-release
+    { void* } [ GdipCreateBitmapFromStream check-gdi+-status ]
+    [ ] with-out-parameters &GdipFree ;
+
+: gdi+-bitmap-width ( bitmap -- w )
+    { UINT } [ GdipGetImageWidth check-gdi+-status ]
+    [ ] with-out-parameters ;
+: gdi+-bitmap-height ( bitmap -- w )
+    { UINT } [ GdipGetImageHeight check-gdi+-status ]
+    [ ] with-out-parameters ;
+: gdi+-lock-bitmap ( bitmap rect mode format -- data )
+    { BitmapData } [ GdipBitmapLockBits check-gdi+-status ]
+    [ clone ] with-out-parameters ;
+
+:: gdi+-bitmap>data ( bitmap -- w h pixels )
+    bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )
+    bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number
+    PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data
+    bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * ] tri
+    memory>byte-array :> pixels
+    bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status
+    w h pixels ;
+    
+:: data>image ( w h pixels -- image )
+    image new
+        { w h } >>dim
+        pixels >>bitmap
+        BGRA >>component-order
+        ubyte-components >>component-type
+        f >>upside-down? ;
+
+PRIVATE>
+
+M: gdi+-image stream>image
+    drop [
+        start-gdi+ &stop-gdi+ drop
+        stream>gdi+-bitmap
+        gdi+-bitmap>data
+        data>image
+    ] with-destructors ;

basis/images/images.factor

@@ -62,7 +62,10 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
 
 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
 

basis/opengl/textures/textures.factor

@@ -312,12 +312,21 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display-
     [ 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 ]
+        [ reset-blend-mode ] tri
-        tri
     ] with-texturing ;
 
 : texture-coords ( texture -- coords )

basis/ui/images/images.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces cache images images.loader accessors assocs
+USING: accessors assocs cache combinators images images.loader
-kernel opengl opengl.gl opengl.textures ui.gadgets.worlds
+kernel memoize namespaces opengl opengl.gl opengl.textures system
-memoize images.png images.tiff ;
+ui.gadgets.worlds vocabs.loader ;
 IN: ui.images
 
 TUPLE: image-name path ;
@@ -30,3 +30,14 @@ PRIVATE>
 
 : image-dim ( image-name -- dim )
     cached-image dim>> ;
+
+<<
+{
+    { [ os macosx? ] [ "images.cocoa"   require ] }
+    { [ os winnt?  ] [ "images.gdiplus" require ] }
+    [
+        "images.png" require
+        "images.tiff" require
+    ]
+} cond
+>>

basis/windows/com/com.factor

@@ -1,6 +1,6 @@
 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
@@ -31,6 +31,55 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
     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 ) ;
@@ -51,3 +100,5 @@ FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
     over [ com-release ] curry [ ] cleanup ; inline
 
 DESTRUCTOR: com-release
+
+

basis/windows/gdiplus/platforms.txt

@@ -0,0 +1 @@
+windows

basis/windows/nt/nt.factor

@@ -12,6 +12,7 @@ USING: alien sequences alien.libraries ;
     { "libm"        "msvcrt.dll"         cdecl   }
     { "gl"          "opengl32.dll"       stdcall }
     { "glu"         "glu32.dll"          stdcall }
+    { "gdiplus"     "gdiplus.dll"        stdcall }
     { "ole32"       "ole32.dll"          stdcall }
     { "usp10"       "usp10.dll"          stdcall }
     { "psapi"       "psapi.dll"          stdcall }

basis/windows/ole32/ole32.factor

@@ -13,6 +13,9 @@ TYPEDEF: void* LPUNKNOWN
 TYPEDEF: LPWSTR LPOLESTR
 TYPEDEF: LPWSTR LPCOLESTR
 
+TYPEDEF: GUID IID
+TYPEDEF: GUID CLSID
+
 TYPEDEF: REFGUID LPGUID
 TYPEDEF: REFGUID REFIID
 TYPEDEF: REFGUID REFCLSID

basis/windows/streams/platforms.txt

@@ -0,0 +1 @@
+windows

basis/windows/streams/streams.factor

@@ -0,0 +1,123 @@
+USING: accessors alien.c-types classes.struct combinators
+continuations io kernel libc literals locals sequences
+specialized-arrays windows.com memoize
+windows.com.wrapper windows.kernel32 windows.ole32
+windows.types ;
+IN: windows.streams
+
+SPECIALIZED-ARRAY: uchar
+
+<PRIVATE
+
+: with-hresult ( quot: ( -- result ) -- result )
+    [ drop E_FAIL ] recover ; inline
+
+:: IStream-read ( stream pv cb out-read -- hresult )
+    [
+        cb stream stream-read :> buf
+        buf length :> bytes
+        pv buf bytes memcpy
+        out-read [ bytes out-read 0 ULONG set-alien-value ] when
+
+        cb bytes = [ S_OK ] [ S_FALSE ] if
+    ] with-hresult ; inline
+
+:: IStream-write ( stream pv cb out-written -- hresult )
+    [
+        pv cb <direct-uchar-array> stream stream-write
+        out-written [ cb out-written 0 ULONG set-alien-value ] when
+        S_OK
+    ] with-hresult ; inline
+
+: origin>seek-type ( origin -- seek-type )
+    {
+        { $ STREAM_SEEK_SET [ seek-absolute ] }
+        { $ STREAM_SEEK_CUR [ seek-relative ] }
+        { $ STREAM_SEEK_END [ seek-end ] }
+    } case ;
+
+:: IStream-seek ( stream move origin new-position -- hresult )
+    [
+        move origin origin>seek-type stream stream-seek
+        new-position [
+            stream stream-tell new-position 0 ULARGE_INTEGER set-alien-value
+        ] when
+        S_OK
+    ] with-hresult ; inline
+
+:: IStream-set-size ( stream new-size -- hresult )
+    STG_E_INVALIDFUNCTION ;
+
+:: IStream-copy-to ( stream other-stream cb out-read out-written -- hresult )
+    [
+        cb stream stream-read :> buf
+        buf length :> bytes
+        out-read [ bytes out-read 0 ULONG set-alien-value ] when
+
+        other-stream buf bytes out-written IStream::Write
+    ] with-hresult ; inline
+
+:: IStream-commit ( stream flags -- hresult )
+    stream stream-flush S_OK ;
+
+:: IStream-revert ( stream -- hresult )
+    STG_E_INVALIDFUNCTION ;
+
+:: IStream-lock-region ( stream offset cb lock-type -- hresult )
+    STG_E_INVALIDFUNCTION ;
+
+:: IStream-unlock-region ( stream offset cb lock-type -- hresult )
+    STG_E_INVALIDFUNCTION ;
+
+:: stream-size ( stream -- size )
+    stream stream-tell :> old-pos
+    0 seek-end stream stream-seek
+    stream stream-tell :> size
+    old-pos seek-absolute stream stream-seek
+    size ;
+
+:: IStream-stat ( stream out-stat stat-flag -- hresult )
+    [
+        out-stat
+            f >>pwcsName
+            STGTY_STREAM >>type
+            stream stream-size >>cbSize
+            FILETIME <struct> >>mtime
+            FILETIME <struct> >>ctime
+            FILETIME <struct> >>atime
+            STGM_READWRITE >>grfMode
+            0 >>grfLocksSupported
+            GUID_NULL >>clsid
+            0 >>grfStateBits
+            0 >>reserved
+            drop
+        S_OK
+    ] with-hresult ;
+
+:: IStream-clone ( out-clone-stream -- hresult )
+    f out-clone-stream 0 void* set-alien-value
+    STG_E_INVALIDFUNCTION ;
+
+CONSTANT: stream-wrapper
+    $[
+        {
+            { IStream {
+                [ IStream-read ]
+                [ IStream-write ]
+                [ IStream-seek ]
+                [ IStream-set-size ]
+                [ IStream-copy-to ]
+                [ IStream-commit ]
+                [ IStream-revert ]
+                [ IStream-lock-region ]
+                [ IStream-unlock-region ]
+                [ IStream-stat ]
+                [ IStream-clone ]
+            } }
+        } <com-wrapper>
+    ]
+
+PRIVATE>
+
+: stream>IStream ( stream -- IStream )
+    stream-wrapper com-wrap ;

basis/windows/streams/summary.txt

@@ -0,0 +1 @@
+IStream interface wrapper for Factor stream objects

basis/windows/types/types.factor

@@ -16,6 +16,8 @@ TYPEDEF: wchar_t             WCHAR
 
 TYPEDEF: short               SHORT
 TYPEDEF: ushort              USHORT
+TYPEDEF: short               INT16
+TYPEDEF: ushort              UINT16
 
 TYPEDEF: ushort              WORD
 TYPEDEF: ulong               DWORD
@@ -94,7 +96,7 @@ TYPEDEF: HANDLE              HDDEDATA
 TYPEDEF: HANDLE              HDESK
 TYPEDEF: HANDLE              HDROP
 TYPEDEF: HANDLE              HDWP
-TYPEDEF: HANDLE              HENMETAFILE
+TYPEDEF: HANDLE              HENHMETAFILE
 TYPEDEF: HANDLE              HFONT
 TYPEDEF: HANDLE              HGDIOBJ
 TYPEDEF: HANDLE              HGLOBAL
@@ -398,3 +400,5 @@ STRUCT: TEXTMETRICW
     { tmCharSet BYTE } ;
 
 TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
+
+TYPEDEF: ULONG PROPID

extra/gpu/textures/textures.factor

@@ -309,7 +309,7 @@ TYPED: read-compressed-texture ( tdt: texture-data-target level: integer -- byte
 
 : 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