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

Linting, refactor random angle walk for flamer

Browse Source
This commit is contained in:
jgk
2021-04-30 13:21:37 +02:00
parent 619756dd73
commit c8e84c775f
14 changed files with 460 additions and 377 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shader/fullscreen.frag
+5
View File
@@ -6,6 +6,11 @@ uniform sampler2D screenTexture;
void main()
{
// vec4 col = vec4(0,0,0,0);
// for (int i = 0; i < 9; i++)
// {
// col +=
// }
fColor = texture(screenTexture, vTexPos);
// fColor = vec4(1,1,1,0);
}
src/Dodge/Creature.hs
+1 -1
View File
@@ -266,7 +266,7 @@ startInventory = IM.fromList (zip [0..20]
(
[lasGun
,autoGun
,bezierGun
,flamer
--,blinkGun
--,spawnGun lamp
--,poisonSprayer
src/Dodge/Default.hs
+3 -7
View File
@@ -6,8 +6,7 @@ Description : Instances of data structures
This module contains prototypical data structures.
-}
module Dodge.Default where
import Dodge.Item.Weapon.Recock
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Data
import Dodge.Data.Menu
import Dodge.SoundLogic
@@ -24,10 +23,8 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
{-
Indestructible wall.
-}
Indestructible wall. -}
defaultWall = Wall
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -37,8 +34,7 @@ defaultWall = Wall
}
{-
Door that opens on approach.
Pathable.
-}
Pathable. -}
defaultAutoDoor = Door
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
src/Dodge/Event.hs
+9 -7
View File
@@ -67,7 +67,7 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
| otherwise -> Just w
_ -> Just w
{-
{- |
Resets the world window size, and resizes the fbo that gets the light map drawn into it.
-}
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
@@ -122,14 +122,16 @@ wheelDownEvent w = case _carteDisplay w of
upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
isis = is ++ is
x = before (_crInvSel (you w)) isis
where
is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
isis = is ++ is
x = before (_crInvSel (you w)) isis
downInvPos :: World -> World
downInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
isis = is ++ is
x = after (_crInvSel (you w)) isis
where
is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
isis = is ++ is
x = after (_crInvSel (you w)) isis
-- these are incomplete: should put in error case here!
before y (x:z:ys) | y == z = x
src/Dodge/Item/Weapon.hs
+36 -201
View File
@@ -1,4 +1,4 @@
{-
{- |
Definitions of weapons.
In progress: move out effects into other modules.
-}
@@ -16,9 +16,11 @@ import Dodge.WorldEvent
import Dodge.Default
import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.Recock
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment
import Geometry
@@ -410,7 +412,7 @@ ltAutoGun = defaultAutoGun
, _wpFireRate = 4
, _wpFireState = 0
, _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50
. withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect'
. withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
@@ -461,7 +463,7 @@ spreadGun = defaultGun
, _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 100
. withMuzFlare
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect'
$ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)]
@@ -504,7 +506,7 @@ multGun = defaultGun
, _wpFire = shootWithSound (fromIntegral shotgunSound)
. withRecoil 200
. withMuzFlare
$ numVelWthHitEff 5 (50,0) 5 bulletEffect'
$ numVelWthHitEff 5 (50,0) 5 basicBulletEffect
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ multGunPic
@@ -571,7 +573,7 @@ poisonSprayer = defaultAutoGun
, _wpFireRate = 0
, _wpFireState = 0
, _wpFire = shoot $ aGasCloud
, _wpSpread = flamerAngle
, _wpSpread = 0.3
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
@@ -591,8 +593,8 @@ flamer = defaultAutoGun
, _wpReloadState = 0
, _wpFireRate = 0
, _wpFireState = 0
, _wpFire = shoot $ aFlame 0
, _wpSpread = flamerAngle
, _wpFire = shoot $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
@@ -804,30 +806,16 @@ aGasCloud cid w
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
aFlame :: Float -> Int -> World -> World
aFlame a cid w
= shakeCr cid 2
$ insertFlame $ resetAngle $ set randGen g $
w
where
(a2,g) = randomR (-0.1,0.1) (_randGen w)
(t,_) = randomR (99,101) (_randGen w)
angle = min flamerAngle $ max (-flamerAngle) (a + a2)
cr = (_creatures w IM.! cid)
dir = _crDir cr + angle
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
w1 = set randGen g w
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
(shoot $ aFlame angle)
aFlame :: Int -> World -> World
aFlame cid w = insertFlame w
where
(t,_) = randomR (99,101) (_randGen w)
cr = (_creatures w IM.! cid)
dir = _crDir cr
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
flamerAngle = 0.3
aSelf :: Int -> World -> World
aSelf = blinkAction
@@ -1610,14 +1598,8 @@ thinLine = lineOfThickness 1
someJust (Just x) | x > 0 = True
| otherwise = False
shakeCr :: Int -> Float -> World -> World
shakeCr cID amount w =
let vec = vNormal $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cID
(x,g) = randomR (-amount,amount) $ _randGen w
in set randGen g . over (creatures . ix cID . crPos) (+.+ (x *.* vec)) $ w
{- |
Sends out pulses that display walls. -}
radar = defaultGun
{ _itName = "RADAR"
, _itIdentity = Generic
@@ -1627,7 +1609,7 @@ radar = defaultGun
, _wpReloadState = 0
, _wpFireRate = 120
, _wpFireState = 0
, _wpFire = shoot $ aRadarPulse
, _wpFire = shoot aRadarPulse
, _wpSpread = autogunSpread
, _wpRange = 20
, _itHammer = HammerUp
@@ -1638,7 +1620,8 @@ radar = defaultGun
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Sends out pulses that display creatures. -}
sonar = defaultGun
{ _itName = "SONAR"
, _itIdentity = Generic
@@ -1648,7 +1631,7 @@ sonar = defaultGun
, _wpReloadState = 0
, _wpFireRate = 120
, _wpFireState = 0
, _wpFire = shoot $ aSonarPulse
, _wpFire = shoot aSonarPulse
, _wpSpread = autogunSpread
, _wpRange = 20
, _itHammer = HammerUp
@@ -1659,96 +1642,8 @@ sonar = defaultGun
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
, _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
aSonarPulse :: Int -> World -> World
aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
aRadarPulse :: Int -> World -> World
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
{-
Radar blip at a point.
-}
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
{_ptDraw = const blank
,_ptUpdate' = mvBlip p col i i
}
mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle -> (World, Maybe Particle)
mvBlip p col maxt 0 w pt = (w, Nothing)
mvBlip p col maxt t w pt
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvSonar 100 p
}
mvSonar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
mvSonar 0 _ w _ = (w, Nothing)
mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
,_ptUpdate' = mvSonar (x-1) p
}
)
where
pic = setDepth (-0.5) . setLayer 1 $ pictures
-- $ sweepPics ++
crBlips -- ++ wallBlips
crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
= Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
$ uncurry translate cpos $ circleSolid crad
| otherwise = Nothing
where crad = _crRad cr
cpos = _crPos cr
r = fromIntegral (500 - x*5)
sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5
-- ,colHelper 0.3 $ uncurry translate p $ thickCircle (r-5) 5
-- ,colHelper 0.1 $ uncurry translate p $ thickCircle (r-10) 5
]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) green)
-- wallBlips
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvRadar 50 p
}
mvRadar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle)
mvRadar 0 _ w _ = (w, Nothing)
mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
,_ptUpdate' = mvRadar (x-1) p
}
)
where
pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics
putBlips = over worldEvents ((.) $ over particles ((++) blips))
blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50)
$ circPoints
circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p)
$ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w)
++ (IM.elems $ wallsAlongCirc p r w)
r = fromIntegral (800 - x*16)
sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
--,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
--,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) red)
{- |
Automatically sends out pulses that display creatures. -}
autoSonar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTOSONAR"
@@ -1762,6 +1657,8 @@ autoSonar = defaultEquipment
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
}
{- |
Automatically sends out pulses that display walls. -}
autoRadar = defaultEquipment
{ _itIdentity = Generic
, _itName = "AUTORADAR"
@@ -1775,74 +1672,8 @@ autoRadar = defaultEquipment
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
}
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50
,_itEffectCounter = 0
}
where f 0 cr i w = aRadarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50
,_itEffectCounter = 0
}
where f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
itemLaserScopeEffect :: ItEffect
itemLaserScopeEffect
= ItInvEffect {_itInvEffect = f
,_itEffectCounter = 0
}
where f cr invid w
| invid == _crInvSel cr
= w & particles %~ (:) (makeLaserScope sp ep d reloadFrac)
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
& laserScopeTargetGlow col glowPoint
-- this flare MAY be buggy... something to do with the creature glare
| otherwise = w
where
p = _crPos cr
d = _crDir cr
r = _crRad cr
sp = (p +.+ (r + 3) *.* unitVectorAtAngle d)
xp = sp +.+ 3000 *.* unitVectorAtAngle d
ep = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,_) -> p
Nothing -> xp
glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
_ -> (ep -.- 2 *.* unitVectorAtAngle d)
it = (cr ^. crInv) IM.! invid
reloadFrac
| _wpLoadedAmmo it == 0 = 1
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
col = mixColors reloadFrac (1-reloadFrac) red green
moveHammerUp !HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle
makeLaserScope p ep d relFrac = Particle
{_ptDraw = const $ onLayer PtLayer $ pictures
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 0.5 [p,ep]
,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 1.5 [p,ep]
,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 2 [p,ep]
]
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
}
{- |
Creates a creature next to the creature using the item. -}
spawnGun :: Creature -> Item
spawnGun cr = defaultGun
{ _itName = "SPAWNER"
@@ -1854,7 +1685,11 @@ spawnGun cr = defaultGun
, _wpFire = spawnCrNextTo cr
}
spawnCrNextTo :: Creature -> Int -> World -> World
spawnCrNextTo
:: Creature -- ^ Creature to spawn
-> Int -- ^ ID of existing creature that will be spawned next to
-> World
-> World
spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
where
k = newKey $ _creatures w
src/Dodge/Item/Weapon/Bullet.hs
+119 -104
View File
@@ -1,3 +1,6 @@
{- |
Effects of bullets upon impact with walls or creatures, and possibly force fields.
-}
module Dodge.Item.Weapon.Bullet
where
import Dodge.Data
@@ -6,21 +9,16 @@ import Dodge.WorldEvent
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
import Dodge.Creature.Property
import Geometry
import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM
import Picture
-- | bullet effects
import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM
-- | Basic bullet hit creature effect.
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
bulHitCr' bt p cr w
| crIsArmouredFrom p cr
@@ -35,13 +33,13 @@ bulHitCr' bt p cr w
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
flashEff = over worldEvents ((.) $ bloodFlashAt p)
flashEff = over worldEvents (bloodFlashAt p . )
cid = _crID cr
(d1,g) = randomR (-0.7,0.7) $ _randGen w
(colID,_) = randomR (0,11) $ _randGen w
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
{-
{- |
Bounce off armoured creatures, otherwise do damage.
-}
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
@@ -63,112 +61,104 @@ bulBounceArmCr' bt p cr w
newDir = safeNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ((over particles (bouncer :) ) . )
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{-
{- |
Bullet pass through creatures.
-}
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 50 sp p ep
,Blunt 50 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
] ++ dams
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ over worldEvents addPiercer
w
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
addPiercer = (.) $ over particles (piercer :)
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- Heavy bullet effects when hitting creature:
piercing, blunt, twisting and pushback damage all applied.
-}
hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
hvBulHitCr' bt p cr w = over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
] ++ dams
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
w
([Piercing 50 sp p ep
,Blunt 50 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
++
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ over worldEvents (addPiercer . )
w
where
(d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
addPiercer = over particles (piercer :)
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- |
Heavy bullet effects when hitting creature:
piercing, blunt, twisting and pushback damage all applied. -}
hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
hvBulHitCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
([Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
++
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
w
where
(d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
{- |
Create a flamelet when hitting a creature. -}
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
bulIncCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep
] ++ dams
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ incFlamelets
w
( Piercing 60 sp p ep : )
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ incFlamelets
w
where
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
v = evalState (randInCirc 1) $ _randGen w
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
{-
Creates a shockwave when hitting a creature.
-}
{- |
Creates a shockwave when hitting a creature. -}
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
bulConCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep
] ++ dams
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ mkwave
w
( Piercing 60 sp p ep : )
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ mkwave
w
where
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
{-
Hitting wall effects: create a spark, damage blocks.
-}
{- |
Hitting wall effects: create a spark, damage blocks. -}
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing
$ set randGen g
w
bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing
$ set randGen g
w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
damageBlocks wall w
= case wall ^? blHP of
reflectDir wall = a +
argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
damageBlocks wall w = case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
{-
{- |
Bounce off walls, do damage to blocks.
-}
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
@@ -183,16 +173,21 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) ( over particles (bouncer : ) )
-- the hack is to get around the fact that the particles list gets reset after
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list
{- Create flamelet on wall.
{- | Create flamelet on wall.
-}
bulIncWall' :: Particle -> Point2 -> Wall -> World -> World
bulIncWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
where
sp = head $ _btTrail' bt
@@ -201,12 +196,17 @@ bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
{- Create a shockwave on wall-}
bulConWall' :: Particle -> Point2 -> Wall -> World -> World
{- | Create a shockwave on wall-}
bulConWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
bulConWall' bt p wl w = damageBlocks wl $ mkwave w
where
sp = head $ _btTrail' bt
@@ -215,25 +215,27 @@ bulConWall' bt p wl w = damageBlocks wl $ mkwave w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
hvBulHitWall' :: Particle -> Point2 -> Wall -> World -> World
hvBulHitWall'
:: Particle
-> Point2 -- Impact point
-> Wall
-> World
-> World
hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv)
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
reflectDir wall = a +
argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
sv = unitVectorAtAngle $ reflectDir x
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
_ -> w
damageBlocks wall w = case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
_ -> w
cs = take 10 $ randomRs (0,11) $ _randGen w
ds = randomRs (-0.7,0.7) $ _randGen w
ts = randomRs (4,8) $ _randGen w
@@ -242,15 +244,20 @@ hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks p
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
bulHitFF' _ _ _ = id
bulletEffect' :: HitEffect
bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
{-
Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.
-}
basicBulletEffect :: HitEffect
basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle -> HitEffect
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
where
mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :)
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle
aGenBulAt'
:: Maybe Int -- ^ Pass-through creature id
-> Color
-> Point2 -- ^ Start position
-> Point2 -- ^ Velocity
-> HitEffect
-> Float -- ^ Bullet width
-> Particle
aGenBulAt' maycid col pos vel hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
@@ -263,7 +270,15 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
, _btHitEffect' = hiteff
}
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle
aCurveBulAt
:: Maybe Int -- ^ Pass-through creature id
-> Color
-> Point2 -- ^ Start position
-> Point2 -- ^ Control position
-> Point2 -- ^ Target position
-> HitEffect
-> Float -- ^ Bullet width
-> Particle
aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = \w -> mvGenBullet' w . setVel
src/Dodge/Item/Weapon/Decoration.hs
+29
View File
@@ -0,0 +1,29 @@
{- |
Particles and pictures that decorate weapons, such as laser scopes etc.
-}
module Dodge.Item.Weapon.Decoration
where
import Dodge.Data
import Dodge.Base
import Geometry.Data
import Picture
import Control.Lens
makeLaserScope
:: Point2 -- ^ Start point
-> Point2 -- ^ End point
-> Float -- ^ Fraction of red/green
-> Particle
makeLaserScope p ep relFrac = Particle
{_ptDraw = const $ onLayer PtLayer $ pictures
[color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 0.5 [p,ep]
,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 1.5 [p,ep]
,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green)
$ lineOfThickness 2 [p,ep]
]
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
}
src/Dodge/Item/Weapon/ExtraEffect.hs
+96
View File
@@ -0,0 +1,96 @@
{-# LANGUAGE BangPatterns #-}
{- |
Extra weapon effects, supplementing explicit use effects.
-}
module Dodge.Item.Weapon.ExtraEffect
where
import Dodge.Data
import Dodge.Base
import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.UseEffect
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry.Vector
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Controls resetting a weapon, allows for non-continuous fire needing a button release. -}
wpRecock :: ItEffect
wpRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
fOnIt it = it & itHammer %~ moveHammerUp
{- |
Special recock for the bezier gun.
Not sure of its purpose at this time... -}
bezierRecock :: ItEffect
bezierRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
fOnIt it = case _itHammer it of
HammerDown -> it & itHammer .~ HammerUp
_ -> it & itAttachment .~ Nothing
{- |
Creates a laser scope and recocks the weapon.
-}
itemLaserScopeEffect :: ItEffect
itemLaserScopeEffect
= ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 }
where
moveHammerUp !HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
f cr invid w
| invid == _crInvSel cr = w
& particles %~ (:) (makeLaserScope sp ep reloadFrac)
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
& laserScopeTargetGlow col glowPoint
| otherwise = w
where
p = _crPos cr
d = _crDir cr
r = _crRad cr
sp = p +.+ (r + 3) *.* unitVectorAtAngle d
xp = sp +.+ 3000 *.* unitVectorAtAngle d
ep = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,_) -> p
Nothing -> xp
glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
_ -> ep -.- 2 *.* unitVectorAtAngle d
it = (cr ^. crInv) IM.! invid
reloadFrac
| _wpLoadedAmmo it == 0 = 1
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
col = mixColors reloadFrac (1-reloadFrac) red green
{- |
Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f 0 cr i w = aRadarPulse (_crID cr) w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
f t cr i w = w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
{- |
Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where f 0 cr i w = aSonarPulse (_crID cr)
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
src/Dodge/Item/Weapon/InventoryDisplay.hs
+4 -12
View File
@@ -13,23 +13,15 @@ import Control.Monad
-- not sure if this is in the right place...
{- |
Displays the item name, ammo if loaded, and any selected '_itCharMode'.
-}
basicWeaponDisplay :: Item -> String
basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of
Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c]
_ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
where
availableAmmo = show $ _wpMaxAmmo it
aIfLoaded = case (_wpReloadState it) of
aIfLoaded = case _wpReloadState it of
0 -> show $ _wpLoadedAmmo it
x -> "R" ++ show x
displayLasGun :: Item -> String
displayLasGun it@(Weapon {_itAttachment = mayPhase})
= midPadL 10 ' ' "LASER" (' ':aIfLoaded) ++ (' ':phaseS)
where aIfLoaded = case (_wpReloadState it) of
0 -> show $ _wpLoadedAmmo it
x -> "R" ++ show x
phaseS = case mayPhase of
Just (ItPhaseV 0.2) -> "V"
Just (ItPhaseV 1) -> "/"
Just (ItPhaseV 5) -> "Z"
src/Dodge/Item/Weapon/Recock.hs
-36
View File
@@ -1,36 +0,0 @@
{-# LANGUAGE BangPatterns #-}
{- |
Controls for continuous and non-continuous fire.
-}
module Dodge.Item.Weapon.Recock
where
import Dodge.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Controls resetting a weapon, allows for non-continuous fire needing a button release. -}
wpRecock :: ItEffect
wpRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
fOnIt it = it & itHammer %~ moveHammerUp
{- |
Special recock for the bezier gun.
Not sure of its purpose at this time... -}
bezierRecock :: ItEffect
bezierRecock = ItInvEffect
{_itInvEffect = f
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
fOnIt it = case _itHammer it of
HammerDown -> it & itHammer .~ HammerUp
_ -> it & itAttachment .~ Nothing
src/Dodge/Item/Weapon/TriggerType.hs
+42 -8
View File
@@ -99,7 +99,9 @@ withRecoil
withRecoil recoilAmount eff cid = eff cid . over (creatures . ix cid) pushback
where
pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr
{- |
Pushes a creature sideways by a random amount.
Applied before the underlying effect. -}
withSidePush
:: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World)
@@ -111,6 +113,19 @@ withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
:: Float -- ^ Maximal possible side push amount
-> (Int -> World -> World)
-- ^ Underlying world effect, takes creature id as input
-> Int -- ^ Creature id
-> World -> World
withSidePushAfter maxSide eff cid w = over (creatures . ix cid) push . eff cid $ w
where
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Applies a world effect and sound effect after an ammo check. -}
shootWithSound
:: Int -- ^ Sound identifier
@@ -134,7 +149,8 @@ shootWithSound soundid f cid w
&& _wpFireState item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- | Applies a world effect after a hammer position check. -}
{- |
Applies a world effect after a hammer position check. -}
hammerCheck
:: (Int -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id
@@ -146,8 +162,8 @@ hammerCheck f cid w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
where
cr = _creatures w IM.! cid
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | Applies a world effect after an ammo check. -}
{- |
Applies a world effect after an ammo check. -}
shoot
:: (Int -> World -> World)
-- ^ Underlying effect, takes creature id as input
@@ -175,8 +191,7 @@ withMuzFlare
-> Int -- ^ Creature id
-> World
-> World
withMuzFlare f cid w = tempLightForAt 3 pos
. muzzleFlashAt pos2 $ f cid w
withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w
where
cr = _creatures w IM.! cid
dir = _crDir cr
@@ -184,8 +199,7 @@ withMuzFlare f cid w = tempLightForAt 3 pos
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- |
Rotates the creature randomly, applies the effect, rotates the creature back.
-}
Rotates the creature randomly, applies the effect, rotates the creature back. -}
withRandomDir
:: Float -- ^ Max possible rotation
-> (Int -> World -> World)
@@ -336,3 +350,23 @@ numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
colids = take num $ randomRs (0,11) (_randGen w)
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- |
Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: Float -- ^ Max offset angle
-> Float -- ^ Walk speed
-> (Int -> World -> World) -- ^ Underlying effect
-> Int -- ^ Creature id
-> World
-> World
randWalkAngle ma aspeed f cid w = w
& creatures . ix cid . crDir -~ a
& f cid
& creatures . ix cid . crDir +~ a
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
(walka, g) = randomR (-aspeed,aspeed) (_randGen w)
newa = min ma $ max (negate ma) (a + walka)
i = _crInvSel $ _creatures w IM.! cid
src/Dodge/Item/Weapon/UseEffect.hs
+110
View File
@@ -0,0 +1,110 @@
{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used. -}
module Dodge.Item.Weapon.UseEffect
where
import Dodge.Data
import Dodge.Base
import Dodge.Item.Weapon.Decoration
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit
import Picture
import Geometry
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Int -> World -> World
aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
{- |
Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: Int -> World -> World
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
{- |
Radar blip at a point.
-}
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
{_ptDraw = const blank
,_ptUpdate' = mvBlip p col i i
}
mvBlip :: Point2 -> Color
-> Int -- ^ Max possible timer value
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvBlip p col maxt 0 w pt = (w, Nothing)
mvBlip p col maxt t w pt
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
{- |
An outwardly increasing circle that draws creatures, even those behind walls. -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }
mvSonar
:: Int -- ^ Timer
-> Point2 -- ^ Center of expanding circle
-> World -> Particle -> (World, Maybe Particle)
mvSonar 0 _ w _ = (w, Nothing)
mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
,_ptUpdate' = mvSonar (x-1) p
}
)
where
pic = setDepth (-0.5) . setLayer 1 $ pictures crBlips
crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
= Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
$ uncurry translate cpos $ circleSolid crad
| otherwise = Nothing
where crad = _crRad cr
cpos = _crPos cr
r = fromIntegral (500 - x*5)
sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) green)
{- |
An outwardly increasing circle that displays walls, even those behind other walls. -}
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvRadar 50 p
}
mvRadar
:: Int -- ^ Timer
-> Point2 -- ^ Center of expanding circle
-> World -> Particle -> (World, Maybe Particle)
mvRadar 0 _ w _ = (w, Nothing)
mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
,_ptUpdate' = mvRadar (x-1) p
}
)
where
pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics
putBlips = over worldEvents ((.) $ over particles ((++) blips))
blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50)
$ circPoints
circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p)
$ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w)
++ (IM.elems $ wallsAlongCirc p r w)
r = fromIntegral (800 - x*16)
sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
--,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
--,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
]
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
colHelper y = color (withAlpha (y * globalAlpha) red)
src/Picture/Preload.hs
+1 -1
View File
@@ -120,7 +120,7 @@ setupFramebuffer = do
textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr)
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2D
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
src/Picture/Render.hs
+5
View File
@@ -140,7 +140,12 @@ createLightMap pdata resDiv wallPoints lightPoints
bindFramebuffer Framebuffer $= defaultFramebufferObject
colorMask $= Color4 Disabled Disabled Disabled Enabled
bindShaderBuffers [_fullscreenShader pdata] [4]
-- by upscaling the shadowmap texture and using Linear' magnification
-- interpolation, we get a poor mans blur
textureBinding Texture2D $= Just (_fboTexture pdata)
textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-- not sure about the perforamnce implications ^^^
generateMipmap' Texture2D
drawShader (_fullscreenShader pdata) 4
colorMask $= Color4 Enabled Enabled Enabled Enabled
blend $= Enabled