-----------------------------------------------------------------------------
-- |
-- Module      :  HCube.Lib
-- Copyright   :  (c) Todd Wegner 2012
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  echbar137@yahoo.co.in
-- Stability   :  provisional
-- Portability :  portable
--
-- Exposes virtual cube functionality.
-----------------------------------------------------------------------------

{-# LANGUAGE Safe #-}

module HCube.Lib (Rubik(..), 
		Cube(..),
		posToId,
		getPos,
		consCubeInfo,
		solvedSurf,
		cubeIdsOfFace,
		cubeTypes,
		initCube,
		getFaceColor,
		getCubeFromPos,
		doCubeOps,
		loadCube,
		saveCube) where

import Data.Monoid
import Control.Monad (foldM)
import Data.List (find, sort, foldl)
import Data.Maybe (fromJust, mapMaybe)
import Data.Char (ord, chr)
import System.Directory (doesFileExist)
import HCube.Data
import HCube.Utility
import HCube.OrientGroup

-- |Vitrual Rubik's cube.
data Rubik		= Rubik {
			n   :: Size,
			crn :: [Cube],
			edg :: [Cube],
			cnt :: [Cube],
			hid :: [Cube],
			loop :: Bool,
			view :: View,
			his :: [Rotation]
			} deriving (Show, Read, Eq)

-- |Individual cube of Rubik's cube, known as a Cubie.
data Cube		= Cube {
			pos :: Vec,
			ori :: Orient,
			cid :: Numb
			} deriving (Show, Read, Eq)

-- |Loads cube from a file.
loadCube		:: Size -> FilePath -> IO Rubik
loadCube sz fp		= doesFileExist fp >>= f where
		f True  = fromFile fp
		f False	= return g <* saveCube fp g
		g 	= initCube sz

-- |Saves cube to a file.
saveCube		:: FilePath -> Rubik -> IO ()
saveCube fn rb 		= writeFile fn (show $ rb {loop = True})

-- |Performs a cube operation on virtual cube.
-- Conceptually this corresponds to multiplying the cube state by an appropriate element of the permutation group.
-- However a vector approach is used here. 
doCubeOps			:: [Rotation] -> Rubik -> Rubik
doCubeOps ops rk		= foldl f rk ops where
    f rk2 (RotateCube sb dr) 	= doCubeOps g rk2 where
	g			= map (Rotation sb dr) [1 .. i]
    f rk3 rt 			= rk3 { crn = h crn,
					edg = h edg,
					cnt = h cnt,
					hid = h hid
						 }  where
        h fn			= twist i rt (fn rk3)
    i				= n rk

twist			:: Size -> Rotation -> [Cube] -> [Cube] 
twist sz rt@(Rotation sb dir nm) = map f where
	f cb 		= g $ nm == getAxis sb (pos cb) where
	    g False	= cb
	    g True	= moveCube sz rt cb

getCube			:: [Cube] -> Vec -> Maybe Cube
getCube cbs ps		= f where
	f		= find g cbs
	g cb		= ps == pos cb

-- | Color of cube id on a face is returned.
-- This function is important for rendering.
getFaceColor		:: Rubik -> (Numb,Side) -> String	
getFaceColor rk (pos, sd) = f (getCubeFromPos rk pos) sd where
    f cb		= show . sideToColor . getFaceOrientation cb

-- | Returns the cubie at a given position.
getCubeFromPos		:: Rubik -> Numb -> Cube	
getCubeFromPos rk pos	= fromJust $ getCube cs (getPos sz pos) where
    sz			= n rk
    cs			= concat [crn rk, edg rk, cnt rk, hid rk] 

-- transformations
rotate			:: Size -> Rotation -> (Point -> Point)
rotate sz rt (x,y)	= f rt where
    f (Rotation dr _  _) 			
			= g $ humanDir sz rt where
    g Clockwise		= (y, sz - x + 1)
    g Counter		= (sz - y + 1, x)
    g Twice		= (sz - x + 1, sz -y + 1)

humanDir		:: Size -> Rotation -> Direction
humanDir sz		= f where
    f (Rotation _ dr _)	= dr
{-
    f (Rotation Layer Clockwise _)	= Counter
    f (Rotation Layer Counter _)	= Clockwise
    f (Rotation Layer Twice _)		= Twice
    f (Rotation HSlice Clockwise _)	= Clockwise
    f (Rotation HSlice Counter _)	= Counter
    f (Rotation HSlice Twice _)		= Twice
    f (Rotation VSlice Clockwise _) 	= Clockwise
    f (Rotation VSlice Counter _)	= Counter
    f (Rotation VSlice Twice _)		= Twice
-}

getTwistOrient		:: Rotation -> Orient
getTwistOrient  	= cons . f where
    f (Rotation Layer Clockwise _)	= 'f'
    f (Rotation Layer Counter _)	= 'l'
    f (Rotation Layer Twice _)		= 't'
    f (Rotation HSlice Clockwise _)	= 'r'
    f (Rotation HSlice Counter _)	= 'g'
    f (Rotation HSlice Twice _)		= 'k'
    f (Rotation VSlice Clockwise _) 	= 'o'
    f (Rotation VSlice Counter _)	= 'd'
    f (Rotation VSlice Twice _)		= 'e'

orient			:: Rotation -> Orient -> Orient
orient	rt or		= f rt where
    f (Rotation sb dr _)
			= Orient $ map (g |*|) (getVec $ mempty) where 
	g		= h |**| to or
	h	 	= to $ getTwistOrient rt

-- imlementation

-- | Creates a virtual cube in solved state
initCube 		:: Size -> Rubik
initCube sz		= f $ cubeTypes sz where
    f (cr,ed,ce,hi) 	= Rubik { n = sz, 
				  crn = map g cr,
				  edg = map g ed,
				  cnt = map g ce,
				  hid = map g hi,
				  loop = True,
				  view = LeftV,
				  his = []}
    g id		= Cube (getPos sz id) mempty id

moveCube		:: Size -> Rotation -> Cube -> Cube
moveCube sz rt cb	= f rt where
	f (Rotation sb dr _) 
			= cb { pos = apply (rotate sz rt) sb (pos cb), 
		 	       ori = orient rt (ori cb) }

apply			:: (Point -> Point) -> Slab -> Vec -> Vec
apply fn sb (a,b,c)	= f sb where
	f VSlice	= (a, g (b,c), h (b,c))
	f HSlice	= (g (a,c), b, h (a,c))
	f Layer		= (g (a,b), h (a,b), c)
	g		= fst . fn
	h		= snd . fn

getFaceOrientation	:: Cube -> Side -> Side
getFaceOrientation cb	= transform (ori cb) 

transform		:: Orient -> Side -> Side
transform or sd		= vecToSide $ (inverse $ to or) |*| (sideToVec sd)

getAxis			:: Slab -> Vec -> Numb
getAxis	Layer (_,_,ps)	= ps
getAxis HSlice (_,ps,_)	= ps
getAxis VSlice (ps,_,_)	= ps

-- | Generates a tuple of cube ids corresponding to (corners, edges, centers, hidden cubies).
cubeTypes		:: Size -> ([Int],[Int],[Int],[Int])
cubeTypes n 		= foldr f ([],[],[],[]) $ consCubeInfo n (solvedSurf n) where
    f (id, _, chs) (cr,ed,ce,hi) = g $ length chs where
	g 0		 = (cr,ed,ce,id:hi)
	g 1		 = (cr,ed,id:ce,hi)
	g 2		 = (cr,id:ed,ce,hi)
	g 3		 = (id:cr,ed,ce,hi)

nullActCube		:: Int -> [(Int,ActualCube,ColorTag)]
nullActCube n		= zip3 [1..] f g where
    f			= replicate h (ActualCube NoColor NoColor NoColor NoColor NoColor NoColor)
    g			= replicate h []
    h			= n*n*n

-- | CubeSurf representing a solved cube.
solvedSurf		:: Int -> CubeSurf
solvedSurf n		= map f [UpS,FrontS,DownS,BackS,LeftS,RightS] where
    f sd		= (sd, replicate (n*n) (sideToColor sd)) 

-- | Converts from a surface view of cube to a cubie view of cube. 
consCubeInfo		:: Int -> CubeSurf -> [(Int, ActualCube, ColorTag)] 
consCubeInfo n		= foldl f (nullActCube n) where
    f acs (sd, cls)	= foldl g acs $ zip (cubeIdsOfFace n sd) cls where
	g acs (pi,cl) 	= map h acs where
	    h tu@(ci,ac,ct)
		| ci == pi  = (ci, i sd ac cl, sort $ (head $ show cl) : ct)
		| otherwise = tu 
    i UpS ac cl    = ac {up = cl}
    i FrontS ac cl = ac {front = cl}
    i DownS ac cl  = ac {down = cl}
    i BackS ac cl  = ac {back = cl}
    i LeftS ac cl  = ac {left = cl}
    i RightS ac cl = ac {right = cl} 

-- | Maps a face id defined with respect to a side, to the cube id.
cubeIdsOfFace	:: Int -> Side -> [Int]
cubeIdsOfFace n = f where
    f UpS	= [1 .. l]
    f FrontS	= concat [[g x .. g x + n -1] | x <-[1..n]]
    f DownS	= h (\s -> (n-1)*l + (s-1)*n + 1)
    f BackS	= h j
    f RightS	= i (\s -> reverse [ (s-1)*n + j y | y <- [1..n]])
    f LeftS 	= i (\s -> [(s-1)*n + k y | y <- [1..n]] )
    g ix	= ix*l - n + 1
    h fu 	= reverse $ concat [ reverse [fu x .. fu x + n - 1] | x <- [1..n] ]
    i fu	= concat [fu x | x <- [1..n]]
    j ix	= (ix-1)*l + 1
    k ix	= (ix-1)*l + n
    l		= n*n

-- | Converts a pseudo-vector representation to a cube id.
posToId			:: Size -> Vec -> Numb
posToId	n (a,b,c)	= a + n*(b-1) + n*n*(c-1) 

-- | Converts a cube id to a pseudo-vector representation.
getPos			:: Size -> Numb -> Vec
getPos n id		= head [(a,b,c) | c <- [1..n],
					  b <- [1..n],
					  a <- [1..n],
					  posToId n (a,b,c) == id]
-- serialization 

fromFile		:: FilePath -> IO Rubik
fromFile fn		= readFile fn >>= return . read