Error.hs

module GameData.Data where
#include "Utils.cpp"
import qualified Data.List as L
import qualified Data.List.Zipper as LZ
import Gamgine.Control (applyIf)
import qualified Gamgine.Zipper as GZ
import qualified GameData.Level as LV
import qualified GameData.Entity as E
IMPORT_LENS_AS_LE


data Data = Data {
   levels :: LZ.Zipper LV.Level
   }

LENS(levels)

instance E.ApplyToEntity Data where
   eMap f = LE.modL currentLevelL (E.eMap f)
   eFilter p = LE.modL currentLevelL (E.eFilter p)


currentLevelL    = currentLevelLens
currentLevelLens = LE.lens getCurrentLevel setCurrentLevel
   where
      getCurrentLevel       = LZ.cursor . levels
      setCurrentLevel level = LE.modL levelsL $ LZ.replace level


newData :: [LV.Level] -> Data
newData = Data . LZ.fromList


allLevels :: Data -> [LV.Level]
allLevels = LZ.toList . levels


atLastLevel :: Data -> Bool
atLastLevel = GZ.atLast . levels


atFirstLevel :: Data -> Bool
atFirstLevel = GZ.atFirst . levels


levelFinished :: Data -> Bool
levelFinished = LV.allStarsCollected . LE.getL currentLevelL


gameFinished :: Data -> Bool
gameFinished d = levelFinished d && atLastLevel d


toNextLevel :: Data -> Data
toNextLevel d@Data {levels = lvs}
   | LZ.emptyp lvs || GZ.atLast lvs = d
   | otherwise =
      let lvs      = levels d
          (c', n') = LV.changeLevels (GZ.current lvs) (GZ.next lvs)
          in d {levels = LZ.replace n' . LZ.right . LZ.replace c' $ lvs}


toPreviousLevel :: Data -> Data
toPreviousLevel d@Data {levels = lvs}
   | LZ.emptyp lvs || GZ.atFirst lvs = d
   | otherwise =
      let (c', p') = LV.changeLevels (GZ.current lvs) (GZ.previous lvs)
          in d {levels = LZ.replace p' . LZ.left . LZ.replace c' $ lvs}


data AddLevel = BeforeCurrent | AfterCurrent | AfterLast

addEmptyLevel :: AddLevel -> Data -> Data
addEmptyLevel BeforeCurrent d@Data {levels = lvs} =
   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
       in d {levels = LZ.insert nlv' . LZ.replace c' $ lvs}

addEmptyLevel AfterCurrent d@Data {levels = lvs} =
   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
       in d {levels = LZ.insert nlv' . LZ.right . LZ.replace c' $ lvs}

addEmptyLevel AfterLast d@Data {levels = lvs} =
   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
       in d {levels = LZ.insert nlv' . LZ.end . LZ.replace c' $ lvs}


data MoveLevel = Forward | Backward

moveCurrentLevel :: MoveLevel -> Data -> Data
moveCurrentLevel Forward d@Data {levels = lvs}
   | LZ.beginp lvs = d
   | otherwise     =
      let (p, c) = (GZ.previous lvs, GZ.current lvs)
          in d {levels = LZ.replace c . LZ.left . LZ.replace p $ lvs}

moveCurrentLevel Backward d@Data {levels = lvs}
   | GZ.atLast lvs = d
   | otherwise     =
      let (c, n) = (GZ.current lvs, GZ.next lvs)
          in d {levels = LZ.replace c . LZ.right . LZ.replace n $ lvs}


removeCurrentLevel :: Data -> Data
removeCurrentLevel d@Data {levels = lvs}
   | GZ.atFirst lvs && GZ.atLast lvs =
      let (_, nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
          in d {levels = LZ.replace nlv' lvs}

   | otherwise = d {levels = applyIf LZ.endp LZ.left . LZ.delete $ lvs}