Allow for items to cast shadows

This commit is contained in:
2021-09-18 11:00:52 +01:00
parent 6ac53c052c
commit 2d8f1089a1
18 changed files with 236 additions and 172 deletions
+55 -48
View File
@@ -37,10 +37,8 @@ basicCrPict
-> SPic -> SPic
basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $ basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $
targetingPic ++ targetingPic ++
[ tr . dm . rotdir $ upperBody col cr [ creatureDisplayText w cr
, tr . dm . rotmdir $ feet cr , tr . rotdir $ _spPicture $ drawEquipment cr
, tr . rotdir $ drawEquipment cr
, creatureDisplayText w cr
] ]
where where
dm = damageMod cr dm = damageMod cr
@@ -58,7 +56,10 @@ basicCrShape
-> World -> World
-> Shape -> Shape
basicCrShape col cr w = mconcat basicCrShape col cr w = mconcat
[ tr . translateSHz 25 . dm . rotdir $ scalp cr [ tr . rotdir $ _spShape $ drawEquipment cr
, tr . translateSHz 25 . dm . rotdir $ scalp cr
, tr . dm . rotmdir $ feet cr
, tr . dm . rotdir $ upperBody col cr
] ]
where where
dm = damageModSH cr dm = damageModSH cr
@@ -66,9 +67,8 @@ basicCrShape col cr w = mconcat
f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just) f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
tr = uncurryV translateSHf (_crPos cr) tr = uncurryV translateSHf (_crPos cr)
rotdir = rotateSH (_crDir cr) rotdir = rotateSH (_crDir cr)
rotmdir = rotate (_crMvDir cr) rotmdir = rotateSH (_crMvDir cr)
. setDepth 1 . colorSH (greyN 0.3)
. color (greyN 0.3)
creatureDisplayText :: World -> Creature -> Picture creatureDisplayText :: World -> Creature -> Picture
creatureDisplayText w cr creatureDisplayText w cr
@@ -131,39 +131,41 @@ damageMod cr pic = piercingMod $ bluntScale pic
damageModSH :: Creature -> Shape -> Shape damageModSH :: Creature -> Shape -> Shape
damageModSH cr = id damageModSH cr = id
feet :: Creature -> Picture feet :: Creature -> Shape
feet cr = case cr ^? crStance . carriage of feet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> pictures Just (Walking sa LeftForward) -> mconcat
[ translate ( f sa) off aFoot [ translateSHf ( f sa) off aFoot
, translate (-f sa) (-off) aFoot , translateSHf (-f sa) (-off) aFoot
] ]
Just (Walking sa RightForward) -> pictures Just (Walking sa RightForward) -> mconcat
[ translate (-f sa) off aFoot [ translateSHf (-f sa) off aFoot
, translate ( f sa) (-off) aFoot , translateSHf ( f sa) (-off) aFoot
] ]
_ -> pictures _ -> mconcat
[ translate 0 off aFoot [ translateSHf 0 off aFoot
, translate 0 (-off) aFoot , translateSHf 0 (-off) aFoot
] ]
where where
aFoot = circleSolid 4 aFoot :: Shape
aFoot = prismPoly 10 $ polyCirc 3 4
off = 5 off = 5
sLen = _strideLength $ _crStance cr sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
arms :: Creature -> Picture arms :: Creature -> Shape
arms cr arms cr
| oneH cr = shoulderH . translate 11 (-3) . rotate (-0.5) $ scale 1 1.5 aHand | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
| twists cr = shoulderH . translate 0 (0.5* crad) . rotate (-1) $ pictures | twists cr = shoulderSH . translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
[ translate 12 4 aHand [ translateSHf 12 4 aHand
, translate 4 (-10) aHand , translateSHf 4 (-10) aHand
] ]
| otherwise = case cr ^? crStance . carriage of | otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistH $ translate (-f sa) (-off) aHand Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
Just (Walking sa RightForward) -> waistH $ translate (-f sa) off aHand Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
_ -> blank _ -> emptySH
where where
aHand = circleSolid 4 aHand :: Shape
aHand = translateSHz (-4) . prismPoly 4 $ polyCirc 3 4
crad = _crRad cr crad = _crRad cr
off = 8 off = 8
sLen = _strideLength $ _crStance cr sLen = _strideLength $ _crStance cr
@@ -176,7 +178,7 @@ scalp cr
| otherwise = translateSHf (0.25 * crad) 0 fhead | otherwise = translateSHf (0.25 * crad) 0 fhead
where where
fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc $ crad * 0.5 fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc 3 $ crad * 0.5
crad = _crRad cr crad = _crRad cr
oneH :: Creature -> Bool oneH :: Creature -> Bool
@@ -189,28 +191,28 @@ twists cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
where where
crIt = _crInv cr IM.! _crInvSel cr crIt = _crInv cr IM.! _crInvSel cr
torso :: Creature -> Picture torso :: Creature -> Shape
torso cr torso cr
| oneH cr = rotate 0.5 $ pictures | oneH cr = rotateSH 0.5 $ mconcat
[ translate 0 3 . rotate (negate 0.2) $ aShoulder [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translate 0 (negate 3) . rotate 0.2 $ aShoulder , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
] ]
| twists cr = translate 0 (0.5* crad) . rotate (-1) $ pictures | twists cr = translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
[ rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) $ aShoulder [ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
, rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 $ aShoulder , rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
] ]
| otherwise = pictures | otherwise = mconcat
[ translate 0 3 . rotate (negate 0.2) $ aShoulder [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
, translate 0 (negate 3) . rotate 0.2 $ aShoulder , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
] ]
where where
aShoulder = scale 0.5 1 $ circleSolid crad aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . prismPoly 10 $ polyCirc 3 crad
crad = _crRad cr crad = _crRad cr
upperBody :: Color -> Creature -> Picture upperBody :: Color -> Creature -> Shape
upperBody col cr = color (light4 col) $ pictures upperBody col cr = colorSH (light4 col) $ mconcat
[ arms cr [ arms cr
, shoulderH $ torso cr , shoulderSH $ torso cr
] ]
--naked :: Color -> Creature -> Picture --naked :: Color -> Creature -> Picture
@@ -229,6 +231,11 @@ shoulderH = setDepth 20
waistH :: Picture -> Picture waistH :: Picture -> Picture
waistH = setDepth 10 waistH = setDepth 10
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
waistSH :: Shape -> Shape
waistSH = translateSHz 10
light4 :: Color -> Color light4 :: Color -> Color
light4 = light . light . light . light light4 = light . light . light . light
@@ -243,20 +250,20 @@ light4 = light . light . light . light
drawEquipment drawEquipment
:: Creature :: Creature
-> Picture -> SPic
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr) drawEquipment cr = mconcat $ map f $ IM.toList (_crInv cr)
where where
f (i,it) = case it ^? itEquipPict of f (i,it) = case it ^? itEquipPict of
Just g -> g cr i Just g -> g cr i
_ -> blank _ -> emptyBlank
circLine :: Float -> Picture circLine :: Float -> Picture
circLine x = line [V2 0 0,V2 x 0] circLine x = line [V2 0 0,V2 x 0]
picAtCrPos :: Picture -> Creature -> World -> SPic picAtCrPos :: Picture -> Creature -> World -> SPic
--{-# INLINE picAtCrPos #-} --{-# INLINE picAtCrPos #-}
picAtCrPos thePic cr _ = SPic empty $ tranRot (_crPos cr) (_crDir cr) thePic picAtCrPos thePic cr _ = SPic emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
picAtCrPosNoRot :: Picture -> Creature -> World -> SPic picAtCrPosNoRot :: Picture -> Creature -> World -> SPic
--{-# INLINE picAtCrPos #-} --{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr _ = SPic empty $ uncurryV translate (_crPos cr) thePic picAtCrPosNoRot thePic cr _ = SPic emptySH $ uncurryV translate (_crPos cr) thePic
+10 -10
View File
@@ -286,14 +286,14 @@ data Item
, _wpSpread :: Float , _wpSpread :: Float
, _wpRange :: Float , _wpRange :: Float
, _itHammer :: HammerPosition , _itHammer :: HammerPosition
, _itFloorPict :: Picture , _itFloorPict :: SPic
, _itMaxStack :: Int , _itMaxStack :: Int
, _itAmount :: Int , _itAmount :: Int
, _itAimingSpeed :: Float , _itAimingSpeed :: Float
, _itAimingRange :: Float , _itAimingRange :: Float
, _itZoom :: ItZoom , _itZoom :: ItZoom
, _itAimZoom :: ItZoom , _itAimZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture , _itEquipPict :: Creature -> Int -> SPic
, _itScroll :: Float -> Creature -> Item -> Item , _itScroll :: Float -> Creature -> Item -> Item
, _itIdentity :: ItemIdentity , _itIdentity :: ItemIdentity
, _itAttachment :: ItAttachment , _itAttachment :: ItAttachment
@@ -311,8 +311,8 @@ data Item
, _itMaxStack :: Int , _itMaxStack :: Int
, _itAmount :: Int , _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World , _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: Picture , _itFloorPict :: SPic
, _itEquipPict :: Creature -> Int -> Picture , _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity , _itIdentity :: ItemIdentity
, _itID :: Maybe Int , _itID :: Maybe Int
, _itInvDisplay :: Item -> String , _itInvDisplay :: Item -> String
@@ -325,8 +325,8 @@ data Item
{ _itName :: String { _itName :: String
, _itMaxStack :: Int , _itMaxStack :: Int
, _itAmount :: Int , _itAmount :: Int
, _itFloorPict :: Picture , _itFloorPict :: SPic
, _itEquipPict :: Creature -> Int -> Picture , _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity , _itIdentity :: ItemIdentity
, _itID :: Maybe Int , _itID :: Maybe Int
, _itInvDisplay :: Item -> String , _itInvDisplay :: Item -> String
@@ -337,8 +337,8 @@ data Item
{ _itName :: String { _itName :: String
, _itMaxStack :: Int , _itMaxStack :: Int
, _itAmount :: Int , _itAmount :: Int
, _itFloorPict :: Picture , _itFloorPict :: SPic
, _itEquipPict :: Creature -> Int -> Picture , _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity , _itIdentity :: ItemIdentity
, _itEffect :: ItEffect , _itEffect :: ItEffect
, _itID :: Maybe Int , _itID :: Maybe Int
@@ -355,7 +355,7 @@ data Item
{ _itName :: String { _itName :: String
, _itMaxStack :: Int , _itMaxStack :: Int
, _itAmount :: Int , _itAmount :: Int
, _itFloorPict :: Picture , _itFloorPict :: SPic
, _twMaxRange :: Float , _twMaxRange :: Float
, _twAccuracy :: Float , _twAccuracy :: Float
, _itUse :: Item -> Creature -> World -> World , _itUse :: Item -> Creature -> World -> World
@@ -366,7 +366,7 @@ data Item
, _itAimingRange :: Float , _itAimingRange :: Float
, _itZoom :: ItZoom , _itZoom :: ItZoom
, _itAimZoom :: ItZoom , _itAimZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture , _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity , _itIdentity :: ItemIdentity
, _itID :: Maybe Int , _itID :: Maybe Int
, _itAttachment :: ItAttachment , _itAttachment :: ItAttachment
+6 -6
View File
@@ -130,8 +130,8 @@ defaultEquipment = Equipment
, _itName = "genericEquipment" , _itName = "genericEquipment"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH blank
, _itEffect = NoItEffect , _itEffect = NoItEffect
, _itHammer = HammerUp , _itHammer = HammerUp
, _itID = Nothing , _itID = Nothing
@@ -152,8 +152,8 @@ defaultConsumable = Consumable
, _itMaxStack = 9 , _itMaxStack = 9
, _itAmount = 1 , _itAmount = 1
, _cnEffect = \_ _ -> Nothing , _cnEffect = \_ _ -> Nothing
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3 , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color blue $ circleSolid 3
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH blank
, _itID = Nothing , _itID = Nothing
, _itInvColor = blue , _itInvColor = blue
, _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it) , _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
@@ -199,8 +199,8 @@ defaultIt = Consumable
, _itMaxStack = 3 , _itMaxStack = 3
, _itAmount = 2 , _itAmount = 2
, _cnEffect = const return , _cnEffect = const return
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH $ blank
, _itID = Nothing , _itID = Nothing
, _itInvDisplay = _itName , _itInvDisplay = _itName
, _itInvColor = blue , _itInvColor = blue
+3 -2
View File
@@ -6,6 +6,7 @@ import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Attachment.Data import Dodge.Item.Attachment.Data
import Dodge.Item.Data import Dodge.Item.Data
import Picture import Picture
import ShapePicture
defaultGun :: Item defaultGun :: Item
defaultGun = Weapon defaultGun = Weapon
{ _itName = "default" { _itName = "default"
@@ -28,14 +29,14 @@ defaultGun = Weapon
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = blank , _itFloorPict = emptyBlank
, _itAmount = 1 , _itAmount = 1
, _itMaxStack = 1 , _itMaxStack = 1
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = ItZoom 20 0.2 1 , _itZoom = ItZoom 20 0.2 1
, _itAimZoom = ItZoom 20 0.2 1 , _itAimZoom = ItZoom 20 0.2 1
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> emptyBlank
, _itScroll = \_ _ -> id , _itScroll = \_ _ -> id
, _itAttachment = NoItAttachment , _itAttachment = NoItAttachment
, _itID = Nothing , _itID = Nothing
+6 -4
View File
@@ -7,6 +7,8 @@ import Dodge.Default
import Dodge.Picture import Dodge.Picture
import Picture import Picture
import Geometry.Data import Geometry.Data
import ShapePicture
import Shape
keyToken :: Int -> Item keyToken :: Int -> Item
keyToken n = defaultEquipment keyToken n = defaultEquipment
@@ -14,8 +16,8 @@ keyToken n = defaultEquipment
, _itName = "KEYTOKEN "++show n , _itName = "KEYTOKEN "++show n
, _itMaxStack = 5 , _itMaxStack = 5
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = setDepth 0.5 keyPic , _itFloorPict = SPic emptySH $ setDepth 0.5 keyPic
, _itEquipPict = \_ _ -> setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic , _itEquipPict = \_ _ -> SPic emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
, _itEffect = NoItEffect , _itEffect = NoItEffect
, _itHammer = HammerUp , _itHammer = HammerUp
, _itID = Nothing , _itID = Nothing
@@ -38,8 +40,8 @@ latchkey n = defaultEquipment
, _itName = "KEY "++show n , _itName = "KEY "++show n
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = setDepth 0.5 latchkeyPic , _itFloorPict = SPic emptySH $ setDepth 0.5 latchkeyPic
, _itEquipPict = \_ _ -> setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic , _itEquipPict = \_ _ -> SPic emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
, _itEffect = NoItEffect , _itEffect = NoItEffect
, _itHammer = HammerUp , _itHammer = HammerUp
, _itID = Nothing , _itID = Nothing
+4 -5
View File
@@ -7,13 +7,12 @@ import Dodge.Picture.Layer
import Dodge.Default import Dodge.Default
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Shape
import ShapePicture
import Dodge.Item.Draw import Dodge.Item.Draw
import Picture import Picture
import Control.Lens import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
medkit :: Int -> Item medkit :: Int -> Item
@@ -23,8 +22,8 @@ medkit i = defaultConsumable
, _itMaxStack = 9 , _itMaxStack = 9
, _itAmount = 1 , _itAmount = 1
, _cnEffect = heal i , _cnEffect = heal i
, _itFloorPict = setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3 , _itFloorPict = SPic emptySH $ setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3
, _itEquipPict = pictureItem $ color blue $ circleSolid 3 , _itEquipPict = pictureItem $ SPic emptySH $ color blue $ circleSolid 3
, _itID = Nothing , _itID = Nothing
} }
+17 -16
View File
@@ -5,15 +5,17 @@ import Dodge.Item.Data
import Dodge.Picture.Layer import Dodge.Picture.Layer
import Dodge.Creature.Stance.Data import Dodge.Creature.Stance.Data
import Picture import Picture
import Shape
import ShapePicture
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import Control.Lens import Control.Lens
{- | Places an item picture onto a creature when the item is selected. -} {- | Places an item picture onto a creature when the item is selected. -}
pictureWeaponOnAim pictureWeaponOnAim
:: Picture :: SPic
-> Creature -> Creature
-> Int -- ^ Position of item in inventory -> Int -- ^ Position of item in inventory
-> Picture -> SPic
pictureWeaponOnAim p cr posInInv pictureWeaponOnAim p cr posInInv
| isSelected && _posture (_crStance cr) == Aiming && isTwisting | isSelected && _posture (_crStance cr) == Aiming && isTwisting
= shoulderD twistWep = shoulderD twistWep
@@ -25,17 +27,16 @@ pictureWeaponOnAim p cr posInInv
= handD holsteredOneHandWep = handD holsteredOneHandWep
| isSelected | isSelected
= handD holsteredWep = handD holsteredWep
| otherwise = blank | otherwise = emptyBlank
where where
shoulderD = setDepth 20.5 shoulderD = translateSPz 20.5
handD = setDepth 15 handD = translateSPz 15
isSelected = _crInvSel cr == posInInv isSelected = _crInvSel cr == posInInv
drawnWep = uncurry translate (_crRad cr,0) p drawnWep = translateSPf (_crRad cr) 0 p
twistWep = uncurry translate (0.5 * _crRad cr,0) p twistWep = translateSPf (0.5 * _crRad cr) 0 p
--twistWep = uncurry translate (0.5 * _crRad cr,negate 0.5 * _crRad cr) p oneHandWep = translateSPf (1.5 * _crRad cr) 0 p
oneHandWep = uncurry translate (1.5 * _crRad cr,0) p holsteredWep = translateSPf (_crRad cr) 0 (rotateSP (sRot + 1.2) p)
holsteredWep = uncurry translate (_crRad cr ,0) (rotate (sRot + 1.2) p) holsteredOneHandWep = translateSPf (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) p
holsteredOneHandWep = uncurry translate (_crRad cr * 0.7 + handPos,_crRad cr * negate 0.7) p
handPos = case cr^? crStance . carriage of handPos = case cr^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50 Just (Walking x LeftForward) -> f x * 50
_ -> 0 _ -> 0
@@ -50,12 +51,12 @@ pictureWeaponOnAim p cr posInInv
sLen = _strideLength $ _crStance cr sLen = _strideLength $ _crStance cr
pictureItem pictureItem
:: Picture :: SPic
-> Creature -> Creature
-> Int -- ^ Position of item in inventory -> Int -- ^ Position of item in inventory
-> Picture -> SPic
pictureItem p cr posInInv pictureItem p cr posInInv
| _crInvSel cr == posInInv = onLayer PtLayer drawnWep | _crInvSel cr == posInInv = drawnWep
| otherwise = blank | otherwise = emptyBlank
where where
drawnWep = uncurry translate (_crRad cr,0) p drawnWep = translateSPf (_crRad cr) 0 p
+10 -8
View File
@@ -6,6 +6,8 @@ import Dodge.Default
import Dodge.Picture.Layer import Dodge.Picture.Layer
import Picture import Picture
import Geometry import Geometry
import ShapePicture
import Shape
magShield :: Item magShield :: Item
magShield = defaultEquipment magShield = defaultEquipment
@@ -13,8 +15,8 @@ magShield = defaultEquipment
, _itName = "MAGSHIELD" , _itName = "MAGSHIELD"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH $ blank
, _itID = Nothing , _itID = Nothing
} }
flameShield :: Item flameShield :: Item
@@ -23,8 +25,8 @@ flameShield = defaultEquipment
, _itName = "FLAMESHIELD" , _itName = "FLAMESHIELD"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] , _itEquipPict = \cr _ -> SPic emptySH $ onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing , _itID = Nothing
} }
{- | Slows you down, blocks forward projectiles. -} {- | Slows you down, blocks forward projectiles. -}
@@ -34,11 +36,11 @@ frontArmour = defaultEquipment
, _itName = "FARMOUR" , _itName = "FARMOUR"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures
[color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
] ]
, _itEquipPict = \_ _ -> onLayer CrLayer $ pictures , _itEquipPict = \_ _ -> SPic emptySH $ onLayer CrLayer $ pictures
[color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
] ]
@@ -52,8 +54,8 @@ jetPack = defaultEquipment
, _itName = "JETPACK" , _itName = "JETPACK"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> onLayer CrLayer , _itEquipPict = \_ _ -> SPic emptySH $ onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect , _itEffect = NoItEffect
, _itID = Nothing , _itID = Nothing
+48 -46
View File
@@ -35,6 +35,8 @@ import Geometry
import Geometry.Vector3D import Geometry.Vector3D
import Picture import Picture
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Shape
import ShapePicture
--import Data.List --import Data.List
--import Data.Char --import Data.Char
@@ -75,13 +77,13 @@ pistol = defaultGun
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer pistolPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer pistolPic
, _itAmount = 1 , _itAmount = 1
, _itMaxStack = 1 , _itMaxStack = 1
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim pistolPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH pistolPic
, _itAttachment = NoItAttachment , _itAttachment = NoItAttachment
, _itID = Nothing , _itID = Nothing
, _itEffect = wpRecock , _itEffect = wpRecock
@@ -119,13 +121,13 @@ rezGun = defaultGun
[] []
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3) [polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3)
] ]
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 0 , _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3) [polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3)
] ]
@@ -150,11 +152,11 @@ teslaGun = defaultGun
] ]
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer teslaGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer teslaGunPic
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itAimingRange = 0 , _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim teslaGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH teslaGunPic
} }
teslaGunPic :: Picture teslaGunPic :: Picture
teslaGunPic = color blue $ pictures teslaGunPic = color blue $ pictures
@@ -185,10 +187,10 @@ lasGun = defaultAutoGun
] ]
, _wpSpread = 0.001 , _wpSpread = 0.001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer lasGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer lasGunPic
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 1 , _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim lasGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH lasGunPic
, _itAttachment = ItCharMode $ Seq.fromList "/VZ" , _itAttachment = ItCharMode $ Seq.fromList "/VZ"
, _itScroll = scrollCharMode , _itScroll = scrollCharMode
, _itInvDisplay = basicWeaponDisplay , _itInvDisplay = basicWeaponDisplay
@@ -208,7 +210,7 @@ forceFieldGun = defaultGun
, _itUse = undefined , _itUse = undefined
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 0.5 , _itAimingRange = 0.5
} }
@@ -247,10 +249,10 @@ tractorGun = defaultAutoGun
] ]
, _wpSpread = 0.00001 , _wpSpread = 0.00001
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 0.5 , _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
} }
@@ -276,10 +278,10 @@ remoteLauncher = defaultGun
] ]
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 0.5 , _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = ItScope (V2 0 0) 0 1 True , _itAttachment = ItScope (V2 0 0) 0 1 True
} }
hvAutoGun :: Item hvAutoGun :: Item
@@ -301,10 +303,10 @@ hvAutoGun = defaultAutoGun
, withMuzFlareI , withMuzFlareI
] ]
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer hvAutoGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer hvAutoGunPic
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 1 , _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim hvAutoGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH hvAutoGunPic
, _wpAmmo = hvBullet , _wpAmmo = hvBullet
} }
hvAutoGunPic :: Picture hvAutoGunPic :: Picture
@@ -332,11 +334,11 @@ ltAutoGun = defaultAutoGun
] ]
, _wpSpread = 0.5 , _wpSpread = 0.5
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer ltAutoGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer ltAutoGunPic
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim ltAutoGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH ltAutoGunPic
, _itAimStance = OneHand , _itAimStance = OneHand
, _wpAmmo = ltBullet , _wpAmmo = ltBullet
} }
@@ -391,10 +393,10 @@ miniGun = defaultAutoGun
, withSmoke 1 black 20 200 5 , withSmoke 1 black 20 200 5
] ]
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer miniGunPict , _itFloorPict = SPic emptySH $ onLayer FlItLayer miniGunPict
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 1 , _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim miniGunPict , _itEquipPict = pictureWeaponOnAim $ SPic emptySH miniGunPict
, _wpAmmo = basicBullet , _wpAmmo = basicBullet
} }
where where
@@ -438,10 +440,10 @@ spreadGun = defaultGun
] ]
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer spreadGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer spreadGunPic
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim spreadGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH spreadGunPic
, _wpAmmo = basicBullet , _wpAmmo = basicBullet
, _wpNumBarrels = 50 , _wpNumBarrels = 50
} }
@@ -470,12 +472,12 @@ multGun = defaultGun
] ]
, _wpSpread = spreadGunSpread , _wpSpread = spreadGunSpread
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer multGunPic
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 1 , _itAimingRange = 1
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomFac = 1.5} , _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim multGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH multGunPic
, _itAimStance = TwoHandTwist , _itAimStance = TwoHandTwist
, _wpAmmo = basicBullet , _wpAmmo = basicBullet
, _wpNumBarrels = 5 , _wpNumBarrels = 5
@@ -515,12 +517,12 @@ longGun = defaultGun
, withMuzFlareI , withMuzFlareI
] ]
, _wpRange = 200 , _wpRange = 200
, _itFloorPict = onLayer FlItLayer longGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer longGunPic
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 1 , _itAimingRange = 1
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} , _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim longGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH longGunPic
, _itScroll = zoomLongGun , _itScroll = zoomLongGun
, _itAttachment = ItScope (V2 0 0) 0 1 False , _itAttachment = ItScope (V2 0 0) 0 1 False
, _itEffect = itemLaserScopeEffect , _itEffect = itemLaserScopeEffect
@@ -559,11 +561,11 @@ poisonSprayer = defaultAutoGun
, spreadNumI , spreadNumI
] ]
, _wpRange = 8 , _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _wpSpread = 0.1 , _wpSpread = 0.1
, _wpNumBarrels = 3 , _wpNumBarrels = 3
} }
@@ -586,12 +588,12 @@ flamer = defaultAutoGun
] ]
, _wpSpread = 0 , _wpSpread = 0
, _wpRange = 8 , _wpRange = 8
, _itFloorPict = onLayer FlItLayer flamerPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer flamerPic
, _itAimingSpeed = 0.5 , _itAimingSpeed = 0.5
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5} , _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim flamerPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH flamerPic
, _itAttachment = NoItAttachment , _itAttachment = NoItAttachment
} }
flamerPic :: Picture flamerPic :: Picture
@@ -617,7 +619,7 @@ blinkGun = defaultGun
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
, _wpSpread = 0.05 , _wpSpread = 0.05
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
} }
@@ -635,7 +637,7 @@ boosterGun = defaultGun
, _itLeftClickUse = Just $ boostSelfL 10 , _itLeftClickUse = Just $ boostSelfL 10
, _wpSpread = 0.05 , _wpSpread = 0.05
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1 , _itAimingSpeed = 1
, _itAimingRange = 0 , _itAimingRange = 0
, _itEffect = resetAttachmentID , _itEffect = resetAttachmentID
@@ -808,7 +810,7 @@ grenade = Throwable
, _itIdentity = Grenade , _itIdentity = Grenade
, _itMaxStack = 8 , _itMaxStack = 8
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150 , _twMaxRange = 150
, _twAccuracy = 30 , _twAccuracy = 30
, _itUse = \_ -> throwGrenade makeExplosionAt , _itUse = \_ -> throwGrenade makeExplosionAt
@@ -861,7 +863,7 @@ remoteBomb = defaultThrowable
, _itIdentity = RemoteBomb , _itIdentity = RemoteBomb
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150 , _twMaxRange = 150
, _twAccuracy = 30 , _twAccuracy = 30
, _itUse = const throwRemoteBomb , _itUse = const throwRemoteBomb
@@ -869,7 +871,7 @@ remoteBomb = defaultThrowable
[ hammerCheckI [ hammerCheckI
] ]
, _itAttachment = ItScope (V2 0 0) 0 1 True , _itAttachment = ItScope (V2 0 0) 0 1 True
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH remoteBombUnarmedPic
} }
fireRemoteLauncher :: Creature -> World -> World fireRemoteLauncher :: Creature -> World -> World
@@ -989,7 +991,7 @@ throwRemoteBomb cr w = setLocation
| otherwise = v' | otherwise = v'
j = _crInvSel cr j = _crInvSel cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE" resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> blank removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
resetFire = set (creatures . ix cid . crInv . ix j . itUse) resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ -> explodeRemoteBomb itid i $ \_ -> explodeRemoteBomb itid i
p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0) p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
@@ -1018,7 +1020,7 @@ explodeRemoteBomb itid pjid cr w
cid = _crID cr cid = _crID cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB" resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponOnAim remoteBombUnarmedPic) (pictureWeaponOnAim $ SPic emptySH remoteBombUnarmedPic)
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0) -- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! cid j = _crInvSel $ _creatures w IM.! cid
remoteBombPic remoteBombPic
@@ -1040,8 +1042,8 @@ pipe = Craftable
, _itName = "PIPE" , _itName = "PIPE"
, _itMaxStack = 3 , _itMaxStack = 3
, _itAmount = 3 , _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> emptyBlank
, _itID = Nothing , _itID = Nothing
, _itInvDisplay = _itName , _itInvDisplay = _itName
, _itInvColor = green , _itInvColor = green
@@ -1066,13 +1068,13 @@ radar = defaultGun
, _wpSpread = autogunSpread , _wpSpread = autogunSpread
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1 , _itAmount = 1
, _itMaxStack = 1 , _itMaxStack = 1
, _itAimingRange = 1 , _itAimingRange = 1
, _itZoom = defaultItZoom { _itZoomMax = 1} , _itZoom = defaultItZoom { _itZoomMax = 1}
, _itAimZoom = defaultItZoom { _itZoomMax = 1} , _itAimZoom = defaultItZoom { _itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
} }
{- | {- |
Sends out pulses that display creatures. -} Sends out pulses that display creatures. -}
@@ -1092,13 +1094,13 @@ sonar = defaultGun
] ]
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1 , _itAmount = 1
, _itMaxStack = 1 , _itMaxStack = 1
, _itAimingRange = 1 , _itAimingRange = 1
, _itZoom = defaultItZoom {_itZoomMax = 1} , _itZoom = defaultItZoom {_itZoomMax = 1}
, _itAimZoom = defaultItZoom {_itZoomMax = 1} , _itAimZoom = defaultItZoom {_itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itEquipPict = pictureWeaponOnAim $ SPic emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
} }
{- | {- |
Automatically sends out pulses that display creatures. -} Automatically sends out pulses that display creatures. -}
@@ -1108,8 +1110,8 @@ autoSonar = defaultEquipment
, _itName = "AUTOSONAR" , _itName = "AUTOSONAR"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH $ blank
, _itEffect = autoSonarEffect , _itEffect = autoSonarEffect
, _itID = Nothing , _itID = Nothing
, _itAimingSpeed = 1 , _itAimingSpeed = 1
@@ -1125,8 +1127,8 @@ autoRadar = defaultEquipment
, _itName = "AUTORADAR" , _itName = "AUTORADAR"
, _itMaxStack = 1 , _itMaxStack = 1
, _itAmount = 1 , _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itFloorPict = SPic emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> blank , _itEquipPict = \_ _ -> SPic emptySH $ blank
, _itEffect = autoRadarEffect , _itEffect = autoRadarEffect
, _itID = Nothing , _itID = Nothing
, _itAimingSpeed = 1 , _itAimingSpeed = 1
+4 -2
View File
@@ -16,6 +16,8 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Picture import Picture
import Geometry import Geometry
import ShapePicture
import Shape
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
@@ -49,12 +51,12 @@ autoGun = defaultAutoGun
, _wpSpread = autogunSpread , _wpSpread = autogunSpread
, _wpRange = 20 , _wpRange = 20
, _itHammer = HammerUp , _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer autoGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer autoGunPic
, _itAimingSpeed = 0.4 , _itAimingSpeed = 0.4
, _itAimingRange = 1 , _itAimingRange = 1
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomFac = 1.5} , _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim autoGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH autoGunPic
, _itEffect = wpRecock , _itEffect = wpRecock
, _itAttachment = ItCharMode $ Seq.fromList "MS" , _itAttachment = ItCharMode $ Seq.fromList "MS"
, _itScroll = scrollCharMode , _itScroll = scrollCharMode
+4 -2
View File
@@ -18,6 +18,8 @@ import Dodge.Picture.Layer
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Picture import Picture
import Geometry import Geometry
import ShapePicture
import Shape
--import System.Random --import System.Random
import Data.Maybe import Data.Maybe
@@ -35,8 +37,8 @@ bezierGun = defaultGun
. withRecoilI 40 . withRecoilI 40
. torqueBefore 0.05 . torqueBefore 0.05
] ]
, _itFloorPict = onLayer FlItLayer bezierGunPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer bezierGunPic
, _itEquipPict = pictureWeaponOnAim bezierGunPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH bezierGunPic
, _itAttachment = NoItAttachment , _itAttachment = NoItAttachment
, _itScroll = \_ _ -> removeItTarget , _itScroll = \_ _ -> removeItTarget
, _itHammer = HammerUp , _itHammer = HammerUp
+7 -5
View File
@@ -14,6 +14,8 @@ import Dodge.Default.Shell
--import Dodge.Default --import Dodge.Default
import Picture import Picture
import Geometry import Geometry
import ShapePicture
import Shape
import Control.Lens import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
@@ -38,7 +40,7 @@ moveGrenade time dir pID w = case hitWl of
updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
$ set (projectiles .ix pID. pjDraw) $ set (projectiles .ix pID. pjDraw)
(\ _ -> onLayer PtLayer $ uncurryV translate newPos (\ _ -> onLayer PtLayer $ uncurryV translate newPos
$ rotate dir $ grenadePic time) $ rotate dir $ _spPicture $ grenadePic time)
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveGrenade (time-1) dir pID) w $ set (projectiles .ix pID.pjUpdate) (\_ -> moveGrenade (time-1) dir pID) w
pj = _projectiles w IM.! pID pj = _projectiles w IM.! pID
oldPos = _pjPos pj oldPos = _pjPos pj
@@ -49,8 +51,8 @@ moveGrenade time dir pID w = case hitWl of
updateV = maybe id (setV . snd) hitWl updateV = maybe id (setV . snd) hitWl
grenadePic :: Int -> Picture grenadePic :: Int -> SPic
grenadePic x = pictures grenadePic x = SPic emptySH $ pictures
[ color (dark $ dark green) $ circleSolid 5 [ color (dark $ dark green) $ circleSolid 5
, color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 )
(degToRad $ 180 - (179 * fromIntegral x / 50) ) (degToRad $ 180 - (179 * fromIntegral x / 50) )
@@ -71,13 +73,13 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = v , _pjVel = v
, _pjDraw = \_ -> onLayer PtLayer $ uncurryV translate p $ grenadePic 0 , _pjDraw = \_ -> onLayer PtLayer $ uncurryV translate p $ _spPicture $ grenadePic 0
, _pjID = i , _pjID = i
, _pjUpdate = \_ -> moveGrenade fuseTime dir i , _pjUpdate = \_ -> moveGrenade fuseTime dir i
, _pjPayload = explosion , _pjPayload = explosion
} }
j = _crInvSel cr j = _crInvSel cr
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> SPic emptySH blank
i = newProjectileKey w i = newProjectileKey w
--(_, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) --(_, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
--(_, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g --(_, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
+4 -2
View File
@@ -22,6 +22,8 @@ import Geometry.Vector3D
import Picture import Picture
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Padding import Padding
import ShapePicture
import Shape
import Data.Maybe import Data.Maybe
import Control.Lens import Control.Lens
@@ -48,10 +50,10 @@ launcher = defaultGun
] ]
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer launcherPic , _itFloorPict = SPic emptySH $ onLayer FlItLayer launcherPic
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 0.5 , _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim launcherPic , _itEquipPict = pictureWeaponOnAim $ SPic emptySH launcherPic
, _itHammer = NoHammer , _itHammer = NoHammer
, _itEffect = NoItEffect , _itEffect = NoItEffect
, _wpAmmo = defaultShellAmmo , _wpAmmo = defaultShellAmmo
+1 -1
View File
@@ -196,7 +196,7 @@ rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]
drawItem :: FloorItem -> Picture drawItem :: FloorItem -> Picture
drawItem flit = uncurryV translate (_flItPos flit) drawItem flit = uncurryV translate (_flItPos flit)
$ rotate (_flItRot flit) (_itFloorPict (_flIt flit)) $ rotate (_flItRot flit) (_spPicture $ _itFloorPict (_flIt flit))
ffToDraw :: World -> [ForceField] ffToDraw :: World -> [ForceField]
+6 -1
View File
@@ -5,10 +5,15 @@ import Shape
import Geometry import Geometry
import Color import Color
import ShapePicture import ShapePicture
import Dodge.Base.Window
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
worldShape :: World -> Shape worldShape :: World -> Shape
worldShape w = mconcat (map (crShape w) (IM.elems (_creatures w))) worldShape w = mconcat (map (crShape w) (IM.elems $ IM.filter crIsClose (_creatures w)))
where
crIsClose cr = dist (_crPos cr) camCen < winSize
winSize = 30 + max (getWindowX w) (getWindowY w)
camCen = _cameraCenter w
crShape :: World -> Creature -> Shape crShape :: World -> Creature -> Shape
crShape w c = _spShape $ _crPict c c w crShape w c = _spShape $ _crPict c c w
+31 -11
View File
@@ -1,7 +1,16 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Shape module Shape
( module Shape.Data ( module Shape.Data
, module Shape , translateSH
, emptySH
, polyCirc
, prismPoly
, flatCirc
, translateSHz
, translateSHf
, rotateSH
, scaleSH
, colorSH
) )
where where
import Geometry import Geometry
@@ -10,16 +19,17 @@ import Geometry.ConvexPoly
import Shape.Data import Shape.Data
import Color import Color
empty :: Shape emptySH :: Shape
{-# INLINE empty #-} {-# INLINE emptySH #-}
empty = Shape [] [] emptySH = Shape [] []
flatCirc :: Float -> Shape flatCirc :: Float -> Shape
flatCirc = flatPoly . polyCirc {-# INLINE flatCirc #-}
flatCirc = flatPoly . polyCirc 3
polyCirc :: Float -> [Point2] polyCirc :: Int -> Float -> [Point2]
{-# INLINE polyCirc #-} {-# INLINE polyCirc #-}
polyCirc x = map (\a -> rotateV a (V2 x 0)) $ take 8 [0,pi/4..] polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/(fromIntegral n)..]
prismPoly prismPoly
:: Float -- ^ height, expected to be strictly positive :: Float -- ^ height, expected to be strictly positive
@@ -57,8 +67,8 @@ flatPoly ps = Shape
g (V2 x y) (V2 a b) = g (V2 x y) (V2 a b) =
[ V3 x y 0 [ V3 x y 0
, V3 a b 0 , V3 a b 0
, V3 x y 0 - n , V3 x y 0 -.-.- n
, V3 a b 0 - n , V3 a b 0 -.-.- n
] ]
where where
n = addZ 0 $ vNormal (V2 (a-x) (b-y)) n = addZ 0 $ vNormal (V2 (a-x) (b-y))
@@ -66,42 +76,52 @@ flatPoly ps = Shape
--n = --n =
colorSH :: Color -> Shape -> Shape colorSH :: Color -> Shape -> Shape
{-# INLINE colorSH #-}
colorSH col = overCol $ const col colorSH col = overCol $ const col
overCol :: (Point4 -> Point4) -> Shape -> Shape overCol :: (Point4 -> Point4) -> Shape -> Shape
{-# INLINE overCol #-}
overCol f Shape{_shVertices=vs,_shEdges=es} = Shape overCol f Shape{_shVertices=vs,_shEdges=es} = Shape
{_shVertices = map (overColVertex f) vs {_shVertices = map (overColVertex f) vs
,_shEdges = es ,_shEdges = es
} }
overPos :: (Point3 -> Point3) -> Shape -> Shape overPos :: (Point3 -> Point3) -> Shape -> Shape
{-# INLINE overPos #-}
overPos f Shape{_shVertices=vs,_shEdges=es} = Shape overPos f Shape{_shVertices=vs,_shEdges=es} = Shape
{_shVertices = map (overPosVertex f) vs {_shVertices = map (overPosVertex f) vs
,_shEdges = map f es ,_shEdges = map f es
} }
translateSH :: Point3 -> Shape -> Shape translateSH :: Point3 -> Shape -> Shape
translateSH !p = overPos (+p) {-# INLINE translateSH #-}
translateSH !p = overPos (+.+.+ p)
translateSHf :: Float -> Float -> Shape -> Shape translateSHf :: Float -> Float -> Shape -> Shape
{-# INLINE translateSHf #-}
translateSHf x y = translateSH (V3 x y 0) translateSHf x y = translateSH (V3 x y 0)
translateSHz :: Float -> Shape -> Shape translateSHz :: Float -> Shape -> Shape
{-# INLINE translateSHz #-}
translateSHz z = translateSH (V3 0 0 z) translateSHz z = translateSH (V3 0 0 z)
rotateSH :: Float -> Shape -> Shape rotateSH :: Float -> Shape -> Shape
{-# INLINE rotateSH #-}
rotateSH a = overPos (rotate3 a) rotateSH a = overPos (rotate3 a)
scaleSH :: Point3 -> Shape -> Shape scaleSH :: Point3 -> Shape -> Shape
scaleSH !p = overPos (*p) {-# INLINE scaleSH #-}
scaleSH !(V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
{-# INLINE overColVertex #-}
overColVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV overColVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
{_svPos = pos {_svPos = pos
,_svCol = f col ,_svCol = f col
} }
overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV
{-# INLINE overPosVertex #-}
overPosVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV overPosVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
{_svPos = f pos {_svPos = f pos
,_svCol = col ,_svCol = col
+12 -3
View File
@@ -9,9 +9,18 @@ import Picture
import Geometry import Geometry
emptyBlank :: SPic emptyBlank :: SPic
emptyBlank = SPic empty blank emptyBlank = SPic emptySH blank
translateSP :: Float -> Float -> SPic -> SPic translateSPf :: Float -> Float -> SPic -> SPic
translateSP x y (SPic sh pic) = SPic translateSPf x y (SPic sh pic) = SPic
(translateSH (V3 x y 0) sh) (translateSH (V3 x y 0) sh)
(translate x y pic) (translate x y pic)
-- TODO make this uniform: currently the shape translates and the picture is set to a constant
translateSPz :: Float -> SPic -> SPic
translateSPz z (SPic sh pic) = SPic
(translateSH (V3 0 0 z) sh)
(setDepth z pic)
rotateSP :: Float -> SPic -> SPic
rotateSP a (SPic sh pic) = SPic (rotateSH a sh) (rotate a pic)
+8
View File
@@ -4,8 +4,16 @@ module ShapePicture.Data
where where
import Shape import Shape
import Picture import Picture
import Control.Lens
data SPic = SPic data SPic = SPic
{ _spShape :: Shape { _spShape :: Shape
, _spPicture :: Picture , _spPicture :: Picture
} }
instance Semigroup SPic where
(<>) (SPic a b) (SPic x y) = SPic (a <> x) (b <>y)
instance Monoid SPic where
mempty = SPic emptySH blank
makeLenses ''SPic