SuperEllipse - IWB Version

[GWS]

Hi folks,

I've re-jigged the superellipse demo program for IWB.
' Super Ellipse - GWS Aug 2011

Code Select Expand


autodefine "off"

def frame,c1,c2:window
def i,n,red,grn,blu:int
def wW,wH,key,run:int
def varW,varH:int
def twopi,d2r,einc:float
def a$:string

type superellipse
def cX:int
def cY:int
def eW:int
def eH:int
def efac:float
def nSeg:int
def pSize:int
def rot:int
def border:int
def fill:int
endtype

def eX:superellipse

' SuperEllipse Parameters:
         
' cX, cY - are the x,y coordinates for centre of the ellipse
' eW - is the x-radius of the ellipse
' eH - is the y-radius of the ellipse
'    (NOTE: set eW = eH to draw circles, squares, & regular polygons)
' efac - determines the shape of the ellipse    (.15 <= efac <= 99)
'       = .15 draws an X-shaped ellipse
'       = .3 to .9  draws diamond with sides curving inwards
'       = 1.0  draws a diamond shaped ellipse
'       = 2.0 draws an oval (or circle if wid = hgt)
'       = 3.0 starts to make oval more rectangular
'       = 30.0 to 100.0 draws a rectangle with rounded corners
' nSeg - number of line segments used to draw the ellipse
' pSize - sets line thickness to desired width
' rot - num of degrees to rotate the ellipse (0 <= rot <= 360)
' border - the ellipse border colour
' fill - the ellipse fill colour
'                                                                                   
' SuperEllipse information sources:                                                 
'    http://astronomy.swin.edu.au/~pbourke/surfaces/superellipse/
'    http://www.wikipedia.org/wiki/Super_ellipse
'    http://mathworld.wolfram.com/Superellipse.html
'   

declare SEllipse(w:window,eX:superellipse)

getscreensize wW,wH
twopi = 8 * atan(1)
d2r = twopi/360

FrameSet()
setc1()
setc2()

run = 1

waituntil run = 0
closewindow frame

end


sub setc2
' set up work window ..
def textW,textH:int

openwindow c2, -wW,-wH, wW, wH, @nocaption, frame,"IWB Super Ellipse", &c2handler
centerwindow c2
setwindowcolor c2,rgb(0,40,40)
showwindow c2,@swhide
control c2,@BUTTON,"Exit",2*(wW - 60)/3,wH * 0.85,60,30,@CTLBTNFLAT, 1
control c2,@BUTTON,"Back",(wW - 60)/3,wH * 0.85,60,30,@CTLBTNFLAT, 2
for i = 1 to 2
  setcontrolcolor c2,i,rgb(124,171,255),rgb(0,80,180)
next i

setfont c2, "Arial", 22, 700, @sfitalic
frontpen c2,RGB(180,180,250)
backpen c2,rgb(0,40,40)
a$ = "Adjust the Shape"
gettextsize c2, a$, textW, textH
move c2, (wW-textW)/2,20
print c2, a$

' Shape Factor modifier scrollbar ..
control c2,@SCROLLBAR,"",wW*0.515,wH*0.73-1,25,32,0x50000001,3
' (note 0x200 centres text vertically as well as horizontally) ..
control c2,@STATIC,"",wW*0.465,wH*0.73,40,28,@cteditcenter|0x200,4
' draw dummy border to emulate edit box ..
rect c2,wW*0.465-1,wH*0.73-1,42,30,rgb(170,240,240)

for i = 3 to 4
setfont c2, "MS Sans Serif", 8,700,0,i
setcontrolcolor c2, i,rgb(50,170,255), rgb(0,0,150)
next i

setfont c2, "Arial",10,500,0
a$ = "Shape Factor"
gettextsize c2, a$, textW, textH
move c2,(wW-textW)/2,wH*0.78
print c2,a$

