summaryrefslogtreecommitdiff
path: root/tests/examples/Error.hs
blob: 72aa44405684ac805f12285922db2f017c0f146c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

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}