-- Drawing "spirograph" curves - epitrochoids, cycolids, roulettes

-- Copyright (C) 2008 Jerry Bauck

-- This file is part of PLplot.

-- PLplot is free software; you can redistribute it and/or modify
-- it under the terms of the GNU Library General Public License as published
-- by the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- PLplot is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Library General Public License for more details.

-- You should have received a copy of the GNU Library General Public License
-- along with PLplot; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

with
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    PLplot_Auxiliary,
    PLplot;
use
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    PLplot_Auxiliary,
    PLplot;

------------------------------------------------------------------------------
-- Generates two kinds of plots:
--   - construction of a cycloid (animated)
--   - series of epitrochoids and hypotrochoids
------------------------------------------------------------------------------

procedure xthick27a is
    -- R, r, p, N
    -- R and r should be integers to give correct termination of the
    -- angle loop using gcd.
    -- N.B. N is just a place holder since it is no longer used
    -- (because we now have proper termination of the angle loop).
    params : Real_Matrix(0 .. 8, 0 .. 3) :=
      ((21.0,  7.0,  7.0,  3.0),
       (21.0,  7.0, 10.0,  3.0),
       (21.0, -7.0, 10.0,  3.0),
       (20.0,  3.0,  7.0, 20.0),
       (20.0,  3.0, 10.0, 20.0),
       (20.0, -3.0, 10.0, 20.0),
       (20.0, 13.0,  7.0, 20.0),
       (20.0, 13.0, 20.0, 20.0),
       (20.0,-13.0, 20.0, 20.0));

    fill : Boolean;

    -- To understand why spiro is written this way you need to understand the
    -- C code from which this was derived. In the main C program, params
    -- is a two-dimensional array with 9 rows numbered 0 .. 8 and 4 columns
    -- numbered 0 .. 3. When spiro is called, it is passed the _address_ of the
    -- element of params's ith row, 0th column--nothing else. Then, inside spiro,
    -- the corresponding entity (also called params!) appears as a
    -- _one-dimensional_ array whose 0th element shares the same address as what
    -- was passed from the main program. So memory locations starting there,
    -- and numbered from 0, represent the 1D array equivalent to the ith row of
    -- params in the main program. Wilma, call Barney--we're programming a
    -- micaprocessor here.
    procedure spiro(params : Real_Matrix; row : Integer; fill : Boolean) is
        NPNT : constant Integer := 2000;
        xcoord, ycoord : Real_Vector(0 .. NPNT);
        windings : Integer;
        steps    : Integer;
        phi      : Long_Float;
        phiw     : Long_Float;
        dphi     : Long_Float;
        xmin     : Long_Float;
        xmax     : Long_Float;
        xrange_adjust : Long_Float;
        ymin     : Long_Float;
        ymax     : Long_Float;
        yrange_adjust : Long_Float;

        function Trunc(a : Long_Float) return Integer renames PLplot_Auxiliary.Trunc;

        -- Calculate greatest common divisor following pseudo-code for the
        -- Euclidian algorithm at http://en.wikipedia.org/wiki/Euclidean_algorithm
        function gcd(a, b : Integer) return Integer is
            t : Integer;
            aa : Integer := a;
            bb : Integer := b;
    begin
            aa := abs(aa);
            bb := abs(bb);
            while bb /= 0 loop
                t := bb;
                bb := aa mod bb;
                aa := t;
            end loop;
            return aa;
        end gcd;

    begin -- spiro
        -- Fill the coordinates.
        -- Proper termination of the angle loop very near the beginning
        -- point, see http://mathforum.org/mathimages/index.php/Hypotrochoid
        windings := Trunc(abs(params(row, 1)) /
            Long_Float(gcd(Trunc(params(row, 0)), Trunc(params(row, 1)))));
        steps    := NPNT / windings;
        dphi     := 2.0 * pi / Long_Float(steps);
        for i in 0 .. windings * steps loop
            phi       := Long_Float(i) * dphi;
            phiw      := (params(row, 0) - params(row, 1)) / params(row, 1) * phi;
            xcoord(i) := (params(row, 0) - params(row, 1)) * cos(phi) + params(row, 2) * cos(phiw);
            ycoord(i) := (params(row, 0) - params(row, 1)) * sin(phi) - params(row, 2) * sin(phiw);
            if i = 0 then
                xmin := xcoord(i);
                xmax := xcoord(i);
                ymin := ycoord(i);
                ymax := ycoord(i);
            end if;
            if xmin > xcoord(i) then xmin := xcoord(i); end if;
            if xmax < xcoord(i) then xmax := xcoord(i); end if;
            if ymin > ycoord(i) then ymin := ycoord(i); end if;
            if ymax < ycoord(i) then ymax := ycoord(i); end if;
        end loop;

        xrange_adjust := 0.15 * (xmax - xmin);
        xmin := xmin - xrange_adjust;
        xmax := xmax + xrange_adjust;
        yrange_adjust := 0.15 * (ymax - ymin);
        ymin := ymin - yrange_adjust;
        ymax := ymax + yrange_adjust;

        Set_Viewport_World(xmin, xmax, ymin, ymax);
        Set_Pen_Color(Red);

        declare
            xcoord_local, ycoord_local : Real_Vector(0 .. steps * windings);
        begin
            xcoord_local := xcoord(0 .. steps * windings);
            ycoord_local := ycoord(0 .. steps * windings);
            if fill then
                Fill_Polygon(xcoord_local, ycoord_local);
            else
                Draw_Curve(xcoord_local, ycoord_local);
            end if;
        end;
    end spiro;

    procedure cycloid is
    begin
        null; -- TODO
    end cycloid;

    procedure arcs is
       NSEG : constant Integer := 8;
       theta : Long_Float;
       dtheta : Long_Float;
       a : Long_Float;
       b : Long_Float;
    begin

       theta := 0.0;
       dtheta := 360.0/Long_Float(NSEG);
       Set_Environment( -10.0, 10.0, -10.0, 10.0, 1, 0 );

       -- Plot segments of circle in different colors
       for i in 0 .. NSEG-1 loop
          Set_Pen_Color( (i mod 2) + 1 );
          Draw_Arc(0.0, 0.0, 8.0, 8.0, theta, theta + dtheta, 0.0, False);
          theta := theta + dtheta;
       end loop;

       -- Draw several filled ellipses inside the circle at different
       -- angles.
       a := 3.0;
       b := a * tan( (dtheta/180.0*pi)/2.0 );
       theta := dtheta/2.0;
       for i in 0 .. NSEG-1 loop
          Set_Pen_Color( 2 - (i mod 2 ) );
          Draw_Arc( a*cos(theta/180.0*pi), a*sin(theta/180.0*pi), a, b, 0.0, 360.0, theta, True);
          theta := theta + dtheta;
       end loop;

    end arcs;

