{ import: Geometry }
{ import: Colour }
{ import: _cairo }
{ include <cairo.h> }

Cairo : Object ( _surface _cr paths )

Cairo _surface	[ ^_surface ]
Cairo _cr	[ ^_cr ]

Cairo withSurface_: _sfc
[
    self := self new.
    _surface := _sfc.
    _cr := libcairo _cairo_create :_sfc.
]

Cairo createImageSurface: extent
[
    ^self withSurface_:
	(libcairo _cairo_image_surface_create
	     : (libcairo _CAIRO_FORMAT_ARGB32)
	     : extent x ceiling _integerValue
	     : extent y ceiling _integerValue).
]

Cairo createMaskSurface: extent
[
    ^self withSurface_:
	(libcairo _cairo_image_surface_create
	     : (libcairo _CAIRO_FORMAT_A8)
	     : extent x ceiling _integerValue
	     : extent y ceiling _integerValue).
]

Cairo destroy [ libcairo cairo_destroy :_cr.
    libcairo cairo_surface_destroy	:_surface.
    _cr := _surface := nil
]

Cairo createImageSurfaceCreateForData: pixels :extent
[
    ^self withSurface_:
	(libcairo _cairo_image_surface_create_for_data
         : pixels
	     : (libcairo _CAIRO_FORMAT_ARGB32)
	     : extent x ceiling _integerValue
	     : extent y ceiling _integerValue
         : (extent x ceiling * 4) _integerValue).
]

Cairo setFontSize: size
[
    libcairo cairo_set_font_size :_cr :size.
]

Cairo selectFontFace: family
[
    libcairo _cairo_select_font_face :_cr :family _stringValue :libcairo _CAIRO_FONT_SLANT_NORMAL :libcairo _CAIRO_FONT_WEIGHT_NORMAL
]

Cairo setSourceR: r G: g B: b		[ libcairo _cairo_set_source_rgb	:_cr :r asFloat :g asFloat :b asFloat ]
Cairo setSourceR: r G: g B: b A: a	[ libcairo _cairo_set_source_rgba	:_cr :r asFloat :g asFloat :b asFloat :a asFloat ]

Cairo setSource: aSource		[ aSource beSourceForCanvas: self ]
Object beSourceForCanvas: aCanvas	[ self error: self debugName, ' cannot be used as a Canvas source' ]
Colour beSourceForCanvas: aCanvas	[ aCanvas setSourceColour: self ]
Cairo setSourceColour: clr		[ libcairo _cairo_set_source_rgba	:_cr :clr r asFloat :clr g asFloat :clr b asFloat :clr a asFloat ]
Cairo setStrokeWidth: w			[ libcairo _cairo_set_line_width	:_cr :w asFloat ]

Cairo rectangle: r			[ libcairo _cairo_rectangle		:_cr :r x asFloat :r y asFloat :r width asFloat :r height asFloat ]

Cairo newPath				[ libcairo _cairo_new_path		:_cr ]
Cairo stroke				[ libcairo _cairo_stroke		:_cr ]
Cairo fill				[ libcairo _cairo_fill			:_cr ]
Cairo fillPreserve      [ libcairo cairo_fill_preserve  :_cr ]
Cairo clip				[ libcairo _cairo_clip			:_cr ]
Cairo resetClip				[ libcairo _cairo_reset_clip		:_cr ]
Cairo save				[ libcairo _cairo_save			:_cr ]
Cairo restore				[ libcairo _cairo_restore		:_cr ]

Cairo moveTo: p				[ libcairo _cairo_move_to		:_cr :p x asFloat :p y asFloat ]
Cairo moveBy: p				[ libcairo _cairo_rel_move_to		:_cr :p x asFloat :p y asFloat ]
Cairo lineTo: p				[ libcairo _cairo_line_to		:_cr :p x asFloat :p y asFloat ]
Cairo lineBy: p				[ libcairo _cairo_rel_line_to		:_cr :p x asFloat :p y asFloat ]
Cairo closePath             [ libcairo cairo_close_path :_cr ]

