253 lines
8.0 KiB
Haskell
253 lines
8.0 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
module Dodge.Prototypes where
|
|
|
|
import Dodge.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.Base
|
|
|
|
import Geometry
|
|
import Picture
|
|
|
|
import Control.Lens
|
|
|
|
import System.Random
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Data.Graph.Inductive.Graph hiding ((&))
|
|
import Data.List
|
|
|
|
--import Graphics.Gloss
|
|
--import Graphics.Gloss.Data.Vector
|
|
|
|
-- defalt datatypes / prototypes {{{
|
|
basicWall = Wall { _wlLine = [(0,0),(50,0)]
|
|
, _wlID = 0
|
|
, _wlColor = greyN 0.6
|
|
, _wlDraw = Nothing
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
}
|
|
basicAutoDoor = AutoDoor { _wlLine = [(0,0),(50,0)]
|
|
, _wlID = 0
|
|
, _doorMech = id
|
|
, _wlColor = light $ dim $ dim $ dim $ yellow
|
|
, _wlDraw = Nothing
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
, _wlCastShadow = True
|
|
}
|
|
basicDoor = Door { _wlLine = [(0,0),(50,0)]
|
|
, _wlID = 0
|
|
, _doorMech = id
|
|
, _wlColor = light $ dim $ dim $ dim $ yellow
|
|
, _wlDraw = Nothing
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
}
|
|
basicCreature :: Creature
|
|
basicCreature = Creature
|
|
{ _crPos = (0,0)
|
|
, _crOldPos = (0,0)
|
|
, _crDir = 0
|
|
, _crID = 1
|
|
, _crPict = const $ onLayer CrLayer $ circleSolid 10
|
|
, _crUpdate = \ w f cr -> (f , Just cr)
|
|
, _crRad = 10
|
|
, _crMass = 10
|
|
, _crHP = 100
|
|
, _crMaxHP = 150
|
|
, _crInv = IM.empty
|
|
, _crInvSel = 0
|
|
, _crAmmo = M.empty
|
|
, _crState = basicState
|
|
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
|
|
}
|
|
basicState = CrSt { _goals = []
|
|
, _stance = Stance {_carriage=Walking 0 0,_posture=AtEase}
|
|
, _faction = NoFaction
|
|
, _crDamage = []
|
|
, _crPastDamage = 0
|
|
, _crSpState = GenCr
|
|
, _crApplyDamage = basicApplyDamage'
|
|
}
|
|
basicEquipment = Equipment
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericEquipment"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \cr _ -> blank
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = basicItZoom
|
|
, _itInvColor = yellow
|
|
, _itInvDisplay = _itName
|
|
}
|
|
basicItZoom = ItZoom 20 0.2 1 20 0.2 1
|
|
basicConsumable :: Item
|
|
basicConsumable = Consumable
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericConsumable"
|
|
, _itMaxStack = 9
|
|
, _itAmount = 1
|
|
, _cnEffect = \_ _ -> Nothing
|
|
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
|
|
, _itEquipPict = \_ _ -> blank
|
|
, _itID = Nothing
|
|
, _itInvColor = blue
|
|
, _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
|
|
, _itEffect = wpRecock
|
|
, _itHammer = HammerUp
|
|
}
|
|
basicApplyDamage' :: [DamageType] -> Creature -> (World -> World, Creature)
|
|
basicApplyDamage' ds cr = (id, doPoisonDam $ foldr (\d c -> snd $ basicApplyDamage d c) cr ds')
|
|
where (ps,ds') = partition isPoison ds
|
|
isPoison (PoisonDam {}) = True
|
|
isPoison _ = False
|
|
poisonDam = quot (max 0 (sum (map _dmAmount ps) - 0)) 10
|
|
doPoisonDam = over crHP (\hp -> hp - poisonDam)
|
|
|
|
basicApplyDamage :: DamageType -> Creature -> (World -> World, Creature)
|
|
basicApplyDamage (Concussive amount from push pushexp pushRad) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount)
|
|
$ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- from)))
|
|
cr
|
|
)
|
|
where pushAmount | dist (_crPos cr) from == 0
|
|
= 0
|
|
| otherwise = min 5 $
|
|
(push*5*pushRad / (dist (_crPos cr) from * _crMass cr))**pushexp
|
|
basicApplyDamage (TorqueDam amount rot) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount) $ over crDir (+ rot) cr)
|
|
basicApplyDamage (PushDam amount pback) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount) $ over crPos (+.+ ((1/_crMass cr) *.* pback )) cr
|
|
)
|
|
basicApplyDamage dt cr
|
|
= ( id , over crHP (\hp -> hp - _dmAmount dt) cr )
|
|
basicFlIt = FlIt {_flItRot=0,_flIt = basicIt, _flItPos = (0,0), _flItID = 0}
|
|
basicIt = Consumable
|
|
{ _itIdentity = Medkit25
|
|
, _itName = "basicIt"
|
|
, _itMaxStack = 3
|
|
, _itAmount = 2
|
|
, _cnEffect = \ _ -> return
|
|
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \cr _ -> blank
|
|
, _itID = Nothing
|
|
, _itInvDisplay = _itName
|
|
, _itInvColor = blue
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
}
|
|
basicButton = Button
|
|
{ _btPict = onLayer WlLayer $ color red $ polygon $ rectNSEW 5 (-5) 10 (-10)
|
|
, _btPos = (0,0)
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> set (buttons . ix (_btID b) . btPict)
|
|
(onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10))
|
|
. set (buttons . ix (_btID b) . btState) BtNoLabel
|
|
. soundOnce 1 $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
basicPT = Particle
|
|
{ _ptPos = (0,0)
|
|
, _ptStartPos = (0,0)
|
|
, _ptVel = (0,0)
|
|
, _ptPict = blank
|
|
, _ptID = 0
|
|
, _ptUpdate = id
|
|
}
|
|
basicPP = PressPlate
|
|
{ _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5
|
|
, _ppPos = (0,0)
|
|
, _ppRot = 0
|
|
, _ppEvent = \pp -> id
|
|
, _ppID = -1
|
|
, _ppText = "Pressure plate"
|
|
}
|
|
-- }}}
|
|
basicWorld = World
|
|
{ _keys = S.empty
|
|
, _mouseButtons = S.empty
|
|
, _cameraPos = (0,0)
|
|
, _cameraAimTime = 0
|
|
, _cameraRot = 0
|
|
, _cameraZoom = 1
|
|
, _cameraCenter = (0,0)
|
|
, _creatures = IM.empty
|
|
, _creaturesZone = IM.empty
|
|
, _clouds = IM.empty
|
|
, _cloudsZone = IM.empty
|
|
, _itemPositions = IM.empty
|
|
, _particles = IM.empty
|
|
, _particles' = []
|
|
, _afterParticles' = []
|
|
, _walls = IM.empty
|
|
, _wallsZone = IM.empty
|
|
, _forceFields = IM.empty
|
|
, _floorItems = IM.empty
|
|
, _randGen = mkStdGen 2
|
|
, _mousePos = (0,0)
|
|
, _testString = []
|
|
, _yourID = 0
|
|
, _worldEvents = id
|
|
, _pressPlates = IM.empty
|
|
, _buttons = IM.empty
|
|
, _soundQueue = []
|
|
-- , _loadedSounds = IM.empty
|
|
, _sounds = M.empty
|
|
, _corpses = IM.empty
|
|
, _decorations = IM.empty
|
|
, _unlimitedAmmo = True
|
|
, _storedLevel = Nothing
|
|
, _menuState = LevelMenu 1
|
|
, _worldState = M.empty
|
|
, _lbClickMousePos = (0,0)
|
|
, _lbRotation = 0
|
|
, _pathGraph = Data.Graph.Inductive.Graph.empty
|
|
, _pathGraph' = []
|
|
, _pathPoints = IM.empty
|
|
, _pathInc = M.empty
|
|
, _windowX = 800
|
|
, _windowY = 840
|
|
, _smoke = []
|
|
, _mapDisplay = (False, 0.2)
|
|
, _lightSources = IM.empty
|
|
, _tempLightSources = [youLight]
|
|
, _closeActiveObjects = []
|
|
}
|
|
youLight =
|
|
-- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) )
|
|
TLS { _tlsPos = (0,0)
|
|
,_tlsRad = 300
|
|
,_tlsIntensity = 0.1
|
|
,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = _crPos (you w)}))
|
|
}
|
|
|
|
|
|
wpRecock :: ItEffect
|
|
--wpRecock = NoItEffect
|
|
wpRecock = ItInvEffect {_itInvEffect = f
|
|
,_itEffectCounter = 0
|
|
}
|
|
where f cr i = creatures . ix (_crID cr) . crInv
|
|
-- . ix i . itHammer %~ ($!) (fmap $! (moveHammerUp `seq` moveHammerUp))
|
|
-- . ix i . itHammer %~ ($!) (fmap $! moveHammerUp)
|
|
-- . ix i . itHammer . _Just %~ ($!) moveHammerUp
|
|
%~ IM.adjust fOnIt i
|
|
moveHammerUp !HammerDown = HammerReleased
|
|
moveHammerUp !HammerReleased = HammerUp
|
|
moveHammerUp !HammerUp = HammerUp
|
|
fOnIt it = it & itHammer %~ moveHammerUp
|
|
|