draw rotated ellipse

[BasicCoder2]

Draw rotated Ellipse.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

type ELLIPSE
    as integer cx,cy   'center of ellipse
    as integer r1,r2   'axis of ellipse
    as ulong   c1,c2   'border color and fill color
    as single  angle   'rotate by angle
end type

sub drawEllipse(e as ELLIPSE)
    
    dim as single x1,y1,x2,y2,x,y,cosAngle,sinAngle
    dim as single steps
    dim as single angle
    
    'compute minimum pixels for circumference
    steps = (abs(e.r1)+abs(e.r2))/360

    cosAngle = cos(e.angle)
    sinAngle = sin(e.angle)
    
    x = cos(angle)*e.r1
    y = sin(angle)*e.r2
    x1 = cosAngle * x - sinAngle * y
    y1 = cosAngle * y + sinAngle * x
        
    for angle  = 0*DtoR to 361*DtoR step steps*DtoR
        x = cos(angle)*e.r1
        y = sin(angle)*e.r2
        x2 = cosAngle * x - sinAngle * y
        y2 = cosAngle * y + sinAngle * x    
        line (x1+e.cx,y1+e.cy)-(x2+e.cx,y2+e.cy),e.c1  'join points
        x1 = x2
        y1 = y2
    next angle
    
    paint (e.cx,e.cy),e.c2,e.c1 
    
end sub

dim shared as ELLIPSE e1
e1.cx = 320
e1.cy = 240
e1.r1 = 100
e1.r2 = 200
e1.c1 = rgb(255,0,0)  'outline color
e1.c2 = rgb(0,0,255)  'fill color

sub update()
    screenlock
    cls
    drawEllipse(e1)
    screenunlock
end sub

screenres 640,480,32

for angle as single = 0 to 360
    e1.angle = angle*DtoR
    update()
    sleep 20
next angle

[xlucas]

That looks very neat, mate! :) It occurs to me that, instead of the space bar, the right mouse button could be used to switch between changing the radius and rotating the oval. Just an idea.

[BasicCoder2]

A few times when using MSPAINT I wished I could rotate an oval.
Probably it should be drawn in a rectangle where the mouse starts it at the top/left corner as in DPAINT and the have the option to rotate and move the rectangle.

It was in response to reading the bit in squares where I noticed the rotated oval had holes which meant it would not fill.
viewtopic.php?f=3&t=16207&start=5505
Found some more,
viewtopic.php?f=3&t=9566&hilit=rotate+ellipse+oval
viewtopic.php?f=3&t=20440&hilit=rotate+ellipse
.

[MrSwiss]

I've used as a start, the one pointed to, in the second link, provided by BasicCoder2.
Then I've made it into a "standalone" Sub (without any external Const's/#Define's):

Code: Select all

' Draws a rotated ellipse
' Written by jofers, edited by Kristopher Windsor and, _
' made independant of all externals by MrSwiss

' Draw an ellipse centered at (cx, cy) with a certain hight, width, _
' rotation angle (in degrees) and color (up to 32-bit)
Sub DrawEllipse(Byval cX As Long, Byval cY As Long, _
                Byval Wid As Single, Byval Hgt As Single, _
                Byval angle As Single, ByVal cc As ULong)
    #Define Pi 3.14159265f  ' As Single
    Dim As Single SinAngle, CosAngle, D2R = Pi / 180
    Dim As Single X, Y      ' a point on the ellipse
    Dim As Single rX, rY    ' the point rotated

    angle *= D2R
    CosAngle = Cos(angle)
    SinAngle = Sin(angle)

    x = ( Wid * Cos(0) )
    y = ( Hgt * -Sin(0) )
    Rx = ( x * CosAngle ) - ( y * SinAngle )
    Ry = ( y * CosAngle ) + ( x * SinAngle )
    Pset ( rx + cx, ry + cy ), cc

    For Theta As UInteger = 1 to 360
        angle = Theta * D2R
        X = Wid * Cos(angle)
        Y = Hgt * -Sin(angle)
        rX = ( X * CosAngle ) - ( Y * SinAngle )
        rY = ( Y * CosAngle ) + ( X * SinAngle )
        Line - (rX + cX, rY + cY), cc ' is rotated
    Next
    #Undef Pi
