-----------------------------------------------------------------------------
-- | 
-- Module      :  HCube.Cons
-- Copyright   :  (c) Todd Wegner 2012
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  echbar137@yahoo.co.in
-- Stability   :  provisional
-- Portability :  portable
-- 
-- Provides functions for re-constructing internal data representation
-- of virtual cube from a physical cube.
-----------------------------------------------------------------------------
{-# LANGUAGE Safe #-}

module HCube.Cons (realToVirtual, fromPhysical, consOrient) where

import Data.Monoid
import Data.Maybe (mapMaybe, fromMaybe)
import Data.List (sort, mapAccumL, nub)
import HCube.Data
import HCube.Utility
import HCube.Lib
import HCube.OrientGroup

fromPhysical		:: FilePath -> IO Rubik
fromPhysical fn		= readFile fn >>= f . read where
    f			= return . realToVirtual

-- | Constructs a virtual cube from a physical cube using CubeSurf.
realToVirtual		:: CubeSurf -> Rubik
realToVirtual cs	= f $ foldr g ([],[],[],[]) $ consCubeInfo sz cs where
    f (cr, ed, ce, hi)	= Rubik sz cr ed ce hi True LeftV []
    g (ci, ac, ct) (cr,ed,ce,hi) = h $ length ct where
	h 0	= (cr,ed,ce,i ci ac :hi)
	h 1 	= (cr,ed,i ci ac :ce,hi)
	h 2 	= (cr,i ci ac :ed,ce,hi)
	h 3 	= (i ci ac :cr,ed,ce,hi)
	i id ac	= Cube (getPos sz id) (k ac) (j ct)
    j 			= m . colorTagToCubeId sz
    k			= l . extractOrientInfo
    l []		= mempty
    l (hd:[])		= mempty
    l (v1:v2:_)		= consOrient v1 v2
    m []		= 0
    m ls		= head ls
    --sz			= fromJust $ getSize cs
    sz			= fromMaybe (error "Improper format") $ getSize cs

getSize			:: CubeSurf -> Maybe Size
getSize cs		= f . nub $ map (squareRoot . length) $ map snd cs where
    f (hd:[])		= hd
    f _			= Nothing


extractOrientInfo	:: ActualCube -> [(Side,Color)]
extractOrientInfo ac	= mapMaybe f [(UpS, up ac), (FrontS, front ac), (DownS, down ac),
			            (BackS, back ac), (LeftS, left ac), (RightS, right ac)] where
    f sc@(sd,cl)	| cl /= NoColor = Just sc
			| otherwise	 = Nothing

colorTagToCubeId	:: Int -> ColorTag -> [Int]
colorTagToCubeId n ct	= mapMaybe f $ consCubeInfo n (solvedSurf n) where
    f (a,b,c) | ct == c   = Just a
	      | otherwise = Nothing

-- | Constructs the orientaion of a cubie from the color of two of its faces.
consOrient		:: (Side,Color) -> (Side,Color) -> Orient
consOrient (sd1, cl1) (sd2, cl2) 
			= orientFromVecs (g cl1, f sd1) (g cl2, f sd2) where 
    f			= sideToVec
    g			= f . colorToSide

orientFromVecs		:: (Vec,Vec) -> (Vec,Vec) -> Orient
orientFromVecs v1 v2	= Orient [f RightS, f BackS] where 
    f 			= (g |*| ) . sideToVec
    g 			= vecsToTran v1 v2

orientFromSides		:: (Side,Side) -> (Side,Side) -> Orient
orientFromSides (sf1, st1) (sf2, st2) 
			= orientFromVecs (f sf1, f st1) (f sf2, f st2) where 
    f			= sideToVec


vecsToTran		:: (Vec,Vec) -> (Vec,Vec) -> Matrix
vecsToTran v1 v2	= missingVec (f v1) (f v2) where
	f (t1,t2)	= vecToMxElem t1 t2

vecToMxElem		:: Vec -> Vec -> (Int,Vec)
vecToMxElem v1 v2	= (vpos v1, multVec (vcomp v1) v2) where

missingVec		:: (Int,Vec) -> (Int,Vec) -> Matrix
missingVec (cl1,v1) (cl2,v2) = f $ g (cl1,cl2) where
    f fu		= h (fu i) (fu $ minus i)
    g (1,2)		= \s-> Matrix v1 v2 s 
    g (2,1)		= \s-> Matrix v2 v1 s
    g (1,3)		= \s-> Matrix v1 s v2
    g (3,1)		= \s-> Matrix v2 s v1
    g (2,3)		= \s-> Matrix s v1 v2
    g (3,2)		= \s-> Matrix s v2 v1
    g _			= \_-> Matrix (0,0,0) (0,0,0) (0,0,0)
    h m1 m2		= if det m1 == 1 then m1 else m2
    i			= cross v1 v2