setcontroltext c2,4,str$(eX.efac)
rect c2,(wW-500)/2,110,500,400,rgb(0,200,200),rgb(20,50,150)

return
endsub

sub c2handler(),INT
select @CLASS
case @IDCloseWindow
run = 0
case @IDChar
' 'ESC'(ape) key will close the program ...
key = @Code
if key = 27 then run = 0
case @IDCONTROL
select @ControlID
' clicking the Exit button ...
case 1
run = 0
case 2
' clicking the back window button ...
showwindow c2,@swhide
showwindow c1,@swrestore
endselect
' Deal with scrollbar movements ..
case @IDVSCROLL
select @controlid   
case 3
' the Shape scrollbar ..   
select @CODE
case @SBLINEUP
' increase Shape factor ..
if (eX.efac < 2.95) then einc = 0.05
if (eX.efac >= 2.95) then einc = 0.5
if (eX.efac >= 9.95) then einc = 5.0
eX.efac = eX.efac + einc
if eX.efac > 90 then Ex.efac = 90 :' place an upper limit on the shape factor - but it could go higher.
setcontroltext c2,4,str$(eX.efac)
rect c2,(wW-500)/2,110,500,400,rgb(0,200,200),rgb(0,50,150)
SEllipse(c2,Ex)

case @SBLINEDOWN
' decrease Shape factor ..
if (eX.efac > 10.0) then einc = -5.0
if (ex.efac > 3.0) & (eX.efac < 10.0) then einc = -0.5
if (eX.efac <= 3.0) then einc = -0.05
eX.efac = eX.efac + einc
if (eX.efac <=0.15) then eX.efac = 0.15 :' place a lower practical limit on the shape factor.
setcontroltext c2,4,str$(eX.efac)
rect c2,(wW-500)/2,110,500,400,rgb(0,200,200),rgb(0,50,150)
SEllipse(c2,eX)
endselect
endselect
endselect

return 0
ENDSUB

sub FrameSet(),INT
' set up the main frame window ..
' created off-screen to avoid flashing ..
openwindow frame, -wW,-wH, wW, wH,0, 0 ,"IWB Super Ellipse", &handler
centerwindow frame
setwindowcolor frame,rgb(0,0,40)
return 0
endsub

sub setc1(),INT
' set up c1 window ..
openwindow c1, -wW,-wH, wW, wH,@nocaption, frame ,"IWB Super Ellipse", &handler
centerwindow c1
setwindowcolor c1,rgb(0,0,40)

control c1,@BUTTON,"Exit",2*(wW - 60)/3,wH * 0.85,60,30,@CTLBTNFLAT, 1
control c1,@BUTTON,"Next",(wW - 60)/3,wH * 0.85,60,30,@CTLBTNFLAT, 2
for i = 1 to 2
  setcontrolcolor c1,i,rgb(124,171,255),rgb(0,80,180)
next i

setfont c1, "Arial", 22, 700, @sfitalic
frontpen c1,RGB(180,180,250)
backpen c1,rgb(0,0,40)
a$ = "Welcome to the Super Ellipse"
gettextsize c1, a$, varW, varH
move c1, (wW-varW)/2,20
print c1, a$

for i = 1 to 15
eX.cX = Rnd(0.1*wW,0.9*wW)
eX.cY = Rnd(0.25*wH,0.7*wH)
eX.eW = Rand(10,100)
eX.eH = Rand(20,100)
eX.efac = 0.25 + rnd(20)
eX.nseg = 60
eX.pSize = 2
eX.rot = rand(180)
eX.border = rgb(rand(255),rand(255),rand(255))
eX.fill=rgb(Rand(40,255),Rand(40,255),Rand(40,255))
SEllipse(c1,eX)
next i
return 0
endsub

