RosettaCodeData/Task/Superellipse/Action-/superellipse.action
2023-07-01 13:44:08 -04:00

58 lines
866 B
Text

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
PROC Superellipse(INT x0 BYTE y0 REAL POINTER n BYTE a)
INT ARRAY f(100)
REAL ar,xr,tmp1,tmp2,tmp3,one,invn
INT x
IntToReal(1,one)
RealDiv(one,n,invn) ;1/n
IntToReal(a,ar)
Power(ar,n,tmp1) ;a^n
Plot(x0,y0-a)
FOR x=0 TO a
DO
IntToReal(x,xr)
Power(xr,n,tmp2) ;x^n
RealSub(tmp1,tmp2,tmp3) ;a^n-x^n
Power(tmp3,invn,tmp2) ;(a^n-x^n)^(1/n)
f(x)=RealToInt(tmp2)
DrawTo(x0+x,y0-f(x))
OD
x=a
WHILE x>=0
DO
DrawTo(x0+x,y0+f(x))
x==-1
OD
FOR x=0 TO a
DO
DrawTo(x0-x,y0+f(x))
OD
x=a
WHILE x>=0
DO
DrawTo(x0-x,y0-f(x))
x==-1
OD
RETURN
PROC Main()
BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
REAL n
Graphics(8+16)
Color=1
COLOR1=$0C
COLOR2=$02
ValR("2.5",n)
Superellipse(160,96,n,80)
DO UNTIL CH#$FF OD
CH=$FF
RETURN