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

"{ NameSpace: Smalltalk }"

DeviceGraphicsContext subclass:#CairoGraphicsContext

	instanceVariableNames:'cr'

	classVariableNames:''

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

		Cairo::Antialias Cairo::Extend'

	category:'Cairo-Compatibility'

!

!CairoGraphicsContext class methodsFor:'instance creation'!

onDeviceGraphicsContext: dGC

    | cGC |

    cGC := self basicNew.

    1 to: DeviceGraphicsContext instSize do:[:i |

        cGC instVarAt: i put: (dGC instVarAt: i).

    ].

    dGC gcId notNil ifTrue:[ 

        cGC initGC.

    ].

    ^ cGC

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

    "Modified: / 18-02-2016 / 22:50:51 / 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.

            ].

        ].

    ].

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

    "Modified: / 23-02-2016 / 14:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-02-2016 / 15:38:52 / jv"

!

cairoSurface

    gcId isNil ifTrue:[ 

        self initGC.

    ].

    cr isNil ifTrue:[ 

        ^ super cairoSurface

    ].

    ^ cr surface

    "Created: / 25-02-2016 / 10:46: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)"    

    #todo.

    ^ super clippingBounds:aRectangleOrNil

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

    "Modified: / 27-02-2016 / 15:20:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

function:aFunctionSymbol

    "set the drawing function"

    #todo.

    ^ super function:aFunctionSymbol

    "Modified: / 27-02-2016 / 15:21:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

lineWidth: w

    super lineWidth: w. 

    cr notNil ifTrue:[

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

    ].

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

    "Modified: / 23-02-2016 / 11:29:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mask:aForm

    "set the drawing mask"

    super mask: aForm.

    cr notNil ifTrue:[ 

        self maskSet.

    ].

    "Modified (format): / 08-03-2016 / 21:22:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

maskOrigin:aPoint

    "set the origin of the mask-pattern"

    super maskOrigin: aPoint.

    gcId notNil ifTrue:[

        mask notNil ifTrue:[   

            self maskSet.

        ].

    ].

    "Created: / 08-03-2016 / 21:23:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

paint: aColor

    super paint: aColor.

    cr notNil ifTrue:[

        cr source: paint.

    ].

    "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>"

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

!

paint:fgColor on:bgColor

    "Set the paint and background-paint color.

     The bg-paint is used in opaque-draw operations"

    super paint: fgColor on: bgColor.

    cr notNil ifTrue:[ 

        cr source: paint.        

    ].

    "Created: / 05-03-2016 / 16:35:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'accessing-transformation'!

transformation:aTransformation 

    "set the transformation"

    super transformation: aTransformation.

    cr notNil ifTrue:[

        cr matrixReset.

            cr

                scale: transformation scale;

                translate: transformation translation.

        ]

    ]

    "Created: / 01-01-2015 / 12:07:07 / 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 |

    gcId isNil ifTrue:[ 

        self initGC.

    ]. 

    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>"

    "Modified: / 21-02-2016 / 15:34:08 / jv"

!

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

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

    gcId isNil ifTrue:[ 

        self initGC.

    ].

    cr stroke.

    "Modified: / 21-02-2016 / 15:24:52 / jv"

!

displayPolygon:points

    "draw a polygon

     - this could be recoded to draw using displayLine"

    gcId isNil ifTrue:[ 

        self initGC.

    ]. 

    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>"

    "Modified: / 21-02-2016 / 15:34:19 / jv"

!

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

    "draw a rectangle

     - this could be recoded to draw using displayLine"

    gcId isNil ifTrue:[ 

        self initGC.

    ]. 

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

        cr stroke.

    ]

    "Modified: / 21-02-2016 / 15:34:34 / jv"

!

displayString:string from:index1 to:index2 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 |

    "

     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

    ]. 

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

        "

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

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

        "

        string displayOn:self x:x y:y from:index1 to:index2 opaque:opaque.

        ^ self

    ].   

    font class == CairoScaledFont ifTrue:[ 

        font displayString:string from:index1 to:index2 x:x y:y cr:cr fg: paint bg: bgPaint opaque:opaque

    ] ifFalse:[ 

        Logger warning:'Drawing text using non-Cairo font (%1 )on CairoGraphicsContext' with: font class name.

        cr surface flush.

        super displayString:string from:index1 to:index2 x:x y:y opaque:opaqueArg maxWidth:maxWidth.

        cr surface markDirty.

    ].

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

    "Modified: / 19-02-2016 / 21:04:49 / jv"

    "Modified: / 24-02-2016 / 17:14:20 / 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 |

    gcId isNil ifTrue:[ 

        self initGC.

    ].

    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>"

    "Modified: / 21-02-2016 / 15:34:47 / jv"

!

fillPolygon:points

    "fill a polygon with current paint color"

    gcId isNil ifTrue:[ 

        self initGC.

    ].

    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>"

    "Modified: / 21-02-2016 / 15:34:52 / jv"

!

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

    "fill a rectangle with current paint color"

    gcId isNil ifTrue:[ 

        self initGC.

    ].

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

        | savedWidth |

        savedWidth := cr lineWidth.

        cr lineWidth: 1.  

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

        cr strokeAndPreserve.

        cr lineWidth: savedWidth.  

        cr fill.

    ].

"/    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: / 21-02-2016 / 15:34:56 / jv"

    "Modified: / 28-02-2016 / 16:52:04 / 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.

    cr notNil ifTrue:[