summaryrefslogtreecommitdiff
path: root/ws2015/ffp/blaetter/11/GameUnits.hs
blob: d8853e96ef775367941740fd659675663d4c3e83 (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
-- 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