"{ Package: 'stx:goodies/libcairo' }"

"{ NameSpace: Smalltalk }"

DeviceGraphicsContext subclass:#CairoGraphicsContext

	instanceVariableNames:'cr'

	poolDictionaries:'Cairo::FontSlant Cairo::FontWeight Cairo::Format Cairo::Status'

	category:'Cairo-Compatibility'

!

!CairoGraphicsContext class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    Lobby := Registry new.

! !

!CairoGraphicsContext class methodsFor:'instance creation'!

onDeviceGraphicsContext: dGC

    | cGC |

    cGC := self basicNew.

    1 to: DeviceGraphicsContext instSize do:[:i |

    ].

    dGC gcId notNil ifTrue:[ 

    ].

    ^ cGC

    "Created: / 15-02-2016 / 21:20:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext class methodsFor:'accessing'!

dllPath

    OperatingSystem isMSWINDOWSlike ifTrue:[

        ^ #( 'C:\Windows' 'C:\Windows\System32' "Wild guess, should not harm" )

    ].

    OperatingSystem isUNIXlike ifTrue:[

        OperatingSystem getSystemType == #linux ifTrue:[

            | path |

            path := #( '/lib' '/usr/lib' '/usr/local/lib' ).

            (OperatingSystem getSystemInfo at:#machine) = 'x86_64' ifTrue:[

                "If the machine is 64bit, prepend standard path for 32bit libs.

                 Leave standard paths at the end, as the system might be completely

                 32bit but running on 64bit-capable CPU.

                CAVEAT: This is bit dangerous, as on 64bit OS, if ia32 libs are

                not installed byt 64bit sqlite libs are, then 64bit libs are found

                and when a function is called, segfault will occur!!

                Q: Is there a way how to figure out if the OS itself is 32bit,

                regardles on CPU?"

                path := #( '/lib32' '/usr/lib32' '/usr/local/lib32' ) , path.

            ].

            ^path

        ].

    ].

    self error:'Unsupported operating system'

    "

        SqliteLibrary dllPath

    "

    "Created: / 31-08-2011 / 18:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

libraryName

    OperatingSystem isUNIXlike ifTrue:[^'libcairo.so.2'].

    OperatingSystem isMSWINDOWSlike ifTrue:[^'cairo.dll'].

    self error:'Library name for host OS is not known'

!

sizeof

    "Returns size of undelaying structure in bytes"

    ^0

! !

!CairoGraphicsContext class methodsFor:'examples'!

rectangleOnTranscript

    "

        Cairo::GraphicsContext rectangleOnTranscript

    "

    | gc |

    gc := Transcript cairo.

    gc paint: Color black.

    gc moveToX: 30 y: 50.

    gc paint: (Color red alpha: 0.5).

    gc rectangleX: 10 y: 15 width: 150 height: 60.

    gc fill.

    gc paint: (Color red alpha: 0.75).

    gc rectangleX: 10 y: 15 width: 150 height: 60.

    gc stroke.

    "Created: / 23-04-2009 / 17:33:57 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'accessing'!

basicFont:aFont

    (aFont ~~ font) ifTrue:[     

        super basicFont: aFont.

        font notNil ifTrue:[ 

            font := CairoScaledFont fromFontDescription: font onDevice: device.

            cr notNil ifTrue:[ 

                cr font: font scaledFont.

                cr fontSize: (Screen current verticalPixelPerInch / 72) * font size.

            ].

        ].

    ].

    "Created: / 16-02-2016 / 15:37:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2016 / 00:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

clippingBounds:aRectangleOrNil

    "set the clipping rectangle for drawing (in logical coordinates);

     a nil argument turn off clipping (i.e. whole view is drawable)"    

    ^ super clippingBounds:aRectangleOrNil

    "Created: / 15-02-2016 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

function:aFunctionSymbol

    "set the drawing function"

    ^ self shouldImplement

!

lineWidth: w

    super lineWidth: w. 

    cr lineWidth: (w == 0 ifTrue:[ 1 ] ifFalse:[ w ]).

    "Created: / 17-06-2012 / 21:55:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-02-2016 / 10:13:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mask:aForm

    "set the drawing mask"

    ^ self shouldImplement

!

paint: aColor

    super paint: aColor.

    "Created: / 10-07-2008 / 11:18:13 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 23-04-2009 / 17:31:33 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'accessing-transformation'!

transformation:aTransformation 

    "set the transformation"

    super transformation: aTransformation.

    cr matrixReset.

    transformation notNil ifTrue:[    

        cr

            scale: transformation scale;

            transform: transformation translation.

    ]

    "Created: / 01-01-2015 / 12:07:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-02-2016 / 10:59:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'basic drawing'!