End Sub


Screen 12

Dim As Single ang = 0.0

Do
    ScreenLock
    Cls
    DrawEllipse(320, 240, 110, 190, ang, 12)
    Paint (320, 240), 9, 12   ' fill ellipse
    ScreenUnLock

    ang += .5    ' use -= for CCW rotation (+= CW)
    If ang > 359.5 Then ang = 0.0
    If ang < 0.0 Then ang = 359.5

    Sleep( 5, 1 )
Loop Until Len( InKey() )

For speed reasons, the Theta-loop was changed, from Single to UInteger ...
It also fill's without problems, as demonstrated in the demo code.
Position cX and cY, changed from Single, to Long.
Also, added cc (ULong) for color (up to 32-bit), as a 6th. parameter.

[dodicat]

Also with Draw:

Code: Select all

function Ellipse(x as long,y as long,rx as long,ry as long,angle as long,col as ulong,paintflag as long=1) as string
    static as single pi2=8*atn(1)
    static as long lx,ly,xpos,ypos
     dim as string s="Ta" &angle &"Bm" &x &"," &y:s+="Bm+" &rx &"," &0:s+="C" &col
    for z as single=0 to pi2*1.1 step pi2/60 
        if z>pi2 then exit for
         xpos=rx*cos(z)
         ypos=ry*sin(z)
       if z<>0 then s+="M+" &(xpos-lx) &"," &(ypos-ly)
        lx=xpos:ly=ypos
    next z
    if paintflag then s+="BM" &x &"," &y &"P" &col &"," &col
    return s
end function

function contrast(c as ulong) as ulong
       #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
       'get the rgb values
       dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
       do
           r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
           'get at least 120 byte difference
           loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120
          return rgb(r2,g2,b2) 
   end function
   
   Function Regulate(Byval MyFps As long,Byref fps As long=0) As long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

screen 20,32
dim as long a,x,y,w,b,flag,k=1
dim as ulong colour1=rgb(200,0,0),colour2=contrast(colour1)
do
    getmouse x,y,w,b
    x=abs(x)
    y=abs(y)
    w=abs(w)
    if b=1 and flag=0 then colour1=rgb(rnd*255,rnd*255,rnd*255):flag=1:colour2=contrast(colour1):k=-k
    a+=1
    screenlock
    cls
draw ellipse(200,200,150,100,a*2,colour1,1) 'fixed
draw ellipse(x,y,150,5+w,-a*k,colour2,1)     'floater
screenunlock
sleep regulate(60),1
flag=b
loop until len(inkey)
sleep 
  

[dafhi]

I'll second comment by xlucas, except i'm using keypress

Code: Select all

#ifndef pi
Const Pi = 4 * Atn(1)
const TwoPi = 8 * Atn(1)
#endif

' Draws a rotated ellipse
' Written by jofers, edited by Kristopher Windsor
' made independant of all externals by MrSwiss
' edited by dafhi
Sub DrawEllipse(Byval cX As single, Byval cY As single, _
                Byval w As Single, Byval h As Single, _
                Byval angle As Single, ByVal col As ULong)
                
    var cosa = Cos(angle)
    var sina = Sin(angle)
    
    Pset ( w * cosa + cx, w * sina + cy ), col

    For angle = 2*pi/360 to 2*pi step 2*pi/360
        var X = w * Cos(angle)
        var Y = h * -Sin(angle)
        Line - (X * cosa - Y * sina + cX, Y * cosa + X * sina + cY), col
    Next

End Sub


