draw rotated ellipse

Source-code only - please, don't post questions here.
BasicCoder2
Posts: 2932
Joined: Jan 01, 2009 7:03

draw rotated ellipse

Postby BasicCoder2 » Nov 22, 2017 23:42

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
Last edited by BasicCoder2 on Nov 25, 2017 13:42, edited 1 time in total.
xlucas
Posts: 256
Joined: May 09, 2014 21:19
Location: Argentina

Re: rotate oval

Postby xlucas » Nov 23, 2017 7:09

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
Posts: 2932
Joined: Jan 01, 2009 7:03

Re: rotate oval

Postby BasicCoder2 » Nov 23, 2017 8:20

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
Posts: 2119
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: rotate oval

Postby MrSwiss » Nov 24, 2017 13:54

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.
Last edited by MrSwiss on Nov 24, 2017 15:08, edited 1 time in total.
dodicat
Posts: 4495
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: rotate oval

Postby dodicat » Nov 24, 2017 15:08

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
Posts: 965
Joined: Jun 04, 2005 9:51

Re: rotate oval

Postby dafhi » Nov 25, 2017 7:02

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
Last edited by dafhi on Nov 29, 2017 12:16, edited 3 times in total.
h4tt3n
Posts: 645
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: rotate oval

Postby h4tt3n » Nov 25, 2017 9:13

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
Posts: 2932
Joined: Jan 01, 2009 7:03

rotate Ellipse with mouse

Postby BasicCoder2 » Nov 26, 2017 7:57

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
Posts: 2119
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: draw rotated ellipse

Postby MrSwiss » Nov 26, 2017 11:42

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

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests