module CloudPacker (diagram) where

-- Cobbled together from snippets and ideas by Chris Done
-- http://github.com/chrisdone/wordcloud/

import Control.Arrow ((&&&), (***), first)
import Control.Monad (liftM)
import Data.Char (isLetter, toLower)
import Data.List (init, sortBy, foldl')
import Data.Maybe (listToMaybe)
import Data.Ord (comparing)
import qualified Data.Map as M

import Graphics.Rendering.Diagrams
import Graphics.Rendering.Diagrams.Engine (sizeAndPos)

type Point = (Int,Int)
type Size = Point
type Rect = (Point,Point)

-- Arrange the text boxes on the page, starting with the
-- largest and placing each one in the first gap available.
diagram :: [Diagram] -> Diagram
diagram = arrange . uncurry zip . (f &&& id)
    where f = map toPoint . foldl addToLayout [] . map size

arrange :: [(Point,Diagram)] -> Diagram
arrange = positionA left top . map (first (fromIntegral *** fromIntegral))

addToLayout :: [Rect] -> Size -> [Rect]
addToLayout [] sz = let (w,h) = sz in [toRect (-w`div`2,-h`div`2) sz]
addToLayout rs sz = maybe rs (\p -> rs ++ [toRect p sz]) $ listToMaybe $ bestfits sz rs

bestfits :: Size -> [Rect] -> [Point]
bestfits sz rs = concatMap (\r -> aroundRect sz r rs) rs

aroundRect :: Size -> Rect -> [Rect] -> [Point]
aroundRect sz r rs = filter valid (potentials sz r)
    where valid pt = not (any (overlaps (toRect pt sz)) rs)

toRect :: Point -> Size -> Rect
toRect (x,y) (w,h) = ((x,y),(x+w,y+h))
toPoint :: Rect -> Point
toPoint = fst

-- Produces candidates in anti-clockwise order.
potentials :: Size -> Rect -> [Point]
potentials (w,h) ((x1,y1),(x2,y2)) = concat [leftside,rightside,bottomside,topside]
    where leftside = init $ map ((,) x) [y..y2]
          rightside = init $ map ((,) x2) [y2,y2-1..y]
          bottomside = init $ map (flip (,) y2) [x..x2]
          topside = init $ map (flip (,) y) [x2,x2-1..x]
          (x,y) = (x1 - w, y1 - h)

overlaps :: Rect -> Rect -> Bool
overlaps r1 r2 = r1 `overlapX` r2 && r1 `overlapY` r2
overlapX :: Rect -> Rect -> Bool
overlapX ((x1,_),(x1',_)) ((x2,_),(x2',_)) = if x1 < x2 then x1' > x2 else x2' > x1
overlapY :: Rect -> Rect -> Bool
overlapY ((_,y1),(_,y1')) ((_,y2),(_,y2')) = if y1 < y2 then y1' > y2 else y2' > y1

size :: Diagram -> Size
size = (ceiling *** ceiling) . fst . sizeAndPos