type imagevars '2017 Oct 10 - by dafhi
  as integer            w,h,bpp,bypp,pitch,rate,  wm, hm, pitchBy 'helpers
  as any ptr            im, pixels
  as ulong ptr          p32
  as string             driver_name
  declare sub           get_info(im as any ptr=0)
  declare               destructor
  as single             midx, midy, diagonal '2017 Oct 10
end type
Destructor.imagevars
  If ImageInfo(im) = 0 Then ImageDestroy im:  im=0
End Destructor
sub imagevars.get_info(im as any ptr)
  if im=0 then
    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name
    pixels=screenptr
  elseif Imageinfo(im)=0 then
    ImageInfo im, w, h, bypp, pitch, pixels
    this.im = im:  bpp = bypp * 8
  endif: wm=w-1: hm=h-1:  pitchBy=pitch\bypp:  p32=pixels
  midx=w/2: midy=h/2:  diagonal = sqr(w*w+h*h)
end sub


type tRunTime
  as single           exit_mark = 25
  as single           key_wait = .2
  as string           kstr
  as double           t, tp, dt
  as single           next_key_time
  declare function    update as double
  declare property    key_allow as boolean
  declare property    rdy2draw as boolean
  declare property    finished as boolean
  declare sub         keytime_advance
  declare constructor
End Type
constructor.tRunTime
  t = Timer:  exit_mark += t
  next_key_time = t + key_wait
end constructor
function tRunTime.update as double:  kstr = inkey
  tp = t:  t = timer
  dt = t - tp:  return dt
End function
property tRunTime.key_allow as boolean
  return t >= next_key_time
End Property
property tRunTime.finished as boolean
  return t >= exit_mark
End Property
sub tRunTime.keytime_advance
  next_key_time = t + key_wait
End Sub


const EDIT_W = 0
const EDIT_A = 1

type editModeVars
  as long       mode = EDIT_W
  as single     w = 110, a
  declare sub   update(dx as single, dy as single)
End Type
sub editModeVars.update(dx as single, dy as single)
  ? "Press a key to toggle edit": ?
  select case as const mode
  case EDIT_W
    w = sqr(dx*dx+dy*dy)
    ? "EDIT MODE:  width"
  case EDIT_A
    a = atan2(dy, dx)
    ? "EDIT MODE:  angle"
  End Select
End Sub


sub main
  
  Screen 12

  var   buf = imagevars:  buf.get_info

  dim as tRunTime     rt
  dim as editModeVars mode
  dim as integer      mousex, mousey, mouseb

  Do
    getmouse mousex,mousey,,mouseb
    
    ScreenLock
      Cls
      DrawEllipse(buf.midx, buf.midy, mode.w, 190, mode.a, 12)
      Paint (buf.midx, buf.midy), 9, 12   ' fill
      mode.update mousex - buf.midx, mousey - buf.midy
    ScreenUnLock
  
    rt.update
    if rt.finished then exit do
    if rt.key_allow then
      if rt.kstr <> "" then
        rt.keytime_advance
        mode.mode = 1 - mode.mode
      EndIf
    EndIf

    Sleep 5,1
  Loop until rt.kstr = chr(27)

  ?: ? "finished.  exiting .. ": sleep 1500
end sub

Main

[h4tt3n]

Here is an example of how to draw rotated ellipses without calling sine and cosine for every iteration. This version is *much* faster and less CPU expensive than the other examples posted here so far.

Cheers, Mike

Code: Select all

''	Very fast ellipse drawing function by Michael "h4tt3n" Nissen
''	version 4.0 March 2010

''	syntax:
''	DrawEllipse(center x, center y, semimajor axis, semiminor axis, angle in radians, color)

Randomize

''	sample program
Dim Shared As Double pi = 4*Atn(1)

declare sub DrawEllipse(byval x as single, byval y as single, byval a as single, _
byval b as single, byval angle as single, byval col as uinteger)

screenres 800, 600, 16

Dim As Double T = Timer

