diff --git a/shader/twoD/basicTweakZ.frag b/shader/twoD/basicTweakZ.frag new file mode 100644 index 000000000..aedc197fd --- /dev/null +++ b/shader/twoD/basicTweakZ.frag @@ -0,0 +1,7 @@ +#version 430 core +in vec4 vColor; +out vec4 fColor; +void main() +{ + fColor = vColor; +} diff --git a/shader/twoD/basicTweakZ.vert b/shader/twoD/basicTweakZ.vert new file mode 100644 index 000000000..b371bf9d4 --- /dev/null +++ b/shader/twoD/basicTweakZ.vert @@ -0,0 +1,12 @@ +#version 430 core +layout (location = 0) in vec4 position; +layout (location = 1) in vec4 color; +layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ; +out vec4 vColor; +void main() +{ + vec4 posxy = theMat * vec4(position.xyz,1); + vec4 posz = theMat * vec4(position.xyw,1); + gl_Position = vec4(posxy.xy,posz.z,1); + vColor = color; +} diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index d47f4d1d4..1645a9175 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -171,7 +171,7 @@ startInventory = IM.fromList (zip [0..20] ,boosterGun ,remoteLauncher ,grenade - ,spawnGun lamp + ,spawnGun (lamp 20) ,lasGun ,flamer ,poisonSprayer diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 03f68f8cc..b3141988e 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -26,29 +26,29 @@ import Control.Lens defaultInanimate :: Creature defaultInanimate = defaultCreature & crActionPlan .~ Inanimate -lamp :: Creature -lamp = defaultInanimate - { _crUpdate = initialiseLamp +lamp :: Float -> Creature +lamp h = defaultInanimate + { _crUpdate = initialiseLamp h , _crHP = 100 - , _crPict = picAtCrPos lampPic + , _crPict = picAtCrPos (lampPic h) , _crRad = 3 , _crMass = 3 } -lampPic :: Picture -lampPic = pictures - [ pictures . map (Poly3D 0 . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 99 - , setDepth (100) $ color white $ circleSolid 3 +lampPic :: Float -> Picture +lampPic h = pictures + [ pictures . map (Poly3D 0 . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 (h-1) + , setDepth h $ color white $ circleSolid 3 ] -initialiseLamp :: CRUpdate -initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp i) +initialiseLamp :: Float -> CRUpdate +initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i) where i = IM.newKey $ _lightSources $ f w -- to give different lights different keys - addLS = over lightSources (IM.insert i (lightAt (x,y,20) i)) + addLS = over lightSources (IM.insert i (lightAt (x,y,h) i)) (x,y) = _crPos cr -updateLamp :: Int -> CRUpdate -updateLamp i = unrandUpdate handleLS internalUpdate +updateLamp :: Float -> Int -> CRUpdate +updateLamp h i = unrandUpdate handleLS internalUpdate where handleLS cr w | _crHP cr < 0 = explosionFlashAt cPos @@ -56,7 +56,7 @@ updateLamp i = unrandUpdate handleLS internalUpdate | otherwise = w & lightSources . ix i . lsPos .~ f cPos where cPos = _crPos cr - f (x,y) = (x,y,120) + f (x,y) = (x,y,h) internalUpdate cr | _crHP cr < 0 = Nothing | otherwise = Just $ doDamage cr diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index b05e6cad2..909e3bacc 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -16,6 +16,7 @@ import Dodge.Creature.Test import Dodge.Item.Data import Picture import Geometry +import Geometry.Vector3D import Control.Lens import Data.List @@ -29,12 +30,13 @@ basicCrPict col cr w = pictures $ targetingPic ++ [ tr . setDepth 0 $ color yellow $ circleSolid 10 , tr . piercingMod $ bluntScale $ naked col cr - , tr $ waist col + , tr $ torso (light4 col) (0,-crad) (0,crad) , trFeet $ feet cr , tr $ arms col cr , tr $ drawEquipment cr ] where + crad = _crRad cr targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just) tr = uncurry translate (_crPos cr) . rotate (_crDir cr) @@ -55,9 +57,6 @@ basicCrPict col cr w = pictures $ _ -> id pastDams = _crPastDamage $ _crState cr -waist :: Color -> Picture -waist col = setDepth 10 . color (light4 col) . scale 0.5 1 $ circleSolid 8 - feet :: Creature -> Picture feet cr = case cr ^? crStance . carriage of Just (Walking sa LeftForward) -> setL @@ -99,7 +98,15 @@ arms col cr f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen aimingTwist = crIsAiming' cr -- && crIt ^? itAimStance == Just TwoHandTwist --crIt = _crInv cr IM.! _crInvSel cr - + +torso :: Color -> Point2 -> Point2 -> Picture +torso col x y = color col $ pictures + [ poly3 [addZ 20 x, addZ 12 v, addZ 12 ((0,0) -.- v), addZ 20 y] + , setDepth 12 . rotate a . scale 1 1 $ circleSolid $ magV v + ] + where + v = 0.25 *.* (x -.- y) + a = argV v naked :: Color -> Creature -> Picture naked col cr @@ -125,7 +132,7 @@ naked col cr , shoulderH . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr ] where - fhead = setDepth 30 $ circleSolid $ crad * 0.5 + fhead = setDepth 22 $ circleSolid $ crad * 0.5 shoulderH = setDepth 20 twistA = negate 1 aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 445d03547..d01993734 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -93,6 +93,7 @@ movementSideEff cr w Just (Boosting v) -> makeFlameletTimed (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi)) + 20 (momentum +.+ 1 *.* rotateV randDir (vInverse v)) Nothing 1 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4408981c8..2b7c49227 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -355,6 +355,18 @@ data Particle , _btTimer' :: Int , _btHitEffect' :: HitEffect } + | PtZ + { _ptDraw :: Particle -> Picture + , _ptUpdate' :: World -> Particle -> (World, Maybe Particle) + , _btVel' :: Point2 + , _btColor' :: Color + , _btPos' :: Point2 + , _btPassThrough' :: Maybe Int + , _btWidth' :: Float + , _btTimer' :: Int + , _btHitEffect' :: HitEffect + , _ptZ :: Float + } | Pt' { _ptDraw :: Particle -> Picture , _ptUpdate' :: World -> Particle -> (World, Maybe Particle) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 3775749d5..87f0129cd 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -105,6 +105,6 @@ dropLight w = placeLS ls dec pos 0 w dec = onLayer PtLayer $ color white $ circleSolid 8 dropLight' :: World -> World -dropLight' w = placeCr lamp pos 0 w +dropLight' w = placeCr (lamp 30) pos 0 w where pos = _crPos(you w) diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index b63bad80d..154e35c7b 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -27,8 +27,8 @@ pictureWeaponOnAim p cr posInInv = handD holsteredWep | otherwise = blank where - shoulderD = setDepth $ negate 0.005 - handD = setDepth 0.01 + shoulderD = setDepth 20.5 + handD = setDepth 15 isSelected = _crInvSel cr == posInInv drawnWep = uncurry translate (_crRad cr,0) p twistWep = uncurry translate (0.5 * _crRad cr,0) p diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index bd47f90fd..43acb1828 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -546,10 +546,10 @@ remoteShellPic :: Int -- ^ Timer -> Picture remoteShellPic t - | rem (t+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + | rem (t+200) 20 < 9 = setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] | otherwise = pictures - [ onLayer UPtLayer $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] - , setLayer 1 $ onLayer HPtLayer $ color col $ circleSolid 3 + [ setDepth 20 $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + , setLayer 1 . setDepth 20.5 . color col $ circleSolid 3 ] where col | t > (-99) = green @@ -797,7 +797,7 @@ moveRemoteShell cid itid pj w ) & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 & smokeGen - & makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 | time > -200 = case thingHit of Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> w diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs index b91542e8a..2204186c4 100644 --- a/src/Dodge/Item/Weapon/Laser.hs +++ b/src/Dodge/Item/Weapon/Laser.hs @@ -3,7 +3,7 @@ module Dodge.Item.Weapon.Laser where import Dodge.Data import Dodge.Picture -import Dodge.Picture.Layer +--import Dodge.Picture.Layer import Dodge.Item.Attachment.Data --import Dodge.Base import Dodge.SoundLogic @@ -56,7 +56,7 @@ moveLaser -> (World, Maybe Particle) moveLaser phaseV pos dir w pt = ( set randGen g $ hitEffect w - , Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 } + , Just pt {_ptDraw = const pic ,_ptUpdate' = ptTimer' 0 } ) where xp = pos +.+ 800 *.* unitVectorAtAngle dir @@ -106,7 +106,7 @@ moveLaser phaseV pos dir w pt Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p)) (reflectDir wl) Nothing _ -> id - pic = pictures + pic = setDepth 20 $ pictures [ fadeLine pos (head ps) 0.2 40 yellow , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 3ffe2ce25..cb630d7e8 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -98,7 +98,7 @@ doThrust pj w = w & randGen .~ g & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 - & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 & smokeGen where accel = _pjAcc pj @@ -172,16 +172,11 @@ reduceSpinBy :: Float -> Projectile -> World -> World reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x shellPic :: Projectile -> Picture -shellPic pj - | t > 40 = onLayerL [levLayer CrLayer - 2] - $ uncurry translate pos $ rotate (argV accel) basePic - | otherwise = onLayer PtLayer $ uncurry translate pos $ rotate (argV accel) basePic +shellPic pj = setDepth 20 . uncurry translate pos $ rotate (argV accel) basePic where basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] accel = _pjAcc pj pos = _pjPos pj - t = _pjTimer pj - pjEffTimeRange :: (Int,Int) diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs index 2fecfb8d1..edfd434d6 100644 --- a/src/Dodge/LightSources.hs +++ b/src/Dodge/LightSources.hs @@ -14,7 +14,7 @@ lightAt (x,y,z) i = LS {_lsID = i ,_lsPos = (x,y,z) ,_lsDir = 0 - ,_lsRad = 500 + ,_lsRad = 700 ,_lsIntensity = 0.75 } basicLS :: PSType diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Particle/Bullet/Draw.hs index 589cf69ba..de4f94306 100644 --- a/src/Dodge/Particle/Bullet/Draw.hs +++ b/src/Dodge/Particle/Bullet/Draw.hs @@ -5,6 +5,6 @@ import Dodge.Data import Picture drawBul :: Particle -> Picture -drawBul pt = setLayer 1 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) +drawBul pt = setLayer 1 . setDepth 20 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) where thecolor = _btColor' pt diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 75f867749..13f05f27c 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -118,7 +118,7 @@ bulIncCr' bt p cr w sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt v = evalState (randInCirc 1) $ _randGen w - incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20) + incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20) {- | Creates a shockwave when hitting a creature. -} bulConCr' :: Particle -> Point2 -> Creature -> World -> World bulConCr' bt p cr w @@ -172,7 +172,7 @@ bulIncWall' bt p wl w = damageBlocksBy 5 wl $ incFlamelets w pOut = p +.+ safeNormalizeV (sp -.- p) wallV = uncurry (-.-) (_wlLine wl) reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) - incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20) + incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20) {- | Create a shockwave on wall-} bulConWall' :: Particle diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index d56c2892e..859e951f5 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -11,7 +11,7 @@ import Control.Lens aGenBulAt :: Maybe Int -- ^ Pass-through creature id -> Point2 -- ^ Start position - -> Point2 -- ^ Velocity + -> Point2 -- ^ Velocity -> HitEffect -> Float -- ^ Bullet width -> Particle diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs index 9f483e3c5..5ee23f26a 100644 --- a/src/Dodge/Picture.hs +++ b/src/Dodge/Picture.hs @@ -43,7 +43,7 @@ wedgeOfThickness t x y n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b)) verticalPipe :: Float -> Color -> Point2 -> Float -> Float -> Picture -verticalPipe w col (xx,xy) za zb = pictures $ map (poly3D . f) ps +verticalPipe w col (xx,xy) za zb = pictures $ map (poly3Col . f) ps where x = (xx,xy,0) xs = map (\(a,b) -> x +.+.+ (a,b,za)) [(w,0),(0,w),(-w,0),(0,-w)] diff --git a/src/Dodge/RandomHelp.hs b/src/Dodge/RandomHelp.hs index ac109968e..8adde7293 100644 --- a/src/Dodge/RandomHelp.hs +++ b/src/Dodge/RandomHelp.hs @@ -3,6 +3,7 @@ Helpers for random generation. -} module Dodge.RandomHelp where import Geometry +import Geometry.Vector3D import Geometry.Data import System.Random @@ -68,6 +69,26 @@ randInCirc maxRad = do rad <- state $ randomR (0,maxRad) ang <- state $ randomR (0,2*pi) return $ rad *.* unitVectorAtAngle ang +randOnUnitSphere :: RandomGen g => State g Point3 +randOnUnitSphere = do + z <- state $ randomR (negate 1,1) + longitude <- state $ randomR (0, 2*pi) + let (x,y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude + return (x,y,z) + +randOnHemisphere :: RandomGen g => State g Point3 +randOnHemisphere = do + z <- state $ randomR (0,1) + longitude <- state $ randomR (0, 2*pi) + let (x,y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude + return (x,y,z) + +randInHemisphere :: RandomGen g => State g Point3 +randInHemisphere = do + p <- randOnHemisphere + r <- state $ randomR (0,1) + return $ r *.*.* p + randInRect :: RandomGen g => Float -> Float -> State g Point2 randInRect w h = do x <- state $ randomR (0,w) y <- state $ randomR (0,h) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index c7da0435b..9e8f77a7e 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -64,7 +64,7 @@ doDrawing pdata w = do depthFunc $= Just Less let scPol = screenPolygon w -- draw the lightmap. Probably changes the bound framebufferObject - createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms + createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints (foregroundPics w) scPol clear [DepthBuffer] @@ -95,6 +95,11 @@ doDrawing pdata w = do blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One)) depthFunc $= Just Lequal _ <- renderFoldable pdata $ picToLTree (Just 1) pic + depthMask $= Disabled + _ <- renderFoldable pdata $ picToLTree (Just 3) pic + _ <- renderFoldable pdata $ picToLTree (Just 4) pic + _ <- renderFoldable pdata $ picToLTree (Just 5) pic + depthMask $= Enabled -- reset blend so that light map applies again -- allows us to be certain these elements are drawn on top of those before, -- in case we want transparency effects diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs index 50329f16d..7cc9ed361 100644 --- a/src/Dodge/Room/Placement.hs +++ b/src/Dodge/Room/Placement.hs @@ -13,7 +13,7 @@ import Data.List import Control.Lens putLamp :: PSType -putLamp = PutCrit lamp +putLamp = PutCrit (lamp 90) singleBlock :: Point2 -> [Placement] singleBlock a = diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 2e3292b0e..46e60b367 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -26,7 +26,7 @@ makeCloudAt rad t drawFunc p w = w & clouds %~ IM.insert i theCloud drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture drawCloudWith radMult fadet col cl = setLayer 2 - . setDepth (-0.02) + . setDepth 25 $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl) where a = min 1 $ fromIntegral (_clTimer cl) / fadet diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 75a2b63b2..86d607c2c 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -12,6 +12,7 @@ import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Dodge.WorldEvent.Shockwave import Geometry +import Geometry.Vector3D import Picture import Control.Monad.State @@ -71,14 +72,16 @@ makeExplosionAt p w $ makeShockwaveAt [] p 50 10 1 white w where fVs = replicateM 75 (randInCirc 1) & evalState $ _randGen w - fPs' = replicateM 75 (randInCirc 15) & evalState $ _randGen w + fPs'' = replicateM 75 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w + (fPs',zs) = let (a,b,c) = unzip3 fPs'' + in (zip a b, c) fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs' inversePushOut v = (15 - magV v) * 0.01 *.* v fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' sizes = randomRs (2,6) $ _randGen w times = randomRs (20,25) $ _randGen w - mF q v size time = makeFlameletTimed q v Nothing size time - newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times + mF q z v size time = makeFlameletTimed q z v Nothing size time + newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times addFlames w' = foldr ($) w' newFs pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 2017a1f11..e9716ce4a 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -49,7 +49,7 @@ Shockwave picture. drawShockwave :: Particle -> Picture drawShockwave pt = pic where - pic = onLayer PtLayer $ uncurry translate p + pic = setDepth 20 . uncurry translate p $ color (_btColor' pt) $ thickCircle rad thickness p = _btPos' pt r = _btRad' pt diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 284f7ae00..5d345693d 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -20,6 +20,7 @@ import Dodge.RandomHelp --import Dodge.Debug import Picture import Geometry +--import Geometry.Data import qualified IntMapHelp as IM import Control.Lens @@ -56,9 +57,9 @@ drawFlame rotd pt = thePic ep = _btPos' pt thePic = pictures [ glow - , aPic prot2 0.002998 (scaleChange + 1,2) red - , aPic prot 0.002996 (scaleChange + 0.5,1.5) orange - , aPic prot3 0.002994 (scaleChange,1) white + , aPic prot2 18 (scaleChange + 1,2) red + , aPic prot 19 (scaleChange + 0.5,1.5) orange + , aPic prot3 20 (scaleChange,1) white ] aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture aPic offset depth (scalex,scaley) col @@ -121,31 +122,80 @@ moveFlame rotd w pt +.+ (0.2 *.* vel) smokeCol = fst $ randomR (0.2,0.5) (_randGen w) smokeGen = makeFlamerSmokeAt smokeCol ep + makeFlameletTimed :: Point2 -- ^ Position + -> Float -- ^ z position -> Point2 -- ^ Velocity -> Maybe Int -- ^ Creature id -> Float -- ^ Size -> Int -- ^ Timer -> World -> World -makeFlameletTimed pos vel maycid size time w = w +makeFlameletTimed (x,y) z vel maycid size time w = w & randGen .~ g & particles %~ (theFlamelet :) where - theFlamelet = Pt' - { _ptDraw = drawFlamelet rot + theFlamelet = PtZ + { _ptDraw = drawFlameletZ rot , _ptUpdate' = moveFlamelet , _btVel' = vel , _btColor' = red - , _btPos' = pos + , _btPos' = (x,y) , _btPassThrough' = maycid , _btWidth' = size , _btTimer' = time , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + , _ptZ = z } (rot ,g) = randomR (0,3) $ _randGen w +drawFlameletZ + :: Float -- ^ Rotation + -> Particle + -> Picture +drawFlameletZ rot pt = pictures + [ setLayer 5 pic + , setLayer 4 pi2 + , setLayer 3 piu + , setLayer 1 glow + ] + where + z = _ptZ pt + sp = _btPos' pt + vel = _btVel' pt + ep = sp +.+ vel + size = _btWidth' pt + siz2 = size + 0.2 + time = _btTimer' pt + glow = setDepth 19 $ uncurry translate ep + $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 + piu = setDepth (z + 20) + . uncurry translate ep + . color (dark red) + . rotate (negate (rot - 0.1 * fromIntegral time)) + . scale s1 s1 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pi2 = setDepth (z + 20) + . uncurry translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + orange (dark red) + ) + . rotate (negate (rot + 0.2 * fromIntegral time)) + . scale s2 s2 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pic = setDepth (z + 20) + . uncurry translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + white (dark red) + ) + . rotate (negate ( 0.1 * fromIntegral time + rot)) + . scale sc sc + $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] + sc = (*) 2 $ log $ 1 + fromIntegral time / 20 + s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 + s2 = 0.5 * (sc + s1) + drawFlamelet :: Float -- ^ Rotation -> Particle @@ -158,16 +208,16 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] size = _btWidth' pt siz2 = size + 0.2 time = _btTimer' pt - glow = setDepth 0.336 $ uncurry translate ep + glow = setDepth 19 $ uncurry translate ep $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 - piu = setDepth 0.334 + piu = setDepth 20 . uncurry translate ep . color (dark red) . rotate (negate (rot - 0.1 * fromIntegral time)) . scale s1 s1 . polygon $ rectNSWE siz2 (-siz2) (-siz2) siz2 - pi2 = setDepth 0.332 + pi2 = setDepth 20.2 . uncurry translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) orange (dark red) @@ -176,7 +226,7 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] . scale s2 s2 . polygon $ rectNSWE siz2 (-siz2) (-siz2) siz2 - pic = setDepth 0.33 + pic = setDepth 20.4 . uncurry translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) white (dark red) @@ -251,10 +301,10 @@ drawTeslaArc pt = pic where ps' = _ptPoints pt pic = setLayer 1 $ pictures - [ onLayer PtLayer $ color (_ptColor pt) $ line ps' - , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' - , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' - , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' + [ setDepth 20.5 $ color (_ptColor pt) $ line ps' + , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' + , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' + , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' ] -- todo: fix electrical damage location moveTeslaArc diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index f45dd633f..ef0d59663 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -115,12 +115,10 @@ Identical to detV. -} crossV :: Point2 -> Point2 -> Float crossV (ax,ay) (bx,by) = ax*by - ay*bx {- | TO CHECK Orthographic projection of one vector onto another. -} -projV - :: Point2 - -> Point2 - -> Point2 +projV :: Point2 -> Point2 -> Point2 projV fromv onv | den == 0 = error "tried projecting onto zero vector" | otherwise = (fromv `dotV` onv) / den *.* onv where den = onv `dotV` onv + diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index 58edeeb53..ff52a1343 100644 --- a/src/Geometry/Vector3D.hs +++ b/src/Geometry/Vector3D.hs @@ -4,6 +4,8 @@ module Geometry.Vector3D import Geometry.Vector import Geometry.Data +import Data.List + infixl 6 +.+.+, -.-.- infixl 7 *.*.* @@ -56,3 +58,33 @@ magV3 (x,y,z) = sqrt $ x^i + y^i + z^i normalizeV3 :: Point3 -> Point3 normalizeV3 (0,0,0) = (0,0,0) normalizeV3 p = (1 / magV3 p) *.*.* p + +addZ :: Float -> Point2 -> Point3 +addZ z (x,y) = (x,y,z) + +orderAround3 + :: Point3 -- ^ Vector to order around + -> [Point3] + -> [Point3] +orderAround3 v ps = sortOn (argV . prj) ps + where + xdir = crossProd v (head ps) + ydir = crossProd v xdir + prj p = (dotV3 xdir p, dotV3 ydir p) + +vCen3 :: [Point3] -> Point3 +vCen3 ps = (1 / fromIntegral (length ps)) *.*.* foldr (+.+.+) (0,0,0) ps + +dotV3 + :: Point3 + -> Point3 + -> Float +dotV3 (x,y,z) (a,b,c) = x*a + y*b + z*c + +projV3 + :: Point3 + -> Point3 + -> Point3 +projV3 = undefined + + diff --git a/src/Picture.hs b/src/Picture.hs index 6d427d674..d7c3fed1e 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE TupleSections #-} module Picture ( module Picture.Data , polygon + , polygonZ , polygonCol - , poly3D + , poly3 + , poly3Col , bezierQuad , arc , arcSolid @@ -63,13 +66,21 @@ polygon :: [Point2] -> Picture {-# INLINE polygon #-} polygon = Polygon 0 +polygonZ :: [Point2] -> Float -> Picture +{-# INLINE polygonZ #-} +polygonZ = PolygonZ 0 + polygonCol :: [(Point2,RGBA)] -> Picture {-# INLINE polygonCol #-} polygonCol = PolygonCol 0 -poly3D :: [(Point3,RGBA)] -> Picture -{-# INLINE poly3D #-} -poly3D = Poly3D 0 +poly3 :: [Point3] -> Picture +{-# INLINE poly3 #-} +poly3 = poly3Col . map (, black) + +poly3Col :: [(Point3,RGBA)] -> Picture +{-# INLINE poly3Col #-} +poly3Col = Poly3D 0 -- note that much of work computing the width of the bezier curve is done here bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 403c9040a..a98c52824 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -14,11 +14,12 @@ import Geometry.Data --import Control.Monad data RenderType - = RenderPoly [(Point3,Point4)] - | RenderBezQ [(Point3,Point4,Point4)] - | RenderText [(Point3,Point4,Point2)] - | RenderArc [(Point3,Point4,Point3)] - | RenderLine [(Point3,Point4)] + = RenderPoly [(Point3,Point4)] + | RenderPolyZ [(Point3,Point4,Float)] + | RenderBezQ [(Point3,Point4,Point4)] + | RenderText [(Point3,Point4,Point2)] + | RenderArc [(Point3,Point4,Point3)] + | RenderLine [(Point3,Point4)] | RenderEllipse [(Point3,Point4)] | Render3 [Point3] | RenderConst @@ -79,6 +80,7 @@ data Picture = Blank | Text Int String | Polygon Int [Point2] + | PolygonZ Int [Point2] Float | BezierQuad Int [(Point2,RGBA,Point2,Point2)] | PolygonCol Int [(Point2,RGBA)] | Poly3D Int [(Point3,RGBA)] diff --git a/src/Picture/Tree.hs b/src/Picture/Tree.hs index d2e9e37ff..c96f575c8 100644 --- a/src/Picture/Tree.hs +++ b/src/Picture/Tree.hs @@ -21,6 +21,8 @@ picToLTree {-# INLINE picToLTree #-} picToLTree mx (Polygon i ps) = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black +picToLTree mx (PolygonZ i ps z) + = filtB mx i $ LLeaf $ RenderPolyZ $ zip3 (map zeroZ $ polyToTris ps) (repeat black) (repeat z) picToLTree mx (PolygonCol i vs) = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs where @@ -85,6 +87,7 @@ overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs overPos f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs overPos f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs +overPos f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (f a,b,c)) vs overPos _ _ = undefined overCol :: (Point4 -> Point4) -> RenderType -> RenderType @@ -95,6 +98,7 @@ overCol f (RenderEllipse vs) = RenderEllipse $ map (second f) vs overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs overCol f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (a,f b,c)) vs overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs +overCol f (RenderPolyZ vs) = RenderPolyZ $ map (\(a,b,c) -> (a,f b,c)) vs overCol _ _ = undefined stringToList :: String -> [(Point3,Point4,Point2)] diff --git a/src/Polyhedra/Data.hs b/src/Polyhedra/Data.hs index 7a3bd717b..1ba75d399 100644 --- a/src/Polyhedra/Data.hs +++ b/src/Polyhedra/Data.hs @@ -5,6 +5,8 @@ module Polyhedra.Data import Geometry.Data import Control.Lens +import qualified Data.Map as M +--import qualified Data.IntSet as IS -- | Polyhedra are represented as a list of faces. -- Each face is a list of points (and colours) that are assumed to lie on a plane, and be -- ordered to form an anticlockwise convex polygon within that plane. @@ -12,4 +14,14 @@ data Polyhedra = Polyhedron { _pyFaces :: [[(Point3,Point4)]] } +-- | Describe a polygon as a map from vertex indices to a positiong and list of faces. +-- The list of faces is assumed to be ordered in clockwise direction around the vertex. +-- The vertices of the faces are assumed to start with a point adjacent to the +-- key vertex and to be listed anticlockwise around the center of the face. +-- The key vertex is not included in the list. +data VF a = VF + { _vertices :: M.Map a (Point3, [[a]]) + } + makeLenses ''Polyhedra +makeLenses ''VF diff --git a/src/Polyhedra/Geodesic.hs b/src/Polyhedra/Geodesic.hs new file mode 100644 index 000000000..0e1ed76ef --- /dev/null +++ b/src/Polyhedra/Geodesic.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE TupleSections #-} +module Polyhedra.Geodesic + where +import Geometry.Data +import Geometry.Vector3D +import Polyhedra.Data + +import Data.List +import qualified Data.Map as M + +icosahedronPoints :: [Point3] +icosahedronPoints = concat + [ [(0,one,gr),(one, gr, 0),(gr, 0, one)] + | one <- [-1,1] + , gr <- [negate (1 + sqrt 5)/2, (1 + sqrt 5)/2 ] + ] + +icosohedronFaces :: [[Point3]] +icosohedronFaces = map orderFace $ + rectEdgeFaces ++ map (map rotTrip) rectEdgeFaces ++ map (map (rotTrip . rotTrip)) rectEdgeFaces + ++ addSym negFst (addSym negSnd $ addSym negThd rectCornFace) + where + rectEdgeFaces = addSym negThd $ addSym negFst rectEdgeFace + rectEdgeFace = [[ (gr,1,0) , (gr,negate 1,0) , (1,0,gr) ]] + rectCornFace = [[ (gr,1,0) , (0,gr,1) , (1,0,gr) ]] + addSym f faces = map (map f) faces ++ faces + negFst (x,y,z) = (negate x,y,z) + negSnd (x,y,z) = (x,negate y,z) + negThd (x,y,z) = (x,y,negate z) + rotTrip (x,y,z) = (z,x,y) + gr = (1 + sqrt 5) / 2 :: Float + orderFace ps = undefined orderAround3 ps + +-- | Assuming that this works, note that it relies heavily on the ordering of +-- faces adjacent to a vertex (clockwise around the vertex) +-- and vertices on faces (anticlockwise around center of face). +truncate :: Ord a => VF a -> VF (a,a) +truncate vf = VF + { _vertices = M.fromList . concatMap f $ M.toList vmap + } + where + vmap = _vertices vf + f (i, (pos, faces)) = map (g i pos faces) faces + g i pos faces (j:_) = + ((i,j) + , (0.5 *.*.* (pos +.+.+ fst (vmap M.! j)) + ,truncFaces i j faces + ) + ) + g _ _ _ _ = undefined + +truncFaces :: Eq a => a -> a -> [[a]] -> [[(a,a)]] +truncFaces v n vss = + [ reverse $ map ((v,) . head) (f1:fs) + , g (n:f0) ++ [(n,v)] + , (n,v) : g (f1 ++ [v]) + ] + where + (f0:f1:fs) = rotateTo ((== n) . head) vss + g (x:y:xs) = [(x,y),(y,x)] ++ g (y:xs) + g _ = [] + +rotateTo :: (a -> Bool) -> [a] -> [a] +rotateTo p xs = ys ++ zs + where + (zs,ys) = break p xs + +facesToVF :: Ord a => [[a]] -> M.Map a [[a]] +facesToVF faces = foldr f M.empty vs + where + vs = nub $ concat faces + f v = M.insert v (g v) + g v = map (tail . rotateTo (== v)) $ filter (elem v) faces + +--triPyramid :: VF +--triPyramid = VF + +--dual :: VF a -> VF [a] +--dual vf = diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 3922269a0..859d257b3 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -45,6 +45,7 @@ preloadRender = do bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] ETriangleStrip pokeBezQStrat cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] ETriangles pokeCharStrat >>= addTexture "data/texture/charMap.png" + basicTweakZShad <- makeShader "twoD/basicTweakZ" [vert,frag] [4,4] ETriangles pokeTriTweakZ -- texture shaders, no textures attached fsShad <- makeShader "texture/simple" [vert,frag] [2,2] ETriangleStrip $ const cornerList -- note we directly poke the shader vertex data here @@ -75,7 +76,8 @@ preloadRender = do clearColor $= Color4 0 0 0 1 return $ RenderData - { _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader] + { _pictureShaders = + [bslist,lslist,cslist,aslist,eslist,bezierQuadShader,basicTweakZShad] , _lightingSurfaceShader = lightingSurfaceShad , _lightingLineShadowShader = lightingLineShadowShad , _lightingOccludeShader = wsShad @@ -160,6 +162,11 @@ pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [x,y,z,r vs pokeBezQStrat _ = [] + +pokeTriTweakZ :: RenderType -> [[Float]] +pokeTriTweakZ (RenderPolyZ vs) = fmap (\(p,co,z) -> flat3 p ++ [z] ++ flat4 co) vs +pokeTriTweakZ _ = [] + {-# INLINE pokeTriStrat #-} pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[Float]] pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> flat3 p ++ flat4 co) vs diff --git a/src/Render.hs b/src/Render.hs index e5816ecf9..2bbf960ab 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -55,11 +55,10 @@ createLightMap -> Int -- Resolution division -> [(Point2,Point2)] -- Wall pairs -> [(Point3,Float,Float)] -- Lights - -> (Float,Float) -- View from position -> [Polyhedra] -- foreground geometry -> [Point2] -> IO () -createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics scPol = do +createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do -- get viewport size so we can reset it later (vppos,vpsize) <- get viewport -- set the viewport size to that of the render buffer