{-
Copyright 2012 Ken Takusagawa

Released under GNU GPL version 3, or, at your option, any later version.
-}
module Main where {
  angles :: [Double];
  angles = map getangle [0..4];
  seventy_two :: Double ;
  seventy_two = (2*pi)/5; 
  getangle :: Int -> Double;
  getangle i = seventy_two * (fromIntegral i);
  slopes :: [Double];
  slopes = map tan angles;
  type Coordinates = (Double,Double);
  right :: Coordinates;
  right = (1,0.7);
  left :: Coordinates;
  left = (-1,1);
  points :: [Coordinates];
  points = magic_points ; -- arbitrary_points;
  arbitrary_points :: [Coordinates];
  arbitrary_points = [(0,0), right, right, left, left];
  magic_points :: [Coordinates];
  magic_points = [(0,0),(magic_width,0),(0,1),(0,1),(negate magic_width,0)];
  width :: Double ;
  width = 0.4;
  magic_width :: Double;
  magic_width = 0.5 * (1/(sin seventy_two + sin (2*seventy_two)));
  {-
(y-y0) = m(x-x0)
-}
  above :: [Bool];
  above = [True,True,False,False,True];
  realspace :: Integer -> Double ; 
  realspace i = (fromIntegral i) * scale - offset;
  realsize :: Double;
  realsize = 4;
  offset :: Double ; 
  offset = realsize/2;
  scale :: Double;
  scale = 1/(fromIntegral size) * realsize;
  size :: Integer;
  size = 1200;
  pbmheader :: String ; pbmheader = "P1\n" ++ show size ++ " " ++ show size ++ "\n" ;
  pixrange :: [Integer] ; pixrange = take (fromInteger size) $ enumFrom 0 ;
  pixel :: Bool -> String ; pixel x = if x then "1\n" else "0\n" ;
  fpbmraster :: (Double -> Double -> Bool) -> String ; fpbmraster f = concat $ do { y <- reverse pixrange ; x <- pixrange ; return $ pixel $ f (realspace x) (realspace y) } ;
  pbmraster :: String;
  pbmraster = fpbmraster all_lines;
  type Region = Double -> Double -> Bool;
  line1 :: Int -> Region;
  line1 i x y = let { (x0,y0) = points !! i ; m = slopes !! i ; cf :: Double -> Double -> Bool ; cf = comparefunction (above !! i)} in cf (y - y0) (m * (x - x0));
  comparefunction :: (Ord a) => Bool -> a -> a -> Bool;
  comparefunction True x y = x > y;
  comparefunction False x y = x < y;
  all_lines :: Region ; 
  all_lines x y = and $ do { i <- [0..4] ; return $ line1 i x y};
  main :: IO ();
  main = putStr $ pbmheader ++ pbmraster;
  }