displayArcX:x y:y width:w height:h from:start angle:angle

    | angle1 angle2 |

    cr save.  

    [

        w ~~ h ifTrue:[

            self notYetImplemented

        ].

        angle1 := (360 - start) .

        angle2 := (360 - (start + angle)) \\ 360.

        (angle2 < angle1) ifTrue:[

            cr arcNegativeX: (x + (w / 2)) y: (y + (h / 2)) radius: w / 2 from: angle1 * (Float pi / 180) to: angle2 * (Float pi / 180).

        ] ifFalse:[ 

            cr arcNegativeX: (x + (w / 2)) y: (y + (h / 2)) radius: w / 2 from: angle2 * (Float pi / 180) to: angle1 * (Float pi / 180).

        ].

        cr stroke.

        w ~~ h ifTrue:[

            self notYetImplemented

        ].

    ] ensure:[ 

        cr restore.

    ]

    "Modified: / 13-02-2016 / 20:05:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

displayLineFromX:x0 y:y0 toX:x1 y:y1

    "draw a line from x0/y0 to x1/y1"

    cr moveToX: x0 y: y0.

    cr lineToX: x1 y: y1.

    cr stroke.

    "Modified: / 13-02-2016 / 20:05:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

displayPolygon:points

    "draw a polygon

     - this could be recoded to draw using displayLine"

    cr moveToX: points first x asFloat y: points first y asFloat.

    2 to: points size do:[:i |  

        cr lineToX: (points at: i) x asFloat  y: (points at: i) y asFloat

    ].

    cr closePath.

    cr stroke.

    "Modified: / 13-02-2016 / 20:04:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

displayRectangleX:x y:y width:w height:h

    "draw a rectangle

     - this could be recoded to draw using displayLine"

    (w > 0 and:[h > 0]) ifTrue:[

        cr rectangleX: x y: y width: w height: h.

        cr stroke.

    ]

    "Modified: / 18-02-2016 / 22:21:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

displayString:aStringArg from:index1Arg to:index2Arg x:x y:y opaque:opaqueArg maxWidth:maxWidth

    "draw a substring at the coordinate x/y - draw foreground pixels in

     paint-color and (if opaque is true), background pixels in bgPaint-color.

     If the transformation involves scaling, the font's point-size is scaled as appropriate.

     Assuming that device can only draw in device colors, we have to handle

     the case where paint and/or bgPaint are dithered colors.

     maxWidth is the maximum width of the string in pixels or nil if unknown."    

    | opaque string |

    "

     if backgroundPaint color is nil, we assume

     this is a non-opaque draw

    "

    opaque := opaqueArg ? false.

    bgPaint isNil ifTrue:[

        opaque := false.

    ].

    gcId isNil ifTrue:[

        self initGC

    ]. 

    (aStringArg isString not or:[aStringArg isText]) ifTrue:[

        "

         hook for non-strings (i.e. attributed text)

         that 'thing' should know how to display itself ...

        "

        aStringArg displayOn:self x:x y:y from:index1Arg to:index2Arg opaque:opaque.

        ^ self

    ].   

    (index1Arg == 1 and:[ index2Arg == aStringArg size ]) ifTrue:[ 

        string := aStringArg

    ] ifFalse:[ 

        string := aStringArg copyFrom: index1Arg to: index2Arg

    ].

    cr save.

    [ 

        | extents |

        extents := cr textExtents: string.

        cr rectangleX: x + extents xBearing ceiling y: y - font ascent ceiling  width: extents xAdvance ceiling height: font height ceiling.

        cr lineWidth: 0.

        opaque ifTrue:[ 

            cr source: bgPaint.

            cr fill.

        ] ifFalse:[

            "/ I'm not sure why this is required but if not done,

            "/ selected text is not rendered correcrtly...

            cr stroke.

        ].

        self assert: cr status == CAIRO_STATUS_SUCCESS.

        cr source: paint.

        cr moveToX: x y: y.

        cr showText: string.

        self assert: cr status == CAIRO_STATUS_SUCCESS.

    ] ensure:[ 

        cr restore.

    ]

    "Created: / 16-02-2016 / 10:51:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2016 / 21:12:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'basic filling'!

