module Main where
import Ix
import Monad
import Char
main = ps_io
 
flip_tuple :: (a, b) -> (b, a)
flip_tuple xy = ((snd xy), (fst xy))
 
ps_header :: String
ps_header
  = (++)
      "%!PS-Adobe EPSF-3.0\n%%BoundingBox: 0 0 612 792\n0.3 setlinewidth\n/l { newpath moveto lineto stroke } def\n"
      ps_drawborder
 
grid_size :: (Int, Int)
grid_size = (37, 23)
 
choose_offset :: [Node]
choose_offset
  = let  
        d :: [Node]
        d = [(3, 1), (2, 1), (3, 2)]
         
        c :: [Node]
        c = d ++ [(1, 1)] ++ (reverse (map flip_tuple d))
         
        neg_second :: Int -> Int -> Node
        neg_second x y = (x, (negate y))
      in (++) (reverse (map (uncurry neg_second) c)) c
 
ps_page_x :: Double
ps_page_x = (*) 8.5 72
 
ps_page_y :: Double
ps_page_y = (*) 11 72
 
type Node = (Int, Int)
 
type Segment = (Node, Node)
 
type Picture = [Segment]
 
all_lines_in_grid :: Node -> Picture
all_lines_in_grid max_coord
  = do start <- (choose_nodes max_coord)
       offset <- choose_offset
       let  
           end :: Node
           end
             = (((+) (fst start) (fst offset)), ((+) (snd start) (snd offset)))
         in
         do guard (inRange (zero_zero, max_coord) end)
            return (start, end)
 
zero_zero :: Node
zero_zero = (0, 0)
 
choose_nodes :: Node -> [Node]
choose_nodes max_coord
  = do x <- (enumFromTo 0 (fst max_coord))
       y <- (enumFromTo 0 (snd max_coord))
       return (x, y)
 
lines_inside_grid :: Node -> Picture
lines_inside_grid max_coord = all_lines_in_grid max_coord
 
ps_convert :: Int -> Int
ps_convert x = round ((*) ps_scale (fromIntegral x))
 
ps_drawnode :: Node -> String
ps_drawnode n
  = (show ((+) ps_offset_y (ps_convert (snd n)))) ++ " " ++
      (show ((+) ps_offset_x (ps_convert (fst n))))
 
ps_drawline :: Segment -> String
ps_drawline l
  = (ps_drawnode (fst l)) ++ " " ++ (ps_drawnode (snd l)) ++ " l\n"
 
ps_drawpicture :: Picture -> String
ps_drawpicture p
  = ps_header ++ (concatMap ps_drawline p) ++ ps_trailer
 
ps_drawborder :: String
ps_drawborder
  = let  
        left :: Node
        left = ((fst grid_size), 0)
         
        right :: Node
        right = (0, (snd grid_size))
      in
      concatMap ps_drawline
        [(zero_zero, left), (zero_zero, right), (left, grid_size),
         (right, grid_size)]
 
ps_trailer :: String
ps_trailer = "showpage\n"
 
char_to_bits :: Char -> [Bool]
char_to_bits c
  = let  
        internal :: Int -> Int -> [Bool]
        internal modulus n
          = case modulus of
                (0) -> []
                _ -> let gt = (<=) modulus n in
                       (:) gt
                         (internal (div modulus 2)
                            (case gt of
                                 True -> (-) n modulus
                                 _ -> n))
      in internal 128 (ord c)
 
bits_to_picture :: [Bool] -> Picture
bits_to_picture b
  = (map fst)
      ((filter snd) ((zip (lines_inside_grid grid_size)) (b)))
 
many_bits_to_picture :: [Bool] -> [Picture]
many_bits_to_picture b
  = case ((<=) (length b) num_lines_inside_grid) of
        True
          -> [(bits_to_picture
                 (take num_lines_inside_grid ((++) b (repeat False))))]
        _ -> (:) (bits_to_picture (take num_lines_inside_grid b))
               (many_bits_to_picture (drop num_lines_inside_grid b))
 
num_lines_inside_grid :: Int
num_lines_inside_grid = length (lines_inside_grid (grid_size))
 
padded_pictures :: [Bool] -> [Picture]
padded_pictures b = many_bits_to_picture b
 
ps_pictures :: [Bool] -> String
ps_pictures b = (concatMap ps_drawpicture) (padded_pictures (b))
 
ps_io :: IO ()
ps_io
  = do fi <- getContents
       putStr (ps_pictures ((concatMap char_to_bits) (fi)))
 
ps_scale :: Double
ps_scale
  = fromIntegral
      (floor ((/) ((-) ps_page_y 72) (fromIntegral (fst grid_size))))
 
ps_offset_x :: Int
ps_offset_x
  = floor
      ((/) ((-) ps_page_y ((*) (fromIntegral (fst grid_size)) ps_scale))
         2)
 
ps_offset_y :: Int
ps_offset_y
  = floor
      ((/) ((-) ps_page_x ((*) (fromIntegral (snd grid_size)) ps_scale))
         2)