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

Add slime crit, start work on slink crit

Browse Source
This commit is contained in:
justin
2026-04-11 19:09:49 +01:00
parent 95a6c90d01
commit 5052ee7a9e
21 changed files with 699 additions and 537 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/CardinalPoint.hs
+3
View File
@@ -21,6 +21,9 @@ cardVec = \case
East -> V2 1 0
West -> V2 (-1) 0
vecCard :: Point2 -> CardinalPoint
vecCard (V2 x y) = undefined
card8Vec :: Cardinal8 -> Point2
card8Vec cp = case cp of
North8 -> V2 0 1
src/Dodge/Base/Collide.hs
+2
View File
@@ -180,6 +180,8 @@ crHeight cr = case cr ^. crHP of
ChaseCrit {} -> 25
Avatar {} -> 25
CrabCrit {} -> 25
SlinkCrit {} -> 25
SlimeCrit {_slimeRad = r} -> r
_ -> error "Need to define crHeight for this crType"
CrIsCorpse{} -> Just 5
CrDestroyed{} -> Nothing
src/Dodge/Creature/ChaseCrit.hs
+23 -1
View File
@@ -4,9 +4,12 @@ module Dodge.Creature.ChaseCrit (
crabCrit,
chaseCrit,
hoverCrit,
slinkCrit,
slimeCrit,
) where
--import Dodge.Data.Equipment.Misc
import qualified Quaternion as Q
import Linear
import Dodge.Data.FloatFunction
import Control.Lens
import Dodge.Data.Creature
@@ -48,6 +51,25 @@ crabCrit = defaultCreature
& crFaction .~ ColorFaction red
& crPerception . cpVision . viFOV .~ FloatFOV pi
slinkCrit :: Creature
slinkCrit = defaultCreature
& crName .~ "slinkCrit"
& crHP .~ HP 1000
& crType .~ SlinkCrit
{ _meleeCooldown = 0
, _slinkSpine = replicate 15 (V3 0 0 2, Q.axisAngle (V3 0 1 0) (pi/15))
}
& crFaction .~ ColorFaction red
& crPerception . cpVision . viFOV .~ FloatFOV pi
slimeCrit :: Creature
slimeCrit = defaultCreature
& crName .~ "slimeCrit"
& crHP .~ HP 1000
& crType .~ SlimeCrit 40 (V2 30 0) False
& crFaction .~ ColorFaction (light green)
& crPerception . cpVision . viFOV .~ FloatFOV pi
hoverCrit :: Creature
hoverCrit =
defaultCreature
src/Dodge/Creature/Mass.hs
+2
View File
@@ -11,4 +11,6 @@ crMass = \case
SwarmCrit -> 2
AutoCrit -> 10
BarrelCrit{} -> 10
SlinkCrit{} -> 100
LampCrit {} -> 3
SlimeCrit {_slimeRad = r} -> r
src/Dodge/Creature/Material.hs
+2
View File
@@ -13,5 +13,7 @@ crMaterial = \case
HoverCrit {} -> Metal
SwarmCrit -> Flesh
AutoCrit -> Flesh
SlinkCrit{} -> Flesh
BarrelCrit{} -> Metal
LampCrit{} -> Glass
SlimeCrit{} -> Flesh
src/Dodge/Creature/MaxHP.hs
+2 -1
View File
@@ -13,4 +13,5 @@ crMaxHP = \case
AutoCrit -> 100
BarrelCrit{} -> 100
LampCrit {} -> 50
SlinkCrit {} -> 1000
SlimeCrit {} -> 1000
src/Dodge/Creature/MoveType.hs
+2
View File
@@ -7,6 +7,7 @@ import Control.Lens
crMvType :: Creature -> CrMvType
crMvType cr = case _crType cr of
Avatar {} -> MvWalking 1.5
SlinkCrit {} -> NoMvType
ChaseCrit {} -> defaultChaseMvType & mvSpeed .~ 1.8
CrabCrit {} -> defaultChaseMvType & mvSpeed .~ 0.5
& mvTurnJit .~ 0.01
@@ -15,6 +16,7 @@ crMvType cr = case _crType cr of
AutoCrit -> defaultAimMvType
BarrelCrit {} -> defaultAimMvType
LampCrit {} -> defaultAimMvType
SlimeCrit {} -> NoMvType
defaultAimMvType :: CrMvType
defaultAimMvType =
src/Dodge/Creature/Picture.hs
+58 -7
View File
@@ -3,16 +3,12 @@ Drawing of creatures.
Takes into account damage etc.
-}
module Dodge.Creature.Picture (
basicCrPict,
deadScalp,
deadUpperBody,
deadFeet,
drawChaseCrit,
drawHoverCrit,
drawCrabCrit,
makeCorpse,
drawCreature,
) where
import Data.Foldable
import qualified Data.Strict.Tuple as ST
import RandomHelp
import Dodge.Base.Collide
import Control.Monad
@@ -37,6 +33,42 @@ import Shape
--import Shape
import ShapePicture
drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
case cr ^. crType of
_ | CrIsCorpse sp <- cr ^. crHP -> sp
_ | null (cr ^? crHP . _HP) -> mempty
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
ChaseCrit {} -> noPic $ drawChaseCrit w cr
Avatar {} -> basicCrPict m cr
SwarmCrit -> basicCrPict m cr
AutoCrit -> basicCrPict m cr
CrabCrit {} -> noPic $ drawCrabCrit w cr
HoverCrit{} -> noPic $ drawHoverCrit cr
SlinkCrit{} -> noPic $ drawSlinkCrit cr
SlimeCrit{} -> noPic $ drawSlimeCrit cr
where
fallrot = case cr ^? crStance . carriage . carDir of
Just q -> _1 . each . sfVs . each %~ Q.rotate q
_ -> id
drawSlimeCrit :: Creature -> Shape
drawSlimeCrit cr = colorSH green $ upperPrismPolyHalf Medium Undesired r $ polyCirc 6 r
& each %~ scaleAlong d s
& each %~ scaleAlong (vNormal d) (1 / s)
& each %~ rotateV (-cr ^. crDir)
where
r = cr ^?! crType . slimeRad
p = cr ^?! crType . slimeCompression
d = normalize p
s = norm p / r
-- assumes d is a unit vector
scaleAlong :: Point2 -> Float -> Point2 -> Point2
scaleAlong d s p = ((s - 1) * dot d p) *^ d + p
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
@@ -58,6 +90,14 @@ basicCrShape cr
crsize = 0.1 * crRad (cr ^. crType)
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
drawSlinkCrit :: Creature -> Shape
drawSlinkCrit cr = snd (foldl' f ((V3 0 0 0,Q.qid), mempty) $ cr ^?! crType . slinkSpine)
& each . sfColor .~ cskin ^?! skinUpper
where
cskin = crShape $ _crType cr
f ((p,q),sh) (p',q') = ((p,q) `Q.comp` (p',q'), sh <> (g p' & each . sfVs . each %~ Q.apply (p,q)))
g _ = upperPrismPoly Medium Important 2 $ polyCirc 6 10
drawHoverCrit :: Creature -> Shape
drawHoverCrit cr = colorSH (_skinHead cskin)
(overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
@@ -332,3 +372,14 @@ upperBody cr = arms cr <> torso cr
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
where
ps = polyCirc 3 10
lampCrSPic :: Float -> SPic
lampCrSPic h =
colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
ST.:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
src/Dodge/Creature/Radius.hs
+2
View File
@@ -15,3 +15,5 @@ crRad = \case
AutoCrit -> 10
BarrelCrit{} -> 10
LampCrit {} -> 3
SlinkCrit {} -> 10
SlimeCrit {_slimeRad = r} -> r
src/Dodge/Creature/Shape.hs
+2
View File
@@ -13,5 +13,7 @@ crShape = \case
HoverCrit {} -> Humanoid (greyN 0.9) (light blue) (greyN 0.3)
SwarmCrit -> Humanoid (greyN 0.9) (lightx4 yellow) (greyN 0.3)
AutoCrit -> Humanoid (greyN 0.9) (lightx4 red) (greyN 0.3)
SlinkCrit{} -> Humanoid (greyN 0.9) (dark . dark . dark $ orange) (greyN 0.3)
BarrelCrit {} -> Barreloid
LampCrit {} -> NonDrawnCreature
SlimeCrit {} -> Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3)
src/Dodge/Creature/Statistics.hs
+2
View File
@@ -48,6 +48,8 @@ crIntelligence cr = case cr ^. crType of
AutoCrit -> 20
BarrelCrit {} -> 0
LampCrit {} -> 0
SlinkCrit{} -> 5
SlimeCrit{} -> 1
getCrMoveSpeed :: LWorld -> Creature -> Int
src/Dodge/Creature/Update.hs
+117 -53
View File
@@ -1,16 +1,18 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where
import qualified Quaternion as Q
import Dodge.Creature.Picture
import Dodge.Base.You
import Control.Monad
import Dodge.Base.Collide
import Dodge.Creature.Radius
import Color
import Control.Monad
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Barreloid
import Dodge.Base.You
-- import Dodge.Base.NewID
import Dodge.Creature.Action
import Dodge.Creature.Picture
import Dodge.Creature.State
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Vocalization
@@ -28,6 +30,7 @@ import Geometry
import LensHelp
import Linear
import NewInt
import qualified Quaternion as Q
import RandomHelp
import Shape
import ShapePicture.Data
@@ -44,27 +47,74 @@ updateCreature cr
tocr = cWorld . lWorld . creatures . ix (_crID cr)
updateLivingCreature :: Creature -> World -> World
updateLivingCreature cr =
case _crType cr of
Avatar{} ->
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate cid
. yourControl
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
ChaseCrit{} -> \w ->
crUpdate cid . performActions cid $
over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
CrabCrit{} ->
crUpdate cid . performActions cid . crabCritInternal cid
AutoCrit {} -> crUpdate cid
SwarmCrit {} -> crUpdate cid
HoverCrit {} -> \w ->
crUpdate cid . performActions cid . hoverCritHoverSound cr $
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
updateLivingCreature cr = case _crType cr of
Avatar{} ->
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate cid
. yourControl
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
ChaseCrit{} -> \w ->
crUpdate cid . performActions cid $
over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
CrabCrit{} ->
crUpdate cid . performActions cid . crabCritInternal cid
AutoCrit{} -> crUpdate cid
SwarmCrit{} -> crUpdate cid
HoverCrit{} -> \w ->
crUpdate cid . performActions cid . hoverCritHoverSound cr $
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
SlinkCrit{} -> slinkCritUpdate cid
SlimeCrit{} -> slimeCritUpdate cid
where
cid = cr ^. crID
slimeCritUpdate :: Int -> World -> World
slimeCritUpdate cid w = w
& cWorld . lWorld . creatures . ix cid .~ mvslime
where
txy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
cr = w ^?! cWorld . lWorld . creatures . ix cid
cxy = cr ^. crPos . _xy
mvslime
| hasLOS cxy txy w = mvslime'
| otherwise = cr
mvslime' = cr & crType . slimeCompression .~ p' + x
& crPos . _xy +~ g (0.5*x)
& crType . slimeIsCompressing %~ (f . f')
& crDir .~ argV (txy-cxy)
g | cr ^?! crType . slimeIsCompressing = negate
| otherwise = id
s | cr ^?! crType . slimeIsCompressing = 2/3
| otherwise = 1.5
f | abs (norm v - norm p') < 0.1 = not
| otherwise = id
v = (s * r) *^ unitVectorAtAngle (cr ^. crDir)
r = crRad (cr ^. crType)
p = cr ^?! crType . slimeCompression
(p',f')
| dot p v > 0 && dot p v > dot p (vNormal v) && dot p v > dot p (-vNormal v) = (p, id)
| dot p (-v) > dot p (vNormal v) && dot p (-v) > dot p (-vNormal v) = (-p, id)
| dot p (vNormal v) > dot p (-vNormal v) = ((r*r/norm p) *^ normalize (vNormal p), not)
| otherwise = (-(r*r/norm p) *^ normalize (vNormal p), not)
x = 0.1 *^ normalize (v - p')
slinkCritUpdate :: Int -> World -> World
slinkCritUpdate cid w =
w
& cWorld
. lWorld
. creatures
. ix cid
. crType
. slinkSpine
. each
. _2
*~ Q.axisAngle (V3 0 1 0) (pi / 1000)
-- spineWalk :: [Point3Q]
-- spineWalk = replicate 15 (V3
hoverCritHoverSound :: Creature -> World -> World
hoverCritHoverSound cr w = fromMaybe w $ do
guard $ d < 100
@@ -93,7 +143,7 @@ crUpdate cid =
checkDeath cid
. doDamage cid
. invItemEffs cid
. updateCarriage cid -- stride appears to be updated elsewhere as well
. updateCarriage cid -- stride appears to be updated elsewhere as well
checkDeath :: Int -> World -> World
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
@@ -101,53 +151,66 @@ checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix c
checkDeath' :: Creature -> World -> World
checkDeath' cr w = case cr ^. crHP of
HP x | x > 0 -> w & tocr . crDamage .~ []
HP x | x > -200 && null (cr ^. crDeathTimer)
-> w & tocr %~ startDeathTimer
HP x | x > -200
,Just y <- cr ^. crDeathTimer
HP x
| x > -200 && null (cr ^. crDeathTimer) ->
w & tocr %~ startDeathTimer
HP x
| x > -200
, Just y <- cr ^. crDeathTimer
, y > 0 ->
w
& tocr . crDamage .~ []
& tocr . crDeathTimer . _Just -~ 1
& tocr
. crDamage
.~ []
& tocr
. crDeathTimer
. _Just
-~ 1
HP _ ->
w
& dropAll cr -- the order of these is possibly important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
& tocr . crStance . carriage %~ toDeathCarriage
& tocr
. crStance
. carriage
%~ toDeathCarriage
_ -> w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
startDeathTimer :: Creature -> Creature
startDeathTimer cr = cr
& crDeathTimer ?~ case cr ^. crType of
HoverCrit {} -> 0
_ -> 5
startDeathTimer cr =
cr
& crDeathTimer
?~ case cr ^. crType of
HoverCrit{} -> 0
_ -> 5
toDeathCarriage :: Carriage -> Carriage
toDeathCarriage = \case
Flying {} -> Falling Q.qid Q.qid
Flying{} -> Falling Q.qid Q.qid
Walking -> OnGround Q.qid
_ -> Falling Q.qid Q.qid
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage ->
sethp (CrIsCorpse $ scorchSPic thecorpse)
. dodeathsound CookDeath
Just PoisonDamage ->
sethp (CrIsCorpse $ poisonSPic thecorpse)
. dodeathsound PoisonDeath
Just PhysicalDamage
| _crPain cr > 300 ->
makeCrGibs cr
. sethp (CrDestroyed Gibbed)
. dodeathsound GibsDeath
_ ->
sethp (CrIsCorpse thecorpse)
. dodeathsound PlainDeath
corpseOrGib cr w =
w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage ->
sethp (CrIsCorpse $ scorchSPic thecorpse)
. dodeathsound CookDeath
Just PoisonDamage ->
sethp (CrIsCorpse $ poisonSPic thecorpse)
. dodeathsound PoisonDeath
Just PhysicalDamage
| _crPain cr > 300 ->
makeCrGibs cr
. sethp (CrDestroyed Gibbed)
. dodeathsound GibsDeath
_ ->
sethp (CrIsCorpse thecorpse)
. dodeathsound PlainDeath
where
dodeathsound dt = f dt . stopSoundFrom (CrMouth cid)
f dt w' = fromMaybe w' $ do
@@ -156,7 +219,8 @@ corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
return $
w'
& soundStart (CrMouth cid) (cr ^. crPos . _xy) sid Nothing
& randGen .~ g
& randGen
.~ g
cid = cr ^. crID
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
thecorpse = makeCorpse (w ^. randGen) cr
@@ -171,8 +235,8 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
--startFalling :: Creature -> Creature
--startFalling cr = case cr ^. crStance . carriage of
-- startFalling :: Creature -> Creature
-- startFalling cr = case cr ^. crStance . carriage of
-- Walking -> cr & crStance . carriage .~ Falling
-- _ -> cr & crStance . carriage .~ Falling
src/Dodge/Creature/Vocalization.hs
+4
View File
@@ -26,6 +26,8 @@ crWarningSounds cr = case cr ^. crType of
, seagullCry1S
, seagullCry2S
]
SlinkCrit{} -> mempty
SlimeCrit{} -> mempty
CrabCrit {} -> mempty
HoverCrit {} -> mempty
SwarmCrit -> mempty
@@ -39,6 +41,8 @@ crDeathSounds cr dt = case cr ^. crType of
ChaseCrit{} -> defaultDeathSounds dt
CrabCrit{} -> defaultDeathSounds dt
HoverCrit{} -> hoverDeathSounds dt
SlinkCrit{} -> defaultDeathSounds dt
SlimeCrit{} -> defaultDeathSounds dt
SwarmCrit -> mempty
AutoCrit -> mempty
BarrelCrit{} -> mempty
src/Dodge/Data/Creature/Misc.hs
+9
View File
@@ -66,6 +66,15 @@ data CreatureType
, _rFootPos :: Point2
}
| HoverCrit {_meleeCooldown :: Int}
| SlinkCrit
{ _meleeCooldown :: Int
, _slinkSpine :: [Point3Q]
}
| SlimeCrit
{ _slimeRad :: Float
, _slimeCompression :: Point2
, _slimeIsCompressing :: Bool
}
| SwarmCrit
| AutoCrit
| BarrelCrit {_barrelType :: BarrelType}
src/Dodge/Machine/Draw.hs
+5 -12
View File
@@ -1,6 +1,5 @@
module Dodge.Machine.Draw (drawMachine,mcColor) where
module Dodge.Machine.Draw (drawMachine, mcColor) where
import Linear
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -11,6 +10,7 @@ import Dodge.Placement.TopDecoration
import Dodge.Room.Foreground
import Dodge.Terminal.Color
import Geometry
import Linear
import Picture
import Shape
import ShapePicture
@@ -60,23 +60,16 @@ terminalShape lw mc = fold $ do
<> screenbackground (getcol term)
where
tps = [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
sps = [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
getcol term = fromMaybe black $ termScreenColor term
screenbackground col =
colorSH
col
$ prismBox
Small
Typical
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
$ prismBox Small Typical sps (sps & each . _z -~ 1)
drawBaseMachine :: Float -> Machine -> SPic
drawBaseMachine h mc =
noPic
. colorSH (mcColor mc)
. upperBox Medium Typical h
. square
$ 10
noPic . colorSH (mcColor mc) . upperBox Medium Typical h . square $ 10
mcColor :: Machine -> Color
mcColor mc = case mc ^. mcType of
src/Dodge/Render/ShapePicture.hs
-29
View File
@@ -1,7 +1,6 @@
--{-# LANGUAGE LambdaCase #-}
module Dodge.Render.ShapePicture (worldSPic) where
import qualified Quaternion as Q
import Dodge.Debug
import Control.Lens
import Data.Foldable
@@ -109,34 +108,6 @@ drawPlasmaBall pb =
. setLayer BloomLayer
$ circleSolidCol green white 5
drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
case cr ^. crType of
_ | CrIsCorpse sp <- cr ^. crHP -> sp
_ | null (cr ^? crHP . _HP) -> mempty
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
ChaseCrit {} -> noPic $ drawChaseCrit w cr
Avatar {} -> basicCrPict m cr
SwarmCrit -> basicCrPict m cr
AutoCrit -> basicCrPict m cr
CrabCrit {} -> noPic $ drawCrabCrit w cr
HoverCrit{} -> noPic $ drawHoverCrit cr
where
fallrot = case cr ^? crStance . carriage . carDir of
Just q -> _1 . each . sfVs . each %~ Q.rotate q
_ -> id
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
where
ps = polyCirc 3 10
lampCrSPic :: Float -> SPic
lampCrSPic h =
colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
shiftDraw fpos fdir fdraw x =
uncurryV translateSPxy (fpos x)
src/Dodge/Room/Tutorial.hs
+3 -3
View File
@@ -56,8 +56,8 @@ tutAnoTree :: State LayoutVars MTRS
tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, chasmSpitTerminal
-- , corDoor
-- , chasmSpitTerminal
, corDoor
, loadAmmoTut
, corDoor
@@ -431,7 +431,7 @@ tutLight = do
crabRoom :: State LayoutVars Room
crabRoom = (putSingleLight =<< roomNgon 6 150)
<&> rmPmnts .:~ psPtPl (PS 100 0) (PutCrit crabCrit)
<&> rmPmnts .:~ psPtPl (PS 40 0) (PutCrit slimeCrit)
loadAmmoTut :: State LayoutVars (MetaTree Room String)
loadAmmoTut = do
src/Dodge/TestString.hs
+4 -3
View File
@@ -41,9 +41,10 @@ tocrs :: (IM.IntMap Creature
tocrs = uvWorld . cWorld . lWorld . creatures
testStringInit :: Universe -> [String]
testStringInit u = u ^.. tocrs . ix 3 . crPos . _xy . to show
<> u ^.. tocrs . ix 3 . crType . lFootPos . to show
<> u ^.. tocrs . ix 3 . crType . rFootPos . to show
testStringInit u = u ^.. tocrs . ix 1 . crPos . _xy . to show
<> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
<> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
<> u ^.. tocrs . ix 1 . crDir . to show
-- where
-- tocr = uvWorld . cWorld . lWorld . creatures . ix 0
-- f = fromMaybe 0
src/Shader/Poke.hs
+16 -7
View File
@@ -133,11 +133,12 @@ pokeShapeObj ::
IO (Int, Int, Int)
{-# INLINE pokeShapeObj #-}
pokeShapeObj shadowtest ptr iptr ieptr counts surf@(Surface shtype shVerts col _ _) = case shtype of
FlatFaces size -> pokeBox blockshadows col size ptr iptr ieptr counts shVerts
RoundedFaces size -> pokeRoundedFaces blockshadows col size ptr iptr ieptr counts shVerts
Cylinder size -> pokeCylinder blockshadows col size ptr iptr ieptr counts shVerts
FlatFaces size -> pokeBox t col size ptr iptr ieptr counts shVerts
RoundedFaces size -> pokeRoundedFaces t col size ptr iptr ieptr counts shVerts
Cylinder size -> pokeCylinder t col size ptr iptr ieptr counts shVerts
Cone n -> pokeCone t col n ptr iptr ieptr counts shVerts
where
blockshadows = shadowtest surf
t = shadowtest surf
pokeRoundedFaces ::
Bool ->
@@ -167,7 +168,7 @@ pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = d
where
xdata
| sfid = 0 -- this records whether the shadow should be shown or not
-- honestly, I think things where faster without this
-- honestly, I think things were faster without this
| otherwise = 1
pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined
@@ -211,11 +212,19 @@ pokeRoundedCurve xdata col ptr tc bc = go True
go False (x : xs) n = pokeJustV xdata bc col ptr n x >>= go True xs
go _ [] n = return n
pokeCone :: Bool -> Color -> Int -> Ptr Float -> Ptr GLuint -> Ptr GLuint
-> (Int,Int,Int) -> [Point3] -> IO (Int,Int,Int)
pokeCone t c n ptr iptr ieptr (nv,nsi,nei) (p:ps) = do
nv' <- undefined t c n ptr iptr ieptr (nv,nsi,nei) (p:ps)
nsi' <- undefined
nei' <- undefined
return (nv', nsi', nei')
pokeCone _ _ _ _ _ _ _ _ = undefined
-- I am not completely sure the normals are correct here
-- they assume that we do actually have a cylinder, with normals for the caps
-- that can be determined by the first two vertices
pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> [Point3] -> Int
-> IO Int
pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> [Point3] -> Int -> IO Int
{-# INLINE pokeCylinderCaps #-}
pokeCylinderCaps xdata col ptr (a:b:as) = go True (a:b:as)
where
src/Shape/Data.hs
+1
View File
@@ -12,6 +12,7 @@ data ShapeType
= FlatFaces { _topBoxSize :: Int }
| RoundedFaces { _shapeHalfSize :: Int }
| Cylinder { _cylinderSize :: Int }
| Cone {_coneBaseNum :: Int}
deriving (Eq, Ord, Show, Read)
-- for RoundedFaces, the first vertex in _sfVs should be the center of the top
-- plane, the second should be the center of the bottom plane.