PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Creating a leopard pattern

https://www.purebasic.fr/english/viewtopic.php?t=84605

Page 1 of 1

Creating a leopard pattern

Posted: Sun Jun 23, 2024 7:45 pm
by Michael Vogel
I'd like to create some endless pattern (tiles) for wallpapers and fill functions. My first target is something like seen in the following SVG file - there are four different forms which look a little bit like distorted ellipses with a dashed outline.

But how to generate (quickly) such objects randomly so that size, form, rotation and the outline never looks the same? Just found Blob Maker which could also be a start...

The second code is a quick approach but doesn't look very promising so I hope, other tactics will show better results.

Code: Select all

CompilerIf #PB_Compiler_Version>555:Macro Base64Decoder(a,b,c,d):Base64DecoderBuffer(a,b,c,d):EndMacro:CompilerEndIf
M=?E-?S:R=AllocateMemory(M):If R:B=Base64Decoder(?S,M,R,M):Z=5524:If B:X=AllocateMemory(Z):F.s=SaveFileRequester("Save file","Gattopardo.svg","All files (*.*)|*.*",0):If F And UseLZMAPacker() And UncompressMemory(R,B,X,Z)=Z:CreateFile(0,F):WriteData(0,X,Z):EndIf:EndIf:EndIf
DataSection
S:
!db 'XQAAAAIAHg/LhxHYzmaRD4Meyv17M9R/6bfaKDF2JWYgTSoJbWr3KXA4MOfMHdsZJpIjXEI1M6azc0wZGEpmHph4iaHl/aOqVn0MDkeXPM43r3epBTU6cWP90tsBuIvShgX1hBJwysrwqvO1DPJMNvJPd9GDwIgWy2/6BhnBbrTKAB71yYPXi8NO9SUxjrn4bh+YNO0JPwRJIv0SuZcHxNp/+AKG123S4BxYofOo19PbIZ4B8qBmYZRu9Eo65Q7C'
!db 'yX8xbhaWoSgovnR0Rh2dVKdEUDhQjmJBJmzSU/Ysa1k282zzSO1hiqUeCR+BjEsOccuHEk12bRhim8i8Zb9nagybR47LwjPMWmTexqx/NIBc4UJgDT9Z8Ap4CeXOwOKz0AW1TTO4/pLC08NgbrworCkwTQ8C8ihZX5JsapQ2U3DO4lIoHAy74uVaMM2AM1ZIWKTLsxv2qXZPyV5V4Hqqbo+ftkAmDJJGwZku6TMW350cIKNcwWI7bFSkHiStQwdv'
!db '/864fHwW3oaBLloJYvs8ZvieAazQMYRtpnIvijmaNu+dmUMR5aDbGGtvZvPAhOHOmLBX0rBKoQ15Tp5cElgva/2/31sJMJvq6AY5ZNInJiNwWUL3l0kateFddlAnkSCYAX0ItG8Lgp8BnD8uA8CqxVkbAYFfyEujyCFSgxE0PBWi7yUA8wGvnwNEBcUFenOY5sKJL+TX+OPpDSOqZ0dBZBts4PRP2R5MCBtOs0XOpaCUYsxOiIfI8gYedv8E7yCn'
!db '3RMLsViQgSGBrAQ10eApvovjAiHGc/R1wik92nqZuF5brit4/ssrYE/vmEml65URuu7JYCaPrPqLe5rVRcOcAzVfCV1EirZJo+ZVE9G6UbfdImCi4MCLq4vN51hHF4sRcE3XlAXtv0dUnV9Zfu5BIWBTVbEzuqLTqEnfEqGd9w/mwL7kExzHnYAZWFx67X5cTc8ij+aTwi2pJtVg9Q1YBIBIQPtY5qujRCbRhOmkgm3IEMyOmcVhV4JxXpxfoBDV'
!db '+cyrpgRDJ+D/Xxe0nAFhAiNIZZtkINcqYd+kLUB60QlepECsGqETQLMCHvZdLNsYyIZ9CJQVSLb+eZuhjbsEjMu4qBg31dvlH6kncfm7F4lsC3Ppq9ur61bV/xw94SXk4ThlfrsWL1rjAUyE1otWyee9N/s30pCods4SAz1wXgC5yf6MXSfvOesFHyqjkLocz8UivmojmAzlKIitiWBvWCv0c2wvouAWHOtlrUr6ddyJKv6fx9gn1I2WVnsKbxY1'
!db 'b3mVAzSH3CfFEELcge1p3YBVFeikB21bNvZg5FQiwZgWoHEsPNc7Ee3Hrhtrmrr/y1NJfHGSS/9FFpq39ZNbCU4FatWRBfI+3ZTpw0KiEMtDvOHlCueAdvZhmfCqrqcC/qVJNfupQXlTs8ECrGpHE+US2IrHmxKV/ThMbWaxgzmzt3sE+TzZ2+suTTz2bE/vZ+0Yuh8EbY3HqYMgmvm6+HKfShmhW9efRweD46C3FUbhUPiNifzeisrhixGSK4VU'
!db 'ssuKG0dJ9Mmd9xLEFOCBFPBEgqxwAH6Me8Tz5HZfap5KHK/6F9tZwIU4uLGDP/8t6dGG9Y7iMbSDSSyhhef0gB5fRbdbBDAIAekuXmr4ChFB/yvB3bzrA5B7mqW7T6YrKsjyp5ZvGRYNAQG3xNSXLplc8gpUdvswQv60iQb19ruznrJgILnb5Ug8Dm5qA7928fI2+jcwEQp3AX0YFZ+oRI0L9kDrXJcIXJrM0ksvw8yslY4856iutb0+xOXd9ZLT'
!db '8TtjKWmSp80PG1RerUxm2dM1SrVWN1Q5mLIrAUVdJJm9zjpGQhZw8fj5iwq/njkg49bi9osBQCg/8nQyui6SbzK9f8CvvMDS+tNK6gvZjUlYPVTwjYJMy/orNJsiQgGMr9JonZlpT43exSf47iSQytsmAy9kNblILb3vQyR+5Qnb5bar8swvdWpHhRVLPWExGMd6apx4TEq6e9W2WyJxfKZWGu91vCYPdX1Y+1X0CNXIqq3RYfkZ0x/p9ajlBdq8'
!db '4FMx2Z1MGtC402MwFQMfOZ04l3INOn8nI92jYfEefvdF5Hvev9dQIIio6us8w7Tdb3t2QPP89RCL6XT2ZwGak2BV4QNWUAfQHWkjSi7WYE5YFyHmNA0/4zOBInEtItCwo1kXrhSac0X6n9maq5EyMSIp4rIT/cKegFb7mEmDRK7SBYA9Fo9gLVC5wEJLCAdIbdA61ZMa+pIBloKvyhDCxcWwocAFvBrDr0TgIMLp5adF914gXlFkQi625drM0hqB'
!db '3siBcAKAntmShDZpoAK/ZMRXsJJJbRwhuNzNn6DbMuqwkzw5kQV42QqxpBz3rFiXLEGb/gX+n482M72/iUvGmdto7aw6lvtrdwRFAPCky1L97VphHepK/imSS07UthVjhwBiY3DOWNAncDnCKFtoQMVEYqrnhuPl0RO91z7FTbDp+olCUIQErgNJ8e/GfGVmN6famOzfoxpWGG1mGdXPuixwdaDR0laSFrMw3db7pHCvXmgYgutjRa5Yuppiu1n7'
!db '9fDSeUncQT/U9yp/6Kw4DnfvpHhT2zXCOAgeUEzrjhzoCxi1t8n0aZnhGSVwhsgL4oGUug7/TGv4M3BRdt1J2ZPj7FvAdN3yYU21C7dI7K9reoWRz4i+yHLfEUzIo7vpckiuYT73zjnksPPa8CzE4w5M3ZhrJEX33uSkULuG/lSfVndFlGD5SFQn7dpgbq479WxEnrYU3LRb/c/KadL5bN+0ELThA4kF8oNBOhq7Bvbrq/VpYWV2ikMVxFMKIcUn'
!db 'Y28bdGGNJMrmsny3cLr4l3pMef2ml1GdV8lXbQV4Mudx/3qtvcDAZz27z+cf7q4OzRTNRT9gQPOCcCL6Drl66BSdyfKCLDKGLvNcuBlKXj5OWrLjh2VqnJSYEtLgDgyR4E86qlOdLSjrgkYvQpMr5iBFtQOOK4+/oK+Yb43/cEhUhcWOssdbWtNZYzR8UFdQFb8/gu7o/PtRbHY9Tj8tkiYqFL57QbfeLzAodn84u3iLI779vCIqukqCeooh9vNL'
!db 'FixSK1xZAz8UPZH9CI3TXRpc2hTmP3S9AgiSnlQj5gK2GIgLoFk9AnaZqrqQiwB0cyniCS4YC/lmLth9VhFmKE6PvzC8SFRVJ6pAXnhlip2d0BPGh1DWt+JUaf0sHy8p7XJcxIWprcXX9BTUDexXuZ1lSfIa4QyeJzgsKOAf4jD8QcJ0GIhbS1F8LN8uUgDTDx+pNHfCQ51s29AzYX3d4+M2DgXWYH3tdPt+NvdwfZsa1UXnG9oGr8AVNJm/CikI'
!db 'kyi66XCWOoaWm44r9DcEDDASXcw6cjyFbgVrZlWmOS+LIjN3ehIKScOKwNcrSulnDJkZ5/tcSutWoojOAfQ9d9lk+3coYlApex9bFsJwjLcH/eC/6A=='
E:
EndDataSection

