Anonymous user
Curve that touches three points: Difference between revisions
Added solution for Action!
(Ada version) |
(Added solution for Action!) |
||
Line 5:
::# Do not use functions of a library, implement the curve() function yourself
::# coordinates:(x,y) starting point (10,10) medium point (100,200) final point (200,10)
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
TYPE Point=[INT x,y]
PROC MyIntToReal(INT a REAL POINTER r)
BYTE ARRAY x
IF a>=0 THEN
IntToReal(a,r)
ELSE
IntToReal(-a,r)
x=r
x(0)==%$80
FI
RETURN
INT FUNC MyRealToInt(REAL POINTER r)
BYTE ARRAY x
REAL tmp
INT i
x=r
IF (x(0)&$80)=0 THEN
i=RealToInt(r)
ELSE
RealAssign(r,tmp)
x=tmp
x(0)==&$7F
i=-RealToInt(tmp)
FI
RETURN (i)
BYTE FUNC IsNegative(REAL POINTER r)
BYTE ARRAY x
x=r
IF (x(0)&$80)=$80 THEN
RETURN (1)
FI
RETURN (0)
PROC QuadraticCurve(Point POINTER p1,p2,p3 REAL POINTER a,b,c)
REAL x1,y1,x2,y2,x3,y3,x11,x22,x33,m,n,tmp1,tmp2,tmp3,tmp4,r1
MyIntToReal(-1,r1)
MyIntToReal(p1.x,x1) MyIntToReal(p1.y,y1)
MyIntToReal(p2.x,x2) MyIntToReal(p2.y,y2)
MyIntToReal(p3.x,x3) MyIntToReal(p3.y,y3)
RealMult(x1,x1,x11) ;x11=x1^2
RealMult(x2,x2,x22) ;x22=x2^2
RealMult(x3,x3,x33) ;x33=x3^2
RealSub(x1,x2,m) ;m=x1-x2
RealSub(x3,x2,n) ;n=x3-x2
RealMult(m,n,tmp1) ;tmp1=m*n
IF IsNegative(tmp1) THEN
RealMult(m,r1,tmp1)
RealAssign(tmp1,m) ;m=-m
FI
RealSub(y1,y2,tmp1) ;tmp1=y1-y2
RealMult(n,tmp1,tmp2) ;tmp2=n*(y1-y2)
RealSub(y3,y2,tmp1) ;tmp1=y3-y2
RealMult(m,tmp1,tmp3) ;tmp3=m*(y3-y2)
RealAdd(tmp2,tmp3,tmp1) ;tmp1=n*(y1-y2)+m*(y3-y2)
RealSub(x11,x22,tmp2) ;tmp2=x1^2-x2^2
RealMult(n,tmp2,tmp3) ;tmp3=n*(x1^2-x2^2)
RealSub(x33,x22,tmp2) ;tmp2=x3^2-x2^2
RealMult(m,tmp2,tmp4) ;tmp4=m*(x3^2-x2^2)
RealAdd(tmp3,tmp4,tmp2) ;tmp2=n*(x1^2-x2^2)+m*(x3^2-x2^2)
RealDiv(tmp1,tmp2,a) ;a=(n*(y1-y2)+m*(y3-y2)) / (n*(x1^2-x2^2)+m*(x3^2-x2^2))
RealSub(x33,x22,tmp1) ;tmp1=x3^2-x2^2
RealMult(tmp1,a,tmp2) ;tmp2=(x3^2-x2^2)*a
RealSub(y3,y2,tmp1) ;tmp1=y3-y2
RealSub(tmp1,tmp2,tmp3) ;tmp3=(y3-y2)-(x3^2-x2^2)*a
RealSub(x3,x2,tmp1) ;tmp1=x3-x2
RealDiv(tmp3,tmp1,b) ;b=((y3-y2)-(x3^2-x2^2)*a) / (x3-x2)
RealMult(a,x11,tmp1) ;tmp1=a*x1^2
RealMult(b,x1,tmp2) ;tmp2=b*x1
RealSub(y1,tmp1,tmp3) ;tmp3=y1-a*x1^2
RealSub(tmp3,tmp2,c) ;c=y1-a*x1^2-b*x1
RETURN
PROC DrawPoint(INT x,y)
Plot(x-2,y-2) DrawTo(x+2,y-2)
DrawTo(x+2,y+2) DrawTo(x-2,y+2)
DrawTo(x-2,y-2)
RETURN
INT FUNC Min(INT a,b)
IF a<b THEN RETURN (a) FI
RETURN (b)
INT FUNC Max(INT a,b)
IF a>b THEN RETURN (a) FI
RETURN (b)
INT FUNC CalcY(REAL POINTER a,b,c INT xi)
REAL xr,xr2,yr,tmp1,tmp2,tmp3
INT yi
MyIntToReal(xi,xr) ;xr=x
RealMult(xr,xr,xr2) ;xr2=x^2
RealMult(a,xr2,tmp1) ;tmp1=a*x^2
RealMult(b,xr,tmp2) ;tmp2=b*x
RealAdd(tmp1,tmp2,tmp3) ;tmp3=a*x^2+b*x
RealAdd(tmp3,c,yr) ;y3=a*x^2+b*x+c
yi=MyRealToInt(yr)
RETURN (yi)
PROC DrawCurve(Point POINTER p1,p2,p3)
REAL a,b,c
INT xi,yi,minX,maxX
QuadraticCurve(p1,p2,p3,a,b,c)
DrawPoint(p1.x,p1.y)
DrawPoint(p2.x,p2.y)
DrawPoint(p3.x,p3.y)
minX=Min(p1.x,p2.x)
minX=Min(minX,p3.x)
maxX=Max(p1.x,p2.x)
maxX=Max(maxX,p3.x)
yi=CalcY(a,b,c,minX)
Plot(minX,yi)
FOR xi=minX TO maxX
DO
yi=CalcY(a,b,c,xi)
DrawTo(xi,yi)
OD
RETURN
PROC Main()
BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
Point p1,p2,p3
Graphics(8+16)
Color=1
COLOR1=$0C
COLOR2=$02
p1.x=10 p1.y=10
p2.x=100 p2.y=180
p3.x=200 p3.y=10
DrawCurve(p1,p2,p3)
DO UNTIL CH#$FF OD
CH=$FF
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Curve_that_touches_three_points.png Screenshot from Atari 8-bit computer]
=={{header|Ada}}==
| |||