justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow for items to cast shadows

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