For i As Integer = 1 To 100
drawellipse(400, 300, Rnd*400, Rnd*300, Rnd*2*pi, RGB(64+Rnd*128, 64+Rnd*128, 64+Rnd*128))		''	yellow ellipse
'drawellipse(400, 300, 400, 300, rgb(255, 0, 255))		''	purple ellipse
'drawellipse(400, 300, 400, 200, rgb(0, 255, 0))			''	green ellipse
'drawellipse(400, 300, 150, 150, rgb(0, 0, 255))			''	blue ellipse
Next

Print Timer-T

sleep

end

''	the sub
sub DrawEllipse(byval x as single, byval y as single, byval a as single, _
	byval b as single, byval angle as single, byval col as uinteger)
	
	''	fast ellipse drawing function by Michael "h4tt3n" Nissen, march 2010
	
	''	these constants decide the graphic quality of the ellipse
	Const As Integer face_length	= 6					''	approx. face length in pixels
	Const As Integer max_faces		= 512				''	maximum number of faces in ellipse
	Const As Integer min_faces		= 32				''	minimum number of faces in ellipse
	
	''	approx. ellipse circumference (Hudson's method)
	Dim As Double h								= ((a-b)*(a-b))/((a+b)*(a+b))
	Dim As Double circumference 	= 0.25*pi*(a+b)*(3*(1+h*0.25)+1/(1-h*0.25))
	
	''	number of faces in ellipse
	Dim As Integer num_faces 			= circumference\face_length
	
	''	clamp number of faces
	If num_faces > max_faces Then num_faces = max_faces
	If num_faces < min_faces Then num_faces = min_faces
	
	''	keep number of faces divisible by 4
	num_faces -= num_faces Mod 4
	
	''
	Dim As Double CosAngle = Cos(Angle)
	Dim As Double SinAngle = Sin(Angle)
	
	''
	Dim As Double c  = Cos(2*pi/num_faces)
	Dim As Double s  = Sin(2*pi/num_faces)
	
	''
	Dim As Double x1 = 1, y1 = 0, x2, y2
	
	''
	For i As Integer = 1 To num_faces-1
		
		x2 = x1
		y2 = y1
		x1 = c*x2-s*y2
		y1 = s*x2+c*y2
		
		Line(x + a*x2*CosAngle - b*y2*SinAngle,	y + a*x2*SinAngle + b*y2*CosAngle)- _
				(x + a*x1*CosAngle - b*y1*SinAngle,	y + a*x1*SinAngle + b*y1*CosAngle), col
		'PSet (x+a*x1*CosAngle-b*y1*SinAngle,	y+a*x1*SinAngle+b*y1*CosAngle), col
		'Draw String (x+a*x2*CosAngle-b*y2*SinAngle,	y+a*x2*SinAngle+b*y2*CosAngle), str(i)
		
	Next
	
	Line(x + a*x1*CosAngle - b*y1*SinAngle, y + a*x1*SinAngle + b*y1*CosAngle)- _
			(x + a*CosAngle, y + a*SinAngle), col
	'Draw String (x+a*x1*CosAngle-b*y1*SinAngle,	y+a*x1*SinAngle+b*y1*CosAngle), str(num_faces)
	
End Sub

[BasicCoder2]

I have edited the first post with my latest version.
In this example you can rotate the ellipse using the mouse while holding down the right mouse button.
Probably will use the left mouse button to grab and move the oval.
Resize maybe have some kind of tag on the oval.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

type ELLIPSE
    as integer xc,yc   'center of ellipse
    as integer r1,r2   'axis of ellipse
    as ulong   c1,c2   'border color and fill color
    as single  angle   'rotate by angle
end type

sub drawEllipse(e as ELLIPSE)
    
    dim as single x1,y1,x2,y2,x,y,cosAngle,sinAngle
    dim as single steps
    dim as single angle
    
    'compute minimum pixels for circumference
    steps = (abs(e.r1)+abs(e.r2))/360

    cosAngle = cos(e.angle)
    sinAngle = sin(e.angle)
    
    x = cos(angle)*e.r1
    y = sin(angle)*e.r2
    x1 = cosAngle * x - sinAngle * y
    y1 = cosAngle * y + sinAngle * x
        
    for angle  = 0*DtoR to 361*DtoR step steps*DtoR
        x = cos(angle)*e.r1
        y = sin(angle)*e.r2
        x2 = cosAngle * x - sinAngle * y
        y2 = cosAngle * y + sinAngle * x    
        line (x1+e.xc,y1+e.yc)-(x2+e.xc,y2+e.yc),e.c1  'join points
        x1 = x2
        y1 = y2
    next angle
    paint (e.xc,e.yc),e.c2,e.c1     
    angle = 180*DtoR
    x = cos(angle)*e.r1
    y = sin(angle)*e.r2
    x1 = cosAngle * x - sinAngle * y
    y1 = cosAngle * y + sinAngle * x
    line (e.xc,e.yc)-(x1+e.xc,y1+e.yc),rgb(255,255,0)
    angle = 90*DtoR
    x = cos(angle)*e.r1
    y = sin(angle)*e.r2
    x1 = cosAngle * x - sinAngle * y
    y1 = cosAngle * y + sinAngle * x
    line (e.xc,e.yc)-(x1+e.xc,y1+e.yc),rgb(255,255,255)    

end sub

dim shared as ELLIPSE e1
e1.xc = 320
e1.yc = 240
e1.r1 = 100
e1.r2 = 200
e1.c1 = rgb(255,0,0)  'outline color
e1.c2 = rgb(0,0,255)  'fill color

sub update()
    screenlock
    cls
    drawEllipse(e1)
    locate 2,2
    print int(e1.angle*RtoD)
    locate 2,2
    print "HOLD RIGHT MOUSE KEY DOWN AND USE MOUSE TO ROTATE ELLIPSE"
    screenunlock
end sub

screenres 640,480,32
dim as integer mx,my,mb
dim as single yd,xd,angle

do
    getmouse mx,my,,mb
    if mb=2 then
        xd = e1.xc-mx
        yd = e1.yc-my
        angle = int(RtoD*(atan2(yd,xd)))
        if angle<0 then angle = angle+360
        e1.angle = angle*DtoR
    end if
    update()
    sleep 2
loop until multikey(&H01)

[MrSwiss]

This refers to: "draw rotated ellipse" only ...
I've changed the Sub, to use "Static As Single Pi" with: conditional compiling, to avoid:
"duplicate definition" Error, if Pi is already defined (externally), just the new sub:

Code: Select all

Sub DrawEllipse(Byval cX As Long, Byval cY As Long, _
                Byval Wid As Single, Byval Hgt As Single, _
                Byval angle As Single, ByVal cc As ULong)
#Ifndef Pi
    Static As Single Pi = 3.14159265f   ' only, if NOT defined! (externally)
#EndIf
    Dim As Single SinAngle, CosAngle, D2R = Pi / 180
    Dim As Single X, Y      ' a point on the ellipse
    Dim As Single rX, rY    ' the point rotated

    angle *= D2R
    CosAngle = Cos(angle)
    SinAngle = Sin(angle)

    x = ( Wid * Cos(0) )
    y = ( Hgt * -Sin(0) )
    Rx = ( x * CosAngle ) - ( y * SinAngle )
    Ry = ( y * CosAngle ) + ( x * SinAngle )
    Pset ( rx + cx, ry + cy ), cc

    For Theta As UInteger = 1 to 360
        angle = Theta * D2R
        X = Wid * Cos(angle)
        Y = Hgt * -Sin(angle)
        rX = ( X * CosAngle ) - ( Y * SinAngle )
        rY = ( Y * CosAngle ) + ( X * SinAngle )
        Line - (rX + cX, rY + cY), cc ' is rotated
    Next
End Sub