Curve that touches three points: Difference between revisions

(Added Perl example)
Line 203:
}</lang>
See [https://github.com/thundergnat/rc/blob/master/img/Curve-3-points-perl6.png Curve-3-points-perl6.png] (offsite .png image)
 
=={{header|Phix}}==
{{trans|zkl}}
<lang Phix>include pGUI.e
 
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
 
enum X, Y
constant p = {{10,10},{100,200},{200,10}}
function lagrange(atom x)
return (x - p[2][X])*(x - p[3][X])/(p[1][X] - p[2][X])/(p[1][X] - p[3][X])*p[1][Y] +
(x - p[1][X])*(x - p[3][X])/(p[2][X] - p[1][X])/(p[2][X] - p[3][X])*p[2][Y] +
(x - p[1][X])*(x - p[2][X])/(p[3][X] - p[1][X])/(p[3][X] - p[2][X])*p[3][Y]
end function
function getPoints(integer n)
sequence pts = {}
atom {dx,pt,cnt} := {(p[2][X] - p[1][X])/n, p[1][X], n}
for j=1 to 2 do
for i=0 to cnt do
atom x := pt + dx*i;
pts = append(pts,{x,lagrange(x)});
end for
{dx,pt,cnt} = {(p[3][X] - p[2][X])/n, p[2][X], n+1};
end for
return pts
end function
procedure draw_cross(sequence xy)
integer {x,y} = xy
cdCanvasLine(cddbuffer, x-3, y, x+3, y)
cdCanvasLine(cddbuffer, x, y-3, x, y+3)
end procedure
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
cdCanvasActivate(cddbuffer)
cdCanvasSetForeground(cddbuffer, CD_BLUE)
cdCanvasBegin(cddbuffer,CD_OPEN_LINES)
atom {x,y} = {p[1][X], p[1][Y]}; -- curve starting point
cdCanvasVertex(cddbuffer, x, y)
sequence pts = getPoints(50)
for i=1 to length(pts) do
{x,y} = pts[i]
cdCanvasVertex(cddbuffer, x, y)
end for
cdCanvasEnd(cddbuffer)
cdCanvasSetForeground(cddbuffer, CD_RED)
for i=1 to length(p) do draw_cross(p[i]) end for
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function
 
function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
cdCanvasSetBackground(cddbuffer, CD_WHITE)
return IUP_DEFAULT
end function
 
procedure main()
IupOpen()
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "220x220")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
 
dlg = IupDialog(canvas,"DIALOGFRAME=YES")
IupSetAttribute(dlg, "TITLE", "Colour wheel")
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
IupCloseOnEscape(dlg)
 
IupMap(dlg)
IupSetAttribute(canvas, "RASTERSIZE", NULL)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure
main()</lang>
 
=={{header|zkl}}==
7,820

edits