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

clean up; add add-library for unix environments (and partially for windows)

db4
Anton Gorenko 2010-05-23 16:05:34 +06:00
parent 0d743f94ff
commit a2ffbdefa9
13 changed files with 109 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/atk/atk.factor
View File

@ -1,8 +1,17 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax
USING: alien alien.libraries alien.syntax combinators kernel
system
gir glib gobject glib.ffi ;
<<
"atk" {
{ [ os winnt? ] [ "libatk-1.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libatk-1.0.so" cdecl add-library ] }
} cond
>>
IN: atk.ffi
TYPEDEF: guint64 AtkState

10
basis/gdk/gdk.factor
View File

@ -1,15 +1,15 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.libraries cairo.ffi
USING: alien alien.destructors alien.syntax alien.libraries cairo.ffi
combinators kernel system
gir glib gobject gio gmodule gdk.pixbuf glib.ffi ;
EXCLUDE: alien.c-types => pointer ;
<<
"gdk" {
{ [ os winnt? ] [ "libgdk-win32-2.0-0.dll" "cdecl" add-library ] }
{ [ os winnt? ] [ "libgdk-win32-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgdk-x11-2.0.so" "cdecl" add-library ] }
{ [ os unix? ] [ "libgdk-x11-2.0.so" cdecl add-library ] }
} cond
>>
@ -27,3 +27,7 @@ GdkEventOwnerChange GdkEventGrabBroken ;
IN-GIR: gdk vocab:gdk/Gdk-2.0.gir
IN: gdk.ffi
DESTRUCTOR: gdk_cursor_unref

7
basis/gdk/gl/gl.factor
View File

