Refactor tractor beam
This commit is contained in:
@@ -162,6 +162,7 @@ startInventory :: IM.IntMap Item
|
||||
startInventory = IM.fromList (zip [0..20]
|
||||
(
|
||||
[spreadGun
|
||||
,tractorGun
|
||||
,longGun
|
||||
,autoGun
|
||||
,ltAutoGun
|
||||
|
||||
@@ -480,6 +480,15 @@ data Prop
|
||||
, _pjID :: Int
|
||||
, _pjUpdate :: Prop -> World -> World
|
||||
}
|
||||
| ProjectileTimed
|
||||
{ _pjPos :: Point2
|
||||
, _pjStartPos :: Point2
|
||||
, _pjVel :: Point2
|
||||
, _prDraw :: Prop -> SPic
|
||||
, _pjID :: Int
|
||||
, _pjUpdate :: Prop -> World -> World
|
||||
, _pjTime :: Int
|
||||
}
|
||||
| Shell
|
||||
{ _pjPos :: Point2
|
||||
, _pjStartPos :: Point2
|
||||
|
||||
@@ -251,18 +251,20 @@ tractorGun = defaultAutoGun
|
||||
, _wpReloadState = 0
|
||||
, _itUseRate = 0
|
||||
, _itUseTime = 0
|
||||
, _itUse = \_ -> aTractorBeam 0
|
||||
, _itUse = aTractorBeam
|
||||
, _itUseModifiers =
|
||||
[ ammoUseCheckI
|
||||
]
|
||||
, _wpSpread = 0.00001
|
||||
, _wpRange = 20
|
||||
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
|
||||
, _itFloorPict = tractorGunSPic
|
||||
, _itAimingSpeed = 0.4
|
||||
, _itAimingRange = 0.5
|
||||
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
|
||||
, _itEquipPict = pictureWeaponOnAim tractorGunSPic
|
||||
}
|
||||
|
||||
-- TODO own picture for tractor gun
|
||||
tractorGunSPic :: SPic
|
||||
tractorGunSPic = lasGunPic
|
||||
|
||||
removeItAttachment :: Int -> Int -> World -> World
|
||||
removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
|
||||
|
||||
@@ -9,7 +9,6 @@ import Dodge.SoundLogic
|
||||
import Dodge.SoundLogic.LoadSound
|
||||
import Dodge.Item.Attachment.Data
|
||||
import Dodge.Item.Draw
|
||||
--import Dodge.Default
|
||||
import Picture
|
||||
import Geometry
|
||||
import ShapePicture
|
||||
@@ -100,5 +99,3 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
|
||||
& itHammer .~ HammerUp
|
||||
& itEquipPict .~ pictureWeaponOnAim (grenadePic 50)
|
||||
| otherwise = it & itEffect . itEffectCounter -~ 1
|
||||
|
||||
--(grenadeAccL, grenadeAccA) = (0.1, 0.1)
|
||||
|
||||
@@ -6,13 +6,13 @@ module Dodge.Item.Weapon.UseEffect
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Zone
|
||||
import Dodge.Base.Collide
|
||||
import Dodge.Picture.Layer
|
||||
--import Dodge.Item.Weapon.Decoration
|
||||
--import Dodge.Item.Weapon.TriggerType
|
||||
--import Dodge.WorldEvent.Flash
|
||||
--import Dodge.WorldEvent.ThingsHit
|
||||
import Picture
|
||||
import ShapePicture
|
||||
import Geometry
|
||||
|
||||
import Data.Maybe
|
||||
@@ -105,87 +105,84 @@ mvRadar x p w pt =
|
||||
| otherwise = fromIntegral x / 10
|
||||
--colHelper y = color (withAlpha (y * globalAlpha) red)
|
||||
|
||||
aTractorBeam
|
||||
:: Int -- ^ Color id
|
||||
-> Creature -- ^ Creature id
|
||||
-> World
|
||||
-> World
|
||||
aTractorBeam col cr w
|
||||
= set (creatures . ix cid . crInv . ix itRef . itUse)
|
||||
(\_ -> aTractorBeam ((col + 1) `mod` 10))
|
||||
$ over props (IM.insert i (tractorBeamAt col i pos dir)) w
|
||||
aTractorBeam :: Item -> Creature -> World -> World
|
||||
aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w
|
||||
where
|
||||
i = newProjectileKey w
|
||||
cid = _crID cr
|
||||
pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir)
|
||||
cpos = _crPos cr
|
||||
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
||||
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
||||
dir = _crDir cr
|
||||
itRef = _crInvSel cr
|
||||
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Prop
|
||||
tractorBeamAt colID i pos dir = Projectile
|
||||
outpos = collidePointWalls cpos xpos
|
||||
$ wallsAlongLine cpos xpos w
|
||||
|
||||
tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop
|
||||
tractorBeamAt i pos outpos dir = ProjectileTimed
|
||||
{ _pjPos = pos
|
||||
, _pjStartPos = p'
|
||||
, _pjStartPos = outpos
|
||||
, _pjVel = d
|
||||
, _prDraw = const (mempty,blank)
|
||||
, _prDraw = tractorSPic
|
||||
, _pjID = i
|
||||
, _pjUpdate = \_ -> updateTractor colID 10 i
|
||||
, _pjUpdate = updateTractor
|
||||
, _pjTime = 10
|
||||
}
|
||||
where
|
||||
d = unitVectorAtAngle dir
|
||||
p' = pos +.+ 400 *.* d
|
||||
|
||||
{- |
|
||||
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 (props . ix i . pjUpdate) (\_ -> updateTractor colID (time-1) i)
|
||||
$ set (props . ix i . prDraw) (const (mempty,mempty))
|
||||
$ over creatures (IM.map tractCr)
|
||||
$ over floorItems (IM.map tractFlIt)
|
||||
w
|
||||
| otherwise = over props (IM.delete i) w
|
||||
updateTractor :: Prop -> World -> World
|
||||
updateTractor pj w
|
||||
| _pjTime pj <= 0 = w & props %~ IM.delete i
|
||||
| otherwise = w
|
||||
& props . ix i . pjTime -~ 1
|
||||
& creatures %~ IM.map (tractCr pullVel pos outpos)
|
||||
& floorItems %~ IM.map (tractFlIt pullVel pos outpos)
|
||||
where
|
||||
tractCr cr
|
||||
| circOnSeg p1 p2 cP 10
|
||||
= over crPos (\p ->
|
||||
p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
|
||||
) cr
|
||||
| otherwise = cr
|
||||
where
|
||||
x = abs y + 1
|
||||
y = errorClosestPointOnLineParam 1 p1 p3 cP
|
||||
cP = _crPos cr
|
||||
m | dist cP p1 < 350 = 1
|
||||
| otherwise = (400 - dist cP p1) / 50
|
||||
tractFlIt it | circOnSeg p1 p2 iP 10
|
||||
= over flItPos (\p -> p -.- m *.*
|
||||
( (0.3/ x) *.* q +.+ (f y *.* p4))
|
||||
) it
|
||||
| otherwise = it
|
||||
where x = abs y + 1
|
||||
y = errorClosestPointOnLineParam 2 p1 p3 iP
|
||||
iP = _flItPos it
|
||||
m | dist iP p1 < 350 = 1
|
||||
| otherwise = (410 - dist iP p1) / 60
|
||||
pj = _props w IM.! i
|
||||
q = _pjVel pj
|
||||
p1 = _pjPos pj
|
||||
p' = _pjStartPos pj
|
||||
p2 = maybe p' fst $ reflectPointWalls p1 p' $ wallsNearPoint p' w
|
||||
p4 = vNormal p5
|
||||
p5 = errorNormalizeV 12 $ p2 -.- p1
|
||||
i = _pjID pj
|
||||
pullVel = _pjVel pj
|
||||
pos = _pjPos pj
|
||||
outpos = _pjStartPos pj
|
||||
|
||||
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
|
||||
tractFlIt q p1 outpos it
|
||||
| circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
|
||||
| otherwise = it
|
||||
|
||||
tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
|
||||
tractCr q p1 outpos cr
|
||||
| circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
|
||||
| otherwise = cr
|
||||
|
||||
tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
|
||||
tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
|
||||
where
|
||||
x' = abs y + 1
|
||||
y = errorClosestPointOnLineParam 1 p1 p3 p
|
||||
m | dist p p1 < 350 = 1
|
||||
| otherwise = (400 - dist p p1) / 50
|
||||
g x | x > 5 = (10 - x) / 250
|
||||
| x > 1 = 0.02
|
||||
| x > -1 = x * 0.02
|
||||
| x > -5 = -0.02
|
||||
| otherwise = (x - 10) / 250
|
||||
--p4 = vNormal p5
|
||||
p4 = vNormal $ safeNormalizeV q
|
||||
p3 = p1 +.+ p4
|
||||
g x | x > 5 = (10 - x) / 5
|
||||
| x > 1 = 1
|
||||
| x > -1 = x
|
||||
| x > -5 = -1
|
||||
| otherwise = (x - 10) / 5
|
||||
f x = g x / 50
|
||||
|
||||
tractorSPic :: Prop -> SPic
|
||||
tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon
|
||||
[ spos -- not sure if this is anticlockwise...
|
||||
, spos +.+ size *.* (d +.+ n)
|
||||
, xpos +.+ size *.* n
|
||||
, xpos -.- size *.* n
|
||||
, spos +.+ size *.* (d -.- n)
|
||||
]
|
||||
where
|
||||
size = fromIntegral (_pjTime pj)
|
||||
spos = _pjPos pj
|
||||
xpos = _pjStartPos pj
|
||||
d = safeNormalizeV $ spos -.- xpos
|
||||
n = vNormal d
|
||||
col = mixColors 0.5 0.5 white blue
|
||||
px z = (fromIntegral time + 5) *.* z
|
||||
pz z = fromIntegral time * 10 *.* z
|
||||
pic = setLayer 1 $ onLayer PtLayer $ color (withAlpha 0.05 col)
|
||||
$ polygon [ p1 +.+ px p4
|
||||
, p1 -.- 10 *.* p5
|
||||
, p1 -.- px p4
|
||||
, (p' -.- pz p5) -.- px p4
|
||||
, (p' -.- pz p5) +.+ px p4]
|
||||
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Room.Foreground
|
||||
where
|
||||
import Dodge.Picture
|
||||
import Dodge.Base
|
||||
--import Dodge.Picture
|
||||
--import Dodge.Base
|
||||
import Picture
|
||||
import Geometry
|
||||
--import Geometry.Data
|
||||
@@ -53,59 +53,63 @@ highPipe h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5
|
||||
where
|
||||
n = 2.5 *.* normalizeV (vNormal (y -.- x))
|
||||
|
||||
girderZ :: Float -> Point2 -> Point2 -> Picture
|
||||
girderZ w x y = setDepth 50 $ color red $ pictures $
|
||||
[ thickLine [xt,yt] 3
|
||||
, thickLine [xb,yb] 3
|
||||
girderZ
|
||||
:: Float -- ^ height
|
||||
-> Float -- ^ distance between cross bars
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderZ h d w x y = colorSH red $ mconcat $
|
||||
[ highPipe h xt yt
|
||||
, highPipe h xb yb
|
||||
]
|
||||
++ map (flip thickLine 3 . tflat2) ls
|
||||
<> zipWith (highPipe (h- 5)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
yb = y +.+ n
|
||||
xt = x -.- n
|
||||
yt = y -.- n
|
||||
ps = divideLineExact (w*2) xb yb
|
||||
dia = rotateV (pi/4) n
|
||||
ps' = map (\p -> intersectSegLine xt yt p (p +.+ dia)) ps
|
||||
ls = catMaybes $ zipWith (fmap . (,)) ps ps'
|
||||
girderV :: Color -> Float -> Point2 -> Point2 -> Picture
|
||||
girderV col w x y = setDepth 50 $ color col $ pictures $
|
||||
[ thickLine [xt,yt] 3
|
||||
, thickLine [xb,yb] 3
|
||||
ps = divideLineExact d xb yb
|
||||
qs = tail $ divideLineExact d xt yt
|
||||
|
||||
girderV
|
||||
:: Float -- ^ height
|
||||
-> Float -- ^ distance between cross bars
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderV h d w x y = colorSH red $ mconcat $
|
||||
[ highPipe h xt yt
|
||||
, highPipe h xb yb
|
||||
]
|
||||
++ map (flip thickLine 3 . tflat2) as'
|
||||
++ map (flip thickLine 3 . tflat2) bs'
|
||||
<> zipWith (highPipe (h- 5)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
yb = y +.+ n
|
||||
xt = x -.- n
|
||||
yt = y -.- n
|
||||
ps = divideLineExact (w*2) xb yb
|
||||
(as,_) = evenOddSplit ps
|
||||
f a = map (\p -> intersectSegLine xt yt p (p +.+ rotateV a n))
|
||||
as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
|
||||
bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
|
||||
girder :: Color -> Float -> Point2 -> Point2 -> Picture
|
||||
girder col w x y = pictures $
|
||||
setDepth 50 (color col $ pictures $
|
||||
[ thickLine [xt,yt] 3
|
||||
, thickLine [xb,yb] 3
|
||||
]
|
||||
++ map (flip thickLine 3 . tflat2) ls
|
||||
)
|
||||
: map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
|
||||
ps = evenDouble $ divideLineExact d xb yb
|
||||
qs = head qs' : evenDouble(tail qs')
|
||||
where
|
||||
qs' = divideLineExact d xt yt
|
||||
evenDouble (a:_:xs) = a:a:evenDouble xs
|
||||
evenDouble xs = xs
|
||||
|
||||
girder
|
||||
:: Float -- ^ height
|
||||
-> Float -- ^ distance between cross bars
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girder h d w x y = colorSH red $ mconcat $
|
||||
[ highPipe h xt yt
|
||||
, highPipe h xb yb
|
||||
]
|
||||
<> zipWith (highPipe (h- 5)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
yb = y +.+ n
|
||||
xt = x -.- n
|
||||
yt = y -.- n
|
||||
ps = divideLineExact (w*2) xb yb
|
||||
ps' = map (\p -> intersectSegLine xt yt p (p +.+ n)) ps
|
||||
ls = catMaybes $ zipWith (fmap . (,)) ps ps'
|
||||
|
||||
|
||||
--highGirder :: Point2 -> Point2 -> Picture
|
||||
--highGirder x y =
|
||||
ps = divideLineExact d xb yb
|
||||
qs = divideLineExact d xt yt
|
||||
|
||||
@@ -24,7 +24,7 @@ startRoom = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (200,400)
|
||||
let fground = sPS (V2 0 0) 0 $ PutForeground $
|
||||
highPipe 80 (V2 0 (h/3)) (V2 w (h/2))
|
||||
girderV 50 20 10 (V2 0 (h/5)) (V2 w (h/5))
|
||||
<> highPipe 40 (V2 0 (h/2)) (V2 w (h/3))
|
||||
<> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h )
|
||||
theLamp = sPS (V2 (w/2) (h/2)) 0 $ putColorLamp (V3 0.75 0.75 0.75)
|
||||
|
||||
Reference in New Issue
Block a user