Code: Select all

OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, 400, 200)

If StartVectorDrawing(CanvasVectorOutput(0))


	Dim dotty.point(35)

	x.d=200
	y.d=100
	r.d=40
	a=Random(359)
	For i=0 To 30
		a+12
		rd=r+Sin(Radian(a*2))*(5+3*Sin(a*5))
		dotty(i)\x=x+Sin(Radian(a))*(rd)
		dotty(i)\y=y+Cos(Radian(a))*(rd)
	Next i

	VectorSourceColor($ff000000)
	MovePathCursor(dotty(0)\x,dotty(0)\y)
	For i=0 To 30
		;AddPathCircle(dotty(i)\x,dotty(i)\y,2)
	Next i
	FillPath()

	MovePathCursor(dotty(0)\x,dotty(0)\y)
	For i=1 To 28 Step 2
		;AddPathCurve(dotty(i)\x,dotty(i)\y,dotty(i+1)\x,dotty(i+1)\y,dotty(i+2)\x,dotty(i+2)\y)
		AddPathArc(dotty(i)\x,dotty(i)\y,dotty(i+1)\x,dotty(i+1)\y,r)
	Next i
	ClosePath()
	VectorSourceColor($ff835720)
	FillPath()

	a=Random(30)
	b=2+Random(10)
	w=8
	For n=1 To b
		d=(a+1)%30
		e=(d+1)%30
		MovePathCursor(dotty(a)\x,dotty(a)\y)
		AddPathArc(dotty(d)\x,dotty(d)\y,dotty(e)\x,dotty(e)\y,r)
		VectorSourceColor($ff000000)
		StrokePath(w,#PB_Path_RoundEnd|#PB_Path_RoundCorner)
		w+1
		a+2
	Next n

	StopVectorDrawing()
EndIf

Repeat
	Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 3:28 pm
by Michael Vogel
Getting nearer but it's still far away from the right stuff.

I am able to create blobs, but this is still a bad source code
- I need hundreds of lines for each instead of some simple curves
- I've still no idea how to do a nice outline shape

Code: Select all

Macro BlobFunction(nexus)

	( Sin(x) nexus Sqr(wobble-x*x+2*sway*x-sway*sway) )

EndMacro
Macro BlobCoordinates()

	(x-ox)*xx+mx, (y-oy)*xx+my

EndMacro
Procedure AddPathBlob(mx.d,my.d,size.d,wobble.d,sway.d)

	Protected.d x,y
	Protected.d min,max
	Protected.d xx
	Protected.d ox,oy

	#FloatStep=0.02

	min=sway-Sqr(wobble)
	max=sway+Sqr(wobble)

	xx=size/(max-min)
	ox=(max+min)/2

	x=ox
	oy=(BlobFunction(+)+BlobFunction(-))/2

	x=min+#FloatStep
	y=BlobFunction(+)
	MovePathCursor(BlobCoordinates())
	While x<max-#FloatStep
		; Debug StrF(x,3)+" | "+StrF(y,3)
		x+#FloatStep
		y=BlobFunction(+)
		AddPathLine(BlobCoordinates())
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		AddPathLine(BlobCoordinates())
	Wend
	ClosePath()

EndProcedure

#W=1000
#H=1000

OpenWindow(0, 0,0, #W,#H, "Blob", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0,0, #W,#H)

StartVectorDrawing(CanvasVectorOutput(0))


For i=1 To 10
	For j=1 To 10

		AddPathBlob(100*i-50,100*j-50,Random(30)+40,2.0+Random(50)/30,0.1+Random(50)/20)
		VectorSourceColor($ff808080|Random(#White))
		FillPath()

	Next j
Next i

StopVectorDrawing()

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 4:08 pm
by jacdelad
Does StrokePath() solve your outline problem?

Code: Select all

Macro BlobFunction(nexus)

	( Sin(x) nexus Sqr(wobble-x*x+2*sway*x-sway*sway) )

EndMacro
Macro BlobCoordinates()

	(x-ox)*xx+mx, (y-oy)*xx+my

EndMacro
Procedure AddPathBlob(mx.d,my.d,size.d,wobble.d,sway.d)

	Protected.d x,y
	Protected.d min,max
	Protected.d xx
	Protected.d ox,oy

	#FloatStep=0.02

	min=sway-Sqr(wobble)
	max=sway+Sqr(wobble)

	xx=size/(max-min)
	ox=(max+min)/2

	x=ox
	oy=(BlobFunction(+)+BlobFunction(-))/2

	x=min+#FloatStep
	y=BlobFunction(+)
	MovePathCursor(BlobCoordinates())
	While x<max-#FloatStep
		; Debug StrF(x,3)+" | "+StrF(y,3)
		x+#FloatStep
		y=BlobFunction(+)
		AddPathLine(BlobCoordinates())
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		AddPathLine(BlobCoordinates())
	Wend
	ClosePath()

EndProcedure

#W=1000
#H=1000

OpenWindow(0, 0,0, #W,#H, "Blob", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0,0, #W,#H)

StartVectorDrawing(CanvasVectorOutput(0))


For i=1 To 10
	For j=1 To 10

		AddPathBlob(100*i-50,100*j-50,Random(30)+40,2.0+Random(50)/30,0.1+Random(50)/20)
		VectorSourceColor($ff808080|Random(#White))
		StrokePath(1)

	Next j
Next i

StopVectorDrawing()

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 7:59 pm
by Michael Vogel
You're right and the result is not bad, but the code it getting more complex and the program is .e x t r e m l y . s l o w... :cry:

You can check that easily by setting Demo Mode = 1 and the value for size below 3.0

Code: Select all

Macro BlobFunction(nexus)

	( Sin(x) nexus Sqr(wobble-x*x+2*sway*x-sway*sway) )

EndMacro
Macro BlobCoordinates()

	(x-ox)*xx+mx, (y-oy)*xx+my

EndMacro
Procedure AddPathBlob(mx.d,my.d,size.d,wobble.d,sway.d,width.d,color)

	Protected.d x,y
	Protected.d min,max
	Protected.d xx,ox,oy
	Protected.d ws,wd,wl
	Protected.i won

	#FloatStep=0.02

	min=sway-Sqr(wobble)
	max=sway+Sqr(wobble)

	xx=size/(max-min)
	ox=(max+min)/2

	x=ox
	oy=(BlobFunction(+)+BlobFunction(-))/2

	x=min+#FloatStep
	y=BlobFunction(+)
	MovePathCursor(BlobCoordinates())
	While x<max-#FloatStep
		x+#FloatStep
		y=BlobFunction(+)
		AddPathLine(BlobCoordinates())
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		AddPathLine(BlobCoordinates())
	Wend
	ClosePath()
	VectorSourceColor(color)
	FillPath()



	VectorSourceColor($ff000000)
	x=min+#FloatStep
	y=BlobFunction(+)
	ws=0
	wl=Random(30)/100
	While x<max-#FloatStep
		x+#FloatStep
		y=BlobFunction(+)
		wd=Sin(x*2)+wl
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
				StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			EndIf
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		wd=Sin(x*2)+wl
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
				StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			EndIf
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend

EndProcedure

#W=1000
#H=1000

OpenWindow(0, 0,0, #W,#H, "Blob", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0,0, #W,#H)

StartVectorDrawing(CanvasVectorOutput(0))
size.d=6


If 0; <------------------------- Demo-Mode = 1
	VectorSourceColor($ff0D79AB)
	FillVectorOutput()
	LoadFont(0,"Arial Black",#PB_Font_Bold)
	VectorFont(FontID(0),350)
	MovePathCursor(0,-100)
	AddPathText("BIRD")
	MovePathCursor(0,220)
	AddPathText("BLOB")
	MovePathCursor(0,540)
	AddPathText("TEST")
	ClipPath()

	VectorSourceColor($fff0f0f0|Random(#White))
	FillVectorOutput()

	size=3.5; <------------------- get's really slow with small values (like 1.5)
EndIf

gogo=100/size


For i=1 To gogo
	For j=1 To gogo
		AddPathBlob(size*10*i-10+Random(size),size*10*j-10+Random(size),Random(size*3)+size*4,2.0+Random(150)/30,0.1+Random(150)/20,size,$ff808080|Random(#White))
	Next j
Next i

StopVectorDrawing()

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 9:23 pm
by Mr.L
Maybe don't use a fixed floatStep value. Instead calculate the floatStep value according to the size of the blob.

Code: Select all

Procedure AddPathBlob(mx.d,my.d,size.d,wobble.d,sway.d,width.d,color)

	Protected.d x,y
	Protected.d min,max
	Protected.d xx,ox,oy
	Protected.d ws,wd,wl
	Protected.i won
	
	Protected floatStep.d = 2.0 / size
	min=sway-Sqr(wobble)
	max=sway+Sqr(wobble)

	xx=size/(max-min)
	ox=(max+min)/2

	x=ox
	oy=(BlobFunction(+)+BlobFunction(-))/2

	x=min+floatStep
	y=BlobFunction(+)
	MovePathCursor(BlobCoordinates())
	While x<max-floatStep
		x+floatStep
		y=BlobFunction(+)
		AddPathLine(BlobCoordinates())
	Wend
	While x>min+floatStep
		x-floatStep
		y=BlobFunction(-)
		AddPathLine(BlobCoordinates())
	Wend
	ClosePath()
	VectorSourceColor(color)
	FillPath()



	VectorSourceColor($ff000000)
	x=min+floatStep
	y=BlobFunction(+)
	ws=0
	wl=Random(30)/100
	While x<max-floatStep
		x+floatStep
		y=BlobFunction(+)
		wd=Sin(x*2)+wl
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
			EndIf
			StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend
	While x>min+floatStep
		x-floatStep
		y=BlobFunction(-)
		wd=Sin(x*2)+wl
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
			EndIf
			StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend

EndProcedure

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 10:29 pm
by Michael Vogel
Good idea, thought also 'bout that, but large patterns still need to much cpu time.
I fear a really speed gain could only be achieved by using curves instead of lines - but this seems to be more tricky than expected.

Re: Creating a leopard pattern

Posted: Mon Jun 24, 2024 11:36 pm
by Mr.L
Maybe this is overkill, but here is my Spline Module, which is ported from the Ogre::SimpleSpline class :wink:

Code: Select all

DeclareModule Spline
	Structure Vec3
		x.f
		y.f
		z.f
	EndStructure
		
	Macro _Spline_SetVec3_(v_, x_, y_, z_)
		v_\x = x_
		v_\y = y_
		v_\z = z_
	EndMacro

	Declare Create()
	Declare AddPoint(*spline, x.f, y.f, z.f)
	Declare.f PointX(*spline, index.i)
	Declare.f PointY(*spline, index.i)
	Declare.f PointZ(*spline, index.i)
	Declare.f ComputeX(*spline)
	Declare.f ComputeY(*spline)
	Declare.f ComputeZ(*spline)
	Declare Count(*spline)
	Declare Update(*spline, index.i, x.f, y.f, z.f)
	Declare Compute(*spline, t.f)
	Declare Clear(*spline)
	Declare Free(*spline)
EndDeclareModule

Module Spline	
	Structure SPLINE
		nrPoints.l
		Array points.Vec3(0)
		Array tangents.Vec3(0)
		splinePos.Vec3
	EndStructure

	Procedure UpdateTangents(*spline.SPLINE)
		If *spline And *spline\nrPoints > 1
			Protected i
			Protected nrPoints = *spline\nrPoints
			
			If (*spline\points(0)\x = *spline\points(nrPoints - 1)\x) And 
			   (*spline\points(0)\y = *spline\points(nrPoints - 1)\y) And
			   (*spline\points(0)\z = *spline\points(nrPoints - 1)\z)
				
				; spline is closed
				_Spline_SetVec3_(*spline\tangents(0),
				                 0.5 * (*spline\points(1)\x - *spline\points(nrPoints - 2)\x),
				                 0.5 * (*spline\points(1)\y - *spline\points(nrPoints - 2)\y),
				                 0.5 * (*spline\points(1)\z - *spline\points(nrPoints - 2)\z))
				_Spline_SetVec3_(*spline\tangents(nrPoints - 1),
				                 *spline\tangents(0)\x, *spline\tangents(0)\y, *spline\tangents(0)\z)
				For i = 1 To nrPoints - 2
					_Spline_SetVec3_(*spline\tangents(i), 
					                 0.5 * (*spline\points(i + 1)\x - *spline\points(i - 1)\x),
					                 0.5 * (*spline\points(i + 1)\y - *spline\points(i - 1)\y),
					                 0.5 * (*spline\points(i + 1)\z - *spline\points(i - 1)\z))
				Next
			Else
				; spline is not closed
				_Spline_SetVec3_(*spline\tangents(0),
				                 0.5 * (*spline\points(1)\x - *spline\points(0)\x),
				                 0.5 * (*spline\points(1)\y - *spline\points(0)\y),
				                 0.5 * (*spline\points(1)\z - *spline\points(0)\z))
				_Spline_SetVec3_(*spline\tangents(nrPoints - 1),
				                 0.5 * (*spline\points(nrPoints - 1)\x - *spline\points(nrPoints - 2)\x),
				                 0.5 * (*spline\points(nrPoints - 1)\y - *spline\points(nrPoints - 2)\y),
				                 0.5 * (*spline\points(nrPoints - 1)\z - *spline\points(nrPoints - 2)\z))
				For i = 1 To nrPoints - 2
					_Spline_SetVec3_(*spline\tangents(i),
					                 0.5 * (*spline\points(i+1)\x - *spline\points(i - 1)\x),
					                 0.5 * (*spline\points(i+1)\y - *spline\points(i - 1)\y),
					                 0.5 * (*spline\points(i+1)\z - *spline\points(i - 1)\z))
				Next
			EndIf
		EndIf
	EndProcedure
	
	Procedure Interpolate(*spline.SPLINE, index.i, t.f)
		If index < *spline\nrPoints
			Protected *point1.Vec3 = @*spline\points(index)
			Protected *point2.Vec3 = @*spline\points(index + 1)
			
			If (index + 1) = *spline\nrPoints
				_Spline_SetVec3_(*spline\splinePos, *point1\x, *point1\y, *point1\z)
			ElseIf t = 0
				_Spline_SetVec3_(*spline\splinePos, *point1\x, *point1\y, *point1\z)
			ElseIf t = 1
				_Spline_SetVec3_(*spline\splinePos, *point2\x, *point2\y, *point2\z)
			Else
				Protected.f t2 = t * t
				Protected.f t3 = t2 * t
				
				Protected *tan1.Vec3 = @*spline\tangents(index)
				Protected *tan2.Vec3 = @*spline\tangents(index + 1)
				
				_Spline_SetVec3_(*spline\splinePos,
				                 t3 * (2 * *point1\x - 2 * *point2\x + *tan1\x + *tan2\x) + 
				                 t2 * (-3 * *point1\x + 3 * *point2\x - 2 * *tan1\x - *tan2\x) +
				                 t * *tan1\x + *point1\x,
				                 t3 * (2 * *point1\y - 2 * *point2\y + *tan1\y + *tan2\y) +
				                 t2 * (-3 * *point1\y + 3 * *point2\y - 2 * *tan1\y - *tan2\y) +
				                 t * *tan1\y + *point1\y,
				                 t3 * (2 * *point1\z - 2 * *point2\z + *tan1\z + *tan2\z) +
				                 t2 * (-3 * *point1\z + 3 * *point2\z - 2 * *tan1\z - *tan2\z) +
				                 t * *tan1\z + *point1\z)
			EndIf
		EndIf
	EndProcedure
	
	Procedure Create()
		Protected *spline.SPLINE = AllocateStructure(SPLINE)
		ProcedureReturn *spline
	EndProcedure
	
	Procedure AddPoint(*spline.SPLINE, x.f, y.f, z.f)
		If *spline
			If *spline\nrPoints >= ArraySize(*spline\points()) 
				ReDim *spline\points(*spline\nrPoints + 4)
				ReDim *spline\tangents(*spline\nrPoints + 4)
			EndIf
			
			_Spline_SetVec3_(*spline\points(*spline\nrPoints), x, y, z)
			*spline\nrPoints + 1
			
			UpdateTangents(*spline)
		EndIf
	EndProcedure
	
	Procedure.f PointX(*spline.SPLINE, index.i)
		If *spline And index < *spline\nrPoints
			ProcedureReturn *spline\points(index)\x
		EndIf
	EndProcedure
	
	Procedure.f PointY(*spline.SPLINE, index.i)
		If *spline And index < *spline\nrPoints
			ProcedureReturn *spline\points(index)\y
		EndIf
	EndProcedure
	
	Procedure.f PointZ(*spline.SPLINE, index.i)
		If *spline And index < *spline\nrPoints
			ProcedureReturn *spline\points(index)\z
		EndIf
	EndProcedure
	
	Procedure.f ComputeX(*spline.SPLINE)
		If *spline
			ProcedureReturn *spline\splinePos\x
		EndIf
	EndProcedure
	
	Procedure.f ComputeY(*spline.SPLINE)
		If *spline
			ProcedureReturn *spline\splinePos\y
		EndIf
	EndProcedure
	
	Procedure.f ComputeZ(*spline.SPLINE)
		If *spline
			ProcedureReturn *spline\splinePos\z
		EndIf
	EndProcedure
	
	Procedure Count(*spline.SPLINE)
		If *spline
			ProcedureReturn *spline\nrPoints
		EndIf
	EndProcedure
	
	Procedure Clear(*spline.SPLINE)
		If *spline
			*spline\nrPoints = 0
			Dim *spline\points(0)
			Dim *spline\tangents(0)
		EndIf
	EndProcedure
	
	Procedure Free(*spline.SPLINE)
		If *spline
			FreeStructure(*spline)
		EndIf
	EndProcedure
	
	Procedure Update(*spline.SPLINE, index.i, x.f, y.f, z.f)
		If *spline And index < *spline\nrPoints
			_Spline_SetVec3_(*spline\points(index), x, y, z)
			UpdateTangents(*spline)
		EndIf
	EndProcedure
	
	Procedure Compute(*spline.SPLINE, t.f)
		If *spline
			Protected fSeg.f = t * (*spline\nrPoints - 1);
			Protected segIdx = Int(fSeg)
			Interpolate(*spline, segIdx, fSeg - segIdx)
		EndIf
	EndProcedure
EndModule


CompilerIf #PB_Compiler_IsMainFile
	OpenWindow(0,0,0,800,600,"!")
	CanvasGadget(0,0,0,800,600)
	
	spline = Spline::Create()
	For r = 0 To 359 Step 30
		Spline::AddPoint(spline, 400 + Sin(Radian(r)) * Random(250, 150), 300 + Cos(Radian(r)) * Random(250, 150), 0)
	Next
	Spline::AddPoint(spline, Spline::PointX(spline, 0), Spline::PointY(spline, 0), 0)
	
	StartVectorDrawing(CanvasVectorOutput(0))
	
	Spline::Compute(spline, 0)
	x = Spline::ComputeX(spline)
	y = Spline::ComputeY(spline)
	MovePathCursor(x, y)
	t.f = 0.01 : Repeat
		Spline::Compute(spline, t)
		AddPathLine(Spline::ComputeX(spline), Spline::ComputeY(spline))
		t + 0.01
	Until t > 1
	
	VectorSourceColor(RGBA(225,225,255,255))
	FillPath(#PB_Path_Winding | #PB_Path_Preserve)
	VectorSourceColor(RGBA(0,0,0,255))
	StrokePath(5)
	StopVectorDrawing()
	
	Repeat
	Until WaitWindowEvent() = #PB_Event_CloseWindow
CompilerEndIf

Re: Creating a leopard pattern

Posted: Tue Jun 25, 2024 4:10 am
by idle
Mr.L wrote: Mon Jun 24, 2024 11:36 pm Maybe this is overkill, but here is my Spline Module, which is ported from the Ogre::SimpleSpline class :wink:
That would be good to post in tricks and tips. 👍

Re: Creating a leopard pattern

Posted: Tue Jun 25, 2024 6:01 am
by Michael Vogel
The splines do look fine :lol: - - - anyhow they are created also by tons of lines, so the drawing time hasn't improved.

Actually, the code of the fourth post (containing extremly slow) does the job in acceptable form. But behind the point if optimizing could be done to use AddPathArc or AddPathCurve commands there is another unsolved point:

How to achieve (pattern) filling an object AND the outline path by using vector commands only? I mean, I want to fill not only the area which is presented by FillPath() but also everything painted by StrokePath(10).

Re: Creating a leopard pattern

Posted: Fri Jun 28, 2024 5:41 am
by Michael Vogel
Aaaarrrgh :evil:

I thought, my 'blob' function is ready but there's still a bug inside :cry:
Everything works fine if I don't use the RotateCoordinates below in the code, but without that, the result looks a little bit booring. When rotating, some shapes are distorted (change RamdomSeed to 10 to see more).

Haven't found a reliable solution for now...

Code: Select all

RandomSeed(0)

Procedure NormalizeColor(color)

	ProcedureReturn ((color&$FF)<<16) | (color&$ff00) | ((color>>16)&$ff)

EndProcedure
Macro BlobFunction(nexus)

	( Sin(x) nexus Sqr(wobble-x*x+2*sway*x-sway*sway) )

EndMacro
Macro BlobCoordinates()

	(x-ox)*xx+mx, (y-oy)*xx+my

EndMacro
Procedure AddPathBlob(mx.d,my.d,size.d,wobble.d,sway.d,width.d,color)

	Protected.d x,y
	Protected.d min,max
	Protected.d xx,ox,oy
	Protected.d ws,wd,wl
	Protected.d rx,ry
	Protected.i won

	#FloatStep=0.1

	min=sway-Sqr(wobble)
	max=sway+Sqr(wobble)

	xx=size/(max-min)
	ox=(max+min)/2

	x=ox
	oy=(BlobFunction(+)+BlobFunction(-))/2

	rx=mx+ox
	ry=my+oy

	x=min+#FloatStep
	y=BlobFunction(+)

	SaveVectorState()
	RotateCoordinates(rx,ry,Random(360),#PB_Coordinate_User) ; <---------------------------- ?????

	MovePathCursor(BlobCoordinates())


	While x<max-#FloatStep*2
		x+#FloatStep
		y=BlobFunction(+)
		AddPathLine(BlobCoordinates())
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		AddPathLine(BlobCoordinates())
	Wend
	ClosePath()
	VectorSourceColor(color)
	FillPath()

	AddPathBox(rx-5,ry-5,11,11)
	VectorSourceColor($ff00ffff)
	FillPath()
	MovePathCursor(rx,ry)
	AddPathLine(rx+20,ry)
	VectorSourceColor($ffff00ff)
	StrokePath(5)


	VectorSourceColor($ff000000)
	x=min+#FloatStep
	y=BlobFunction(+)
	ws=0
	wl=Random(30)/100
	While x<max-#FloatStep
		x+#FloatStep
		y=BlobFunction(+)
		If width
			wd=Sin(x*2)+wl
		EndIf
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
				StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			EndIf
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend
	While x>min+#FloatStep
		x-#FloatStep
		y=BlobFunction(-)
		If width
			wd=Sin(x*2)+wl
		EndIf
		If wd>0
			If ws
				AddPathLine(BlobCoordinates())
				StrokePath(width*(1+wd),#PB_Path_RoundCorner|#PB_Path_RoundEnd)
			EndIf
			MovePathCursor(BlobCoordinates())
			ws=1
		Else
			If ws
				ws=0
			EndIf
		EndIf
	Wend

	RestoreVectorState()

EndProcedure

#W=1000
#H=1000

OpenWindow(0, 0,0, #W,#H, "Blob", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

CreateImage(2,#W,#H,32,#PB_Image_Transparent)
StartVectorDrawing(ImageVectorOutput(2))

z1=NormalizeColor($F8EDD9)
z2=NormalizeColor($2C2924)
z3=NormalizeColor($E7BD2B)

VectorSourceColor($ff000000|z1)
FillVectorOutput()

size=9.5
gogo=100/size

For i=0 To gogo
	For j=0 To gogo
		shift=(j&1)*size*5
		Select Random(8)
		Case 1
			color=z2
		Case 2
			color=z3
		Default
			color=z2
			color=Random(#White)|$808080
		EndSelect

		AddPathBlob(size*10*i+shift-10+Random(size),size*10*j-10+Random(size),Random(size)+size*5,1.0+Random(10)/50,0.1+Random(50)/50,size/2,$ff000000|color)
	Next j
Next i

StopVectorDrawing()

ImageGadget(0, 0,0, #W,#H,ImageID(2))

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited