Bitmap/Bézier curves/Cubic: Difference between revisions

Added solution for Action!
(Added 11l)
(Added solution for Action!)
Line 120:
+-----------------+
</pre>
 
=={{header|Action!}}==
{{libheader|Action! Bitmap tools}}
{{libheader|Action! Tool Kit}}
<lang Action!>INCLUDE "H6:RGBLINE.ACT" ;from task Bresenham's line algorithm
INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
 
RGB black,yellow,violet,blue
 
TYPE IntPoint=[INT x,y]
 
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)
 
PROC CubicBezier(RgbImage POINTER img
IntPoint POINTER p1,p2,p3,p4 RGB POINTER col)
INT i,n=[20],prevX,prevY,nextX,nextY
REAL one,two,three,ri,rn,rt,ra,rb,rc,rd,tmp1,tmp2,tmp3
REAL x1,y1,x2,y2,x3,y3,x4,y4
 
IntToReal(p1.x,x1) IntToReal(p1.y,y1)
IntToReal(p2.x,x2) IntToReal(p2.y,y2)
IntToReal(p3.x,x3) IntToReal(p3.y,y3)
IntToReal(p4.x,x4) IntToReal(p4.y,y4)
IntToReal(1,one) IntToReal(2,two)
IntToReal(3,three) IntToReal(n,rn)
FOR i=0 TO n
DO
prevX=nextX prevY=nextY
 
IntToReal(i,ri)
RealDiv(ri,rn,rt) ;t=i/n
RealSub(one,rt,tmp1) ;tmp1=1-t
RealMult(tmp1,tmp1,tmp2) ;tmp2=(1-t)^2
RealMult(tmp2,tmp1,ra) ;a=(1-t)^3
RealMult(three,rt,tmp2) ;tmp2=3*t
RealMult(tmp1,tmp1,tmp3) ;tmp3=(1-t)^2
RealMult(tmp2,tmp3,rb) ;b=3*t*(1-t)^2
 
RealMult(three,rt,tmp2) ;tmp2=3*t
RealMult(rt,tmp1,tmp3) ;tmp3=t*(1-t)
RealMult(tmp2,tmp3,rc) ;c=3*t^2*(1-t)
 
RealMult(rt,rt,tmp2) ;tmp2=t^2
RealMult(tmp2,rt,rd) ;d=t^3
 
RealMult(ra,x1,tmp1) ;tmp1=a*x1
RealMult(rb,x2,tmp2) ;tmp2=b*x2
RealAdd(tmp1,tmp2,tmp3) ;tmp3=a*x1+b*x2
RealMult(rc,x3,tmp1) ;tmp1=c*x3
RealAdd(tmp3,tmp1,tmp2) ;tmp2=a*x1+b*x2+c*x3
RealMult(rd,x4,tmp1) ;tmp1=d*x4
RealAdd(tmp2,tmp1,tmp3) ;tmp3=a*x1+b*x2+c*x3+d*x4
nextX=MyRealToInt(tmp3)
 
RealMult(ra,y1,tmp1) ;tmp1=a*y1
RealMult(rb,y2,tmp2) ;tmp2=b*y2
RealAdd(tmp1,tmp2,tmp3) ;tmp3=a*y1+b*y2
RealMult(rc,y3,tmp1) ;tmp1=c*y3
RealAdd(tmp3,tmp1,tmp2) ;tmp2=a*y1+b*y2+c*y3
RealMult(rd,y4,tmp1) ;tmp1=d*y4
RealAdd(tmp2,tmp1,tmp3) ;tmp3=a*y1+b*y2+c*y3+d*y4
nextY=MyRealToInt(tmp3)
 
IF i>0 THEN
RgbLine(img,prevX,prevY,nextX,nextY,col)
FI
OD
RETURN
 
PROC DrawImage(RgbImage POINTER img BYTE x,y)
RGB POINTER ptr
BYTE i,j
 
ptr=img.data
FOR j=0 TO img.h-1
DO
FOR i=0 TO img.w-1
DO
IF RgbEqual(ptr,yellow) THEN
Color=1
ELSEIF RgbEqual(ptr,violet) THEN
Color=2
ELSEIF RgbEqual(ptr,blue) THEN
Color=3
ELSE
Color=0
FI
Plot(x+i,y+j)
ptr==+RGBSIZE
OD
OD
RETURN
 
PROC Main()
RgbImage img
BYTE CH=$02FC,width=[70],height=[40]
BYTE ARRAY ptr(8400)
IntPoint p1,p2,p3,p4
 
Graphics(7+16)
SetColor(0,13,12) ;yellow
SetColor(1,4,8) ;violet
SetColor(2,8,6) ;blue
SetColor(4,0,0) ;black
 
RgbBlack(black)
RgbYellow(yellow)
RgbViolet(violet)
RgbBlue(blue)
 
InitRgbImage(img,width,height,ptr)
FillRgbImage(img,black)
 
p1.x=0 p1.y=3
p2.x=10 p2.y=39
p3.x=69 p3.y=31
p4.x=40 p4.y=8
RgbLine(img,p1.x,p1.y,p2.x,p2.y,blue)
RgbLine(img,p2.x,p2.y,p3.x,p3.y,blue)
RgbLine(img,p3.x,p3.y,p4.x,p4.y,blue)
CubicBezier(img,p1,p2,p3,p4,yellow)
SetRgbPixel(img,p1.x,p1.y,violet)
SetRgbPixel(img,p2.x,p2.y,violet)
SetRgbPixel(img,p3.x,p3.y,violet)
SetRgbPixel(img,p4.x,p4.y,violet)
 
DrawImage(img,(160-width)/2,(96-height)/2)
 
DO UNTIL CH#$FF OD
CH=$FF
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/B%C3%A9zier_curves_cubic.png Screenshot from Atari 8-bit computer]
 
=={{header|Ada}}==
Anonymous user