SUB handler(),INT
select @CLASS
case @IDCloseWindow
run = 0
case @IDChar
' 'ESC'(ape) key will close the program ...
key = @Code
if key = 27 then run = 0
case @IDCONTROL
select @ControlID
' clicking the Exit button ...
case 1
run = 0
case 2
' clicking the next window button ...
showwindow c1,@swhide
showwindow c2,@swrestore
' set up initial ellipse values ..
eX.eW = 0.2 * wW
eX.eH = 0.2 * wH
eX.cX = wW/2
eX.cY = wH*0.4
eX.efac = 0.15
setcontroltext c2,4,str$(eX.efac)
eX.nseg = 60
eX.pSize = 1
eX.rot = 0
eX.border = 0x0
eX.fill = 0x0
rect c2,(wW-500)/2,110,500,400,rgb(0,200,200),rgb(0,50,150)
SEllipse (c2,eX)
endselect
endselect
return 0
endsub

Sub SEllipse(w:WINDOW,eX:superellipse)

def theta,inc,limit:double
def n,power:float
def x1,y1,x2,y2:int
def cs,sn,rot,rotx,roty:double

' validate the line thickness
if eX.pSize < 1 | eX.pSize > 6 then eX.pSize = 1
setlinestyle w,@LSSOLID,eX.pSize

' validate the ellipse shape factor
n = eX.efac
if n < .15 then n = .15
if n > 99 then n = 99

power = 2.0/n - 1

' keep rotation angle to between 0 and 360 degrees
if eX.rot < 0 then eX.rot = 0
if eX.rot > 360 then eX.rot = 360

' Convert number of segments from degrees to radians
inc = 360/eX.nSeg * d2r
' Convert rot angle from degrees to radians
rot = d2r * eX.rot

' if the rotation angle is zero, then no need to do the extra number crunching
if rot = 0
' calculate the co-ords for the first point ..
x1 = eX.eW + eX.cX
y1 = eX.cY
move w,x1,y1
limit = twopi + inc
theta = inc

while theta < limit
' calculate x,y co-ords of the next point on the Ellipse
x2 = eX.eW * cos(theta) * abs(cos(theta))^power + eX.cX
y2 = eX.eH * sin(theta) * abs(sin(theta))^power + eX.cY
' draw a line from last coords (x1,y1) to x2,y2
lineto w, x2, y2, eX.border
theta = theta + inc
endwhile

else

' perform a rotation ..
  cs = cos(rot)
  sn = sin(rot)
' calculate the rotated co-ords for the first point of a line segment
  rotX = eX.eW
  x1 = cs * rotX + eX.cX
  y1 = sn * rotX + eX.cY
move w,x1,y1
  limit = twopi + 2*inc

while theta < limit
' calculate rotated x,y co-ords of the next point on the Ellipse
    rotX = cos(theta) * eX.eW * abs(cos(theta))^power
    rotY = sin(theta) * eX.eH * abs(sin(theta))^power
    x2 = cs * rotX - sn * rotY + eX.cX
    y2 = sn * rotX + cs * rotY + eX.cY
' draw a line from last coords (x1,y1) to x2,y2 ..
if x2 > 0 then lineto w, x2, y2, eX.border :' avoid a zero at 180 degree rotation
theta = theta + inc
endwhile

endif

' fill the ellipse with required colour ..
rastermode w,@RMCOPYPEN
floodfill w,eX.cX,eX.cY,eX.fill
return
endsub



[Edit: Just tidied up the code a bit ..  ]

all the best,

Graham

[jerryclement]

 

Thanks for the excellent graphics.  I am sure I'll be able to use your routines for those beautiful rectangles in my programs.  I really appreciate your efforts to share your knowledge with us newbies.
Thanks,
JerryC

[GWS]

You're welcome Jerry.

The graphics facilities in both big brother IWBasic, and the small (but beautifully formed  ) Creative Basic, are one of the things which distinguishes these languages from the other tools available, including Microsoft's  elephantine offerings.

I always find the graphics and wonderful fonts of Windows very satisfying .. 

all the best,

Graham