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

Refactor vao preload

Browse Source
This commit is contained in:
justin
2021-02-19 12:41:46 +01:00
parent f4db9bf9a1
commit f6efe98181
16 changed files with 441 additions and 485 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+13 -1
View File
@@ -422,6 +422,18 @@ lineOfThickness t = pictures . f
f _ = []
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
lineGeom :: Float -> Point2 -> Point2 -> [Point2]
lineGeom t x y
| x == y = []
| otherwise = [x +.+ n x y, x -.- n x y, y +.+ n x y, y -.- n x y]
where n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
wedgeGeom :: Float -> Point2 -> Point2 -> [Point2]
wedgeGeom t x y
| x == y = []
| otherwise = [x +.+ n x y, x -.- n x y, y]
where n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
wedgeOfThickness t x y
| x == y = blank
@@ -701,7 +713,7 @@ onLayer l = setDepth (fromIntegral (levLayer l) / 100)
--onLayer l p = [(p, [levLayer l])]
onLayerL :: [Int] -> Picture -> Picture
onLayerL is = setDepth (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..])
onLayerL is = setDepth ((sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
levLayer :: Layer -> Int
levLayer BgLayer = 20
src/Dodge/Critters.hs
+1 -2
View File
@@ -342,7 +342,7 @@ goalPict cr = let r = _crRad cr in case _crState cr of
(SubPathTo p i _:_) -> dGoals $ sizeColEnemy r blue
(Search i:_) -> dGoals $ sizeColEnemy r black
_ -> dGoals $ sizeColEnemy r magenta
where dGoals p = pictures [p, rotate (radToDeg (_crDir cr)) $ scale 0.1 0.1 $ color white $ text $ show gls]
where dGoals p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
_ -> sizeColEnemy r (light $ dim green)
startCr :: Creature
@@ -395,5 +395,4 @@ basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
-- | crDam > _crHP cr && odd (crDam - _crHP cr)
-- = [color white $ circleSolid $ _crRad cr]
| otherwise = pictures [color col $ circleSolid $ _crRad cr, circLine $ _crRad cr]
-- , rotate (radToDeg $ _crDir cr) $ scale 0.2 0.2 $ color white $ text $ show $ _crPos cr
pdam = _crPastDamage $ _crState cr
src/Dodge/Data.hs
+1
View File
@@ -242,6 +242,7 @@ data MenuState
| PauseMenu
| GameOverMenu
| InGame
deriving (Eq,Ord)
data Sound = Sound { _soundTime :: Int
, _soundFadeTime :: Int
src/Dodge/LevelGen.hs
+1 -1
View File
@@ -750,7 +750,7 @@ placeLS ls dec p rot w = over lightSources addLS
(ls {_lsPos = p,_lsDir = rot,_lsID = newKey lss})
lss
addDec decs = IM.insert (newKey decs)
(uncurry translate p $ rotate (radToDeg rot) dec)
(uncurry translate p $ rotate (0 - rot) dec)
decs
src/Dodge/Rendering.hs
+22 -20
View File
@@ -51,7 +51,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
= case _mapDisplay w of
(True, z) -> (blank
,pictures [color white $ circleSolid 3
,scale z z $ rotate (radToDeg (_cameraRot w))
,scale z z $ rotate (0 - (_cameraRot w))
$ uncurry translate ((0,0) -.- _cameraCenter w)
$ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
)
@@ -68,7 +68,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
x2 = (x''+1)
y1 = (y''-1)
y2 = (y''+1)
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w)
zoom = _cameraZoom w
pathsTest = map drawPair $ _pathGraph' w
@@ -100,7 +100,7 @@ collectDrawings w = pictures
]
-- <> [onLayer GloomLayer $ theLighting w]
where
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w)
zoom = _cameraZoom w
decPicts = IM.elems $ _decorations w
@@ -127,12 +127,13 @@ collectDrawings w = pictures
menuScreen = case _menuState w of
InGame -> blank
LevelMenu x ->
pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 ("LEVEL "++show x)
pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
tst (-100) 100 0.4 ("LEVEL "++show x)
,controlsList
]
PauseMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 "PAUSED"
PauseMenu -> pictures
[--color (withAlpha 0.5 black) $ polygon $ screenBox w
tst (-100) 100 0.4 "PAUSED"
,tst (-100) 50 0.2 "n - new level"
,tst (-100) 0 0.2 "r - restart"
, controlsList
@@ -157,11 +158,11 @@ hudDrawings w = (onLayer InvLayer)
where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
crDraw :: Creature -> Drawing
crDraw c = uncurry translate (_crPos c) $ rotateRad (_crDir c) (_crPict c c)
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
ppDraw :: PressPlate -> Drawing
ppDraw c = uncurry translate (_ppPos c) $ rotateRad (_ppRot c) (_ppPict c)
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Drawing
btDraw c = uncurry translate (_btPos c) $ rotateRad (_btRot c) (_btPict c)
btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Drawing
clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
@@ -171,6 +172,7 @@ drawCursor w = translate (105-halfWidth w)
(halfHeight w - (25* (fromIntegral iPos)) - 20
)
-- $ rectangleWire 200 25
$ color white
$ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)]
where iPos = _crInvSel $ _creatures w IM.! _yourID w
@@ -242,7 +244,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
pb p' = p' -.- orth p'
pao p' = pa p' +.+ l *.* safeNormalizeV (pa p' -.- _cameraCenter w)
pbo p' = pb p' +.+ l *.* safeNormalizeV (pb p' -.- _cameraCenter w)
semiCirc p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r
semiCirc p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r
a p' = pi - argV (orth p')
trap p' = polygon [pa p', pb p', pbo p', pao p']
f p' = [semiCirc p', trap p']
@@ -256,7 +258,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
pao' p' = pa' p' +.+ l *.* safeNormalizeV (pa' p' -.- _cameraCenter w)
pbo' p' = pb' p' +.+ l *.* safeNormalizeV (pb' p' -.- _cameraCenter w)
trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
semiCirc' p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r'
semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
drawWall :: Wall -> Drawing
@@ -283,7 +285,7 @@ printPoint p = color white $ uncurry translate p $ pictures [circle 3 ,scale 0.0
printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p = color white $ uncurry translate p $ pictures [circle 3
, rotate r $ scale 0.1 0.1 $ text (show p)]
, rotate (0 - r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: World -> [Point2]
outsideScreenPolygon w = [tr,tl,bl,br]
@@ -390,42 +392,42 @@ drawButText :: World -> Button -> Picture
drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ _btText bt
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
zoom = _cameraZoom w
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
drawPPText :: World -> PressPlate -> Picture
drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100
&& hasLOS (_ppPos pp) (_crPos (you w)) w
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ _ppText pp
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
zoom = _cameraZoom w
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
drawItemName :: World -> FloorItem -> Picture
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ nameOfItem
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
FlAm {_flAm = PistolBullet} -> "Bullets"
FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
@@ -472,7 +474,7 @@ drawFF (FF {_ffLine = l, _ffColor = col}) = pictures [color white $ line l, colo
drawFFShadow :: World -> ForceField -> [Picture]
drawFFShadow w ff
| youOnFF = []
| otherwise = map (rotate (radToDeg (- _cameraRot w)) . pane)
| otherwise = map (rotate ( _cameraRot w) . pane)
[0,0.05..0.25]
where p = rotateV (-_cameraRot w) $ ypShift
x = rotateV (-_cameraRot w) x'
src/Dodge/Update.hs
+7 -4
View File
@@ -22,7 +22,10 @@ import Control.Lens
-- }}}
update :: World -> World
update w = let w1 = updateParticles' $ updateParticles
update w
| _menuState w /= InGame = w
| otherwise =
let w1 = updateParticles' $ updateParticles
$ updateLightSources
$ zoneClouds
$ updateClouds
@@ -31,16 +34,16 @@ update w = let w1 = updateParticles' $ updateParticles
$ updateBlocks -- $ zoning
$ updateSeenWalls
w
w2 = -- updateWeaponCounters $
w2 = -- updateWeaponCounters $
simpleCrSprings
$ zoneCreatures $ wallEvents
$ set worldEvents id $ _worldEvents w1
w1
w3 = updateCamera
w3 = updateCamera
$ updateAfterParticles'
$ colCrsWalls
w2
in checkEndGame $ ppEvents w3
in checkEndGame $ ppEvents w3
where -- zoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w))
-- w
-- wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
src/Dodge/Weapons.hs
+68 -67
View File
@@ -45,7 +45,7 @@ pistol,lasGun,tractorGun,launcher,autoGun
,longGun,flamer,blinkGun,forceFieldGun :: Item
pistol = Weapon
{ _itName = "pistol"
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
@@ -101,7 +101,7 @@ autoEffectGun name eff = autoGun
}
autoGun = defaultGun
{ _itName = "autoGun .........."
{ _itName = "AUTOGUN AUTO"
, _itIdentity = AutoGun
, _wpMaxAmmo = 30
, _wpLoadedAmmo = 30
@@ -142,12 +142,12 @@ incMode :: Int -> World -> World
incMode _ w
= case newMode of
0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0
& creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun .........."
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN AUTO"
& creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer
& creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect
& creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode
1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1
& creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun ."
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN SINGLE"
& creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp
& creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock
& creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode
@@ -157,17 +157,17 @@ incMode _ w
f x = mod (x+1) 2
decMode :: Int -> World -> World
decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f
& creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun" ++ g newMode
& creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
newMode = fromMaybe 1 $ fmap f oldMode
f x = mod (x-1) 2
g 1 = " ."
g 2 = " ..."
g 0 = " .........."
g 1 = " SINGLE"
g 2 = " BURST"
g 0 = " AUTO"
rezGun = defaultGun
{ _itName = "reanimator"
{ _itName = "REANIMATOR"
, _wpMaxAmmo = 50
, _wpLoadedAmmo = 50
, _wpAmmoType = Battery
@@ -191,7 +191,7 @@ rezGun = defaultGun
]
}
teslaGun = autoGun
{ _itName = "teslaGun"
{ _itName = "TESLAGUN"
, _itIdentity = TeslaGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
@@ -217,7 +217,7 @@ teslaGun = autoGun
]
}
lasGun = autoGun
{ _itName = "lasGun ////"
{ _itName = "LASGUN ////"
, _itIdentity = LasGun
, _wpMaxAmmo = 200
, _wpLoadedAmmo = 200
@@ -241,7 +241,7 @@ lasGun = autoGun
}
incPhaseV :: Int -> World -> World
incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
& creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV
& creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
@@ -257,7 +257,7 @@ incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just .
g 5 = " \\\\//"
decPhaseV :: Int -> World -> World
decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
& creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV
& creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
@@ -272,7 +272,7 @@ decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just .
g 2 = " \\///"
g 5 = " \\\\//"
forceFieldGun = defaultGun
{ _itName = "forceField"
{ _itName = "FORCEFIELD"
, _itIdentity = ForceFieldGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
@@ -311,7 +311,7 @@ forceFieldGun = defaultGun
-- , _itAimingRange = 0.5
-- }
tractorGun = autoGun
{ _itName = "tractorGun"
{ _itName = "TRACTORGUN"
, _itIdentity = TractorGun
, _wpMaxAmmo = 10000
, _wpLoadedAmmo = 10000
@@ -331,7 +331,7 @@ tractorGun = autoGun
, _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
launcher = defaultGun
{ _itName = "launcher"
{ _itName = "lAUNCHER"
, _itIdentity = Launcher
, _wpMaxAmmo = 30
, _wpLoadedAmmo = 30
@@ -353,7 +353,7 @@ launcher = defaultGun
, _itEffect = NoItEffect
}
remoteLauncher = defaultGun
{ _itName = "remoteLauncher"
{ _itName = "REMOTELAUNCHER"
, _itIdentity = RemoteLauncher
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
@@ -374,7 +374,7 @@ remoteLauncher = defaultGun
, _itAttachment = Just $ ItScope (0,0) 0 1 True
}
hvAutoGun = autoGun
{ _itName = "hvMachineGun"
{ _itName = "HVMACHINEGUN"
, _itIdentity = HvAutoGun
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
@@ -401,7 +401,7 @@ hvAutoGun = autoGun
hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun = autoGun
{ _itName = "autoPistol"
{ _itName = "AUTOPISTOL"
, _itIdentity = LtAutoGun
, _wpMaxAmmo = 25
, _wpLoadedAmmo = 25
@@ -426,7 +426,7 @@ ltAutoGun = autoGun
]
}
miniGun = autoGun
{ _itName = "miniGun"
{ _itName = "MINIGUN"
, _itIdentity = MiniGun
, _wpMaxAmmo = 150
, _wpLoadedAmmo = 150
@@ -447,7 +447,7 @@ miniGun = autoGun
, _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
}
spreadGun = defaultGun
{ _itName = "spreadgun"
{ _itName = "SPREADGUN"
, _itIdentity = SpreadGun
, _wpMaxAmmo = 5
, _wpLoadedAmmo = 5
@@ -491,7 +491,7 @@ spreadGun = defaultGun
-- , _itAimingRange = 0.5
-- }
multGun = defaultGun
{ _itName = "multGun"
{ _itName = "MULTGUN"
, _itIdentity = MultGun
, _wpMaxAmmo = 2
, _wpLoadedAmmo = 2
@@ -522,7 +522,7 @@ multGun = defaultGun
, polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
]
longGun = defaultGun
{ _itName = "elephantGun"
{ _itName = "ELEPHANTGUN"
, _itIdentity = LongGun
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
@@ -563,7 +563,7 @@ startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatu
poisonSprayer = autoGun
{ _itName = "poisonSprayer"
{ _itName = "POISONSPRAYER"
, _itIdentity = PoisonSprayer
, _wpMaxAmmo = 500
, _wpLoadedAmmo = 500
@@ -585,7 +585,7 @@ poisonSprayer = autoGun
}
flamer = autoGun
{ _itName = "flamethrower"
{ _itName = "FLAMETHROWER"
, _itIdentity = Flamethrower
, _wpMaxAmmo = 250
, _wpLoadedAmmo = 250
@@ -609,7 +609,7 @@ flamer = autoGun
, _itAttachment = Nothing
}
blinkGun = defaultGun
{ _itName = "blinker"
{ _itName = "BLINKER"
, _itIdentity = Blinker
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
@@ -804,11 +804,11 @@ moveShell time i cid rot accel w
(moveShell (time-1) i cid rot (rotateV rot accel))
$ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ smokeGen
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
$ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos))
(0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
$ smokeGen
w
| time > -200 = case thingHit of
Just p -> shellExplosionAt oldPos
@@ -829,9 +829,9 @@ moveShell time i cid rot accel w
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
dir = argV $ vel
pic = onLayer PtLayer $ uncurry translate newPos $ rotate (-radToDeg (argV accel)) shellPic
pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
piclow = onLayerL [levLayer CrLayer - 2]
$ uncurry translate newPos $ rotate (-radToDeg (argV accel)) shellPic
$ uncurry translate newPos $ rotate (argV accel) shellPic
hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
thingHit = hitCr <|> hitWl
@@ -1018,24 +1018,24 @@ moveFlame rotd w pt =
damcr cr p = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ Flaming (div time 10) sp p ep)
hiteff = _btHitEffect' pt pt
thepic p' = pictures [ pic p' , piu p' , pi2 p' , glow p' ]
thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
pic p' = onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p')
$ rotate (90 + (negate $ radToDeg $ argV rotd))
$ rotate (pi * 0.5 + argV rotd)
$ scale scaleChange 1
-- $ color white
-- $ circleSolid 5
$ pictures [color white $ circleSolid 4
$ pictures $ reverse [color white $ circleSolid 4
,color (withAlpha 0.5 white) $ circleSolid 5
]
-- $ rotate (radToDeg (fromIntegral time * 10))
-- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)]
pi2 p' = onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p')
-- $ rotate ( (fromIntegral time * 5))
$ rotate (90 + (negate $ radToDeg $ argV rotd))
$ rotate (pi * 0.5 + argV rotd)
-- $ color (mixColors 0.5 0.5 orange white)
-- $ polygon [(-6,-6),(6,-6),(6,6),(-6,6)]
$ scale (scaleChange + 0.5) 1.5
$ pictures [color orange $ circleSolid 4.5
$ pictures $ reverse [color orange $ circleSolid 4.5
,color (withAlpha 0.5 orange) $ circleSolid 5
]
-- $ color orange
@@ -1044,10 +1044,10 @@ moveFlame rotd w pt =
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
piu p' = onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p')
$ rotate (90 + (negate $ radToDeg $ argV rotd))
$ rotate (pi*0.5 + argV rotd)
-- $ rotate ((fromIntegral time * (-10)))
$ scale (scaleChange + 1) 2
$ pictures [color red $ circleSolid 4.5
$ pictures $ reverse [color red $ circleSolid 4.5
,color (withAlpha 0.5 red) $ circleSolid 5
]
-- $ color (dark red)
@@ -1697,7 +1697,7 @@ grenadeLauncher = pistol
grenade,remoteBomb :: Item
grenade = Throwable
{ _itName = "grenade " ++ show fuseTime
{ _itName = "GRENADE " ++ show fuseTime
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
@@ -1724,7 +1724,7 @@ increaseFuse :: Int -> Int -> World -> World
increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
& creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
& creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
& creatures . ix 0 . crInv . ix itRef . itName .~ "grenade " ++ show newTime
& creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
& creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
& creatures . ix 0 . crInv . ix itRef . itZoom
.~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
@@ -1736,7 +1736,7 @@ decreaseFuse :: Int -> Int -> World -> World
decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
& creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
& creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
& creatures . ix 0 . crInv . ix itRef . itName .~ "grenade " ++ show newTime
& creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
& creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
& creatures . ix 0 . crInv . ix itRef . itZoom
.~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
@@ -1746,7 +1746,7 @@ decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~
defaultThrowable = grenade
remoteBomb = defaultThrowable
{ _itName = "remoteBomb"
{ _itName = "REMOTEBOMB"
, _itIdentity = RemoteBomb
, _itMaxStack = 1
, _itAmount = 1
@@ -1783,7 +1783,7 @@ throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randG
p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
| otherwise = p'
dir = negate $ radToDeg $ argV $ v
dir = argV v
setWp :: World -> World
setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
--maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just
@@ -1814,7 +1814,7 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
((179 * fromIntegral x / 50) - 180 )
(180 - (179 * fromIntegral x / 50) )
5
, translate (-2) 2 $ rotate 90
, translate (-2) 2 $ rotate (pi*0.5)
$ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20
]
@@ -1838,7 +1838,7 @@ fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
newitid = newKey $ _itemPositions w
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i
resetName = set (creatures . ix cid . crInv . ix j . itName) "remoteRocket"
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
setLocation :: World -> World
setLocation w' = case maybeitid of
Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid
@@ -1910,9 +1910,9 @@ moveRemoteShell time i cid itid dir w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
dir = argV $ vel
pic = onLayer PtLayer $ uncurry translate newPos
$ rotate (-radToDeg (argV accel)) $ remoteShellPic time
$ rotate (argV accel) $ remoteShellPic time
piclow = onLayerL [levLayer CrLayer - 2]
$ uncurry translate newPos $ rotate (-radToDeg (argV accel))
$ uncurry translate newPos $ rotate (argV accel)
$ remoteShellPic time
hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
@@ -1924,8 +1924,9 @@ moveRemoteShell time i cid itid dir w
(s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
-- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w
-- v1 = fst $ runState (randInCirc 0.5) $ _randGen w
smokeGen = makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
. makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
smokeGen = makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
. makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
-- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
doExplosion = explodeRemoteRocket itid i cid
setScope w' = case _itemPositions w' IM.! itid of
@@ -1943,7 +1944,7 @@ explodeRemoteRocket itid ptid n w
-- $ resetScope
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
where resetName = set (itPoint . itName) "remoteLauncher"
where resetName = set (itPoint . itName) "REMOTELAUNCHER"
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
itPoint = pointToItem $ _itemPositions w IM.! itid
@@ -1968,7 +1969,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
v | magV v' > 6 = 6 *.* normalizeV v'
-- zoom = 1 / _cameraZoom w
j = _crInvSel $ _creatures w IM.! n
resetName = set (creatures . ix n . crInv . ix j . itName) "remote"
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i
cr = _creatures w IM.! n
@@ -1995,19 +1996,19 @@ explodeRemoteBomb itid ptid n w
-- $ resetScope
$ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
-- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
where resetName = set (creatures . ix n . crInv . ix j . itName) "remoteBomb"
where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
(drawWeapon $ remoteBombUnarmedPic)
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! n
remoteBombPic :: Int -> Picture
remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5
, rotate (fromIntegral x * 10 + 45) $ color red $ arc 0 90 5
, rotate (fromIntegral x * 10 + 45) $ color (withAlpha 0.05 red)
, rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 90 5
, rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red)
$ arcSolid 0 90 50
, rotate (fromIntegral x * 10 + 20) $ color (withAlpha 0.05 red)
, rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red)
$ arcSolid 0 40 40
, rotate (fromIntegral x * 10 + 10) $ color (withAlpha 0.05 red)
, rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red)
$ arcSolid 0 20 20
]
remoteBombUnarmedPic :: Picture
@@ -2027,7 +2028,7 @@ drawWeapon p cr posInInv
medkit :: Int -> Item
medkit i = basicConsumable
{ _itIdentity = Medkit25
, _itName = "medkit" ++ show i
, _itName = "MEDKIT" ++ show i
, _itMaxStack = 9
, _itAmount = 1
, _cnEffect = heal i
@@ -2328,7 +2329,7 @@ autogunSpread = 0.07
medkit25,pipe,magShield :: Item
medkit25 = basicConsumable
{ _itIdentity = Medkit25
, _itName = "medkit25"
, _itName = "MEDKIT25"
, _itMaxStack = 3
, _itAmount = 2
, _cnEffect = heal25
@@ -2337,7 +2338,7 @@ medkit25 = basicConsumable
}
pipe = Craftable
{ _itIdentity = Generic
, _itName = "pipe"
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2348,7 +2349,7 @@ pipe = Craftable
}
magShield = basicEquipment
{ _itIdentity = MagShield
, _itName = "magshield"
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2357,7 +2358,7 @@ magShield = basicEquipment
}
flameShield = basicEquipment
{ _itIdentity = FlameShield
, _itName = "flameShield"
, _itName = "FLAMESHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2368,7 +2369,7 @@ flameShield = basicEquipment
}
frontArmour = basicEquipment
{ _itIdentity = FrontArmour
, _itName = "frontArmour"
, _itName = "FRONTARMOUR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 90 10 5
@@ -2384,7 +2385,7 @@ frontArmour = basicEquipment
}
jetPack = basicEquipment
{ _itIdentity = JetPack
, _itName = "JetPack"
, _itName = "JETPACK"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2399,11 +2400,11 @@ jetPack = basicEquipment
latchkey :: Int -> Item
latchkey n = basicEquipment
{ _itIdentity = Generic
, _itName = "key "++show n
, _itName = "KEY "++show n
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ latchkeyPic
, _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate 50 latchkeyPic
, _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
, _itEffect = NoItEffect
, _itHammer = HammerUp
, _itID = Nothing
@@ -2549,7 +2550,7 @@ shakeCr cID amount w =
radar = defaultGun
{ _itName = "radar"
{ _itName = "RADAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
@@ -2571,7 +2572,7 @@ radar = defaultGun
}
sonar = defaultGun
{ _itName = "sonar"
{ _itName = "SONAR"
, _itIdentity = Generic
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
@@ -2678,7 +2679,7 @@ mvRadar x p w pt = (putBlips w, Just $ pt {_ptPict' = pic
autoSonar = basicEquipment
{ _itIdentity = Generic
, _itName = "autoSonar"
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2691,7 +2692,7 @@ autoSonar = basicEquipment
}
autoRadar = basicEquipment
{ _itIdentity = Generic
, _itName = "autoRadar"
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
src/Dodge/WorldActions.hs
+38 -36
View File
@@ -482,10 +482,9 @@ crGlareWidth wdth col alphay p cr =
)
}
where l x = uncurry translate x
$ rotate (90 - (radToDeg $ argV (p -.- x)))
$ rotate (pi*0.5 + argV (p -.- x))
$ color (withAlpha alphay col)
$ thickArc 0 180 (_crRad cr) wdth
-- where l = rotate (radToDeg $ argV (cp -.- p)) $ uncurry translate cp $ color (withAlpha 0.5 white) $ thickArc 0 25 (_crRad cr) 5
cp = _crPos cr
cid = _crID cr
upp cid' w' = case w' ^? creatures . ix cid . crPos of
@@ -597,38 +596,37 @@ mvGenBullet' w bt
t = _btTimer' bt
bulLine :: Color -> Float -> [Point2] -> Drawing
bulLine col width (a:b:[])
bulLine _ _ [] = blank
bulLine _ _ (x:[]) = blank
bulLine col width (a:b:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures
[color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,b]
,color white $ wedgeOfThickness width a b
-- ,color white $ lineOfThickness width [a,b]
-- ,color (withAlpha 0.3 white) $ lineOfThickness width [a3,b]
-- ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
[polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
-- where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
-- a3 = (0.3 *.* a) +.+ (0.7 *.* b)
bulLine col width (a:b:c:_)
bulLine col width (a:b:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures
[color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,c]
,color white $ wedgeOfThickness width a c
-- ,color white $ lineOfThickness width [a,b]
-- ,color (withAlpha 0.3 white) $ lineOfThickness (width-1) [a3,c]
-- ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
-- ,color white $ lineOfThickness width [a,a2]
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
-- where a2 = b
-- a3 = (0.5 *.* b) +.+ (0.5 *.* c)
-- where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
-- a3 = (0.3 *.* a) +.+ (0.7 *.* b)
--bulLine col width (a:b:c:d:_)
bulLine col width (a:b:_:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLine col width (a:b:_:_:c:_) -- (a:b:[])
= onLayer HPtLayer $ pictures
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
-- [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,b]
-- ,color white $ wedgeOfThickness width a b
--bulLine col width (a:b:c:_)
-- = onLayer HPtLayer $ pictures
-- [color (withAlpha 0.5 col) $ lineOfThickness (width+1) [a,c]
-- ,color (withAlpha 0.3 white) $ lineOfThickness width [a3,b]
-- ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
-- ,color white $ lineOfThickness width [a,a2]
-- ]
-- where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
-- a3 = (0.3 *.* a) +.+ (0.7 *.* b)
-- [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,c]
-- ,color white $ wedgeOfThickness width a c
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
-> [(Point2, (Either3 Creature Wall ForceField))]
@@ -735,11 +733,11 @@ moveFlamelet levelInt rot w pt =
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red)
)
$ rotate (radToDeg ( 0.1 * fromIntegral time + rot))
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
$ scale sc sc
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
piu = onLayerL [levelInt,1] $ uncurry translate ep
$ color (dark red) $ rotate (radToDeg (rot - 0.1 * fromIntegral time))
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
$ scale s1 s1
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
glow = onLayerL [levelInt,0] $ uncurry translate ep
@@ -753,7 +751,7 @@ moveFlamelet levelInt rot w pt =
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
orange (dark red)
)
$ rotate (radToDeg $ rot + 0.2 * fromIntegral time)
$ rotate (0 - (rot + 0.2 * fromIntegral time))
$ scale s2 s2
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
@@ -822,7 +820,8 @@ moveSmoke' scal p time i
makeSmokeAt'' :: Point2 -> Float -> Int -> Point2 -> World -> World
makeSmokeAt'' vel scal time p w = over particles' ((:) smokeP) w
where smokeP = Particle'
{ _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
--{ _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
{ _ptPict' = onLayerL [levLayer PtLayer ] $ uncurry translate p $ color black $ circleSolid 1
, _ptUpdate' = moveSmoke'' scal time p vel
}
@@ -836,15 +835,18 @@ moveSmoke'' scal time p vel w pt
})
| otherwise = (w, Nothing)
where pNew = p +.+ vel
pic = onLayerL [levLayer PtLayer - 1]
pic = onLayerL [levLayer PtLayer]
--pic = onLayerL [levLayer PtLayer - 1]
$ uncurry translate pNew
$ color (greyN 0.5) $ circleSolid $ (21 - fromIntegral time) * scal
pi1 = pictures
pi1 = pictures $ reverse
[(onLayerL [levLayer PtLayer]
$ uncurry translate pNew
$ color (withAlpha (0.3 * (1 + fromIntegral time /50)) (greyN 0.5))
$ circleSolid $ 21 * scal)
, (onLayerL [levLayer BgLayer+1]
,
--(onLayerL [levLayer BgLayer+1]
(onLayerL [levLayer PtLayer]
$ uncurry translate pNew
$ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5))
$ circleSolid $ 21 * scal)