-----------------------------------------------------------------------------
-- |
-- Module      :  HCube.Theory
-- Copyright   :  (c) Todd Wegner 2012
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  echbar137@yahoo.co.in
-- Stability   :  provisional
-- Portability :  portable
-- 
-- Module for generating tables exhibiting internals of hcube.
-- See the design directory for output generated by these functions.
-----------------------------------------------------------------------------
{-# LANGUAGE Safe #-}

module HCube.Theory (
	displayColors,
	displayOrientVecMapping,
	displayOrientTransforms,
	displayOrientMatrices,
	displayColorToOrient,
	displayOrientI,
	displayOrientP,
	displayColorTags,
	displayFaceIds
	) where

import Data.Monoid ( (<>) )
import Data.List (sort)
import HCube.Lib (getPos, consCubeInfo, solvedSurf, cubeIdsOfFace)
import HCube.Data (Side, Color, sideToColor,Size, Matrix)
import HCube.Utility
import HCube.Cons
import HCube.OrientGroup
import HCube.Common

-- Information common Rubik cubes of all size

{-
: COLOR MAPPING
SIDE    VECTOR   COLOR
-}
-- | Show mapping of cube face to vector and color.
displayColors		:: IO ()
displayColors		= putStrLn . unlines $ map f sides where
    f sd		= concat [prShow 8 sd, prShow 9 $ sideToVec sd, show $ sideToColor sd]

{-
: DEFINITION OF CUBE ORIENTATION
: RIGHT GOES TO FACE 1.
: BACK GOES TO FACE 2.
VECTOR 1   VECTOR 2   FACE 1	FACE 2    COLOR	RAW	ORIENT	IDS
-}
-- | Two vectors are required to uniquely determine cube orientation.
-- Orientation is defined as an operation from identity orientation.
-- Right face goes to face represented by vector 1.
-- Back gace goes to face represented by vector 2.
displayOrientVecMapping :: IO ()
displayOrientVecMapping	= dispLis f $ spanDomain g where
    f (id1,(id2,ch,v1,v2,rw, f1, f2, cl)) 
			= concat [prShow 11 v1,
				  prShow 11 v2,
				  prShow 10 f1,
				  prShow 10 f2,
			  	  cl, 
				  plShow 7 rw, "   ",
				  plShow 4 id1, "   ", 
				  [ch] ] 
    g or@(Orient (v1:v2:[])) 
			= (h, eid or, v1, v2, rawOrientNum or, 
    --g v1 v2		= (h, eid $ Orient [v1,v2], v1, v2, rawOrientNum v1 v2, 
			   vecToSide v1, vecToSide v2,
			   i v1 ++ i v2) where
	h		= rawToOrientNumber $ rawOrientNum or
	i		= show . vecToColor

{-
: CUBE ORIENTATION VIEWED AS A TRANSFORMATION OF CUBE FACE
: FROM IDENTITY ORIENTATION n
ID  SIDE    GOES TO             ID  SIDE    GOES TO
-}
-- | Cube orientation can be viewed as a transformation of faces from identity position.
displayOrientTransforms	= putStrLn . unlines . twoPagesOnOne "\t\t" $ map f g where 
    f (oc,sf,st)	= concat [oc, "   ", i 8 sf, i 8 st] 
    g			= map h [(or,sd) | or <- orientChrDomain, sd <- sides] 
    h (oi,sd)		= ([oi],sd, vecToSide i) where
	i		= (to . cons $ oi) |*| (sideToVec sd) 
    i			= prShow

{-
: ORIENTATION TRANSFORMATION MATRICES 
ID    COLUMN 1    COLUMN 2    COLUMN 3  DET
a-}
-- | Matrix representation of oriention group.
-- Right handed coordinate system implies determinate must be one.
displayOrientMatrices	= putStrLn . unlines $ map f g where
    f (oc, mx)		= concat [oc, "   ", showM mx, "\t", show $ det mx] 
    g			= map h orientChrDomain
    h oi		= ([oi], to . cons $ oi)

{-
: CONSTRUCTION OF VIRTUAL CUBE ORIENTATION FROM PHYSICAL CUBE
C1	Two colors on cube, one and two respectively.
C2	Identity face position for color 1.	
C3	Identity face position for color 2.
C4	Calculated cube orientation.

C1  C2	     C3      C4         C1  C2       C3      C4
-}
-- | Shows how colors on a cubie are mapped to orientation. 
displayColorToOrient	:: IO ()
displayColorToOrient	= writeFile "store/colorToOrient" $ unlines . twoPagesOnOne "\t\t"
			. sort . map f $ map g sideColorDomain where
    f (((fd1,cl1),(fd2,cl2)), vs) 
			= concat [show cl1 ++ show cl2, "  ",
			          k 9 fd1, 
				  k 8 fd2,
				  [eid $ Orient vs]]
    g sc@(sc1,sc2)	= (sc, getVec $ consOrient sc1 sc2)
    i			= "\t"
    j			= show . vecToColor
    k			= prShow 

sideColorDomain		:: [((Side, Color), (Side, Color))] 
sideColorDomain		= [(x,y) | x <-f, y <-f, x /=y, g x y] where
    f			= [(sd1, sideToColor sd2) | sd1 <- sides, sd2 <-sides]
    g (sd1,cl1) (sd2,cl2) = h (i sd1) (j cl1) (i sd2) (j cl2)
    h v1 u1 v2 u2	  = v1 /= v2 && u1 /= u2 && v1 /= minus v2 && u1 /= minus u2
    i			  = sideToVec
    j			  = colorToVec

{-
: INVERSE TABLE FOR ORIENT GROUP
-}
-- | Displays inverses for orientation group.
displayOrientI	= putStrLn . unlines $  twoPagesOnOne "\t\t" [g e1 | e1 <- f] where
    f		= map cons ['a'..'x'] :: [Orient]
    g e1	= concat ["inv ", [eid e1], " = ", [eid $ inv e1]]

{-
: MULTIPLICATION TABLE FOR ORIENT GROUP
-}
-- | Displays multiplication table for orientation group.
displayOrientP	= putStrLn . unlines $ h [g e1 e2 | e1 <- f, e2 <- f] where
    f		= map cons ['a'..'x'] :: [Orient]
    g e1 e2	= concat [ [eid e1], " x ", [eid e2], " = ", [eid $ e1 <> e2]]
    h		= fourPagesOnOne "\t"

-- Infomation depending on size of Rubik's cube

{-
: CONSTRUCTING VIRTUAL CUBE ID FROM CUBE COLORS OF PHYSICAL CUBE
: 	THREE COLORS MEANS CORNER CUBE
: 	TWO COLORS MEANS EDGE CUBE
: 	ONE COLOR MEANS CENTER CUBE
: 	NO COLOR MEANS CUBE IS INTERNAL CUBE

CUBE      CUBE       COLOR      CUBE      CUBE      COLOR
ID        POSITION   TAG        ID        POSITION  TAG
-}

-- | Displays how coloring of cubie is used to determine cube id of cube.
-- Cube id represents position of cubie in solved configuration.
displayColorTags	:: Size -> IO ()
displayColorTags n 	= putStrLn . unlines . twoPagesOnOne "\t\t" 
			  . map f $ consCubeInfo n (solvedSurf n) where
    f (a,b,c)		= concat [plShow 3 a, "\t", prShow 8 $ getPos n a, "\t" ++ c]

{-
: MAPPING OF FACE ID TO CUBE ID
: FACE ID IS USED TO ENTER COLOR ON A PHYSICAL CUBE FOR LOADING
: INTO PROGRAM

RUBIKS    FACE	     CUBE       RUBIKS    FACE      CUBE
CUBE      ID         ID         CUBE      ID        ID
FACE
-}

-- | Displays mapping of face id to cube id.
-- Face ids are useful when specifing the state of a physical cube.
displayFaceIds		:: Size -> IO ()
displayFaceIds n	= putStrLn . unlines . twoPagesOnOne "\t\t" $ concatMap f sides where
    f sd		= map g . zip [1..] $ cubeIdsOfFace n sd where
	g (fi, cis)	= concat [prShow 10 sd, prShow 10 fi, plShow 2 cis] 

dispLis			:: (a -> String) -> [a] -> IO ()
dispLis fu		= putStrLn . unlines . map fu