fillArcX:x y:y width:w height:h from:start angle:angle

    | angle1 angle2 |

    cr save. 

    [

        w ~~ h ifTrue:[

            self notYetImplemented

        ].

        angle1 := (360 - start) .

        angle2 := (360 - (start + angle)) \\ 360.

        cr moveToX: (x + (w / 2)) y: (y + (h / 2)).

        (angle2 < angle1) ifTrue:[

            cr arcNegativeX: (x + (w / 2)) y: (y + (h / 2)) radius: w / 2 from: angle1 * (Float pi / 180) to: angle2 * (Float pi / 180).

        ] ifFalse:[ 

            cr arcNegativeX: (x + (w / 2)) y: (y + (h / 2)) radius: w / 2 from: angle2 * (Float pi / 180) to: angle1 * (Float pi / 180).

        ].

        cr closePath.

        cr strokeAndPreserve.

        cr fill.

        w ~~ h ifTrue:[

            self notYetImplemented        

        ].

    ] ensure:[ 

        cr restore.

    ]

    "Modified: / 13-02-2016 / 20:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

fillPolygon:points

    "fill a polygon with current paint color"

    cr moveToX: points first x asFloat y: points first y asFloat.

    2 to: points size do:[:i |  

        cr lineToX: (points at: i) x asFloat  y: (points at: i) y asFloat

    ].

    cr closePath.

    cr strokeAndPreserve.

    cr fill.

    "Modified: / 13-02-2016 / 20:01:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

fillRectangleX:x y:y width:w height:h

    "fill a rectangle with current paint color"

    (w > 0 and:[h > 0]) ifTrue:[

        cr lineWidth: 0.      

        cr rectangleX: x y: y width: w height: h. 

        cr fill.

        cr lineWidth: (lineWidth == 0 ifTrue:[1] ifFalse:[lineWidth])  

    ].

"/    cr save.

"/    cr rectangleX: x y: y width: w height: h. 

"/    cr sourceR: 1 G: 0 B: 0.

"/    cr lineWidth: 1.  

"/    cr stroke.

"/    cr restore.

    "Modified: / 18-02-2016 / 22:20:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'bit blitting'!

copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY

    "copy bits from a smalltalk byteArray.

     The bits found there are supposed to be in the devices native format (i.e.

     translated to allocated color indices on pseudoColor devices and padded as required.

     The byteOrder is MSB and will be converted as appropriate by the underlying devices

     method to whatever the device needs."

    cr notNil ifTrue:[ 

        cr surface flush

    ].

    ^ super copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth padding:pad width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY

    "Created: / 18-02-2016 / 20:16:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async

    "copy from aDrawable into the receiver;

     the source may be the receiver as well - in this case its a scroll.

     All coordinates are in device coordinates.

     If the receiver is a view AND async is true, the call returns immediately

     - otherwise, it returns when the scroll operation is finished.

     (not all devices care for this).

     If the receiver is a pixmap, the call always returns immediately."

    cr notNil ifTrue:[ 

        cr surface flush

    ].

    ^ super copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async

    "Created: / 18-02-2016 / 20:17:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h

    "copy one plane from aDrawable into the receiver. 0's are drawn in

     background, while 1's are drawn with foreground color.

     The depth of aDrawable must (should) be 1.

     The drawable must have been allocated on the same device.

     All coordinates are in device coordinates."

     cr notNil ifTrue:[ 

        cr surface flush

    ].

    ^ super copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h

    "Created: / 18-02-2016 / 20:17:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'drawing'!

displayForm:aFormOrImage x:x y:y

    "draw a form (or image) at x/y; 

     if the form has depth 1, 1's in the form are

     drawn in current paint color, 0's are ignored.

     If the form has depth ~~ 1, the current fg color setting is ignored."

    | image width height stride data image_surface |

    ^ super displayForm:aFormOrImage x:x y:y.

    image := aFormOrImage asImage.

    width := image width.

    height := image height.

    stride := Cairo::CPrimitives cairo_format_stride_for_width: CAIRO_FORMAT_ARGB32 _: width.

    data := ExternalBytes basicNew allocateBytes: stride * height clear: false.

    [

        image bitsARGB32Into: data stride: stride fg: self paint bg:  self backgroundPaint. 

        image_surface := Cairo::CPrimitives cairo_image_surface_create_for_data: data _: CAIRO_FORMAT_ARGB32 _: width _: height _: stride.

        Cairo::CPrimitives cairo_set_source_surface: cr _: image_surface _: x asFloat _: y asFloat.

        Cairo::CPrimitives cairo_paint: cr.

    ] ensure:[ 

        data finalize.

        image_surface release.

    ].

    "Created: / 31-12-2014 / 12:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 17-02-2016 / 20:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

displayLineFrom:p0 to:p1

    "draw a line (with current paint-color); apply transformation if nonNil"

    ^ self displayLineFromX: p0 x y: p0 y toX: p1 x y: p1 y