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

"{ NameSpace: Smalltalk }"

DeviceGraphicsContext subclass:#CairoGraphicsContext

	instanceVariableNames:'cr crId'

	classVariableNames:'Lobby'

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

	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.

    "Modified: / 09-01-2015 / 15:08:47 / 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'!

    cr font: family slant: slant weight: weight.

    cr fontSize: psize .

!

function:aFunctionSymbol

    "set the drawing function"

    ^ self shouldImplement

!

lineWidth: w

    super lineWidth: w. 

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

!

mask:aForm

    "set the drawing mask"

    ^ self shouldImplement

!

paint: aColor

    super paint: aColor.

    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: / 13-02-2016 / 17:39:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'accessing-transformation'!

transformation:aTransformation 

    "set the transformation"

    super transformation: aTransformation.

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

    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"

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

    cr stroke.

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

!

    cr save.

    [ 

        cr moveToX: x y: y.

        ] ifFalse:[ 

        ].

    ] ensure:[ 

        cr restore.

    ]

! !

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

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

    cr strokeAndPreserve.

    cr fill.

! !

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

    image := aFormOrImage asImage.

    width := image width.

    height := image height.

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

    [

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

    ] ensure:[ 

        data finalize.

        image_surface release.

    ].

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

!

displayRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn

    | r pi |

    wCorn ~~ hCorn ifTrue:[ 

        self notYetImplemented.

    ].

    r := wCorn / 2.

    pi := Float pi.

    "/ top-left arc

    cr arcX: x + r     y: y + r     radius: r from:         pi to: (3/2) * pi.

    "/ top-right atc

    cr arcX: x + w - r y: y + r     radius: r from: (3/2) * pi to: 0.0.

    "/ bottom-right atc

    cr arcX: x + w - r y: y + h - r radius: r from: 0.0        to: (1/2) * pi.

    "/ bottom-left atc

    cr arcX: x + r     y: y + h - r radius: r from: (1/2) * pi to:         pi.

    cr closePath.

    cr stroke.

    "

     |v|

     (v := View new) extent:200@200; openAndWait.

     v cairo 

            lineWidth: 5;

            displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20;

            release

    "

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

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

! !

!CairoGraphicsContext methodsFor:'filling'!

fillRoundRectangleX:x y:y width:w height:h wCorner:wCorn hCorner:hCorn

    | r pi |

    wCorn ~~ hCorn ifTrue:[ 

        self notYetImplemented.

    ].

    r := wCorn / 2.

    pi := Float pi.

    "/ top-left arc

    cr arcX: x + r     y: y + r     radius: r from:         pi to: (3/2) * pi.

    "/ top-right atc

    cr arcX: x + w - r y: y + r     radius: r from: (3/2) * pi to: 0.0.

    "/ bottom-right atc

    cr arcX: x + w - r y: y + h - r radius: r from: 0.0        to: (1/2) * pi.

    "/ bottom-left atc

    cr arcX: x + r     y: y + h - r radius: r from: (1/2) * pi to:         pi.

    cr closePath.

    cr fill.

    "

     |v|

     (v := View new) extent:200@200; openAndWait.

     v cairo 

            lineWidth: 5;

            displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20;

            release

    "

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

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

! !

!CairoGraphicsContext methodsFor:'finalization'!

executor

    ^ super executor

    "/^ self shallowCopy

    "Created: / 12-02-2016 / 17:04:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

finalization

    self destroy

    "Created: / 09-01-2015 / 10:20:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

finalizationLobby

    "answer a Registry used for finalization.

     Use a generic Registry for any object.

     Subclasses using their own Registry should redefine this"

    ^ Lobby

    "Created: / 09-01-2015 / 10:20:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CairoGraphicsContext methodsFor:'initialization & release'!

createCR

    "Physically create a Cairo graphics context"