Take a step back: separate Cairo's GraphicsContext (cairo_t) and Smalltalk/X's graphics context
...into two separate classes for cleaner responsibilities. Also, API of Smalltalk/X graphics
contexts does not play well with Cairo's save/restore semantics.
"{ 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'!
font:aFont
| dfont family slant psize weight |
dfont := aFont onDevice: device.
family := dfont family.
slant := SymbolicFontSlantToCairoFontSlantMap at: (dfont style ? 'roman').
weight := SymbolicFontFaceToCairoFontWeightMap at: (dfont face ? 'regular').
cr font: family slant: slant weight: weight.
psize := dfont pixelSize.
psize isNil ifTrue:[
psize := (self device verticalPixelPerInch / 72) * dfont size.
].
cr fontSize: psize .
font := ScaledFont family: dfont family face: dfont face style: dfont style size: dfont size.
font handle: (CPrimitives cairo_get_scaled_font: crId).
"Modified: / 13-02-2016 / 21:17:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
function:aFunctionSymbol
"set the drawing function"
^ self shouldImplement
!
lineWidth: w
super lineWidth: w.
cr lineWidth: w.
"Created: / 17-06-2012 / 21:55:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-02-2016 / 17:38:55 / 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.
cr
matrixReset;
scale: transformation scale;
transform: transformation translation.
"Created: / 01-01-2015 / 12:07:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-02-2016 / 19:55:47 / 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>"
!
displayOpaqueString:aString from:index1 to:index2 x:x y:y maxWitdh:maxWidth
"draw part of a string with both fg and bg at x/y in current font"
^ self shouldImplement
!
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>"
!
displayString:aString from:index1 to:index2 x:x y:y
"draw part of a string with fg at x/y in current font"
cr save.
[
cr moveToX: x y: y.
(index1 == 1 and:[ index2 == aString size ]) ifTrue:[
cr showText: aString
] ifFalse:[
cr showText: (aString copyFrom: index1 to: index2).
].
] ensure:[
cr restore.
]
"Modified: / 13-02-2016 / 20:04:22 / 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"
cr rectangleX: x y: y width: w height: h.
cr strokeAndPreserve.
cr fill.
"Modified: / 13-02-2016 / 20:01:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CairoGraphicsContext methodsFor:'bit blitting'!
copyFrom:aGC x:srcX y:srcY toX:dstX y:dstY width:w height:h
"copy from a drawable - maybe self"
^ self shouldImplement
! !
!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.
stride := 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 := CPrimitives cairo_image_surface_create_for_data: data _: CAIRO_FORMAT_ARGB32 _: width _: height _: stride.
CPrimitives cairo_set_source_surface: crId _: image_surface _: x asFloat _: y asFloat.
CPrimitives cairo_paint: crId.
] ensure:[
data finalize.
image_surface release.
].
"Created: / 31-12-2014 / 12:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-01-2015 / 02:48:32 / 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"
cr := self cairo.
"Created: / 12-02-2016 / 16:59:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-02-2016 / 19:56:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
createGC
"physically create a device GC.
Since we do not need a gc-object for the drawable until something is
really drawn, none is created up to the first draw.
This method is sent, when the first drawing happens"
super createGC.
self createCR
"Created: / 12-02-2016 / 16:58:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
destroyCR
"Tell Cairo library to destroy the corresponding C object.
Remember that object is physically destroyed only if internal
refcounter goes to zero. However, after calling destroy,
this instance should be treated as invalid."
cr notNil ifTrue:[
| surface |
surface := cr surface.
cr release.
surface release.
].
"Created: / 12-02-2016 / 16:59:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-02-2016 / 19:59:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
destroyGC
self destroyCR.
super destroyGC
"Created: / 12-02-2016 / 17:01:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
releaseCR
self destroyCR
"Created: / 12-02-2016 / 17:02:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
releaseGC
"destroy the associated device GC resource - can be done to be nice to the
display if you know that you are done with a drawable."
self releaseCR.
super releaseGC.
"Created: / 12-02-2016 / 17:03:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CairoGraphicsContext class methodsFor:'documentation'!
version
^'$Id$'
!
version_HG
^ '$Changeset: <not expanded> $'
! !
CairoGraphicsContext initialize!