[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