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

Add test tileset textures

Browse Source
This commit is contained in:
jgk
2021-06-11 13:51:06 +02:00
parent 02511afa80
commit a9aa2ca2cb
18 changed files with 75 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action/UseItem.hs
+1 -1
View File
@@ -16,7 +16,7 @@ useItem n w = itemEffect c it w
-- TODO this needs sorting out and possibly removing
crUseItem :: Creature -> World -> World
--crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
crUseItem cr = tryUseItem cr
crUseItem = tryUseItem
tryUseItem
:: Creature
src/Dodge/Creature/Picture.hs
+6 -6
View File
@@ -68,7 +68,7 @@ feet cr = case cr ^? crStance . carriage of
, translate 0 (-off) $ circleSolid 5
]
where
setL = onLayerL [levLayer CrLayer, (-5)] . color (greyN 0.3) . pictures
setL = onLayerL [levLayer CrLayer, -5] . color (greyN 0.3) . pictures
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -86,7 +86,7 @@ arms col cr
_ -> blank
where
sc = scale 1 1
setL = onLayerL [levLayer CrLayer, (-4)] . color (light4 col) . pictures
setL = onLayerL [levLayer CrLayer, -4] . color (light4 col) . pictures
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -103,20 +103,20 @@ naked col cr
[ translate (0.25 * crad) 0 $ circleSolid (crad * 0.5)
, onCrL . translate 8 (-8) . color col' $ circleSolid 4
, translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
]
| aimingTwist = translate 0 (0.5* crad) . rotate twistA $ pictures
[ aboveIt . translate (negate 0.25 * crad) 0.25 $
circleSolid (crad * 0.5)
, onCrL . translate 12 (4) . color col' $ circleSolid 4
, onCrL . translate 12 4 . color col' $ circleSolid 4
, onCrL . translate 4 (-10) . color col' $ circleSolid 4
, onCrL . rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, onCrL . rotate (negate 0.2) . translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, onCrL . rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
]
| otherwise = onCrL $ pictures
[ translate (0.25 * crad) 0 $ circleSolid (crad * 0.5)
, translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
, translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
]
where
aboveIt = onLayer HPtLayer
src/Dodge/Default.hs
+2 -2
View File
@@ -162,9 +162,9 @@ defaultPT = Projectile
{ _pjPos = (0,0)
, _pjStartPos = (0,0)
, _pjVel = (0,0)
, _pjDraw = \_ -> blank
, _pjDraw = const blank
, _pjID = 0
, _pjUpdate = \_ -> id
, _pjUpdate = const id
}
defaultPP :: PressPlate
defaultPP = PressPlate
src/Dodge/Default/Shell.hs
+3 -3
View File
@@ -11,9 +11,9 @@ defaultShell = Shell
, _pjAcc = (0,0)
, _pjDir = 0
, _pjSpin = 0
, _pjDraw = \_ -> blank
, _pjDraw = const blank
, _pjID = 0
, _pjTimer = 0
, _pjUpdate = \_ -> id
, _pjPayload = \_ -> id
, _pjUpdate = const id
, _pjPayload = const id
}
src/Dodge/Default/Weapon.hs
+2 -2
View File
@@ -46,9 +46,9 @@ defaultAutoGun = defaultGun
}
defaultShellAmmo :: Ammo
defaultShellAmmo = ShellAmmo
{ _amPayload = \_ -> id
{ _amPayload = const id
, _amString = "Shell"
, _amPjParams = []
, _amPjDraw = \_ -> blank
, _amPjDraw = const blank
, _amParamSel = 0
}
src/Dodge/Event.hs
+1 -1
View File
@@ -114,7 +114,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
moveYourAmmoSel :: Int -> World -> World
moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
. wpAmmo . amParamSel %~ (`mod` (length l)) . (subtract i)
. wpAmmo . amParamSel %~ (`mod` (length l)) . subtract i
_ -> w
moveYourAmmoParam :: Int -> World -> World
moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of
src/Dodge/Item/Weapon.hs
+3 -3
View File
@@ -92,12 +92,12 @@ useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b)
effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
, _itUse = \_ -> eff
, _itUse = const eff
}
autoEffectGun :: String -> (Creature -> World -> World) -> Item
autoEffectGun name eff = defaultAutoGun
{ _itName = name ++ "Gun"
, _itUse = \_ -> eff
, _itUse = const eff
}
rezGun :: Item
rezGun = defaultGun
@@ -876,7 +876,7 @@ throwRemoteBomb cr w = setLocation
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
-- $ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
$ resetName
$ resetPict
src/Dodge/Item/Weapon/Booster.hs
+3 -3
View File
@@ -46,7 +46,7 @@ boostSelfL x cr invid w = case boostPoint x cr w of
. (crInv . ix invid %~
ammoEff
. (itEffect . itEffectCounter .~ 1)
. (itAttachment .~ Just (ItInt pid))
. (itAttachment ?~ ItInt pid)
)
boostSelf
@@ -85,8 +85,8 @@ updateLinearShockwave pj w
drawBoostShockwave :: Projectile -> Picture
drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ pictures $
theArc ++
[ lineCol $ zip (reverse lps) $ map (flip withAlpha white) [0,0.05..]
, lineCol $ zip (reverse rps) $ map (flip withAlpha white) [0,0.05..]
[ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0,0.05..]
, lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0,0.05..]
]
where
-- drawing half a circle here is not perfect, a slightly smaller arc would fit
src/Dodge/Item/Weapon/ExtraEffect.hs
+1 -1
View File
@@ -56,7 +56,7 @@ itemLaserScopeEffect :: ItEffect
itemLaserScopeEffect
= ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 }
where
moveHammerUp !HammerDown = HammerReleased
moveHammerUp HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
f _ cr invid w
| invid == _crInvSel cr && crIsAiming' cr = w
src/Dodge/Item/Weapon/Launcher.hs
+4 -4
View File
@@ -35,7 +35,7 @@ launcher = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = \it -> shootWithSound (fromIntegral launcherSound) $ aRocketWithItemParams it
, _itUse = shootWithSound (fromIntegral launcherSound) . aRocketWithItemParams
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer launcherPic
@@ -64,7 +64,7 @@ basicAmPjMoves =
]
spinDrag :: PjParam
spinDrag = PjParam
{ _pjMoveParam = \i _ _ -> reduceSpinBy (1 - (fromIntegral i)*2 / 200)
{ _pjMoveParam = \i _ _ -> reduceSpinBy (1 - fromIntegral i*2 / 200)
, _pjIntParam = 1
, _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show
, _pjMaxParam = 5
@@ -87,7 +87,7 @@ thrustParam = PjParam
}
pjThrust :: Int -> Projectile -> World -> World
pjThrust i = pjEffTimeRange (st,et) $ doThrust
pjThrust i = pjEffTimeRange (st,et) doThrust
where
et | i == 0 = 36
| otherwise = 40 - (fromIntegral i * 20)
@@ -131,7 +131,7 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
i = IM.newKey $ _projectiles w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr
ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
theShell = defaultShell
{ _pjPos = pos
, _pjStartPos = pos
src/Dodge/Item/Weapon/UseEffect.hs
+2 -2
View File
@@ -126,7 +126,7 @@ tractorBeamAt colID i pos dir = Projectile
{ _pjPos = pos
, _pjStartPos = p'
, _pjVel = d
, _pjDraw = \_ -> blank
, _pjDraw = const blank
, _pjID = i
, _pjUpdate = \_ -> updateTractor colID 10 i
}
@@ -139,7 +139,7 @@ The interaction of this with objects, walls etc needs more thought. -}
updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w
| time > 0 = set (projectiles . ix i . pjUpdate) (\_ -> updateTractor colID (time-1) i)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjDraw) (const pic)
$ over creatures (IM.map tractCr)
$ over floorItems (IM.map tractFlIt)
w
src/Dodge/Render.hs
+3 -5
View File
@@ -54,7 +54,7 @@ doDrawing pdata w = do
pic = worldPictures w
wallPoints = map fst wallPointsCol
-- set the coordinate uniforms ready for drawing elements using world coordinates
setCommonUniforms pdata rot camzoom trans wins
setIsoMatrixUniforms pdata rot camzoom trans wins
depthFunc $= Just Less
pmat <- (newMatrix RowMajor $ perspectiveMatrix rot camzoom trans wins viewFroms)
:: IO (GLmatrix GLfloat)
@@ -138,8 +138,7 @@ renderBlankWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps
bindShaderBuffers [_wallBlankShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
uniform (( _shaderMatrixUniform $ _wallBlankShader pdata) )
$= pmat
uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat
cullFace $= Just Back
drawShader (_wallBlankShader pdata) n
cullFace $= Nothing
@@ -153,8 +152,7 @@ renderTextureWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps
bindShaderBuffers [_wallTextureShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
uniform (( _shaderMatrixUniform $ _wallTextureShader pdata) )
$= pmat
uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat
cullFace $= Just Back
drawShader (_wallTextureShader pdata) n
cullFace $= Nothing
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -55,7 +55,7 @@ testPic w =
]
crDraw :: World -> Creature -> Picture
crDraw w c = (_crPict c c w)
crDraw w c = _crPict c c w
ppDraw :: PressPlate -> Picture
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture