Files
loop/src/Dodge/Item/Draw/SPic.hs
T

530 lines
17 KiB
Haskell

module Dodge.Item.Draw.SPic (
itemSPic,
) where
import Color
import qualified Data.Map.Strict as M
--import Data.Maybe
import Dodge.Data.Item
--import Dodge.Item.AmmoPosition
--import Dodge.Item.Weapon.FractionLoaded
import Geometry
import LensHelp
--import qualified Linear.Quaternion as Q
import Picture
import Shape
import ShapePicture
--import Data.Maybe
--itemHeldAmmoPic :: Item -> Item -> SPic
--itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
--addAmmoClip :: Item -> Item -> SPic
--addAmmoClip itm amit = fromMaybe mempty $ do
-- hit <- itm ^? itType . iyBase . ibtHeld
-- return mempty
itemSPic :: Item -> SPic
itemSPic it =
M.foldMapWithKey (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of
CRAFT _ -> defSPic
HELD ht -> heldItemSPic ht it
LEFT lt -> leftItemSPic lt it
EQUIP et -> equipItemSPic et it
CONSUMABLE{} -> defSPic
ATTACH {} -> defSPic
AMMOMAG {} -> defSPic
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
MAGSHIELD -> defSPic
FLAMESHIELD -> defSPic
FRONTARMOUR ->
( mempty
, setDepth 20 $
fold
[ color yellow $ thickArc 0 (pi / 2) 10 5
, color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5
]
)
WRISTARMOUR -> defSPic
INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPolySI 3 $ rectWH 2 2)
BRAINHAT -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
HAT -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
TARGETINGHAT _ -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
HEADLAMP -> noPic headLampShape
POWERLEGS -> legsSPic yellow
SPEEDLEGS -> legsSPic green
JUMPLEGS -> legsSPic red
JETPACK -> noPic $ colorSH yellow backpackShape
BATTERYPACK -> noPic $ colorSH blue backpackShape
FUELPACK ->
noPic $ colorSH yellow $ upperPrismPolyMT 10 $ polyCirc 3 5
BULLETBELTPACK ->
noPic $ colorSH green backpackShape
BULLETBELTBRACER
-> noPic (colorSH green $ upperPrismPolySU 3 $ rectWH 2 2)
AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
backpackShape :: Shape
backpackShape = upperPrismPolyMT 10 $ rectNSWE 5 (-5) (-4) 4
leftItemSPic :: LeftItemType -> Item -> SPic
leftItemSPic lt _ = case lt of
BLINKER -> defSPic
_ -> defSPic
--ammoPosition :: Item -> HeldItemType -> AmmoPosition
--ammoPosition itm hit = case hit of
-- FLATSHIELD -> NoAmmoPosition
-- FORCEFIELDGUN -> NoAmmoPosition
-- TORCH -> NoAmmoPosition
-- BANGSTICK i -> bangStickAmmoPos i itm
-- PISTOL -> Magazine (V3 5 2 0) lhs
-- MACHINEPISTOL -> Magazine (V3 5 2 0) lhs
-- AUTOPISTOL -> Magazine (V3 5 2 0) lhs
-- SMG -> Magazine (V3 7 (-2) 0) rhs
-- BANGCONE -> NoAmmoPosition
-- BLUNDERBUSS -> NoAmmoPosition
-- GRAPECANNON _ -> NoAmmoPosition
-- MINIGUNX _ -> NoAmmoPosition
-- VOLLEYGUN i -> volleygunAmmoPos i
-- MULTIGUN i -> multigunAmmoPos i
-- RIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
-- REPEATER -> Magazine (V3 10 (-2) 0) rhs
-- AUTORIFLE -> Magazine (V3 10 (-2) 0) rhs
-- BURSTRIFLE -> Magazine (V3 10 (-2) 0) rhs
-- BANGROD -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
-- ELEPHANTGUN -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
-- AMR -> Magazine (V3 10 (-2) 0) rhs
-- AUTOAMR -> Magazine (V3 10 (-2) 0) rhs
-- SNIPERRIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
-- MACHINEGUN -> Magazine (V3 10 (-2) 0) rhs
-- FLAMESPITTER -> NoAmmoPosition
-- FLAMETHROWER -> NoAmmoPosition
-- FLAMETORRENT -> NoAmmoPosition
-- FLAMEWALL -> NoAmmoPosition
-- BLOWTORCH -> NoAmmoPosition
-- SPARKGUN -> NoAmmoPosition
-- TESLAGUN -> NoAmmoPosition
-- LASGUN -> NoAmmoPosition
-- LASCIRCLE -> NoAmmoPosition
-- DUALBEAM -> NoAmmoPosition
-- LASWIDE _ -> NoAmmoPosition
-- --SONICGUN -> noPic baseSonicShape
-- TRACTORGUN -> NoAmmoPosition
-- LAUNCHER -> NoAmmoPosition
-- LAUNCHERX _ -> NoAmmoPosition
-- REMOTELAUNCHER -> NoAmmoPosition
-- POISONSPRAYER -> NoAmmoPosition
-- DRONELAUNCHER -> NoAmmoPosition
-- SHATTERGUN -> NoAmmoPosition
-- HELDDETECTOR _ -> NoAmmoPosition
-- KEYCARD _ -> NoAmmoPosition
-- where
-- lhs = Q.axisAngle (V3 1 0 0) pi
-- rhs = Q.axisAngle (V3 1 0 0) 0
--bangStickAmmoPos :: Int -> Item -> AmmoPosition
--bangStickAmmoPos _ itm =
-- Bullets
-- [(rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a)
-- | a <- map _mzRot (itm ^?! itUse . heldAim . aimMuzzles)]
--volleygunAmmoPos :: Int -> AmmoPosition
--volleygunAmmoPos i =
-- Bullets
-- [(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0 .. i -1]]
-- where
-- f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)
--
--multigunAmmoPos :: Int -> AmmoPosition
--multigunAmmoPos i =
-- Bullets
-- [(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0 .. i -1]]
-- where
-- f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)
--revolverAmmoPos :: AmmoPosition
--revolverAmmoPos =
-- Bullets
-- [(V3 5 0 1 + Q.rotate q (V3 0 0 2), q) | q <- qs]
-- where
-- qs = [Q.axisAngle (V3 1 0 0) (f i) | i <- [1 .. 6 :: Int]]
-- f i = fromIntegral i * pi / 3 + pi / 6
heldItemSPic :: HeldItemType -> Item -> SPic
heldItemSPic ht it = case ht of
FLATSHIELD -> flatShieldEquipSPic
FORCEFIELDGUN -> defSPic
TORCH -> noPic torchShape
BANGSTICK i -> noPic $ baseStickShapeX it i -- <> addBullets it
PISTOL -> noPic $ baseStickShape <> addTinClip it
MACHINEPISTOL -> noPic $ baseStickShape <> addTinClip it
AUTOPISTOL -> noPic $ baseStickShape <> addTinClip it
SMG -> noPic $ baseSMGShape <> addTinClip it
BANGCONE -> noPic $ bangConeShape 5
BLUNDERBUSS -> noPic $ bangConeShape 20
GRAPECANNON _ -> noPic $ bangConeShape 20
MINIGUNX i -> miniGunXPictItem i it
VOLLEYGUN i -> noPic $ volleyGunShape i -- <> addBullets it
RIFLE -> noPic $ baseRifleShape -- <> addBullets it
-- REPEATER -> noPic $ baseRifleShape <> addTinClip it
AUTORIFLE -> noPic $ baseRifleShape <> addTinClip it
BURSTRIFLE -> noPic $ baseRifleShape <> addTinClip it
BANGROD -> noPic $ baseRodShape -- <> addBullets it
ELEPHANTGUN -> noPic $ baseAMRShape -- <> addBullets it
AMR -> noPic $ baseAMRShape <> addTinClip it
AUTOAMR -> noPic $ baseAMRShape <> addTinClip it
SNIPERRIFLE -> noPic $ baseAMRShape -- <> addBullets it
-- MACHINEGUN -> noPic $ baseAMRShape <> addTinClip it
FLAMESPITTER -> flamerPic it
FLAMETHROWER -> flamerPic it
FLAMETORRENT -> flamerPic it
FLAMEWALL -> flamerPic it
BLOWTORCH -> flamerPic it
SPARKGUN -> teslaGunPic
TESLAGUN -> teslaGunPic
LASGUN -> lasGunPic it
-- LASCIRCLE -> lasGunPic it
-- DUALBEAM -> dualBeamPic it
-- LASWIDE _ -> lasGunPic it
--SONICGUN -> noPic baseSonicShape
TRACTORGUN -> tractorGunPic it
LAUNCHER -> launcherPic it
LAUNCHERX _ -> launcherPic it
REMOTELAUNCHER -> launcherPic it
POISONSPRAYER -> flamerPic it
DRONELAUNCHER -> defSPic
SHATTERGUN -> shatterGunSPic
HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)
torchShape :: Shape
torchShape =
colorSH blue $
translateSHxy 0 1.5 side
<> translateSHxy 0 (-1.5) side
<> translateSHz 2.5 top
<> translateSHz (-0.5) bot
<> back
where
side = upperPrismPolySE 3 $ rectXH 10 0.5
top = upperPrismPolySE 0.5 $ rectXH 10 2
bot = upperPrismPolySE 0.5 $ rectXH 9 2
back = upperPrismPolySE 3 $ rectXH 1 2
modulesSPic :: Item -> ModuleSlot -> ItemModuleType -> SPic
modulesSPic it _ imt = case imt of
ATTACHTORCH -> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape)
_ -> mempty
baseStickShapeX :: Item -> Int -> Shape
baseStickShapeX it _ = foldMap f (it ^?! itUse . heldAim . aimMuzzles)
where
f brl = rotateSH (_mzRot brl) baseStickShape
baseStickShape :: Shape
baseStickShape = colorSH green $ xCylinderST 3 10
bangConeShape :: Float -> Shape
bangConeShape x =
colorSH cyan $
xCylinderST 3 x
<> upperPrismPolyST 6 ( rectNSWE 4 (-4) x (10 + x))
defSPic :: SPic
defSPic = noPic $ colorSH green $ upperPrismPolyST 3 $ square 4
shatterGunSPic :: SPic
shatterGunSPic =
-- TODO cylinderize
noPic $
colorSH blue $
upperPrismPolyST 5 (rectNESW xb 8 xa 0)
<> upperPrismPolyST 5 (rectNESW (- xa) 8 (- xb) 0)
where
xa = 1
xb = 9
baseCaneShape :: Shape
baseCaneShape = colorSH red $ xCylinderST 3 15
baseRifleShape :: Shape
--baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
--baseRifleShape = colorSH red . rotateSHq (V3 0 1 0) (pi/2) . upperCylinder 25 $ polyCirc 3 2
--baseRifleShape = colorSH red $ xCylinder 4 2 25
baseRifleShape = colorSH red $ xCylinderST 3 25
--addBullets :: Item -> Shape
--addBullets itm = fromMaybe mempty $ do
-- x <- itm ^? itUse . heldConsumption . laSource . _InternalSource . iaLoaded
-- hit <- itm ^? itType . iyBase . ibtHeld
-- ps <- fmap (take x) $ ammoPosition itm hit ^? amPosDirs
-- return $ foldMap (uncurry (drawBullet itm)) ps
---- why is this duplicated?
--drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape
--drawBullet itm p q =
-- translateSH p $
-- overPosSH (Q.rotate q) $
-- colorSH
-- midcol
-- ( upperPrismPolyTS 0.2 $
-- reverse
-- (rectNSWE 0.2 (- 0.2) (-1) 1)
-- )
-- <> tip
-- <> foot
-- where
-- midcol =
-- maybe
-- black
-- bulletEffectColor
-- (itm ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
-- tip = fromMaybe mempty $ do
-- ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
-- return $
-- colorSH (bulletPayloadColor ebt) $
-- upperPrismPolyTS 0.2 $
-- reverse $
-- rectNSWE 0.2 (- 0.2) 1 2
-- foot = fromMaybe mempty $ do
-- ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
-- return $
-- colorSH (bulletTrajColor ebt) $
-- upperPrismPolyTS 0.2 $
-- reverse $
-- rectNSWE 0.2 (- 0.2) (-2) (-1)
addTinClip :: Item -> Shape
addTinClip _ = mempty
--addTinClip :: Item -> Shape
--addTinClip itm = fromMaybe mempty $ do
-- hit <- itm ^? itType . iyBase . ibtHeld
-- let ap = ammoPosition itm hit
-- p <- ap ^? amposPos
-- d <- ap ^? amposDir
-- return $ translateSH p $ overPosSH (Q.rotate d) $ makeTinClip itm
--
--makeTinClip :: Item -> Shape
--makeTinClip it =
-- colorSH
-- midcol
-- ( upperPrismPolyTS
-- 1
-- ( reverse $
-- rectNSWE 0 (- y) (-1) 1
-- )
-- )
-- <> tips
-- <> tails
-- where
-- midcol =
-- maybe
-- black
-- bulletEffectColor
-- (it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
-- y = fromIntegral y' * 0.3
-- y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laSource . _InternalSource . iaLoaded
-- tips = fromMaybe mempty $ do
-- ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
-- return $
-- colorSH (bulletPayloadColor ebt) $
-- upperPrismPolyTS 1.1 $
-- reverse $
-- rectNSWE 0 (- y) 1 2
-- tails = fromMaybe mempty $ do
-- ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
-- return $
-- colorSH (bulletTrajColor ebt) $
-- upperPrismPolyTS 1.1 $
-- reverse $
-- rectNSWE 0 (- y) (-2) (-1)
--bulletEffectColor :: BulletEffect -> Color
--bulletEffectColor x = case x of
-- DestroyBullet -> black
-- BounceBullet -> mixColors 0.5 0.5 black yellow
-- PenetrateBullet -> mixColors 0.5 0.5 black blue
--bulletTrajColor :: BulletTrajectory -> Color
--bulletTrajColor x = case x of
-- BasicBulletTrajectory -> black
-- BezierTrajectory{} -> chartreuse
-- FlechetteTrajectory{} -> white
-- MagnetTrajectory{} -> yellow
--bulletPayloadColor :: BulletSpawn -> Color
--bulletPayloadColor x = case x of
-- BulBall y -> energyBallColor y
-- BulSpark -> black
-- BulFlak -> chartreuse
-- BulFrag -> magenta
-- BulGas -> green
--energyBallColor :: EnergyBallType -> Color
--energyBallColor ebt = case ebt of
-- IncBall -> orange
-- TeslaBall -> cyan
-- ConcBall -> white
-- FlashBall -> yellow
volleyGunShape :: Int -> Shape
volleyGunShape i =
colorSH
red
( foldMap
( (\y -> translateSHxy 0 y $ xCylinderST 3 15)
. (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))
)
[0 .. i -1]
)
-- to get this rotating should probably add extra state to the minigun
miniGunXPictItem :: Int -> Item -> SPic
miniGunXPictItem i it = miniGunXPict i spin
where
spin = (-10) -- * _iaLoaded (_laSource (_heldConsumption (_itUse it)))
+ _warmTime (_heldDelay $ _itUse it)
miniGunXPict :: Int -> Int -> SPic
miniGunXPict i spin =
( colorSH red (rotateSHx a barrels)
<> baseRifleShape
, -- <> clip (-1) 0
-- <> clip (-7) 0
mempty
)
where
aBarrel = translateSH (V3 15 2 2) baseCaneShape
barrels = foldMap (\an -> aBarrel & rotateSHx (2 * pi * fromIntegral an / fromIntegral i)) [1 .. i]
a = fromIntegral spin / 100
--x = fromIntegral am / 10
-- clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4)
-- . upperPrismPoly 2
-- $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))
--baseSonicShape :: Shape
--baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
baseSMGShape :: Shape
baseSMGShape = colorSH green $ xCylinderST 3 20
flamerPic :: Item -> SPic
--flamerPic it =
flamerPic _ =
( colorSH yellow $
translateSHxy tx ty (upperPrismPolyST tz $ polyCirc 3 r)
<> xCylinderST 5 18
--, color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * am)
, color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * 0.5)
)
where
tx = 4
ty = - 6
tz = 3
r = 5
-- am = fractionLoadedAmmo2 it
launcherPic :: Item -> SPic
launcherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
--launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20
-- ( colorSH cyan $
-- prismPoly
-- (map (+.+.+ V3 20 0 5) $ polyCircx 4 5)
-- (map (+.+.+ V3 0 0 5) $ polyCircx 4 5)
-- , mempty
-- )
baseRodShape :: Shape
baseRodShape = colorSH orange $ xCylinderST 3 20
baseAMRShape :: Shape
baseAMRShape = colorSH orange $ xCylinderST 3 30
teslaGunPic :: SPic
teslaGunPic =
noPic $
colorSH blue $
upperPrismPolyST 5 (rectNESW xb 8 xa 0)
<> upperPrismPolyST 5 (rectNESW (- xa) 8 (- xb) 0)
where
xa = 1
xb = 9
lasGunPic :: Item -> SPic
--lasGunPic it =
lasGunPic _ =
( colorSH blue $
upperBoxST 4 (rectNESW 3 30 1 0)
<> upperBoxSU 4 (rectNESW (-1) 30 (-3) 0)
<> upperBoxSU 1 (rectNESW 3 30 (-3) 0)
, setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
)
where
--amFrac = fractionLoadedAmmo it
amFrac = 0.5
col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red
--dualBeamPic :: Item -> SPic
--dualBeamPic it =
-- ( colorSH blue $
-- upperBoxST 4 (rectNESW gap 3 (- gap) 1)
-- <> upperBoxSU 4 (rectNESW gap (-1) (- gap) (-3))
-- <> upperBoxSU 1 (rectNESW gap 3 (- gap) (-3))
-- , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW gap 1 (- gap) (-1)
-- )
-- where
-- --amFrac = fractionLoadedAmmo it
-- amFrac = 0.5
-- col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red
-- gap = _dbGap (_itParams it) - 3
tractorGunPic :: Item -> SPic
tractorGunPic = lasGunPic
flatShieldEquipSPic :: SPic
flatShieldEquipSPic =
( colorSH yellow $ upperBoxMT 10 (rectWH 2 10)
, mempty
)
headLampShape :: Shape
headLampShape =
colorSH yellow $
oneside 5 2 4
<> oneside 5 2 0
<> oneside 5 (-2) 4
<> oneside 5 (-2) 0
where
oneside x y z = translateSH (V3 x y z) (upperPrismPolySE 4 $ rectWH 4 1)
detectorColor :: Detector -> Color
detectorColor dt = case dt of
ITEMDETECTOR -> blue
CREATUREDETECTOR -> green
WALLDETECTOR -> red
keyPic :: Picture
keyPic =
color green $
fold
[ translate (-4) 0 $ thickCircle 4 2
, thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)]
, thickLine 2 $ map toV2 [(4, 0), (4, -4)]
]
--latchkeyPic :: Picture
--latchkeyPic =
-- color yellow $
-- pictures
-- [ translate (-4) 0 $ thickCircle 4 2
-- , thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)]
-- , thickLine 2 $ map toV2 [(4, 0), (4, -4)]
-- ]
legsSPic :: Color -> SPic
legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPolyST 3 $ rectWH 2 2