[Cuis-dev] VectorGraphics and Morph
Hilaire Fernandes
hilaire at drgeo.eu
Sat Jul 4 13:46:11 PDT 2020
Hi,
I have been porting part of the Squeak PolygonMorph (in fact I am just
porting the polygon part not the curved part). WIP file out attached,
the Vector Engine Paste Up morph hack posted by Juan a few days ago is
needed.
I need to adress the #morphContainsPoint:
The current code is as bellow, the filled polygon detection part seems
to use the mask technique you described.
containsPoint: aPoint (super containsPoint: aPoint) ifFalse: [^
false]. (closed and: [color isTransparent not]) ifTrue: [ ^
(self filledForm pixelValueAt: aPoint - bounds topLeft + 1) > 0].
self lineSegmentsDo: [ :p1 :p2 | (aPoint onLineFrom: p1
to: p2 within: (3 max: borderWidth+1//2) asFloat)
ifTrue: [^ true]]. self arrowForms do: [ :f | (f
pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]]. ^ false
Juan, can you document a bit more how to use your technique described
bellow to make morph detection on the filled part of the polygon shape?
Thanks
Hilaire
Le 19/06/2020 à 17:30, Juan Vuletich via Cuis-dev a écrit :
> VectorEngine already does this. It includes an extra buffer, ivar
> 'morphIds' in VectorEngine classes. Recently I also added ivar 'id' to
> Morph. For every pixel the engine draws in the context of a Morph, its
> id is stored at pixel position in morphIds. Then, it is just a matter
> of querying morphIds.
>
> For Cairo, the technique you wrote can be used. For regular,
> orthorectangular morhps in BitBlt canvas, the simple existing code can
> still be used. For morphs that use VectorGraphics to build cached
> Forms, as developed by Hilaire, it is just a matter of querying the
> form for transparency.
>
> All this means that soon no morph will need to include geometry
> specific code for hit detection (#morphContainsPoint:) at all.
>
> All we need to do is to make all this work consistently in a framework.
--
GNU Dr. Geo
http://drgeo.eu
https://pouet.chapril.org/@hilaire
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.cuis.st/mailman/archives/cuis-dev/attachments/20200704/1f25e5de/attachment.htm>
-------------- next part --------------
'From Cuis 5.0 [latest update: #4228] on 4 July 2020 at 10:37:38 pm'!
!classDefinition: #PolygonMorph category: #'DrGeo-Models-Morphs'!
BorderedRectMorph subclass: #PolygonMorph
instanceVariableNames: 'vertices closed filledForm arrows arrowForms borderDashSpec borderForm'
classVariableNames: ''
poolDictionaries: ''
category: 'DrGeo-Models-Morphs'!
!PolygonMorph commentStamp: '<historical>' prior: 0!
A morph to represent polygon (closed) or polyline (open)!
!PolygonMorph methodsFor: 'geometry'!
closestPointTo: aPoint
| closestPoint minDist |
closestPoint _ minDist := nil.
self lineSegmentsDo:
[:p1 :p2 | | dist curvePoint |
curvePoint _ aPoint nearestPointOnLineFrom: p1 to: p2.
dist _ curvePoint distanceTo: aPoint.
(closestPoint isNil or: [dist < minDist])
ifTrue:
[closestPoint _ curvePoint.
minDist _ dist]].
^closestPoint! !
!PolygonMorph methodsFor: 'geometry'!
closestSegmentTo: aPoint
"Answer the starting index of my (big) segment nearest to aPoint"
| closestPoint minDist vertexIndex closestVertexIndex |
vertexIndex _ 0.
closestVertexIndex _ 0.
closestPoint _ minDist := nil.
self lineSegmentsDo:
[:p1 :p2 | | curvePoint dist |
(p1 = (self vertices at: vertexIndex + 1))
ifTrue: [ vertexIndex _ vertexIndex + 1 ].
curvePoint _ aPoint nearestPointOnLineFrom: p1 to: p2.
dist _ curvePoint distanceTo: aPoint.
(closestPoint isNil or: [dist < minDist])
ifTrue: [closestPoint _ curvePoint.
minDist _ dist.
closestVertexIndex _ vertexIndex. ]].
^ closestVertexIndex! !
!PolygonMorph methodsFor: 'geometry' stamp: 'hlsf 7/4/2020 11:14:00'!
makeClosed
closed _ true! !
!PolygonMorph methodsFor: 'geometry' stamp: 'hlsf 7/3/2020 23:17:40'!
makeOpen
closed _ false.! !
!PolygonMorph methodsFor: 'geometry' stamp: 'hlsf 7/4/2020 11:23:55'!
morphExtent
^ extent ifNil: [
extent _ (( Rectangle encompassing: vertices ) expandBy: borderWidth * 0.5 ) encompassingIntegerRectangle]! !
!PolygonMorph methodsFor: 'accessing' stamp: 'hlsf 7/3/2020 13:00:04'!
lineSegmentsDo: endPointsBlock
"Emit a sequence of segment endpoints into endPointsBlock."
| beginPoint |
vertices size < 1
ifTrue: [^ self].
"test too few vertices first"
beginPoint _ nil.
vertices do: [:vert |
beginPoint ifNotNil: [
endPointsBlock value: beginPoint value: vert].
beginPoint _ vert].
(closed or: [vertices size = 1]) ifTrue: [
endPointsBlock value: beginPoint value: vertices first].
! !
!PolygonMorph methodsFor: 'accessing' stamp: 'hlsf 7/3/2020 13:00:34'!
nextToFirstPoint
"For arrow direction"
^ vertices second! !
!PolygonMorph methodsFor: 'accessing' stamp: 'hlsf 7/3/2020 13:00:57'!
nextToLastPoint
"For arrow direction"
^ vertices at: vertices size - 1! !
!PolygonMorph methodsFor: 'accessing'!
vertices
^ vertices! !
!PolygonMorph methodsFor: 'accessing' stamp: 'hlsf 7/4/2020 14:37:39'!
vertices: newVertices
vertices _ newVertices.
self releaseCachedState ! !
!PolygonMorph methodsFor: 'to refactor'!
arrowForms
"ArrowForms are computed only upon demand"
arrowForms
ifNotNil: [^ arrowForms].
arrowForms _ Array new.
self hasArrows
ifFalse: [^ arrowForms].
(arrows == #forward
or: [arrows == #both])
ifTrue: [arrowForms _ arrowForms
copyWith: (self computeArrowFormAt: vertices last from: self nextToLastPoint)].
(arrows == #back
or: [arrows == #both])
ifTrue: [arrowForms _ arrowForms
copyWith: (self computeArrowFormAt: vertices first from: self nextToFirstPoint)].
^ arrowForms! !
!PolygonMorph methodsFor: 'to refactor'!
computeArrowFormAt: endPoint from: priorPoint
"Compute a triangle oriented along the line from priorPoint to
endPoint. Then draw those lines in a form and return that
form, with appropriate offset"
| p1 pts box arrowForm bb origin |
pts _ self arrowBoundsAt: endPoint from: priorPoint.
box _ ((pts first rectangle: pts last) encompass: (pts second)) expandBy: 1.
arrowForm _ Form extent: box extent asIntegerPoint.
bb _ (BitBlt toForm: arrowForm)
sourceForm: nil;
fillColor: Color black;
combinationRule: Form over;
width: 1;
height: 1.
origin _ box topLeft.
p1 _ pts last - origin.
pts do:
[:p |
bb drawFrom: p1 to: p - origin.
p1 _ p - origin].
arrowForm convexShapeFill: Color black.
^arrowForm offset: box topLeft! !
!PolygonMorph methodsFor: 'to refactor'!
filledForm
"Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1 at 1 in the form. This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside. Computation of the filled form is done only on demand."
| bb origin |
closed ifFalse: [^ filledForm _ nil].
filledForm ifNotNil: [^ filledForm].
filledForm _ Form extent: bounds extent+2.
"Draw the border..."
bb _ (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black;
combinationRule: Form over; width: 1; height: 1.
origin _ bounds topLeft asIntegerPoint-1.
self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
to: p2 asIntegerPoint-origin].
"Fill it in..."
filledForm convexShapeFill: Color black.
(borderColor isColor and: [borderColor isTranslucentButNotTransparent]) ifTrue:
["If border is stored as a form, then erase any overlap now."
filledForm copy: self borderForm boundingBox from: self borderForm
to: 1 at 1 rule: Form erase].
^ filledForm! !
!PolygonMorph methodsFor: 'testing'!
containsPoint: aPoint
(super containsPoint: aPoint) ifFalse: [^ false].
(closed and: [color isTransparent not]) ifTrue:
[ ^ (self filledForm pixelValueAt: aPoint - bounds topLeft + 1) > 0].
self lineSegmentsDo:
[ :p1 :p2 |
(aPoint onLineFrom: p1 to: p2 within: (3 max: borderWidth+1//2) asFloat)
ifTrue: [^ true]].
self arrowForms do:
[ :f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]].
^ false! !
!PolygonMorph methodsFor: 'testing'!
hasArrows
"Are all the conditions meet for having arrows?"
^ (closed or: [arrows == #none or: [vertices size < 2]]) not! !
!PolygonMorph methodsFor: 'arrow'!
arrowBoundsAt: endPoint from: priorPoint
"Answer a triangle oriented along the line from priorPoint to endPoint."
| d v angle wingBase arrowSpec length width |
v _ endPoint - priorPoint.
angle _ v degrees.
d _ borderWidth max: 1.
arrowSpec _ self valueOfProperty: #arrowSpec ifAbsent: [PolygonMorph defaultArrowSpec].
length _ arrowSpec x abs. width := arrowSpec y abs.
wingBase _ endPoint + (Point r: d * length degrees: angle + 180.0).
arrowSpec x >= 0
ifTrue: [^ { endPoint.
wingBase + (Point r: d * width degrees: angle + 125.0).
wingBase + (Point r: d * width degrees: angle - 125.0) }]
ifFalse: ["Negative length means concave base."
^ { endPoint.
wingBase + (Point r: d * width degrees: angle + 125.0).
wingBase.
wingBase + (Point r: d * width degrees: angle - 125.0) }]! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:14:59'!
arrowSpec: specPt
"Specify a custom arrow for this line.
specPt x abs gives the length of the arrow (point to base) in terms of borderWidth.
If specPt x is negative, then the base of the arrow will be concave.
specPt y abs gives the width of the arrow.
The standard arrow is equivalent to arrowSpec: PolygonMorph defaultArrowSpec.
See arrowBoundsAt:From: for details."
self setProperty: #arrowSpec toValue: specPt! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:13:55'!
makeBackArrow
arrows _ #back.! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:13:50'!
makeBothArrows
arrows _ #both.! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:14:04'!
makeForwardArrow
arrows _ #forward! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:14:07'!
makeNoArrows
arrows _ #none! !
!PolygonMorph methodsFor: 'arrow' stamp: 'hlsf 7/4/2020 11:14:14'!
standardArrows
self removeProperty: #arrowSpec.! !
!PolygonMorph methodsFor: 'drawing' stamp: 'hlsf 7/4/2020 22:37:33'!
adjustSegmentPointsForArrows
" In the list of vertices, adjust first and last entry if this polygon uses arrows.
Returned the adjusted vertices, and if any the arrows bound"
| verts arrowsBound |
self hasArrows ifFalse: [ ^ Array with: vertices with: nil].
verts _ vertices copy.
arrowsBound _ Array new: 2.
(arrows == #back or: [ arrows == #both ])
ifTrue: [ | arrow |
arrow _ self arrowBoundsAt: verts first from: verts second.
arrowsBound at: 1 put: arrow.
arrow size = 4
ifTrue: [ verts at: 1 put: arrow third ]
ifFalse: [ verts at: 1 put: (arrow copyFrom: 2 to: 3) average ] ].
(arrows == #forward or: [ arrows == #both ])
ifTrue: [ | arrow |
arrow _ self arrowBoundsAt: verts last from: (verts at: (verts size - 1)).
arrowsBound at: 2 put: arrow.
arrow size = 4
ifTrue: [ verts at: verts size put: arrow third ]
ifFalse: [ verts at: verts size put: (arrow copyFrom: 2 to: 3) average ] ].
^ Array with: verts with: arrowsBound ! !
!PolygonMorph methodsFor: 'drawing' stamp: 'hlsf 7/3/2020 22:21:20'!
drawArrow: pts on: aCanvas at: endPoint from: priorPoint
"Draw a triangle oriented along the line from priorPoint to
endPoint. Answer the wingBase."
| spec |
spec _ self valueOfProperty: #arrowSpec ifAbsent: [PolygonMorph defaultArrowSpec].
spec x sign = spec y sign
ifTrue: [aCanvas fillColor: borderColor do: [aCanvas polyLine: pts]]
ifFalse:
[aCanvas strokeWidth: (borderWidth + 1) // 2 color: borderColor do: [aCanvas polyLine: pts]].! !
!PolygonMorph methodsFor: 'drawing' stamp: 'hlsf 7/3/2020 22:16:34'!
drawArrows: arrowsBound on: aCanvas
"Answer (possibly modified) endpoints for border drawing"
"ArrowForms are computed only upon demand"
arrowsBound ifNil: [^ self ]. "No arrow"
"backward arrow?"
arrowsBound first ifNotNil: [:arrow |
self drawArrow: arrow on: aCanvas at: vertices first from: self nextToFirstPoint].
"forward arrow?"
arrowsBound second ifNotNil: [ :arrow |
self drawArrow: arrow on: aCanvas at: vertices last from: self nextToLastPoint].
! !
!PolygonMorph methodsFor: 'drawing' stamp: 'hlsf 7/3/2020 21:50:55'!
drawOn: aCanvas
| verticesAndArrows |
vertices size < 1
ifTrue: [self error: 'a polygon must have at least one point'].
verticesAndArrows _ self adjustSegmentPointsForArrows.
closed ifTrue: [
aCanvas
strokeWidth: borderWidth
color: borderColor
fillColor: color
do: [aCanvas polyLine: verticesAndArrows first]]
ifFalse: [
aCanvas
strokeWidth: borderWidth
color: borderColor
do: [aCanvas polyLine: verticesAndArrows first]].
self drawArrows: verticesAndArrows second on: aCanvas.! !
!PolygonMorph methodsFor: 'dashes'!
borderDashOffset
borderDashSpec size < 4 ifTrue: [^0.0].
^ (borderDashSpec fourth) asFloat! !
!PolygonMorph methodsFor: 'dashes'!
dashedBorder
^borderDashSpec
"A dash spec is a 3- or 5-element array with
{ length of normal border color.
length of alternate border color.
alternate border color.
starting offset.
amount to add to offset at each step }
Starting offset is usually = 0, but changing it moves the dashes along the curve."
! !
!PolygonMorph methodsFor: 'dashes'!
dashedBorder: dashSpec
"A dash spec is a 3- or 5-element array with
{ length of normal border color.
length of alternate border color.
alternate border color.
starting offset.
amount to add to offset at each step }
Starting offset is usually = 0, but changing it moves the dashes along the curve."
borderDashSpec _ dashSpec.
self changed! !
!PolygonMorph methodsFor: 'initialization' stamp: 'hlsf 7/4/2020 14:36:26'!
initialize
super initialize.
extent _ nil.
vertices _ Array
with: 5 @ 0
with: 20 @ 10
with: 0 @ 20.
closed _ true.
arrows _ #none! !
!PolygonMorph methodsFor: 'initialization' stamp: 'hlsf 7/4/2020 14:37:28'!
releaseCachedState
super releaseCachedState.
filledForm _ nil.
arrowForms _ nil.
borderForm _ nil.
extent _ nil! !
!PolygonMorph methodsFor: 'initialization' stamp: 'hlsf 7/3/2020 23:01:42'!
vertices: verts color: aColor borderWidth: borderWidthInteger borderColor: anotherColor
super initialize.
vertices _ verts.
color _ aColor.
borderWidth _ borderWidthInteger.
borderColor _ anotherColor.
closed _ vertices size > 2.
arrows _ #none.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
!classDefinition: 'PolygonMorph class' category: #'DrGeo-Models-Morphs'!
PolygonMorph class
instanceVariableNames: ''!
!PolygonMorph class methodsFor: 'examples' stamp: 'hlsf 7/4/2020 14:20:32'!
example1
"self example1"
^ PolygonMorph
vertices: {61 at 100. 88 at 219. 102 at 95. 22 at 50. 41 at 83}
color: Color blue
borderWidth: 3
borderColor: Color black! !
!PolygonMorph class methodsFor: 'examples' stamp: 'hlsf 7/4/2020 14:21:23'!
example2
"self example2"
^ PolygonMorph
vertices: {61 at 100. 88 at 219. 102 at 95. 22 at 50. 41 at 83}
color: Color blue
borderWidth: 1
borderColor: Color black.! !
!PolygonMorph class methodsFor: 'examples' stamp: 'hlsf 7/4/2020 14:21:27'!
example3
"self example3"
| poly |
poly _ PolygonMorph
vertices: {61 at 100. 88 at 219. 102 at 95. 22 at 50. 41 at 83}
color: Color blue
borderWidth: 3
borderColor: Color black.
poly makeOpen.
^ poly ! !
!PolygonMorph class methodsFor: 'examples' stamp: 'hlsf 7/4/2020 14:21:31'!
example4
"self example4"
| poly |
poly _ (PolygonMorph
vertices: {61 at 100. 88 at 219. 102 at 95. 22 at 50. 41 at 83}
color: Color blue
borderWidth: 3
borderColor: Color black).
poly dashedBorder: { 5 .
5.
Color red.
50 .
0 }.
^ poly ! !
!PolygonMorph class methodsFor: 'instance creation' stamp: 'hlsf 7/4/2020 11:14:28'!
arrowPrototype
"Answer an instance of the receiver that will serve as a prototypical arrow"
"PolygonMorph arrowPrototype openInWorld"
| aa |
aa _ self new.
aa vertices: (Array with: 0 at 0 with: 40 at 40)
color: Color black
borderWidth: 2
borderColor: Color black.
aa makeForwardArrow.
^ aa! !
!PolygonMorph class methodsFor: 'instance creation' stamp: 'hlsf 7/3/2020 13:05:48'!
vertices: verts color: c borderWidth: bw borderColor: bc
"(PolygonMorph
vertices: {261 at 400. 388 at 519. 302 at 595. 222 at 500. 141 at 583. 34 at 444}
color: Color blue
borderWidth: 3
borderColor: Color black) openInWorld"
^ self basicNew vertices: verts color: c borderWidth: bw borderColor: bc! !
!PolygonMorph class methodsFor: 'settings'!
defaultArrowSpec
^ 5 at 4! !
More information about the Cuis-dev
mailing list