Permalink
Browse files

- The game logic is broken totally.

- The new property-based logic is under development.
  • Loading branch information...
graninas committed Sep 10, 2013
1 parent cb00389 commit b08667a0fcf349ad56d33790f5a5ecde7ab52719
View
@@ -66,7 +66,9 @@ library
Test.Data,
World.Items.KaryonTest,
World.WorldMap,
World.GameMapUpdater
World.GameMapUpdater,
World.Properties,
Test.PropertiesTest
executable Amoeba
build-depends: base >= 4
@@ -108,5 +110,7 @@ executable Amoeba
Test.Data,
World.Items.KaryonTest,
World.WorldMap,
World.GameMapUpdater
World.GameMapUpdater,
World.Properties,
Test.PropertiesTest
@@ -15,4 +15,8 @@ instance Arbitrary Bound where
arbitrary = oneof [ liftM pointBound arbitrary
, liftM2 rectBound arbitrary arbitrary
, liftM2 circleBound arbitrary arbitrary
, return noBound ]
, return noBound ]
instance Arbitrary Direction where
arbitrary = oneof $ map return [ left, right, up, down,
leftUp, rightDown, leftDown, rightUp ]
@@ -0,0 +1,15 @@
module Test.PropertiesTest where
import World.Properties
import World.Geometry
import Test.Data
import Test.Arbitraries
prop_moving p dir = let property = moving dir . dislocation p
newPoint = movePoint p dir
in (query dislocation (tick property) == newPoint) && (p /= newPoint)
prop_notMoving p dir = let property = dislocation p
in query dislocation (tick property) == p
View
@@ -7,6 +7,9 @@ import qualified Control.Arrow as Arr
class Bounded i where
bounds :: i -> Point -> Bound
class ToVector i where
toVector :: i -> Point
-- TODO: extract shapes data types (Rectangle, Circle, etc.) from Bound.
data Bound = Circled { circleCenter :: Point
@@ -21,7 +24,9 @@ type Bounds = [Bound]
type Radius = Double
type Point = L.V3 Int
type Points = [Point]
type Direction = Point
data Direction = Left | Right | Up | Down
| LeftUp | RightDown | LeftDown | RightUp
deriving (Show, Read, Eq)
type Directions = [Direction]
type Shift = Point -> Point
type Shifts = [Shift]
@@ -80,20 +85,41 @@ point :: Int -> Int -> Int -> L.V3 Int
point = L.V3
zeroPoint = L.V3 0 0 0 :: L.V3 Int
leftUp = L.V3 (-1) (-1) 0 :: L.V3 Int
leftDown = L.V3 (-1) 1 0 :: L.V3 Int
rightUp = L.V3 1 (-1) 0 :: L.V3 Int
rightDown = L.V3 1 1 0 :: L.V3 Int
left = L.V3 (-1) 0 0 :: L.V3 Int
right = L.V3 1 0 0 :: L.V3 Int
up = L.V3 0 (-1) 0 :: L.V3 Int
down = L.V3 0 1 0 :: L.V3 Int
-- Directions
leftUp = LeftUp
leftDown = LeftDown
rightUp = RightUp
rightDown = RightDown
left = Left
right = Right
up = Up
down = Down
instance ToVector Direction where
toVector Left = leftP
toVector Right = rightP
toVector Up = upP
toVector Down = downP
toVector LeftUp = leftUpP
toVector RightDown = rightDownP
toVector LeftDown = leftDownP
toVector RightUp = rightUpP
leftUpP = L.V3 (-1) (-1) 0 :: L.V3 Int
leftDownP = L.V3 (-1) 1 0 :: L.V3 Int
rightUpP = L.V3 1 (-1) 0 :: L.V3 Int
rightDownP = L.V3 1 1 0 :: L.V3 Int
leftP = L.V3 (-1) 0 0 :: L.V3 Int
rightP = L.V3 1 0 0 :: L.V3 Int
upP = L.V3 0 (-1) 0 :: L.V3 Int
downP = L.V3 0 1 0 :: L.V3 Int
pointX (L.V3 x _ _) = x
pointY (L.V3 _ y _) = y
pointZ (L.V3 _ _ z) = z
movePoint :: Point -> Direction -> Point
movePoint = (L.^+^)
movePoint p dir = p (L.^+^) (toVector dir)
addPoint = (L.^+^)
relativeCorners = [leftUp, leftDown, rightUp, rightDown]
relativeSides = [left, right, up, down]
@@ -19,9 +19,6 @@ import qualified Data.Either as E
import qualified Control.Monad.Reader as R
import Control.Monad (liftM)
plasmaCost :: Energy
plasmaCost = 1
plasmaEmitent = let
sqList = 0 : [x * x | x <- [1,3..]]
ringsList = zipWith (-) (tail sqList) sqList
@@ -54,10 +51,8 @@ instance Active Karyon where
instance Descripted Karyon where
description = show . mkSerializable
karyon :: ItemId -> Player -> Energy -> Point -> [(Point, Karyon)]
karyon kId pl e pos = [kayronCell]
where
kayronCell = (pos, Karyon kId pl e ordinalKaryonBound)
karyon :: ItemId -> Player -> Energy -> Point -> (Point, Karyon)
karyon kId pl e pos = (pos, Karyon kId pl e ordinalKaryonBound)
data ActivationContext = ActivationContext { activationItem :: Karyon
, activationPiecePoint :: Point
@@ -68,62 +63,15 @@ type ActivationData = (World, Annotations, Energy)
activateKaryon :: Point -> Karyon -> World -> (World, Annotations)
activateKaryon p k@(Karyon kId pl e age _) w = let
(w', anns, e') = emitKaryonPlasma p k w
res = updateKaryon p k { karyonEnergy = e', karyonAge = (age + 1) } (w', anns)
res = updateKaryon p k { karyonEnergy = e', karyonAge = age + 1 } (w', anns)
in res
calcPlasmaEmitent age e = let
emitent = head . drop age $ plasmaEmitent
in min (emitent * plasmaCost) e
emitKaryonPlasma :: Point -> Karyon -> World -> (World, Annotations, Energy)
emitKaryonPlasma p k@(Karyon kId pl e age _) w = let
plasmaCount = calcPlasmaEmitent age e
runPieceActivation :: Point -> Karyon -> Shift -> ActivationData -> ActivationData
runPieceActivation p k sh actData = let
actContext = ActivationContext k p sh
in R.runReader (activatePiece actData) actContext
askIsCornerPiece :: R.Reader ActivationContext Bool
askIsCornerPiece = do
sh <- liftM activationPieceShift R.ask
return $ isCornerShift sh
askSubDirections :: R.Reader ActivationContext (Direction, Direction)
askSubDirections = do
sh <- liftM activationPieceShift R.ask
return (subDirection1 sh, subDirection2 sh)
askDirection :: R.Reader ActivationContext Direction
askDirection = liftM (direction . activationPieceShift) R.ask
activatePiece :: ActivationData -> R.Reader ActivationContext ActivationData
activatePiece actData = do
isCornerPiece <- askIsCornerPiece
if isCornerPiece then activateCornerPiece actData
else activateOrdinaryPiece actData
activateCornerPiece :: ActivationData -> R.Reader ActivationContext ActivationData
activateCornerPiece actData = do
(subDir1, subDir2) <- askSubDirections
activatePieceGrowing subDir1 actData >>= activatePieceGrowing subDir2
activateOrdinaryPiece :: ActivationData -> R.Reader ActivationContext ActivationData
activateOrdinaryPiece actData = do
dir <- askDirection
activatePieceGrowing dir actData
activatePieceGrowing :: Direction -> ActivationData -> R.Reader ActivationContext ActivationData
activatePieceGrowing _ actData@(w, anns, 0) = return actData
activatePieceGrowing dir actData@(w, anns, e) = do
(pl, bounds, p) <- askLocals
case growPlasma pl bounds p dir w of
Left ann -> return (w, anns ++ [ann], e)
Right (w', anns') -> return (w', anns ++ anns', e-1)
where
askLocals = do
(ActivationContext k p _) <- R.ask
return (karyonPlayer k, [karyonBound k p], p)
ageEmitent = head . drop age $ plasmaEmitent
emitent = min e ageEmitent
(w', anns) = emitPlasma emitent p pl w
in (w', anns, e - emitent)
data SerializibleKaryon = SKaryon { sKaryonId :: ItemId
, sKaryonPlayer :: Player
@@ -12,6 +12,8 @@ import World.Descripted
import World.Types
import World.Id
import World.WorldMap
import System.Random
import qualified Data.List as L
import qualified Data.Either as E
@@ -36,11 +38,11 @@ instance Active Plasma where
instance Descripted Plasma where
description = show
plasma :: Point -> ItemId -> Player -> [(Point, Plasma)]
plasma p pId pl = [(p, Plasma pId pl)]
plasma :: Point -> ItemId -> Player -> (Point, Plasma)
plasma p pId pl = (p, Plasma pId pl)
conflictedPlasma :: Point -> ItemId -> Player -> Players -> [(Point, Plasma)]
conflictedPlasma p pId pl pls = [(p, ConflictedPlasma pId pl (L.nub pls))]
conflictedPlasma :: Point -> ItemId -> Player -> Players -> (Point, Plasma)
conflictedPlasma p pId pl pls = (p, ConflictedPlasma pId pl (L.nub pls))
data GrowResult = CreepOver
| GrowImpossible
@@ -49,6 +51,14 @@ data GrowResult = CreepOver
| TakeConflict Players
| AlreadyConflicted Players
deriving (Show, Read, Eq)
emitPlasma :: Energy -> Point -> Player -> World -> (World, Annotations)
emitPlasma 0 _ _ w = (w, [])
emitPlasma n p pl w = let
checkGrow :: Player -> Bounds -> Point -> World -> GrowResult
checkGrow pl bounds toPoint w
View
@@ -0,0 +1,30 @@
module World.Properties where
import World.Geometry
data Property = Moving
| Energetics
type Properties = [Property]
type Target = Point
type Speed = Int
type Energy = Int
type Durability = Int
dislocation :: Point -> Property
moving :: Direction -> Property
-- (Properties -> Bool) == Condition
pursuit :: (Properties -> Bool) -> Target -> Speed -> Property
energetics :: Energy -> Property
ownership :: Player -> Property
interaction :: Property -> Property -> Property
type ProductionAlg = Properties -> Property
type PlacementAlg = Property -> Properties -> Point -> Bool
durability :: Durability -> Property
fabric :: ProductionAlg -> PlacementAlg -> Property
View
@@ -48,6 +48,12 @@ aStar :: (Cell c, Ord d, Num d)
-> Maybe [Node c]
aStar = AStar.aStar
ordinaryDistance _ _ = 1
search (WorldMap m _) distToGoal goal = let
fromMaybe [] $ aStar (graph m) ordinaryDistance
{-
-- From here: http://hackage.haskell.org/packages/archive/astar/0.1/doc/html/src/Data-Graph-AStar.html#aStar
aStar

0 comments on commit b08667a

Please sign in to comment.