module HCube.Cons (realToVirtual, consOrient) where
import Data.Monoid
import Data.Maybe (mapMaybe)
import Data.List (sort, mapAccumL)
import HCube.Data
import HCube.Utility
import HCube.Lib
import HCube.OrientGroup
realToVirtual :: Size -> CubeSurf -> Rubik
realToVirtual sz ci = f $ foldr g ([],[],[],[]) $ consCubeInfo sz ci 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
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
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