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 itemSPic :: Item -> SPic itemSPic it = M.foldMapWithKey (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of NoItemType -> over _1 (colorSH magenta) defSPic CRAFT _ -> defSPic HELD ht -> heldItemSPic ht it LEFT lt -> leftItemSPic lt it EQUIP et -> equipItemSPic et it Consumable{} -> defSPic equipItemSPic :: EquipItemType -> Item -> SPic equipItemSPic et _ = case et of MAGSHIELD -> defSPic FLAMESHIELD -> defSPic FRONTARMOUR -> ( mempty , setDepth 20 $ pictures [ color yellow $ thickArc 0 (pi / 2) 10 5 , color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5 ] ) WRISTARMOUR -> defSPic INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) BRAINHAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) HAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) TARGETINGHAT _ -> noPic (colorSH yellow $ upperPrismPoly 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 $ upperPrismPoly 10 $ polyCirc 3 5 AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2) backpackShape :: Shape backpackShape = upperPrismPoly 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 REVOLVER -> revolverAmmoPos REVOLVERX _ -> revolverAmmoPos 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 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 BINOCULARS -> NoAmmoPosition where lhs = Q.axisAngle (V3 1 0 0) pi rhs = Q.axisAngle (V3 1 0 0) 0 bangStickAmmoPos :: Int -> Item -> AmmoPosition bangStickAmmoPos i itm = Bullets [(rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a) | a <- map f [0 .. i - 1]] where f n = barrelspread * fromIntegral n - 0.5 * barrelspread * fromIntegral (_brlNum (_gunBarrels (_itParams itm)) -1) barrelspread = itm ^?! itParams . gunBarrels . brlSpread . spreadAngle 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) 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 REVOLVER -> noPic $ baseStickShape <> addBullets it REVOLVERX _ -> noPic $ baseStickShape <> addBullets 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) $ upperPrismPoly 3 $ rectWH 2 2) KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic) BINOCULARS -> mempty -- TODO 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 = upperPrismPoly 3 $ rectXH 10 0.5 top = upperPrismPoly 0.5 $ rectXH 10 2 bot = upperPrismPoly 0.5 $ rectXH 9 2 back = upperPrismPoly 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 i = foldMap f [0 .. i -1] where f j = rotateSH ang baseStickShape where ang = fromIntegral j * barrelspread - (fromIntegral i - 1) * barrelspread * 0.5 barrelspread = it ^?! itParams . gunBarrels . brlSpread . spreadAngle baseStickShape :: Shape baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2 bangConeShape :: Float -> Shape bangConeShape x = colorSH cyan $ upperPrismPoly 3 (rectXH x 2) <> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) x (10 + x)) defSPic :: SPic defSPic = noPic $ colorSH green $ upperPrismPoly 3 $ square 4 shatterGunSPic :: SPic shatterGunSPic = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb 8 xa 0) <> upperPrismPoly 5 (rectNESW (- xa) 8 (- xb) 0) where xa = 1 xb = 9 baseCaneShape :: Shape baseCaneShape = colorSH red $ upperPrismPoly 3 $ rectXH 15 1.5 baseRifleShape :: Shape baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2 addBullets :: Item -> Shape addBullets itm = fromMaybe mempty $ do x <- itm ^? itUse . heldConsumption . laLoaded hit <- itm ^? itType . iyBase . ibtHeld ps <- fmap (take x) $ ammoPosition itm hit ^? amPosDirs return $ foldMap (uncurry (drawBullet itm)) ps drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape drawBullet itm p q = translateSH p $ overPosSH (Q.rotate q) $ colorSH midcol ( upperPrismPoly 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) $ upperPrismPoly 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) $ upperPrismPoly 0.2 $ reverse $ rectNSWE 0.2 (- 0.2) (-2) (-1) 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 ( upperPrismPoly 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 . laLoaded tips = fromMaybe mempty $ do ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $ reverse $ rectNSWE 0 (- y) 1 2 tails = fromMaybe mempty $ do ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 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 -> upperPrismPoly 3 $ map (+.+ V2 0 y) $ rectXH 15 2) . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5)) ) [0 .. i -1] ) miniGunXPictItem :: Int -> Item -> SPic miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _heldConsumption (_itUse it)) where spin = (-10) * _laLoaded (_heldConsumption (_itUse it)) + _warmTime (_heldDelay $ _itUse it) miniGunXPict :: Int -> 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 $ upperPrismPoly 3 $ rectXH 20 2 flamerPic :: Item -> SPic flamerPic it = ( colorSH yellow $ translateSHxy tx ty (upperPrismPoly tz $ polyCirc 3 r) <> upperPrismPoly 5 (rectNESW 2 18 (-2) 0) , color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * am) ) where tx = 4 ty = - 6 tz = 3 r = 5 am = fractionLoadedAmmo2 it launcherPic :: Item -> SPic launcherPic _ = ( 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 $ upperPrismPoly 3 $ rectXH 20 2 baseAMRShape :: Shape baseAMRShape = colorSH orange $ upperPrismPoly 3 $ rectXH 30 2 teslaGunPic :: SPic teslaGunPic = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb 8 xa 0) <> upperPrismPoly 5 (rectNESW (- xa) 8 (- xb) 0) where xa = 1 xb = 9 lasGunPic :: Item -> SPic lasGunPic it = ( colorSH blue $ upperPrismPoly 4 (rectNESW 3 30 1 0) <> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0) <> upperPrismPoly 1 (rectNESW 3 30 (-3) 0) , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0 ) where amFrac = fractionLoadedAmmo it col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red dualBeamPic :: Item -> SPic dualBeamPic it = ( colorSH blue $ upperPrismPoly 4 (rectNESW gap 3 (- gap) 1) <> upperPrismPoly 4 (rectNESW gap (-1) (- gap) (-3)) <> upperPrismPoly 1 (rectNESW gap 3 (- gap) (-3)) , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW gap 1 (- gap) (-1) ) where amFrac = fractionLoadedAmmo it col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red gap = _dbGap (_itParams it) - 3 tractorGunPic :: Item -> SPic tractorGunPic it = ( colorSH red $ upperPrismPoly 4 (rectNESW 3 30 1 0) <> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0) <> upperPrismPoly 1 (rectNESW 3 30 (-3) 0) , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0 ) where amFrac = fractionLoadedAmmo it col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red flatShieldEquipSPic :: SPic flatShieldEquipSPic = ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10) , mempty ) headLampShape :: Shape headLampShape = colorSH yellow $ translateSH (V3 5 2 4) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 2 0) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1) <> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1) detectorColor :: Detector -> Color detectorColor dt = case dt of ITEMDETECTOR -> blue CREATUREDETECTOR -> green WALLDETECTOR -> red keyPic :: Picture keyPic = color green $ 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)] ] --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 $ upperPrismPoly 3 $ rectWH 2 2