513 lines
17 KiB
Haskell
513 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
|
|
|
|
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
|