Merge remote-tracking branch 'Blei/gtk-image-loader'
Conflicts: basis/alien/enums/enums-tests.factor basis/alien/enums/enums.factor basis/alien/parser/parser.factor basis/gdk/pixbuf/ffi/ffi.factor basis/glib/ffi/ffi.factor basis/tools/deploy/shaker/shaker.factor basis/ui/backend/gtk/gtk.factor basis/windows/nt/nt.factordb4
Joe Groff
commit
9040ee37e0
|
|
@ -43,7 +43,9 @@ SYNTAX: IMPORT: scan [ ] import-objc-class ;
|
|||
"NSApplication"
|
||||
"NSArray"
|
||||
"NSAutoreleasePool"
|
||||
"NSBitmapImageRep"
|
||||
"NSBundle"
|
||||
"NSColorSpace"
|
||||
"NSData"
|
||||
"NSDictionary"
|
||||
"NSError"
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ H{
|
|||
{ "d" c:double }
|
||||
{ "B" c:bool }
|
||||
{ "v" c:void }
|
||||
{ "*" c:c-string }
|
||||
{ "*" c:void* }
|
||||
{ "?" unknown_type }
|
||||
{ "@" id }
|
||||
{ "#" Class }
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
! 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
|
||||
|
||||
|
|
@ -18,3 +18,12 @@ 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 ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! 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
|
||||
|
|
@ -15,7 +16,62 @@ 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
|
||||
|
|
@ -38,3 +94,18 @@ DESTRUCTOR: g_free
|
|||
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* ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
macosx
|
||||
|
|
@ -0,0 +1 @@
|
|||
Image loading using MacOS X's native Cocoa APIs
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
windows
|
||||
|
|
@ -0,0 +1 @@
|
|||
Philipp Brüschweiler
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
! 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 ;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
linux
|
||||
bsd
|
||||
|
|
@ -0,0 +1 @@
|
|||
Image loading using GTK's GdkPixbuf API
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
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
|
||||
|
|
@ -19,7 +19,7 @@ IN: images.tests
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -10,12 +10,12 @@ IN: images.tesselation
|
|||
[
|
||||
{
|
||||
{
|
||||
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 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 B{ 9 10 13 14 } }
|
||||
T{ image f { 2 2 } L ubyte-components f B{ 11 12 15 16 } }
|
||||
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 } }
|
||||
}
|
||||
}
|
||||
] [
|
||||
|
|
@ -30,12 +30,12 @@ IN: images.tesselation
|
|||
[
|
||||
{
|
||||
{
|
||||
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 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 B{ 7 8 } }
|
||||
T{ image f { 1 1 } L ubyte-components f B{ 9 } }
|
||||
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 } }
|
||||
}
|
||||
}
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
tri
|
||||
[ reset-blend-mode ] tri
|
||||
] with-texturing ;
|
||||
|
||||
: texture-coords ( texture -- coords )
|
||||
|
|
|
|||
|
|
@ -100,6 +100,13 @@ IN: tools.deploy.shaker
|
|||
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
|
||||
|
|
@ -542,6 +549,7 @@ SYMBOL: deploy-vocab
|
|||
strip-call
|
||||
strip-cocoa
|
||||
strip-gobject
|
||||
strip-gtk-icon
|
||||
strip-debugger
|
||||
strip-ui-error-hook
|
||||
strip-specialized-arrays
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
! 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
|
||||
]
|
||||
|
|
@ -1,9 +1,8 @@
|
|||
! 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 )
|
||||
|
|
@ -14,12 +13,12 @@ IN: tools.deploy.unix
|
|||
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 ;
|
||||
|
|
|
|||
|
|
@ -3,14 +3,18 @@
|
|||
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
|
||||
|
|
@ -213,6 +217,17 @@ CONSTANT: action-key-codes
|
|||
: 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 ]
|
||||
|
|
@ -502,6 +517,7 @@ M: gtk-ui-backend (with-ui)
|
|||
[
|
||||
0 gint <ref> f void* <ref> gtk_init
|
||||
0 gint <ref> f void* <ref> gtk_gl_init
|
||||
load-icon
|
||||
init-clipboard
|
||||
start-ui
|
||||
[
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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 ;
|
||||
|
|
@ -30,3 +30,11 @@ PRIVATE>
|
|||
|
||||
: image-dim ( image-name -- dim )
|
||||
cached-image dim>> ;
|
||||
|
||||
<<
|
||||
{
|
||||
{ [ os macosx? ] [ "images.cocoa" require ] }
|
||||
{ [ os winnt? ] [ "images.gdiplus" require ] }
|
||||
[ "images.gtk" require ]
|
||||
} cond
|
||||
>>
|
||||
|
|
|
|||
|
|
@ -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 ) ;
|
||||
|
|
@ -50,3 +99,5 @@ FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
|
|||
over [ com-release ] curry [ ] cleanup ; inline
|
||||
|
||||
DESTRUCTOR: com-release
|
||||
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1 @@
|
|||
windows
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
windows
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
IStream interface wrapper for Factor stream objects
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -28,7 +28,12 @@ ARTICLE: "vocabs.roots" "Vocabulary roots"
|
|||
{ $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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -88,12 +88,18 @@ TUPLE: vbo
|
|||
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*
|
||||
|
|
|
|||
Loading…
Reference in New Issue