Re: [Help-smalltalk] cairo library wrapper

[Brad Watson]

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