begin
    -- Parse and process command line arguments
    Parse_Command_Line_Arguments(Parse_Full);

    -- Initialize plplot
    Initialize_PLplot;

    -- Illustrate the construction of a cycloid
    cycloid;

    -- Loop over the various curves.
    -- First an overview, then all curves one by one
    Set_Number_Of_Subpages(3, 3) ; -- Three by three window

    -- Overview
    fill := False;
    for i in params'range(1) loop
        Advance_To_Subpage(Next_Subpage);
        Set_Viewport_Normalized( 0.0, 1.0, 0.0, 1.0);
        spiro(params, i, fill);
    end loop;

    -- Don't fill the curves.
    Advance_To_Subpage(Next_Subpage);
    Set_Number_Of_Subpages(1, 1) ; -- One window per curve
    for i in params'range(1) loop
        Advance_To_Subpage(Next_Subpage);
        Set_Viewport_Normalized(0.0, 1.0, 0.0, 1.0);
        spiro(params, i, fill);
    end loop;

    -- Fill the curves
    fill := True;
    Advance_To_Subpage(Next_Subpage);
    Set_Number_Of_Subpages(1, 1); -- One window per curve
    for i in params'range(1) loop
        Advance_To_Subpage(Next_Subpage) ;
        Set_Viewport_Normalized( 0.0, 1.0, 0.0, 1.0 ) ;
        spiro(params, i, fill);
    end loop;

    arcs;

    -- Don't forget to call End_PLplot to finish off!
    End_PLplot;
end xthick27a;
