{-

    Draw a regular hexagon, internally shaded with a rainbow.

    Copyright 2016 Ken Takusagawa

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

    This program 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 General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.

 -}
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
module Main(main) where {
import Codec.Picture(encodePng,pixelMap,PixelRGBF(..),PixelRGB8(..),generateImage,Image);
import System.Environment(getArgs);
import qualified Data.ByteString.Lazy as ByteString;
import Data.Word(Word8);
import Data.Tuple.Curry(uncurryN);
import Data.List;
import Control.Exception(assert);
import Control.Monad(msum,MonadPlus,mzero);
import Data.Maybe(fromJust);

main::IO();
main = getArgs >>= \case
{[size] -> heptagon (read size)
;["faster",size] -> heptagonpic (read size)
;_ -> undefined;
};

heptagonpic :: Integer -> IO();
heptagonpic = ByteString.putStr . encodePng . pixelMap quantize_pixel . heptagonImage;

quantize_pixel :: PixelRGBF -> PixelRGB8;
quantize_pixel (PixelRGBF x y z) = let {
q :: Float -> Word8;
q t
| t>1 = 0
| t==1 = 255
| t<0 = 255
| True = floor $ t*256;
}
in uncurryN PixelRGB8 $ mapTuple3 q (x,y,z);

mapTuple3 :: (a -> b) -> (a,a,a) -> (b,b,b);
mapTuple3 f (x,y,z) = (f x, f y, f z);

-- wow that worked on the first try.
eval_line :: Point -> [Double] -> Double;
eval_line (Point p) n = (sum $ zipWith (*) p n) -1;

cossin :: Double -> [Double];
cossin x= [cos x, sin x];

newtype Point = Point [Double];

eval_shape :: [[Double]] -> Point -> Double;
eval_shape vs p = maximum $ map (eval_line p) vs;

ngon :: Integer -> [[Double]];
ngon n = do {
i :: Integer <- genericTake n $ enumFrom 0;
return $ cossin $ 2*pi*fromIntegral i/fromIntegral n;
};

range01 :: Integer -> [Double];
range01 width =
map (\(i::Double) -> i/(fromIntegral width))
$ genericTake width
$ enumFrom 0;

heptagon :: Integer -> IO();
heptagon size = do
{putStrLn "P3"
;print size
;print size
;putStrLn "255"
;sequence_ $ do
{x <- eval_pixels size;
;if x > 0
then return $ putStrLn "255 255 255"
else return $ putStrLn $ outcolor $ quantize_pixel $ getcolor $ negate x;
};
};

eval_pixels :: Integer -> [Double];
eval_pixels size = do
{i <- range01 size >>= return . scale
;j <- range01 size >>= return . scale
;return $ eval_shape (ngon 7) $ Point [i,j]
};

scale :: Double -> Double;
scale x = ((x-0.5)*2)*1.15;

getcolor :: Double -> PixelRGBF;
getcolor x = assert (0<=x) $ assert (x<=1) $ continuous3rainbow (1-x);

continuous3 :: Double -> [Double];
continuous3 x = let {
pieces :: [Double -> [Double]];
pieces =
[\t -> [1  ,t  ,0]
,\t -> [1-t,1  ,0]
,\t -> [0  ,1  ,t]
,\t -> [0  ,1-t,1]
,\t -> [t  ,0  ,1]
,\t -> [1  ,0  ,1-t]
];
eval_piece :: (MonadPlus m) => Double -> (Double,Double -> b) -> m b;
eval_piece t (z,f) = if t <= z+1 then
return $ f $ t - z else mzero;
npieces :: [(Double, Double -> [Double])];
npieces = zip (map fromInteger [(0::Integer)..]) pieces;
} in assert (0 <= x) $ if (6 < x) then continuous3 $ x-6 else
fromJust $ msum (map (eval_piece x) npieces);

continuous3rainbow :: Double -> PixelRGBF;
continuous3rainbow =  uncurryN PixelRGBF . fromList3 . map realToFrac . continuous3 . (*6);

outcolor :: PixelRGB8 -> String;
outcolor (PixelRGB8 a b c) = concat $ intersperse " " $map show [a,b,c];

--toList3 (x,y,z) = [x,y,z];
fromList3 :: [a] -> (a,a,a);
fromList3 [x,y,z] = (x,y,z);
fromList3 _ = undefined;

rescale :: Integer -> Int -> Double;
rescale size i = scale $ fromIntegral i/fromInteger size;

heptagonImage :: Integer -> Image PixelRGBF;
heptagonImage size = generateImage (heptagon_generate size) (fromInteger size) (fromInteger size);

heptagon_generate :: Integer -> Int -> Int -> PixelRGBF;
heptagon_generate size p q = let
{x = eval_shape (ngon 7) $ Point $ map (rescale size) [q,p]
}in if x>0 then PixelRGBF 1 1 1
else getcolor $ negate x;

} -- end.