Cairo identityMatrix			[ libcairo _cairo_identity_matrix	:_cr ]
Cairo translateX: x Y: y		[ libcairo _cairo_translate		:_cr :x asFloat :y asFloat ]
Cairo transform: t			[ libcairo _cairo_transform		:_cr :t asTransform2D ]
Cairo translate: p	[ libcairo _cairo_translate	:_cr :p x asFloat :p y asFloat ]
Cairo scale:	p	[ libcairo _cairo_scale		:_cr :p x asFloat :p y asFloat ]

Cairo paint                 [ libcairo _cairo_paint :_cr ]

Cairo showText: s			[
    self scale: 1, -1.
    libcairo _cairo_show_text		:_cr :s _stringValue.
    self scale: 1, -1.
]

Cairo rectangleX: x Y: y W: width H: height
[
    libcairo _cairo_rectangle :_cr :x asFloat :y asFloat :width asFloat :height asFloat
]

Cairo getCurrentPoint
[
    | x y |
    x := Float new.
    y := Float new.
    libcairo cairo_get_current_point :_cr :x :y.
    ^ Pair x: x y: y
]

CairoTextExtents : Object (x_bearing y_bearing width height x_advance y_advance)
CairoTextExtents x_bearing: _x_bearing y_bearing: _y_bearing width: _width height: _height x_advance: _x_advance y_advance: _y_advance
[
    x_bearing := _x_bearing.
    y_bearing := _y_bearing.
    width := _width.
    height := _height.
    x_advance := _x_advance.
    y_advance := _y_advance.
]

CairoTextExtents x_bearing [^x_bearing]
CairoTextExtents y_bearing [^y_bearing]
CairoTextExtents width [^width]
CairoTextExtents height [^height]
CairoTextExtents x_advance [^x_advance]
CairoTextExtents y_advance [^y_advance]

CairoTextExtents printOn: aStream
[
    aStream nextPutAll: 'CairoTextExtents ('.
    aStream nextPutAll: 'x_bearing: '; print: x_bearing.
    aStream nextPutAll: ',y_bearing: '; print: y_bearing.
    aStream nextPutAll: ',width: '; print: width.
    aStream nextPutAll: ',height: '; print: height.
    aStream nextPutAll: ',x_advance: '; print: x_advance.
    aStream nextPutAll: ',y_advance: '; print: y_advance.
    aStream nextPutAll: ')'.
]

Cairo textExtents: utf8
[
    | x_bearing y_bearing width height x_advance y_advance |
    x_bearing := Float new.
    y_bearing := Float new.
    width := Float new.
    height := Float new.
    x_advance := Float new.
    y_advance := Float new.
    libcairo _textExtents :_cr :utf8 _stringValue :x_bearing :y_bearing :width :height :x_advance :y_advance.
    ^ CairoTextExtents new x_bearing: x_bearing y_bearing: y_bearing width: width height: height x_advance: x_advance y_advance: y_advance.
]

libcairo _textExtents :_cr :_utf8 :x_bearing :y_bearing :width :height :x_advance :y_advance {
    cairo_text_extents_t extents;
    cairo_text_extents((cairo_t *)(long)v__cr, (char *)(long)v__utf8, &extents);
    memcpy(v_x_bearing, &extents.x_bearing, sizeof(double));
    memcpy(v_y_bearing, &extents.y_bearing, sizeof(double));
    memcpy(v_width, &extents.width, sizeof(double));
    memcpy(v_height, &extents.height, sizeof(double));
    memcpy(v_x_advance, &extents.x_advance, sizeof(double));
    memcpy(v_y_advance, &extents.y_advance, sizeof(double));
}

"----------------------------------------------------------------"
"NullCanvas is used in test cases. It assumes every fonts are 8x18."

NullCanvas : Object ()

NullCanvas setFontSize: aNumber []
NullCanvas selectFontFace: family []

NullCanvas textExtents: aString
[
    ^ CairoTextExtents new x_bearing: 0 y_bearing: -8
        width: aString size * 8 height: 18
        x_advance: aString size * 8 y_advance: 0.
]

{ import: HostWindow }

NullWindow : HostWindow ()

NullWindow painter [ ^NullCanvas new ]
"----------"

Cairo setClipRectangle: aRectangle
[
    self resetClip; newPath; rectangle: aRectangle; clip
]