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
|
-- Fortgeschrittene Funktionale Programmierung,
-- LMU, TCS, Wintersemester 2015/16
-- Steffen Jost, Alexander Isenko
--
-- Übungsblatt 11. 13.01.2016
--
-- Teilaufgabe
-- A11-4b TemplateHaskell
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
module GameUnits where
import Data.Char
import System.Random
import Language.Haskell.TH
uncapitalize :: String -> String
uncapitalize (c:s) = (toLower c):s
uncapitalize [] = []
---------------------------
-- Datatype Declarations --
---------------------------
data Unit = Unit {str, hit :: Int, flyer :: Bool, name :: String }
deriving (Eq, Show)
type Units = [Unit]
unit :: Unit -- default Value
unit = Unit {str=undefined, hit=2, flyer=False, name=undefined }
takeHit :: Unit -> Unit
takeHit monster = monster { hit = hit monster - 1 }
isDead :: Unit -> Bool
isDead Unit { hit=n } = n <= 0
----------------------------------
-- Some Stock Units in the game --
----------------------------------
stockUnitList :: [Unit]
stockUnitList =
[ unit{ name = "Scout", str= 5 }
, unit{ name = "Crow", str= 5, hit=1, flyer=True }
, unit{ name = "Orc", str=20, hit=1 }
, unit{ name = "Dwarf", str=15, hit=2 }
, unit{ name = "Elf", str=30, hit=1 }
, unit{ name = "Giant", str=20, hit=4 }
, unit{ name = "Knight",str=35, hit=2 }
, unit{ name = "Dragon",str=55, hit=3, flyer=True }
]
battle :: Unit -> Unit -> IO Unit
battle att def = do
attRoll <- randomRIO (0,99)
defRoll <- randomRIO (0,99)
case (attRoll < str att, defRoll < str def) of
(True, False) -> check att $ takeHit def
(False,True ) -> check (takeHit att) def
_other -> battle att def -- reroll
where
check a d
| isDead a = return d
| isDead d = return a
| otherwise = battle a d
stockUnitShortcuts :: Q [Dec]
-- declares a constants of type Unit for each unit on the stockUnitList
stockUnitShortcuts = sequence $ zipWith toDec ([0..] :: [Int]) stockUnitList
where
toDec n c = valD (varP (mkName . uncapitalize $ name c)) (normalB [| stockUnitList !! $n' |]) []
where
n' = litE . integerL $ toInteger n
|
