[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Help-smalltalk] cairo library wrapper
From: |
Brad Watson |
Subject: |
Re: [Help-smalltalk] cairo library wrapper |
Date: |
Fri, 24 Nov 2006 17:54:19 -0800 (PST) |
Thanks !
----- Original Message ----
From: Mike Anderson <address@hidden>
To: address@hidden
Sent: Thursday, November 23, 2006 1:52:56 AM
Subject: Re: [Help-smalltalk] cairo library wrapper
Brad Watson wrote:
> Please find attached a first attempt at creating a wrapper for the cairo
> library.
The "clock demo" I posted a while back uses Cairo to do its drawing.
Here is the relevant code for comparison.
Mike
"======================================================================
|
| Copyright 2006 Mike Anderson
| Written by Mike Anderson
|
| This is free software; you can redistribute it and/or modify it under
| the terms of the GNU Lesser General Public License as published by the
| Free Software Foundation; either version 2.1, or (at your option) any
| later version.
|
| This code is distributed in the hope that it will be useful, but
| WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
| or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
| License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.
|
======================================================================
"
Object subclass: #CLibrary
instanceVariableNames: ''
classVariableNames: 'typesMap funcsMap'
poolDictionaries: ''
category: ''
!
!CLibrary class methodsFor: 'loading'!
smalltalkize: aString
| r aa |
r := WriteStream on: String new.
aa := (aString tokenize: '_') asOrderedCollection.
r << aa removeFirst.
aa do: [ :each | r << each first asUppercase << (each copyFrom: 2) ].
^r contents.
!
defaultSelector: aFuncName args: aArgs
| sel |
sel := self smalltalkize: aFuncName.
aArgs notEmpty ifTrue:
[ sel := WriteStream with: sel.
sel << ': ' << (self smalltalkize: (aArgs at: 1)).
(aArgs copyFrom: 2) do:
[ :each | sel << ' ' << (self smalltalkize: each) << ': '
<< (self smalltalkize: each) ].
sel := sel contents. ].
^sel
!
normalizeSpace: aString
| s |
s := aString copyReplacingAllRegex: '[ \t\n\r]+' with: ' '.
s := s copyReplacingAllRegex: ' \*' with: '*'.
^s trimSeparators
!
parseCFunction: aFuncDecl
| parsed args fn m ret sel |
m := (self normalizeSpace: aFuncDecl)
=~ '^([\w+ \*]+)\b([\w-]+) *\(([^\)]*)\)'.
m matched ifFalse:
[ self error: 'Can''t parse function declaration: ', aFuncDecl ].
parsed := LookupTable new.
args := OrderedCollection new.
parsed at: #args put: args.
ret := self normalizeSpace: (m at: 1).
self typesMap at: ret ifPresent: [ :a | ret := a ].
parsed at: #return put: ret asSymbol.
fn := m at: 2.
parsed at: #name put: fn.
(m at: 3) onRegexMatches: '(\w[^,]*)\b(\w[-\w]*)(,|$)' do:
[ :each | | name type |
name := each at: 2.
type := self typesMap at: (self normalizeSpace: (each at: 1)).
args add: name -> type. ].
parsed at: #selector put:
(self funcsMap
at: fn
ifAbsent:
[ self
defaultSelector: fn
args: (args collect: [ :each | each key ]) ]).
^parsed
!
addCFunction: aFuncDecl
| parsed added |
parsed := self parseCFunction: aFuncDecl.
DLD defineExternFunc: (parsed at: #name).
"Transcript << self name << ' ' << (parsed at: #selector)."
[ added := self class defineCFunc: (parsed at: #name)
withSelectorArgs: (parsed at: #selector)
returning: (parsed at: #return)
args: ((parsed at: #args) collect: [ :each | each value ]) asArray.
] on: Error do:
[ :sig |
Transcript << 'defineCFunc failed for:'; nl.
Transcript << (parsed at: #name) ; nl.
Transcript << (parsed at: #selector) ; nl.
Transcript << (parsed at: #return) ; nl.
Transcript << ((parsed at: #args) collect: [ :each | each value ])
asArray; nl.
sig signal. ].
"Transcript << ' ok'; nl."
^parsed
!
initializeTypesMap
#('unknown' 'boolean' 'char' 'string' 'stringOut' 'symbol' 'byteArray'
'int' 'uInt' 'long' 'uLong' 'double' 'cObject'
'smalltalk' 'variadic' 'variadicSmalltalk' 'self' 'selfSmalltalk')
do:
[ :each | typesMap at: each put: each asSymbol ].
typesMap
at: 'unsigned int' put: #uInt;
at: 'unsigned long' put: #uLong;
at: 'char*' put: #string.
!
typesMap
typesMap isNil ifTrue:
[ typesMap := LookupTable new.
self initializeTypesMap ].
^typesMap
!
funcsMap
funcsMap isNil ifTrue: [ funcsMap := LookupTable new ].
^funcsMap
!
!
"======================================================================
|
| Copyright 2006 Mike Anderson
| Written by Mike Anderson
|
| This is free software; you can redistribute it and/or modify it under
| the terms of the GNU Lesser General Public License as published by the
| Free Software Foundation; either version 2.1, or (at your option) any
| later version.
|
| This code is distributed in the hope that it will be useful, but
| WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
| or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
| License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.
|
======================================================================
"
CLibrary subclass: #Cairo
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: ''
!
CStruct subclass: #CairoMatrix
declaration: #(
(#xx #double)
(#yx #double)
(#xy #double)
(#yy #double)
(#x0 #double)
(#y0 #double)
)
classVariableNames: ''
poolDictionaries: ''
category: ''
!
CStruct subclass: #CairoTextExtents
declaration: #(
(#xBearing #double)
(#yBearing #double)
(#width #double)
(#height #double)
(#xAdvance #double)
(#yAdvance #double)
)
classVariableNames: ''
poolDictionaries: ''
category: ''
!
!Cairo class methodsFor: 'loading'!
defaultSelector: aFuncName args: aArgs
| sel |
sel := super defaultSelector: aFuncName args: aArgs.
(sel startsWith: 'cairo') ifTrue:
[ sel := (sel at: 6) asLowercase asString, (sel copyFrom: 7) ].
^sel.
!
load
(DLD addLibrary: 'libcairo') ifNotNil: [ :s | s printNl ].
self typesMap
at: 'const char*' put: #string;
at: 'Drawable' put: #uLong; "From XLib"
at: 'Pixmap' put: #uLong; "From XLib"
at: 'cairo_t*' put: #cObject;
at: 'cairo_surface_t*' put: #cObject;
at: 'cairo_pattern_t*' put: #cObject;
at: 'cairo_line_cap_t' put: #int;
at: 'cairo_line_join_t' put: #int;
at: 'const cairo_matrix_t*' put: #cObject;
at: 'cairo_matrix_t*' put: #cObject;
at: 'cairo_text_extents_t*' put: #cObject;
at: 'cairo_font_slant_t' put: #int;
at: 'cairo_font_weight_t' put: #int.
#( 'void cairo_surface_destroy (cairo_surface_t *surface);'
'void cairo_surface_flush (cairo_surface_t *surface);'
'void cairo_surface_finish (cairo_surface_t *surface);'
'cairo_surface_t* cairo_xlib_surface_create (Display *dpy, Drawable
drawable, Visual *visual, int width, int height);'
'cairo_surface_t* cairo_xlib_surface_create_for_bitmap (Display *dpy,
Pixmap bitmap, Screen *screen, int width, int height);'
'void cairo_xlib_surface_set_size (cairo_surface_t *surface, int width,
int height);'
'void cairo_xlib_surface_set_drawable (cairo_surface_t *surface,
Drawable drawable, int width, int height);'
'cairo_t* cairo_create (cairo_surface_t *target);'
'cairo_t* cairo_reference (cairo_t *cr);'
'void cairo_destroy (cairo_t *cr);'
'void cairo_save (cairo_t *cr);'
'void cairo_restore (cairo_t *cr);'
'void cairo_new_path (cairo_t *cr);'
'void cairo_move_to (cairo_t *cr, double x, double y);'
'void cairo_line_to (cairo_t *cr, double x, double y);'
'void cairo_curve_to (cairo_t *cr, double x1, double y1, double x2,
double y2, double x3, double y3);'
'void cairo_arc (cairo_t *cr, double xc, double yc, double radius,
double angle1, double angle2);'
'void cairo_arc_negative (cairo_t *cr, double xc, double yc, double
radius, double angle1, double angle2);'
"void cairo_arc_to (cairo_t *cr, double x1, double y1, double x2,
double y2, double radius);"
'void cairo_rel_move_to (cairo_t *cr, double dx, double dy);'
'void cairo_rel_line_to (cairo_t *cr, double dx, double dy);'
'void cairo_rel_curve_to (cairo_t *cr, double dx1, double dy1, double
dx2, double dy2, double dx3, double dy3);'
'void cairo_rectangle (cairo_t *cr, double x, double y, double width,
double height);'
"void cairo_stroke_to_path (cairo_t *cr);"
'void cairo_close_path (cairo_t *cr);'
'void cairo_translate (cairo_t *cr, double tx, double ty);'
'void cairo_scale (cairo_t *cr, double sx, double sy);'
'void cairo_rotate (cairo_t *cr, double angle);'
'void cairo_transform (cairo_t *cr, const cairo_matrix_t *matrix);'
'void cairo_set_matrix (cairo_t *cr, const cairo_matrix_t *matrix);'
'void cairo_get_matrix (cairo_t *cr, cairo_matrix_t *matrix);'
'void cairo_identity_matrix (cairo_t *cr);'
'void cairo_paint (cairo_t *cr);'
'void cairo_paint_with_alpha (cairo_t *cr, double alpha);'
'void cairo_mask (cairo_t *cr, cairo_pattern_t *pattern);'
'void cairo_mask_surface (cairo_t *cr, cairo_surface_t *surface, double
surface_x, double surface_y);'
'void cairo_stroke (cairo_t *cr);'
'void cairo_stroke_preserve (cairo_t *cr);'
'void cairo_fill (cairo_t *cr);'
'void cairo_fill_preserve (cairo_t *cr);'
'void cairo_set_source (cairo_t *cr, cairo_pattern_t *source);'
'void cairo_set_source_rgb (cairo_t *cr, double red, double green,
double blue);'
'void cairo_set_source_rgba (cairo_t *cr, double red, double green,
double blue, double alpha);'
'void cairo_set_line_width (cairo_t *cr, double width);'
'void cairo_set_line_cap (cairo_t *cr, cairo_line_cap_t line_cap);'
'void cairo_set_line_join (cairo_t *cr, cairo_line_join_t line_join);'
'void cairo_pattern_add_color_stop_rgb (cairo_pattern_t *pattern,
double offset, double red, double green, double blue);'
'void cairo_pattern_add_color_stop_rgba (cairo_pattern_t *pattern,
double offset, double red, double green, double blue, double alpha);'
'cairo_pattern_t* cairo_pattern_create_rgb (double red, double green,
double blue);'
'cairo_pattern_t* cairo_pattern_create_rgba (double red, double green,
double blue, double alpha);'
'cairo_pattern_t* cairo_pattern_create_for_surface (cairo_surface_t
*surface);'
'cairo_pattern_t* cairo_pattern_create_linear (double x0, double y0,
double x1, double y1);'
'cairo_pattern_t* cairo_pattern_create_radial (double cx0, double cy0,
double radius0, double cx1, double cy1, double radius1);'
'void cairo_pattern_destroy (cairo_pattern_t *pattern);'
'void cairo_pattern_set_matrix (cairo_pattern_t *pattern, const
cairo_matrix_t *matrix);'
'void cairo_pattern_get_matrix (cairo_pattern_t *pattern,
cairo_matrix_t *matrix);'
'void cairo_select_font_face (cairo_t *cr, const char *family,
cairo_font_slant_t slant, cairo_font_weight_t weight);'
'void cairo_set_font_size (cairo_t *cr, double size);'
'void cairo_set_font_matrix (cairo_t *cr, const cairo_matrix_t
*matrix);'
'void cairo_get_font_matrix (cairo_t *cr, cairo_matrix_t *matrix);'
'void cairo_show_text (cairo_t *cr, const char *utf8);'
'void cairo_text_extents (cairo_t *cr, const char *utf8,
cairo_text_extents_t *extents);'
)
do:
[ :each | self addCFunction: each. ].
!
!
Cairo load
!
"Namespace current at: #Cairo put: (CairoLibrary new)"
!
"======================================================================
|
| Copyright 2006 Mike Anderson
| Written by Mike Anderson
|
| This is free software; you can redistribute it and/or modify it under
| the terms of the GNU Lesser General Public License as published by the
| Free Software Foundation; either version 2.1, or (at your option) any
| later version.
|
| This code is distributed in the hope that it will be useful, but
| WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
| or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
| License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.
|
======================================================================
"
PackageLoader fileInPackages: #('Regex' 'MUtility')!
Class methodsFor: 'organization of methods and classes'!
defineExternCFunc: aCFuncName withSelectorArgs: aSelector returning:
aReturnType args: aArgArray
"Convenience method"
DLD defineExternFunc: aCFuncName asSymbol.
self class defineCFunc: aCFuncName
withSelectorArgs: aSelector
returning: aReturnType
args: aArgArray.
!
!
Array methodsFor: 'converting'!
asDictionary
| r |
r := LookupTable new: self size.
self do:
[ :each | r at: each first put: each second ].
^r
!
!
String methodsFor: 'regex'!
onRegexMatches: aPattern do: aBlock
"Searches for a pattern and executed passed instruction-body (as a trigger)"
| idx regex m |
regex := aPattern asRegex.
idx := 1.
[ m := self searchRegex: regex startingAt: idx.
m matched ]
whileTrue:
[ aBlock value: m.
idx := m to + 1. ].
!
!
DLD class methodsFor: 'debugging'!
addLibrary: library
"Add library to the search path of libraries to be used by DLD."
^(LibraryList anySatisfy: [ :anAssociation | anAssociation key = library ])
ifTrue: [ 'Already added' ]
ifFalse:
[ | handle |
handle := (self linkFile: library).
LibraryList add: library -> handle.
LibraryStream := RoundRobinStream on: LibraryList readStream.
handle isNil
ifTrue: [ 'Link failed.' ]
ifFalse: [ nil ] ].
!
!
_______________________________________________
help-smalltalk mailing list
address@hidden
http://lists.gnu.org/mailman/listinfo/help-smalltalk
____________________________________________________________________________________
Yahoo! Music Unlimited
Access over 1 million songs.
http://music.yahoo.com/unlimited