From 6b69fc1684c3c96f51c5ed36294dbb0d1f8105de Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 22 Jul 2022 10:44:54 +0100 Subject: [PATCH] Add Read/Show instance for Creature --- src/Dodge/Corpse/Draw.hs | 7 + src/Dodge/Corpse/Make.hs | 36 ++++ src/Dodge/Creature.hs | 5 +- src/Dodge/Creature/Action.hs | 3 +- src/Dodge/Creature/ArmourChase.hs | 4 +- src/Dodge/Creature/ChaseCrit.hs | 3 +- src/Dodge/Creature/Impulse.hs | 6 +- src/Dodge/Creature/Memory/Data.hs | 1 + src/Dodge/Creature/Perception.hs | 19 +- src/Dodge/Creature/Perception/Data.hs | 16 +- src/Dodge/Creature/Picture.hs | 17 +- src/Dodge/Creature/Stance/Data.hs | 13 +- src/Dodge/Creature/State.hs | 13 +- src/Dodge/Creature/State/Data.hs | 7 +- src/Dodge/Creature/SwarmCrit.hs | 3 +- src/Dodge/Creature/Test.hs | 5 +- src/Dodge/Data.hs | 2 + src/Dodge/Data/ActionPlan.hs | 258 +++++++++++++------------- src/Dodge/Data/Ammo.hs | 2 +- src/Dodge/Data/Corpse.hs | 18 ++ src/Dodge/Data/Creature.hs | 14 +- src/Dodge/Data/Creature/Misc.hs | 20 +- src/Dodge/Data/Creature/State.hs | 1 + src/Dodge/Data/CreatureEffect.hs | 13 ++ src/Dodge/Data/FloatFunction.hs | 8 + src/Dodge/Data/Item.hs | 2 +- src/Dodge/Data/Item/Consumption.hs | 2 +- src/Dodge/Data/LoadAction.hs | 1 + src/Dodge/Default/Creature.hs | 26 +-- src/Dodge/Equipment/Data.hs | 2 +- src/Dodge/FloatFunction.hs | 16 ++ src/Dodge/RandImpulse.hs | 9 + src/Dodge/Render/ShapePicture.hs | 7 +- src/ShapePicture.hs | 7 +- src/ShapePicture/Data.hs | 4 + 35 files changed, 345 insertions(+), 225 deletions(-) create mode 100644 src/Dodge/Corpse/Draw.hs create mode 100644 src/Dodge/Corpse/Make.hs create mode 100644 src/Dodge/Data/Corpse.hs create mode 100644 src/Dodge/Data/FloatFunction.hs create mode 100644 src/Dodge/FloatFunction.hs create mode 100644 src/Dodge/RandImpulse.hs create mode 100644 src/ShapePicture/Data.hs diff --git a/src/Dodge/Corpse/Draw.hs b/src/Dodge/Corpse/Draw.hs new file mode 100644 index 000000000..e9382ecbd --- /dev/null +++ b/src/Dodge/Corpse/Draw.hs @@ -0,0 +1,7 @@ +module Dodge.Corpse.Draw where +import Dodge.Data.Corpse +import ShapePicture + +-- not currently used, too simple +drawCorpse :: Corpse -> SPic +drawCorpse cp = _cpSPic cp diff --git a/src/Dodge/Corpse/Make.hs b/src/Dodge/Corpse/Make.hs new file mode 100644 index 000000000..e511b21ec --- /dev/null +++ b/src/Dodge/Corpse/Make.hs @@ -0,0 +1,36 @@ +module Dodge.Corpse.Make where +import Dodge.Creature.Picture +import Dodge.Data.Creature +import Dodge.Data.Corpse +import Control.Lens +import ShapePicture +import Shape +import Geometry + +makeCorpse :: CreatureCorpse -> Creature -> Corpse +makeCorpse cc = case cc of + MakeDefaultCorpse -> makeDefaultCorpse + +makeDefaultCorpse :: Creature -> Corpse +makeDefaultCorpse cr = defaultCorpse + & cpPos .~ _crPos cr + & cpDir .~ _crDir cr + & cpSPic .~ noPic (scaleSH (V3 crsize crsize crsize) $ mconcat + [ colorSH (_skinHead cskin) $ deadScalp cr + , colorSH (_skinUpper cskin) $ deadUpperBody cr + , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr + ] + ) + where + cskin = _crType cr -- this should be fixed + crsize = 0.1 * _crRad cr + rotmdir = rotateSH (_crMvDir cr - _crDir cr) + +defaultCorpse :: Corpse +defaultCorpse = Corpse + { _cpID = 0 + , _cpPos = 0 + , _cpDir = 0 + , _cpSPic = mempty + , _cpRes = NoResurrection + } diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 00df8ee44..0b4ad5f7e 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -27,9 +27,6 @@ import Dodge.Item.Weapon import Dodge.Item.Equipment import Dodge.Item.Consumable import Dodge.Creature.Inanimate -import Dodge.Creature.Picture ---import Dodge.Creature.ChooseTarget ---import Dodge.Item import Picture import Geometry.Data import qualified IntMapHelp as IM @@ -102,7 +99,7 @@ startCr = defaultCreature , _crHP = 1000 , _crMaxHP = 1500 , _crInv = startInventory - , _crCorpse = basicCrCorpse + , _crCorpse = MakeDefaultCorpse , _crFaction = PlayerFaction , _crMvType = MvWalking yourDefaultSpeed } diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 70b75499a..0a8e12188 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -20,6 +20,7 @@ module Dodge.Creature.Action , pickUpItemID ) where +import Dodge.FloatFunction import Dodge.Inventory.Add import Dodge.CreatureEffect --import Dodge.ShortShow @@ -63,7 +64,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) cpos = _crPos cr canSee' = canSee (_crID cr) tcid w aimSp = case cr ^? crMvType . mvAimSpeed of - Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) + Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) Nothing -> error "creature without aiming type" tpos | canSee' = _crPos (_creatures w IM.! tcid) | otherwise = p diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index e024db390..b1aff361d 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -3,6 +3,7 @@ module Dodge.Creature.ArmourChase , flockArmourChaseCrit ) where import Dodge.Data +import Dodge.Data.FloatFunction import Dodge.Default import Dodge.Creature.ChaseCrit import Dodge.Item.Equipment @@ -38,9 +39,8 @@ armourChaseCrit = chaseCrit [(0,frontArmour) ,(1,medkit 200) ] - , _crMvType = defaultChaseMvType {_mvTurnRad = f} + , _crMvType = defaultChaseMvType {_mvTurnRad = FloatConst 0.05} } & crEquipment . at OnChest ?~ 0 & crInvEquipped . at 0 ?~ OnChest where - f _ = 0.05 diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 7732cc0d9..5d75423b8 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -5,7 +5,6 @@ module Dodge.Creature.ChaseCrit ) where import Dodge.Data import Dodge.Default -import Dodge.Creature.Picture import Dodge.Item.Consumable import Dodge.Item.Equipment import Dodge.SoundLogic @@ -20,7 +19,7 @@ smallChaseCrit = chaseCrit { _crHP = 1 , _crRad = 4 , _crInv = IM.fromList [(0,medkit 200)] - , _crCorpse = basicCrCorpse + , _crCorpse = MakeDefaultCorpse } invisibleChaseCrit :: Creature invisibleChaseCrit = chaseCrit diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index e63b1137d..5f5f47b1d 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -4,6 +4,8 @@ module Dodge.Creature.Impulse , followThenClearImpulses ) where import Dodge.Data +import Dodge.FloatFunction +import Dodge.RandImpulse import Dodge.CreatureEffect import Dodge.Creature.Vocalization import Dodge.Creature.Impulse.Movement @@ -53,7 +55,7 @@ followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature) followImpulse cr w imp = case imp of ImpulseNothing -> (id,cr) RandomImpulse rimp -> - let (newimp,newgen) = runState rimp (_randGen w) + let (newimp,newgen) = runState (doRandImpulse rimp) (_randGen w) in first ((randGen .~ newgen) .) $ followImpulse cr w newimp Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr) Move p -> crup $ crMvBy p cr @@ -88,7 +90,7 @@ followImpulse cr w imp = case imp of crup = (id,) mvType = _crMvType cr speed = _mvSpeed mvType - turnRad = _mvTurnRad mvType + turnRad = doFloatFloat $ _mvTurnRad mvType cpos = _crPos cr cdir = _crDir cr cid = _crID cr diff --git a/src/Dodge/Creature/Memory/Data.hs b/src/Dodge/Creature/Memory/Data.hs index 0a39bce04..79212a334 100644 --- a/src/Dodge/Creature/Memory/Data.hs +++ b/src/Dodge/Creature/Memory/Data.hs @@ -10,5 +10,6 @@ data Memory = Memory { _soundsToInvestigate :: [Point2] , _nodesSearched :: [Int] } + deriving (Eq,Ord,Show,Read) makeLenses ''Memory diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 6e91dac4c..f1da30d7b 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -5,6 +5,7 @@ module Dodge.Creature.Perception -- , newSounds ) where import Dodge.Data +import Dodge.FloatFunction import Dodge.Creature.Vocalization import Dodge.Base.Collide import RandomHelp @@ -45,9 +46,10 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of oldAwareness = _cpAwareness $ _crPerception cr newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness - thejitter = do - p <- randInCirc 1 - return $ Move p + thejitter = RandImpulseCircMove 1 + --do + --p <- randInCirc 1 + --return $ Move p maybeBark | becomesCognizant = case vocalizationTest cr of Just sid -> crActionPlan . apAction .~ @@ -77,9 +79,10 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness --randBool = takeOne [False,True] & evalState $ _randGen w - thejitter = do - p <- randInCirc 2 - return $ Move p + thejitter = RandImpulseCircMove 2 + -- do + -- p <- randInCirc 2 + -- return $ Move p maybeBark | becomesCognizant -- && randBool && cr ^? crVocalization . vcCoolDown == Just 0 @@ -133,7 +136,7 @@ newExtraAwareness -> Maybe Awareness newExtraAwareness cr w cid | not $ canSeeIndirect (_crID cr) cid w = Nothing - | otherwise = Just . Suspicious $ _viFOV vi ang * _viDist vi d * awakeLevelPerception cr + | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr where vi = _cpVision $ _crPerception cr tpos = _crPos $ _creatures w IM.! cid @@ -168,7 +171,7 @@ rememberSounds w cr = cr -- TODO work out correct form for sounds passing through walls soundIsClose :: World -> Creature -> (Point2,Float) -> Bool soundIsClose w cr (pos,vol) = dist cpos pos < 2000 - && vol > (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos) + && vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos) && hasLOS cpos pos w where cpos = _crPos cr diff --git a/src/Dodge/Creature/Perception/Data.hs b/src/Dodge/Creature/Perception/Data.hs index fbdc65881..98b41b632 100644 --- a/src/Dodge/Creature/Perception/Data.hs +++ b/src/Dodge/Creature/Perception/Data.hs @@ -21,6 +21,7 @@ module Dodge.Creature.Perception.Data ) where import Control.Lens +import Dodge.Data.FloatFunction import qualified IntMapHelp as IM data Perception = Perception @@ -30,14 +31,18 @@ data Perception = Perception , _cpVision :: Vision , _cpAudition :: Audition } + deriving (Eq,Ord,Show,Read) data Vision = Eyes - { _viFOV :: Float -> Float - , _viDist :: Float -> Float + { _viFOV :: FloatFloat + , _viDist :: FloatFloat } + deriving (Eq,Ord,Show,Read) + newtype Audition = Ears - { _auDist :: Float -> Float + { _auDist :: FloatFloat } + deriving (Eq,Ord,Show,Read) data Vigilance = Comatose @@ -45,16 +50,17 @@ data Vigilance | Lethargic | Vigilant | Overstrung - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data Attention = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness } | Fixated {_getFixated :: Int } + deriving (Eq,Ord,Show,Read) data Awareness = Suspicious Float | Cognizant Float - deriving (Eq,Ord) + deriving (Eq,Ord,Show,Read) makeLenses ''Attention makeLenses ''Perception diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index f0499c735..b696ba8bb 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -9,7 +9,10 @@ module Dodge.Creature.Picture , picAtCrPos , shapeAtCrPos , picAtCrPosNoRot - , basicCrCorpse +-- , basicCrCorpse + , deadScalp + , deadUpperBody + , deadFeet ) where import Dodge.Data import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand) @@ -230,15 +233,3 @@ picAtCrPosNoRot :: Picture -> Creature -> SPic --{-# INLINE picAtCrPos #-} picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic -basicCrCorpse :: Creature -> Corpse -> SPic -basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat - [ rotdir . colorSH (_skinHead cskin) $ deadScalp cr - , rotdir $ colorSH (_skinUpper cskin) $ deadUpperBody cr - , rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr - ] - where - cskin = _crType cr -- this should be fixed - crsize = 0.1 * _crRad cr - tr = uncurryV translateSHf (_cpPos cp) - rotdir = rotateSH (_cpDir cp) - rotmdir = rotateSH (_crMvDir cr - _crDir cr) diff --git a/src/Dodge/Creature/Stance/Data.hs b/src/Dodge/Creature/Stance/Data.hs index c8939bc76..f695a74b1 100644 --- a/src/Dodge/Creature/Stance/Data.hs +++ b/src/Dodge/Creature/Stance/Data.hs @@ -10,7 +10,8 @@ data Stance = Stance ,_posture :: Posture ,_strideLength :: Int } - deriving (Eq,Show) + deriving (Eq,Ord,Show,Read) + data Carriage = Walking { _strideAmount :: Int @@ -20,18 +21,18 @@ data Carriage | Floating | Flying | Boosting Point2 - deriving (Eq,Show) + deriving (Eq,Ord,Show,Read) + data FootForward = LeftForward | RightForward | WasLeftForward | WasRightForward - deriving - (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) + data Posture = Aiming | AtEase - deriving - (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) makeLenses ''Stance makeLenses ''Carriage diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index c537e820a..849799d08 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -2,6 +2,7 @@ module Dodge.Creature.State ( stateUpdate , doDamage ) where +import Dodge.Corpse.Make import Dodge.Data import Dodge.Targeting import Dodge.ItEffect @@ -71,9 +72,9 @@ checkDeath cr w | otherwise = creatures . at (_crID cr) .~ Nothing corpseOrGib :: Creature -> World -> World corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of - Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap scorchSPic) + Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ scorchSPic) Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse - Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap poisonSPic) + Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic) _ | _crPastDamage cr > 200 -> w & addCrGibs cr & bloodPuddleAt cpos & bloodPuddleAt cpos @@ -84,13 +85,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of & plNew corpses cpID thecorpse where cpos = _crPos cr - thecorpse = Corpse - { _cpID = 0 - , _cpPos = _crPos cr - , _cpDir = _crDir cr - , _cpPict = _crCorpse cr cr - , _cpRes = Nothing - } + thecorpse = makeDefaultCorpse cr scorchSPic :: SPic -> SPic scorchSPic = over _1 $ diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index a96c434ff..291da1301 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -12,10 +12,11 @@ data CreatureDropType = DropAll | DropAmount Int | DropSpecific [Int] + deriving (Eq,Ord,Show,Read) data CrSpState = Barrel { _piercedPoints :: [Point2]} | GenCr - deriving (Eq,Show,Ord) + deriving (Eq,Ord,Show,Read) data Faction = GenericFaction Int | ZombieFaction @@ -25,7 +26,7 @@ data Faction | NoFaction | ColorFaction Color | PlayerFaction - deriving (Eq,Show) + deriving (Eq,Ord,Show,Read) data CrGroup = LoneWolf | Swarm @@ -34,5 +35,5 @@ data CrGroup } | CrGroupID { _crGroupID :: Int } | ShieldGroup - deriving (Eq, Show) + deriving (Eq,Ord,Show,Read) makeLenses ''CrSpState diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index f3e9a518a..4de2158a0 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -3,7 +3,6 @@ module Dodge.Creature.SwarmCrit ) where import Dodge.Data import Dodge.Default -import Dodge.Creature.Picture import Picture import Control.Lens @@ -13,7 +12,7 @@ swarmCrit = defaultCreature { _crHP = 1 , _crRad = 2 , _crMass = 2 - , _crCorpse = basicCrCorpse + , _crCorpse = MakeDefaultCorpse , _crFaction = ColorFaction yellow , _crMeleeCooldown = 0 } diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index e2fe7ee97..8b585a403 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -27,7 +27,7 @@ module Dodge.Creature.Test import Dodge.Data import Dodge.Base.Collide import Geometry -import SameConstr +--import SameConstr import Data.List (find) import Data.Maybe @@ -64,7 +64,8 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of Nothing -> True crStratConMatches :: Strategy -> Creature -> Bool -crStratConMatches strat cr = eqConstr strat (_apStrategy $ _crActionPlan cr) +crStratConMatches strat cr = strat == (_apStrategy $ _crActionPlan cr) + -- this equality check might be slow... crAwayFromPost :: Creature -> Bool crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 59dcddcd4..d3c1fc7e7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -10,6 +10,7 @@ circular imports are probably not a good idea. {-# LANGUAGE DerivingStrategies #-} module Dodge.Data ( module Dodge.Data + , module Dodge.Data.Corpse , module Dodge.Data.ActionPlan , module Dodge.Data.CreatureEffect , module Dodge.Data.WorldEffect @@ -72,6 +73,7 @@ module Dodge.Data , module Dodge.Data.RadarBlip , module Dodge.Data.PathGraph ) where +import Dodge.Data.Corpse import Dodge.Data.ActionPlan import Dodge.Data.CreatureEffect import Dodge.Data.WorldEffect diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 71ad7427c..8ac8ed29d 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -19,13 +19,17 @@ data ActionPlan ,_apStrategy :: Strategy ,_apGoal :: [Goal] } -newtype RandImpulse = RandImpulseList [Impulse] + deriving (Eq,Ord,Show,Read) +data RandImpulse + = RandImpulseList [Impulse] + | RandImpulseCircMove Float + deriving (Eq,Ord,Show,Read) data Impulse = Move Point2 | MoveForward Float | Turn Float | RandomTurn Float - | RandomImpulse (State StdGen Impulse) + | RandomImpulse RandImpulse -- (State StdGen Impulse) | TurnToward Point2 Float | MvTurnToward Point2 | MvForward @@ -52,34 +56,34 @@ data Impulse {_impulseUseAheadPos :: P2Imp } | ImpulseNothing -instance Show Impulse where - show imp = case imp of - Move p -> "Move "++shortPoint2 p - MoveForward f -> "MoveForward "++ show f - Turn f -> "Turn "++show f - RandomTurn f -> "RandomTurn "++show f - TurnToward p f -> "TurnToward "++shortPoint2 p++show f - MvTurnToward p -> "MvTurnToward "++shortPoint2 p - MvForward -> "MvForward" - TurnTo p -> "TurnTo "++shortPoint2 p - UseItem -> "UseItem" - SwitchToItem i -> "SwitchToItem "++show i - DropItem -> "DropItem" - Bark sid -> "Bark "++show sid - Melee i -> "Melee "++show i - ChangePosture post -> "ChangePosture " ++ show post - MakeSound sid -> "MakeSound " ++ show sid - ChangeStrategy s -> "ChangeStrategy " ++ show s - AddGoal g -> "AddGoal " ++ show g - ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction" - ArbitraryImpulse {} -> "ArbitraryImpulse" - ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect" - ImpulseUseTargetCID {} -> "ImpulseUseTargetCID" - ImpulseUseTarget {} -> "ImpulseUseTarget" - ImpulseUseAheadPos {} -> "ImpulseUseAheadPos" - RandomImpulse {} -> "RandomImpulse" - ImpulseNothing -> "ImpulseNothing" --- deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) +--instance Show Impulse where +-- show imp = case imp of +-- Move p -> "Move "++shortPoint2 p +-- MoveForward f -> "MoveForward "++ show f +-- Turn f -> "Turn "++show f +-- RandomTurn f -> "RandomTurn "++show f +-- TurnToward p f -> "TurnToward "++shortPoint2 p++show f +-- MvTurnToward p -> "MvTurnToward "++shortPoint2 p +-- MvForward -> "MvForward" +-- TurnTo p -> "TurnTo "++shortPoint2 p +-- UseItem -> "UseItem" +-- SwitchToItem i -> "SwitchToItem "++show i +-- DropItem -> "DropItem" +-- Bark sid -> "Bark "++show sid +-- Melee i -> "Melee "++show i +-- ChangePosture post -> "ChangePosture " ++ show post +-- MakeSound sid -> "MakeSound " ++ show sid +-- ChangeStrategy s -> "ChangeStrategy " ++ show s +-- AddGoal g -> "AddGoal " ++ show g +-- ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction" +-- ArbitraryImpulse {} -> "ArbitraryImpulse" +-- ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect" +-- ImpulseUseTargetCID {} -> "ImpulseUseTargetCID" +-- ImpulseUseTarget {} -> "ImpulseUseTarget" +-- ImpulseUseAheadPos {} -> "ImpulseUseAheadPos" +-- RandomImpulse {} -> "RandomImpulse" +-- ImpulseNothing -> "ImpulseNothing" infixr 9 `WaitThen` infixr 9 `DoActionThen` infixr 9 `DoActionWhile` @@ -180,101 +184,101 @@ data Action {_sideImpulses :: [Impulse] ,_mainAction :: Action } - deriving (Generic) -instance Show Action where - show act = case act of - ActionNothing -> "ActionNothing" - LabelAction - {_actLabel = str - ,_actAction = subAct - } -> str++":"++show subAct - AimAt - {_targetID = tid - ,_targetSeenAt = p - } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p - PathTo - {_pathToPoint = p - } -> "PathTo:"++shortPoint2 p - TurnToPoint - {_turnToPoint = p - } -> "TurnToPoint:"++shortPoint2 p ----- | PickupItem ----- {_pickupItemID :: Int ----- } - ImpulsesList - {_impulsesListList = iss - } -> "ImpulsesList:"++show iss - DoImpulses - {_doImpulsesList = is - } -> "DoImpulses:"++show is - WaitThen - {_waitThenTimer = i - ,_waitThenAction = a - } -> "WaitThen timer:"++show i++" act:"++show a - DoActionWhile - {_doActionWhileCondition = _ - ,_doActionWhileAction = a - } -> "DoActionWhile (function) act:"++show a - DoActionWhilePartial - {_doActionWhilePartial = partact - ,_doActionWhileCondition = _ - ,_doActionWhileAction = a - } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a - DoActionIf - {_doActionIfCondition = _ - ,_doActionIfAction = a - } -> "DoActionIf act:"++show a - DoActionIfElse - {_doActionIfElseIfAction = ifa - ,_doActionIfElseCondition = _ - ,_doActionIfElseElseAction = elsea - } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea - DoActionWhileInterrupt - {_doActionWhileThenDo = whilea - ,_doActionWhileThenCondition = _ - ,_doActionWhileThenThen = thena - } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena - DoActions - {_doActionsList = as - } -> "DoActions " ++ foldMap show as - DoActionThen - {_doActionThenFirst = a1 - ,_doActionThenSecond = a2 - } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2 ----- | DoGuardActions ----- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] ----- } - DoReplicate - {_doReplicateTimes = i - ,_doReplicateAction = a - } -> "DoReplicate times:" ++ show i ++ " act:"++ show a - DoReplicatePartial - {_partialAction = pa - ,_doReplicateTimes = i - ,_doReplicateAction = ra - } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra - LeadTarget - {_leadTargetBy = p - } -> "LeadTarget by:"++ show p - NoAction -> "NoAction" - StartSentinelPost -> "StartSentinelPost" - UseTarget - {_useTarget = _ - } -> "UseTarget func" - UseSelf - {_useSelf = _ - } -> "UseSelf func" - UseAheadPos - {_useAheadPos = _ - } -> "UseAheadPos func" - UseMvTargetPos - {_useMvTargetPos = _ - } -> "UseMvTargetPos func" - ArbitraryAction {} -> "ArbitraryAction func" - DoImpulsesAlongside - {_sideImpulses = is - ,_mainAction = a - } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a + deriving (Eq,Ord,Show,Read) +--instance Show Action where +-- show act = case act of +-- ActionNothing -> "ActionNothing" +-- LabelAction +-- {_actLabel = str +-- ,_actAction = subAct +-- } -> str++":"++show subAct +-- AimAt +-- {_targetID = tid +-- ,_targetSeenAt = p +-- } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p +-- PathTo +-- {_pathToPoint = p +-- } -> "PathTo:"++shortPoint2 p +-- TurnToPoint +-- {_turnToPoint = p +-- } -> "TurnToPoint:"++shortPoint2 p +------ | PickupItem +------ {_pickupItemID :: Int +------ } +-- ImpulsesList +-- {_impulsesListList = iss +-- } -> "ImpulsesList:"++show iss +-- DoImpulses +-- {_doImpulsesList = is +-- } -> "DoImpulses:"++show is +-- WaitThen +-- {_waitThenTimer = i +-- ,_waitThenAction = a +-- } -> "WaitThen timer:"++show i++" act:"++show a +-- DoActionWhile +-- {_doActionWhileCondition = _ +-- ,_doActionWhileAction = a +-- } -> "DoActionWhile (function) act:"++show a +-- DoActionWhilePartial +-- {_doActionWhilePartial = partact +-- ,_doActionWhileCondition = _ +-- ,_doActionWhileAction = a +-- } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a +-- DoActionIf +-- {_doActionIfCondition = _ +-- ,_doActionIfAction = a +-- } -> "DoActionIf act:"++show a +-- DoActionIfElse +-- {_doActionIfElseIfAction = ifa +-- ,_doActionIfElseCondition = _ +-- ,_doActionIfElseElseAction = elsea +-- } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea +-- DoActionWhileInterrupt +-- {_doActionWhileThenDo = whilea +-- ,_doActionWhileThenCondition = _ +-- ,_doActionWhileThenThen = thena +-- } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena +-- DoActions +-- {_doActionsList = as +-- } -> "DoActions " ++ foldMap show as +-- DoActionThen +-- {_doActionThenFirst = a1 +-- ,_doActionThenSecond = a2 +-- } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2 +------ | DoGuardActions +------ {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] +------ } +-- DoReplicate +-- {_doReplicateTimes = i +-- ,_doReplicateAction = a +-- } -> "DoReplicate times:" ++ show i ++ " act:"++ show a +-- DoReplicatePartial +-- {_partialAction = pa +-- ,_doReplicateTimes = i +-- ,_doReplicateAction = ra +-- } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra +-- LeadTarget +-- {_leadTargetBy = p +-- } -> "LeadTarget by:"++ show p +-- NoAction -> "NoAction" +-- StartSentinelPost -> "StartSentinelPost" +-- UseTarget +-- {_useTarget = _ +-- } -> "UseTarget func" +-- UseSelf +-- {_useSelf = _ +-- } -> "UseSelf func" +-- UseAheadPos +-- {_useAheadPos = _ +-- } -> "UseAheadPos func" +-- UseMvTargetPos +-- {_useMvTargetPos = _ +-- } -> "UseMvTargetPos func" +-- ArbitraryAction {} -> "ArbitraryAction func" +-- DoImpulsesAlongside +-- {_sideImpulses = is +-- ,_mainAction = a +-- } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a -- deriving (Eq,Ord,Show) data Strategy @@ -293,13 +297,13 @@ data Strategy | Reload | Flee | MeleeStrike - deriving (Generic,Show) + deriving (Eq,Ord,Show,Read) -- deriving (Eq,Ord,Show) data Goal = LiveLongAndProsper | Kill Int | SentinelAt Point2 Float - deriving (Show) + deriving (Eq,Ord,Show,Read) makeLenses ''ActionPlan makeLenses ''Impulse makeLenses ''Action diff --git a/src/Dodge/Data/Ammo.hs b/src/Dodge/Data/Ammo.hs index 6174a8e91..722984141 100644 --- a/src/Dodge/Data/Ammo.hs +++ b/src/Dodge/Data/Ammo.hs @@ -41,6 +41,6 @@ data AmmoType { _amForceFieldType :: Wall } | GenericAmmo - deriving (Show,Read) + deriving (Eq,Ord,Show,Read) makeLenses ''ProjectileUpdate makeLenses ''AmmoType diff --git a/src/Dodge/Data/Corpse.hs b/src/Dodge/Data/Corpse.hs new file mode 100644 index 000000000..920e43ef3 --- /dev/null +++ b/src/Dodge/Data/Corpse.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Corpse where +import ShapePicture.Data +import Geometry.Data + +import Control.Lens + +data CorpseResurrection = NoResurrection + +data Corpse = Corpse + { _cpID :: Int + , _cpPos :: Point2 + , _cpDir :: Float + , _cpSPic :: SPic + , _cpRes :: CorpseResurrection + } +makeLenses ''Corpse diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 02582ecc5..d3fbd49c1 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -45,7 +45,7 @@ data Creature = Creature , _crEquipment :: M.Map EquipPosition Int , _crLeftInvSel :: Maybe Int , _crState :: CreatureState - , _crCorpse :: Creature -> Corpse -> SPic + , _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic , _crMaterial :: Material , _crPastDamage :: Int , _crStance :: Stance @@ -63,18 +63,14 @@ data Creature = Creature , _crStatistics :: CreatureStatistics , _crCamouflage :: CamouflageStatus } -data Corpse = Corpse - { _cpID :: Int - , _cpPos :: Point2 - , _cpDir :: Float - , _cpPict :: Corpse -> SPic - , _cpRes :: Maybe Creature - } + deriving (Eq,Ord,Show,Read) +data CreatureCorpse = MakeDefaultCorpse + deriving (Eq,Ord,Show,Read) data Intention = Intention { _targetCr :: Maybe Creature , _mvToPoint :: Maybe Point2 , _viewPoint :: Maybe Point2 } + deriving (Eq,Ord,Show,Read) makeLenses ''Creature makeLenses ''Intention -makeLenses ''Corpse diff --git a/src/Dodge/Data/Creature/Misc.hs b/src/Dodge/Data/Creature/Misc.hs index ca8b4d75e..a5cf6d61b 100644 --- a/src/Dodge/Data/Creature/Misc.hs +++ b/src/Dodge/Data/Creature/Misc.hs @@ -4,17 +4,20 @@ module Dodge.Data.Creature.Misc ( module Dodge.Data.Creature.Misc , module Dodge.Data.CamouflageStatus ) where +import Dodge.Data.FloatFunction import Dodge.Data.CamouflageStatus import Sound.Data import Geometry.Data import Color import Control.Lens + data CreatureStatistics = CreatureStatistics { _strength :: Int , _dexterity :: Int , _intelligence :: Int } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) + data Vocalization = Mute | Vocalization @@ -23,19 +26,24 @@ data Vocalization ,_vcMaxCoolDown :: Int ,_vcCoolDown :: Int } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) + data CrMvType = NoMvType | MvWalking { _mvSpeed :: Float } | CrMvType { _mvSpeed :: Float - , _mvTurnRad :: Float -> Float + , _mvTurnRad :: FloatFloat , _mvTurnJit :: Float - , _mvAimSpeed :: Float -> Float + , _mvAimSpeed :: FloatFloat } + deriving (Eq,Ord,Show,Read) + data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI | LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI | LongAI | MultGunAI + deriving (Eq,Ord,Show,Read) + data CreatureType = Humanoid { _skinHead :: Color @@ -47,7 +55,11 @@ data CreatureType | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int} | Turretoid | NonDrawnCreature + deriving (Eq,Ord,Show,Read) + data BarrelType = PlainBarrel | ExplosiveBarrel + deriving (Eq,Ord,Show,Read) + makeLenses ''CreatureStatistics makeLenses ''Vocalization makeLenses ''CrMvType diff --git a/src/Dodge/Data/Creature/State.hs b/src/Dodge/Data/Creature/State.hs index f2c98c611..21dd65d8b 100644 --- a/src/Dodge/Data/Creature/State.hs +++ b/src/Dodge/Data/Creature/State.hs @@ -10,4 +10,5 @@ data CreatureState = CrSt , _csSpState :: CrSpState , _csDropsOnDeath :: CreatureDropType } + deriving (Eq,Ord,Show,Read) makeLenses ''CreatureState diff --git a/src/Dodge/Data/CreatureEffect.hs b/src/Dodge/Data/CreatureEffect.hs index 4162a93b9..dd3192c2f 100644 --- a/src/Dodge/Data/CreatureEffect.hs +++ b/src/Dodge/Data/CreatureEffect.hs @@ -1,37 +1,50 @@ module Dodge.Data.CreatureEffect where data WdCrCr = NoCreatureEffect + deriving (Eq,Ord,Show,Read) data CrWdImp = NoCrWdImp + deriving (Eq,Ord,Show,Read) data CrWdWd = CrWdWdId + deriving (Eq,Ord,Show,Read) data IntImp = NoIntImp + deriving (Eq,Ord,Show,Read) data CrImp = NoCrImp | TurnTowardCr Float -- turn amount + deriving (Eq,Ord,Show,Read) data P2Imp = P2ImpNo + deriving (Eq,Ord,Show,Read) data WdCrBl = WdCrTrue | WdCrBlfromCrBl CrBl | WdCrNegate WdCrBl | WdCrLOSTarget | WdCrSafeDistFromTarget Float + deriving (Eq,Ord,Show,Read) data CrBl = CrCanShoot | CrIsReloading | CrIsAiming + deriving (Eq,Ord,Show,Read) data MCrAc = MCrNoAction + deriving (Eq,Ord,Show,Read) data CrAc = CrTurnAround | CrFleeFromTarget + deriving (Eq,Ord,Show,Read) data P2Ac = P2NoAction + deriving (Eq,Ord,Show,Read) data MP2Ac = MP2NoAction + deriving (Eq,Ord,Show,Read) data CrWdAc = CrWdBFSThenReturn Int | ChooseMovementSpreadGun | ChooseMovementLtAuto + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Data/FloatFunction.hs b/src/Dodge/Data/FloatFunction.hs new file mode 100644 index 000000000..98dc2a693 --- /dev/null +++ b/src/Dodge/Data/FloatFunction.hs @@ -0,0 +1,8 @@ +module Dodge.Data.FloatFunction where + +data FloatFloat = FloatID + | FloatFOV Float + | FloatLessCheck Float + | FloatAbsCheckGreaterLess Float Float Float + | FloatConst Float + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 4b9ce4940..39e2346c4 100644 --- a/src/Dodge/Data/Item.hs +++ b/src/Dodge/Data/Item.hs @@ -40,7 +40,7 @@ data Item = Item , _itValue :: ItemValue , _itParams :: ItemParams } - deriving (Show,Read) + deriving (Eq,Ord,Show,Read) data ItemTweaks = NoTweaks | Tweakable diff --git a/src/Dodge/Data/Item/Consumption.hs b/src/Dodge/Data/Item/Consumption.hs index edff4f908..317867892 100644 --- a/src/Dodge/Data/Item/Consumption.hs +++ b/src/Dodge/Data/Item/Consumption.hs @@ -28,5 +28,5 @@ data ItemConsumption { _icAmount :: IcAmount } | NoConsumption - deriving (Show,Read) + deriving (Eq,Ord,Show,Read) makeLenses ''ItemConsumption diff --git a/src/Dodge/Data/LoadAction.hs b/src/Dodge/Data/LoadAction.hs index bf14ff21c..8c912e2b5 100644 --- a/src/Dodge/Data/LoadAction.hs +++ b/src/Dodge/Data/LoadAction.hs @@ -11,6 +11,7 @@ data LoadAction | LoadPrime {_actionTime :: Int, _actionSound :: SoundID} deriving (Eq,Ord,Show,Read) data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction } + deriving (Eq,Ord,Show,Read) data InvSelAction = NoInvSelAction | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType} diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 8eed284e7..3e5e9cc41 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -1,6 +1,6 @@ module Dodge.Default.Creature where import Dodge.Data -import Dodge.Creature.Picture +import Dodge.Data.FloatFunction import Geometry.Data import Picture @@ -30,7 +30,7 @@ defaultCreature = Creature , _crInvEquipped = mempty , _crLeftInvSel = Nothing , _crState = defaultState - , _crCorpse = basicCrCorpse + , _crCorpse = MakeDefaultCorpse , _crMaterial = Flesh , _crPastDamage = 0 , _crEquipment = M.empty @@ -78,17 +78,12 @@ defaultPerceptionState = Perception } defaultVision :: Vision defaultVision = Eyes - { _viFOV = f - , _viDist = g + { _viFOV = FloatFOV 0.5 + , _viDist = FloatLessCheck 500 } - where - f x | abs x < 0.5 * pi = 1 - | otherwise = 0 - g x | x > 500 = 0 - | otherwise = 1 defaultAudition :: Audition defaultAudition = Ears - { _auDist = id + { _auDist = FloatID } defaultIntention :: Intention defaultIntention = Intention @@ -99,9 +94,9 @@ defaultIntention = Intention defaultChaseMvType :: CrMvType defaultChaseMvType = CrMvType { _mvSpeed = 2 - , _mvTurnRad = f + , _mvTurnRad = FloatAbsCheckGreaterLess (pi/4) 0.2 0.05--f , _mvTurnJit = 0.2 - , _mvAimSpeed = g + , _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01 } where g x | x > pi/8 = 0.2 @@ -111,13 +106,10 @@ defaultChaseMvType = CrMvType defaultAimMvType :: CrMvType defaultAimMvType = CrMvType { _mvSpeed = 3 - , _mvTurnRad = const 0.2 + , _mvTurnRad = FloatConst 0.2 , _mvTurnJit = 0.05 - , _mvAimSpeed = f + , _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01 } - where - f x | x > pi/8 = 0.2 - | otherwise = 0.01 defaultAimingCrit :: Creature defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType } diff --git a/src/Dodge/Equipment/Data.hs b/src/Dodge/Equipment/Data.hs index b775bc761..9b715baaa 100644 --- a/src/Dodge/Equipment/Data.hs +++ b/src/Dodge/Equipment/Data.hs @@ -15,4 +15,4 @@ data EquipPosition | OnRightWrist | OnLegs | OnSpecial - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/FloatFunction.hs b/src/Dodge/FloatFunction.hs new file mode 100644 index 000000000..ff258d87c --- /dev/null +++ b/src/Dodge/FloatFunction.hs @@ -0,0 +1,16 @@ +module Dodge.FloatFunction where +import Dodge.Data.FloatFunction + +doFloatFloat :: FloatFloat -> Float -> Float +doFloatFloat ff x = case ff of + FloatID -> x + FloatConst y -> y + FloatFOV a + | abs x < 0.5 * a -> 1 + | otherwise -> 0 + FloatLessCheck y + | x > y -> 0 + | otherwise -> 1 + FloatAbsCheckGreaterLess a y1 y2 + | abs x > a -> y1 + | otherwise -> y2 diff --git a/src/Dodge/RandImpulse.hs b/src/Dodge/RandImpulse.hs new file mode 100644 index 000000000..d7e9311c9 --- /dev/null +++ b/src/Dodge/RandImpulse.hs @@ -0,0 +1,9 @@ +module Dodge.RandImpulse where +import Dodge.Data.ActionPlan +import Control.Monad.State +import RandomHelp + +doRandImpulse :: RandImpulse -> State StdGen Impulse +doRandImpulse ri = case ri of + RandImpulseList xs -> takeOne xs + RandImpulseCircMove r -> Move <$> randInCirc r diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index c2db7b6d1..aa5b099f6 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -61,7 +61,7 @@ worldSPic cfig w <> foldup drawProjectile (filtOn _prjPos _projectiles) <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) - <> foldup (dbArg _cpPict) (filtOn _cpPos _corpses) + <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses) <> foldup drawCreature (filtOn _crPos _creatures) <> foldup floorItemSPic (filtOn _flItPos _floorItems) <> foldup btSPic (filtOn _btPos _buttons) @@ -112,6 +112,11 @@ shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x) . rotateSP (fdir x) $ fdraw x x +shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic +shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos x) + . rotateSP (fdir x) + $ fdraw x + cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w) diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs index 798242d6f..901f5f79e 100644 --- a/src/ShapePicture.hs +++ b/src/ShapePicture.hs @@ -1,11 +1,10 @@ {-# LANGUAGE TupleSections #-} module ShapePicture - ( --emptyBlank - translateSP + ( module ShapePicture.Data + , translateSP , translateSPf , translateSPz , rotateSP - , SPic , noPic , noShape -- , _spShape @@ -14,6 +13,7 @@ module ShapePicture , mirrorSPxz , overPosSP ) where +import ShapePicture.Data import Shape import Picture import Geometry @@ -22,7 +22,6 @@ import Data.Bifunctor import Control.Lens --import qualified Streaming.Prelude as S -type SPic = (Shape, Picture) shMap :: (ShapeObj -> ShapeObj) -> Shape -> Shape shMap = map diff --git a/src/ShapePicture/Data.hs b/src/ShapePicture/Data.hs new file mode 100644 index 000000000..8abbd9a00 --- /dev/null +++ b/src/ShapePicture/Data.hs @@ -0,0 +1,4 @@ +module ShapePicture.Data where +import Picture.Data +import Shape.Data +type SPic = (Shape, Picture)