Radial projection test

gistfile1.hs

import           Control.Monad
import qualified Control.Monad.State as State
import           Control.Monad.State   (State)

import qualified Data.Map as Map
import           Data.Map   (Map)
import           Data.Maybe

type Image = Map (Int, Int)

data Cell m a = Cell
    { get      :: m a
    , set      :: a -> m ()
    , location :: (Int, Int)
    , moveTo   :: (Int, Int) -> Cell m a
    }

type StateCell a = Cell (State (Image a)) a

class    Nullable n    where nothing :: n
instance Nullable Char where nothing = ' '

at :: Nullable a => Image a -> (Int, Int) -> StateCell a
image `at` point = Cell
    { get      = get'
    , set      = set'
    , location = point
    , moveTo   = (image `at`)
    }
  where
    get'       = (`atPoint` point) `fmap` State.get
    set' item  = State.modify $ Map.insert point item

atPoint :: (Ord k, Nullable a) => Map k a -> k -> a
atPoint img pt = fromMaybe nothing $ pt `Map.lookup` img

row :: Nullable a => Float -> Int -> State (Image a) [a]
row angle len = 
    State.get >>= \img -> 
        sequence $ for (radiusVector angle len) $ get . (img `at`)

unrow :: Nullable a => (Float, [a]) -> Int -> State (Image a) ()
unrow (angle, the_row) len =
    forM_ chain $ \((x, y), item) ->
        State.get >>= \img ->
            img `at` (x, y) `set` item

  where
    chain = radiusVector angle len `zip` the_row

radiusVector :: Float -> Int -> [(Int, Int)]
radiusVector angle len =
    map list2tuple $
        for [0.. len]   $ \point ->
        for [nsin, cos] $ \projection -> 
            round $ fromIntegral point * projection angle

  where
    nsin              = sin . negate
    list2tuple [x, y] = (x, y)
    list2tuple  _     = error "wut?"

fromBiList :: Nullable a => [[a]] -> Image a
fromBiList blist = blist
    |> map (zip [0..])
    |> zipWith setRowIndices [0..]
    |> concat
    |> Map.fromList

  where
    setRowIndices x list = for list $ withRow x

    withRow x (y, item)  = ((x - cx, y - cy), item)

    [cx, cy] = for [w, h] (`div` 2)

    (w,  h)  = (length blist, minimum $ for blist length)

cutBiList :: Nullable a => (Int, Int, Int, Int) -> Image a -> [[a]]
cutBiList (l, u, r, d) img =
    for [ [ (x, y) 

        | x <- [l.. r] ] 
        | y <- [u.. d] ] 

    $ map (img `atPoint`)

for  :: [a] -> (a -> b) -> [b]
(|>) ::  a  -> (a -> b) ->  b

for  = flip map
(|>) = flip ($)

main :: IO ()
main = 
    mapM_ print $ cutBiList (-20, -20, 20, 20) img

  where
    reimg = sequence $ for (angles `zip` fan) (`unrow` 40)
    rows  = sequence $ for  angles            (  `row` 40)

    fan   = fst $ State.runState rows      test2
    img   = snd $ State.runState reimg Map.empty

    angles = for [1..200] (pi / 100 *)

test2 :: Image Char
test2 = fromBiList $ zipWith (++) test test ++ zipWith (++) test test

test :: [String]
test = 
    [ ".........36........."
    , "........3246........"
    , ".......321546......."
    , "......321..546......"
    , ".....321....546....."
    , "....321......546...."
    , "...3217......8546..."
    , "..321..7....8..546.."
    , ".321....7..8....546."
    , "321......78......546"
    , "321......87......546"
    , ".321....8..7....546."
    , "..321..8....7..546.."
    , "...3218......7546..."
    , "....321......546...."
    , ".....321....546....."
    , "......321..546......"
    , ".......321546......."
    , "........3246........"
    , ".........36........."
    ]