@ -1,13 +1,14 @@
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.libraries alien.syntax combinators kernel system vocabs.parser words
USING: alien alien.c-types alien.libraries combinators kernel
system vocabs.parser words
gir glib gobject gio gmodule gdk gdk.ffi gdk.pixbuf ;
<<
"gdk.gl" {
{ [ os winnt? ] [ "" "cdecl" add-library ] }
{ [ os winnt? ] [ drop ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgdkglext-x11-1.0.so" "cdecl" add-library ] }
{ [ os unix? ] [ "libgdkglext-x11-1.0.so" cdecl add-library ] }
} cond
>>

11
basis/gdk/pixbuf/pixbuf.factor
View File

@ -1,7 +1,16 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: gir glib gobject gio gmodule ;
USING: alien alien.libraries combinators kernel system
gir glib gobject gio gmodule ;
EXCLUDE: alien.c-types => pointer ;
<<
"gdk.pixbuf" {
{ [ os winnt? ] [ "libgdk_pixbuf-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgdk_pixbuf-2.0.so" cdecl add-library ] }
} cond
>>
IN-GIR: gdk.pixbuf vocab:gdk/pixbuf/GdkPixbuf-2.0.gir

11
basis/gio/gio.factor
View File

@ -1,7 +1,16 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: gir glib gobject ;
USING: alien alien.libraries combinators kernel system
gir glib gobject ;
EXCLUDE: alien.c-types => pointer ;
<<
"gio" {
{ [ os winnt? ] [ "libgio-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgio-2.0.so" cdecl add-library ] }
} cond
>>
IN-GIR: gio vocab:gio/Gio-2.0.gir

10
basis/glib/glib.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.libraries alien.syntax combinators gir
USING: alien alien.c-types alien.libraries alien.syntax combinators gir
kernel system vocabs.parser words ;
<<
"glib" {
{ [ os winnt? ] [ "libglib-2.0-0.dll" "cdecl" add-library ] }
{ [ os macosx? ] [ "/opt/local/lib/libglib-2.0.0.dylib" "cdecl" add-library ] }
{ [ os unix? ] [ drop ] }
{ [ os winnt? ] [ "libglib-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ "/opt/local/lib/libglib-2.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ "libglib-2.0.so" cdecl add-library ] }
} cond
>>
@ -23,7 +23,7 @@ TYPEDEF: long glong
TYPEDEF: ulong gulong
TYPEDEF: int gint
TYPEDEF: uint guint
TYPEDEF: gint gboolean
TYPEDEF: bool gboolean
TYPEDEF: char gint8
TYPEDEF: uchar guint8

11
basis/gmodule/gmodule.factor
View File

@ -1,6 +1,15 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: gir glib ;
USING: alien alien.libraries combinators kernel system
gir glib ;
<<
"gmodule" {
{ [ os winnt? ] [ "libgmodule-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgmodule-2.0.so" cdecl add-library ] }
} cond
>>
IN-GIR: gmodule vocab:gmodule/GModule-2.0.gir

55
basis/gobject/gobject.factor
View File

@ -1,10 +1,18 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.destructors
USING: alien alien.syntax alien.destructors
alien.libraries combinators kernel literals math system
gir glib glib.ffi ;
EXCLUDE: alien.c-types => pointer ;
<<
"gobject" {
{ [ os winnt? ] [ "libobject-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ "/opt/local/lib/libgobject-2.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ "libgobject-2.0.so" cdecl add-library ] }
} cond
>>
IN: gobject.ffi
TYPEDEF: void* GSignalCMarshaller
@ -12,6 +20,8 @@ TYPEDEF: void GStrv
! есть alias
TYPEDEF: gchar* gchararray
IMPLEMENT-STRUCTS: GValue ;
IN-GIR: gobject vocab:gobject/GObject-2.0.gir
IN: gobject.ffi
@ -26,26 +36,25 @@ DESTRUCTOR: g_object_unref
! (разобраться)
TYPEDEF: GParamSpec GParam
<< CONSTANT: G_TYPE_FUNDAMENTAL_SHIFT 2 >>
CONSTANT: G_TYPE_INVALID $[ 0 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_NONE $[ 1 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_INTERFACE $[ 2 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_CHAR $[ 3 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_UCHAR $[ 4 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_BOOLEAN $[ 5 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_INT $[ 6 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_UINT $[ 7 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_LONG $[ 8 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_ULONG $[ 9 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_INT64 $[ 10 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_UINT64 $[ 11 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_ENUM $[ 12 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_FLAGS $[ 13 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_FLOAT $[ 14 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_DOUBLE $[ 15 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_STRING $[ 16 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_POINTER $[ 17 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_BOXED $[ 18 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_PARAM $[ 19 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_OBJECT $[ 20 G_TYPE_FUNDAMENTAL_SHIFT shift ]
CONSTANT: G_TYPE_INVALID $[ 0 2 shift ]
CONSTANT: G_TYPE_NONE $[ 1 2 shift ]
CONSTANT: G_TYPE_INTERFACE $[ 2 2 shift ]
CONSTANT: G_TYPE_CHAR $[ 3 2 shift ]
CONSTANT: G_TYPE_UCHAR $[ 4 2 shift ]
CONSTANT: G_TYPE_BOOLEAN $[ 5 2 shift ]
CONSTANT: G_TYPE_INT $[ 6 2 shift ]
CONSTANT: G_TYPE_UINT $[ 7 2 shift ]
CONSTANT: G_TYPE_LONG $[ 8 2 shift ]
CONSTANT: G_TYPE_ULONG $[ 9 2 shift ]
CONSTANT: G_TYPE_INT64 $[ 10 2 shift ]
CONSTANT: G_TYPE_UINT64 $[ 11 2 shift ]
CONSTANT: G_TYPE_ENUM $[ 12 2 shift ]
CONSTANT: G_TYPE_FLAGS $[ 13 2 shift ]
CONSTANT: G_TYPE_FLOAT $[ 14 2 shift ]
CONSTANT: G_TYPE_DOUBLE $[ 15 2 shift ]
CONSTANT: G_TYPE_STRING $[ 16 2 shift ]
CONSTANT: G_TYPE_POINTER $[ 17 2 shift ]
CONSTANT: G_TYPE_BOXED $[ 18 2 shift ]
CONSTANT: G_TYPE_PARAM $[ 19 2 shift ]
CONSTANT: G_TYPE_OBJECT $[ 20 2 shift ]

8
basis/gst/gst.factor
View File

@ -1,15 +1,15 @@
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.libraries combinators
USING: alien alien.syntax alien.libraries combinators
kernel system
gir glib glib.ffi gobject gmodule ;
EXCLUDE: alien.c-types => pointer ;
<<
"gst" {
{ [ os winnt? ] [ "" "cdecl" add-library ] }
{ [ os macosx? ] [ "" "cdecl" add-library ] }
{ [ os unix? ] [ "libgstreamer-0.10.so" "cdecl" add-library ] }
{ [ os winnt? ] [ drop ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgstreamer-0.10.so" cdecl add-library ] }
} cond
>>

6
basis/gtk/gl/gl.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.libraries combinators kernel system
USING: alien alien.libraries combinators kernel system
gir glib gobject gio gmodule gdk.pixbuf gdk gdk.gl gtk gtk.ffi ;
EXCLUDE: alien.c-types => pointer ;
<<
"gtk.gl" {
{ [ os winnt? ] [ "" "cdecl" add-library ] }
{ [ os winnt? ] [ drop ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgtkglext-x11-1.0.so" "cdecl" add-library ] }
{ [ os unix? ] [ "libgtkglext-x11-1.0.so" cdecl add-library ] }
} cond
>>

8
basis/gtk/gtk.factor
View File

@ -1,15 +1,15 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.libraries cairo.ffi combinators
USING: alien alien.syntax alien.libraries cairo.ffi combinators
kernel system
gir glib glib.ffi gobject gio gmodule gdk.pixbuf gdk atk ;
EXCLUDE: alien.c-types => pointer ;
<<
"gtk" {
{ [ os winnt? ] [ "libgtk-win32-2.0-0.dll" "cdecl" add-library ] }
{ [ os winnt? ] [ "libgtk-win32-2.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgtk-x11-2.0.so" "cdecl" add-library ] }
{ [ os unix? ] [ "libgtk-x11-2.0.so" cdecl add-library ] }
} cond
>>
@ -20,5 +20,7 @@ TYPEDEF: void GtkEnumValue
TYPEDEF: void GtkFlagValue
TYPEDEF: GType GtkType
IMPLEMENT-STRUCTS: GtkTreeIter ;
IN-GIR: gtk vocab:gtk/Gtk-2.0.gir

163
basis/pango/cairo/cairo.factor
View File

@ -1,25 +1,19 @@
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.destructors
alien.libraries alien.syntax alien.strings arrays math math.functions
math.vectors destructors combinators colors fonts accessors assocs
namespaces kernel unicode.data images sequences
cache init system math.rectangles fry memoize io.encodings.utf8
classes.struct cairo cairo.ffi
gir pango pango.ffi gobject gobject.ffi ;
USING: alien alien.c-types alien.libraries alien.syntax cairo.ffi
combinators kernel system
gir pango pango.ffi ;
<<
"pango.cairo" {
{ [ os winnt? ] [ "libpangocairo-1.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ "/opt/local/lib/libpangocairo-1.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ drop ] }
{ [ os unix? ] [ "libpangocairo-1.0.so" cdecl add-library ] }
} cond
>>
IN-GIR: pango.cairo vocab:pango/cairo/PangoCairo-1.0.gir
IN: pango.cairo.ffi
FUNCTION: void
@ -31,152 +25,3 @@ pango_cairo_show_layout ( cairo_t* cr, PangoLayout* layout ) ;
FUNCTION: PangoLayout*
pango_cairo_create_layout ( cairo_t* cr ) ;
IN: pango.cairo
TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
SYMBOL: dpi
72 dpi set-global
: set-layout-font ( font layout -- )
swap cache-font-description pango_layout_set_font_description ;
: set-layout-text ( str layout -- )
#! Replace nulls with something else since Pango uses null-terminated
#! strings
swap utf8 string>alien -1 pango_layout_set_text ;
: layout-extents ( layout -- ink-rect logical-rect )
PangoRectangle <struct>
PangoRectangle <struct>
[ pango_layout_get_extents ] 2keep
[ PangoRectangle>rect ] bi@ ;
: layout-baseline ( layout -- baseline )
pango_layout_get_iter &pango_layout_iter_free
pango_layout_iter_get_baseline
pango>float ;
: set-foreground ( cr font -- )
foreground>> set-source-color ;
: fill-background ( cr font dim -- )
[ background>> set-source-color ]
[ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
: rect-translate-x ( rect x -- rect' )
'[ _ 0 2array v- ] change-loc ;
: first-line ( layout -- line )
layout>> 0 pango_layout_get_line_readonly ;
: line-offset>x ( layout n -- x )
#! n is an index into the UTF8 encoding of the text
[ drop first-line ] [ swap string>> >utf8-index ] 2bi
0 0 <int> [ pango_layout_line_index_to_x ] keep
*int pango>float ;
: x>line-offset ( layout x -- n )
#! n is an index into the UTF8 encoding of the text
[
[ first-line ] dip
float>pango 0 <int> 0 <int>
[ pango_layout_line_x_to_index drop ] 2keep
[ *int ] bi@ swap
] [ drop string>> ] 2bi utf8-index> + ;
: selection-start/end ( selection -- start end )
selection>> [ start>> ] [ end>> ] bi ;
: selection-rect ( layout -- rect )
[ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
[ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
: fill-selection-background ( cr layout -- )
dup selection>> [
[ selection>> color>> set-source-color ]
[
[ selection-rect ] [ ink-rect>> loc>> first ] bi
rect-translate-x
fill-rect
] 2bi
] [ 2drop ] if ;
: text-position ( layout -- loc )
[ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
: set-text-position ( cr loc -- )
first2 cairo_move_to ;
: draw-layout ( layout -- image )
dup ink-rect>> dim>> [ >fixnum ] map [
swap {
[ layout>> pango_cairo_update_layout ]
[ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
[ fill-selection-background ]
[ text-position set-text-position ]
[ font>> set-foreground ]
[ layout>> pango_cairo_show_layout ]
} 2cleave
] make-bitmap-image ;
: escape-nulls ( str -- str' )
{ { 0 CHAR: zero-width-no-break-space } } substitute ;
: unpack-selection ( layout string/selection -- layout )
dup selection? [
[ string>> escape-nulls >>string ] [ >>selection ] bi
] [ escape-nulls >>string ] if ; inline
: set-layout-resolution ( layout -- )
pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
: <PangoLayout> ( text font -- layout )
dummy-cairo pango_cairo_create_layout |g_object_unref
[ set-layout-resolution ] keep
[ set-layout-font ] keep
[ set-layout-text ] keep ;
: glyph-height ( font string -- y )
swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
MEMO: missing-font-metrics ( font -- metrics )
#! Pango doesn't provide x-height and cap-height but Core Text does, so we
#! simulate them on Pango.
[
[ metrics new ] dip
[ "x" glyph-height >>x-height ]
[ "Y" glyph-height >>cap-height ] bi
] with-destructors ;
: layout-metrics ( layout -- metrics )
dup font>> missing-font-metrics clone
swap
[ layout>> layout-baseline >>ascent ]
[ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
dup [ height>> ] [ ascent>> ] bi - >>descent ;
: <layout> ( font string -- line )
[
layout new-disposable
swap unpack-selection
swap >>font
dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
dup layout-metrics >>metrics
dup draw-layout >>image
] with-destructors ;
M: layout dispose* layout>> g_object_unref ;
SYMBOL: cached-layouts
: cached-layout ( font string -- layout )
cached-layouts get [ <layout> ] 2cache ;
: cached-line ( font string -- line )
cached-layout layout>> first-line ;
[ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-startup-hook

48
basis/pango/pango.factor
View File

@ -1,16 +1,14 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.syntax alien.c-types alien.destructors
alien.strings alien.libraries arrays classes.struct combinators
destructors fonts init kernel math math.rectangles memoize
io.encodings.utf8 system
USING: alien alien.c-types alien.destructors alien.libraries
alien.syntax combinators kernel system
gir glib glib.ffi ;
<<
"pango" {
{ [ os winnt? ] [ "libpango-1.0-0.dll" cdecl add-library ] }
{ [ os macosx? ] [ "/opt/local/lib/libpango-1.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ drop ] }
{ [ os unix? ] [ "libpango-1.0.so" cdecl add-library ] }
} cond
>>
@ -19,48 +17,12 @@ IN: pango.ffi
TYPEDEF: void PangoLayoutRun ! не совсем верно
TYPEDEF: guint32 PangoGlyph
IMPLEMENT-STRUCTS: PangoRectangle ;
IN-GIR: pango vocab:pango/Pango-1.0.gir
IN: pango.ffi
FORGET: PangoRectangle
STRUCT: PangoRectangle
{ x int }
{ y int }
{ width int }
{ height int } ;
IN: pango
CONSTANT: PANGO_SCALE 1024
: pango>float ( n -- x ) PANGO_SCALE /f ; inline
: float>pango ( x -- n ) PANGO_SCALE * >integer ; inline
: PangoRectangle>rect ( PangoRectangle -- rect )
[ [ x>> pango>float ] [ y>> pango>float ] bi 2array ]
[ [ width>> pango>float ] [ height>> pango>float ] bi 2array ] bi
<rect> ;
DESTRUCTOR: pango_font_description_free
DESTRUCTOR: pango_layout_iter_free
! перенести в ui.*?
MEMO: (cache-font-description) ( font -- description )
[
[ pango_font_description_new |pango_font_description_free ] dip {
[ name>> utf8 string>alien pango_font_description_set_family ]
[ size>> float>pango pango_font_description_set_size ]
[ bold?>> PANGO_WEIGHT_BOLD PANGO_WEIGHT_NORMAL ? pango_font_description_set_weight ]
[ italic?>> PANGO_STYLE_ITALIC PANGO_STYLE_NORMAL ? pango_font_description_set_style ]
[ drop ]
} 2cleave
] with-destructors ;
: cache-font-description ( font -- description )
strip-font-colors (cache-font-description) ;
[ \ (cache-font-description) reset-memoized ] "pango" add-startup-hook