create eliptical shape with WritePixel?

BlitzPlus Forums/BlitzPlus Programming/create eliptical shape with WritePixel?

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.

Just found this, by AngelDaniel in the Max forums, I've knocked it back to Blitz+

Graphics 640,480,0

Local xCenter = 320
Local yCenter = 240
Local Rx,Ry
Local p,px,py,x,y,prevy
Local Rx2,Ry2,twoRx2,twoRy2
Local pFloat#
Repeat
	Cls
	If MouseDown(1)
		xCenter=MouseX()
		yCenter=MouseY()
	EndIf
	Rx=Abs(xCenter-MouseX())
	Ry=Abs(yCenter-MouseY())
	Text 20,20,Rx+" x "+Ry;String(Rx)+" x "+String(Ry)
	Rx2=Rx*Rx
	Ry2=Ry*Ry
	twoRx2=Rx2 Shl 1
	twoRy2=Ry2 Shl 1
	;'Region 1
	x=0
	y=Ry
	;Color $FF,$88,$00 
	Rect xCenter-Rx,yCenter,Rx Shl 1,1
	;SetColor $FF,$FF,$FF
	Plot xCenter+Rx,yCenter
	Plot xCenter-Rx,yCenter
	Plot xCenter,yCenter-Ry
	Plot xCenter,yCenter+Ry
	pFloat=(Ry2-(Rx2*Ry))+(0.25*Rx2)
	p=Int(pFloat + (Sgn(pFloat)*0.5))
	px=0
	py=twoRx2*y
	While px<py-1
		prevy=y
		x = x+1
		px = px+twoRy2
		If p>=0
			y=y-1
			py = py-twoRx2
		EndIf
		If p<0 Then p=p+Ry2+px Else p=p+Ry2+px-py
		If y<prevy And px<py-1
			;SetColor $FF,$88,$00
			Rect xCenter-x,yCenter+y,x Shl 1,1
			Rect xCenter-x,yCenter-y,x Shl 1,1
			;SetColor $FF,$FF,$FF
			Plot xCenter+x,yCenter+y
			Plot xCenter-x,yCenter+y
			Plot xCenter+x,yCenter-y
			Plot xCenter-x,yCenter-y
		EndIf
	Wend
	;'Region 2
	pFloat=(Ry2*(x+0.5)*(x+0.5))+(Rx2*(y-1.0)*(y-1.0))-(Rx2*(Float(Ry2)))
	p=Int(pFloat + (Sgn(pFloat)*0.5))
	y=y+1
	While y>1
		y=y-1
		py=py-twoRx2
		If p<=0
			x=x+1
			px=px+twoRy2
		EndIf
		If p>0 Then p=p+Rx2-py Else p=p+Rx2-py+px
		;SetColor $FF,$88,$00
		Rect xCenter-x,yCenter+y,x Shl 1,1
		Rect xCenter-x,yCenter-y,x Shl 1,1
		;SetColor $FF,$FF,$FF
		Plot xCenter+x,yCenter+y
		Plot xCenter-x,yCenter+y
		Plot xCenter+x,yCenter-y
		Plot xCenter-x,yCenter-y
		Wend
	Flip
Until KeyHit(1)
End


Dabz