Implement headlamp

src/Dodge/Combine/Data.hs

@@ -80,6 +80,7 @@ data CombineType
     | FRONTARMOUR
     | WRISTARMOUR
     | BRAINHAT
+    | HEADLAMP
     | POWERLEGS
     | SPEEDLEGS
     | JUMPLEGS

src/Dodge/Creature.hs

@@ -175,6 +175,7 @@ testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
     [ makeTypeCraftNum 9 PIPE
     , brainHat
+    , headLamp
     , autoSonar
     , autoRadar
     , magShield

src/Dodge/Creature/HandPos.hs

@@ -3,7 +3,7 @@ import Dodge.Data
 import Dodge.Creature.Test
 --import Shape
 import ShapePicture
---import Geometry
+import Geometry
 
 import Control.Lens
 import Data.Maybe
@@ -72,9 +72,19 @@ translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStanc
 translateToHead :: Creature -> SPic -> SPic
 translateToHead cr
     | twists cr = translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25 
+            . rotateSP 1
     | oneH   cr = translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0 
+            . rotateSP (negate 0.5)
     | otherwise = translateSPz 20 . translateSPf 2.5 0 
 
+translatePointToHead :: Creature -> Point3 -> Point3
+translatePointToHead cr
+    | twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
+            . rotate3 1
+    | oneH   cr = (+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
+            . rotate3 (negate 0.5)
+    | otherwise = (+.+.+ V3 2.5 0 20)
+
 translateToChest :: Creature -> SPic -> SPic
 translateToChest cr
     | oneH cr   = rotateSP 0.5

src/Dodge/Item/Equipment.hs

@@ -2,6 +2,7 @@ module Dodge.Item.Equipment where
 import Dodge.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.LightSource
 import Dodge.Default
 import Dodge.Default.Wall
 import Dodge.Creature.Test
@@ -219,6 +220,26 @@ brainHat = defaultEquipment
     }
     & itUse . eqSite .~ GoesOnHead
 
+headLamp :: Item
+headLamp = defaultEquipment
+    { _itType = HEADLAMP
+    , _itName = "HEADLAMP"
+    , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
+            translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
+            <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1)
+            -- <> (upperPrismPoly 3 $ rectWH 4 4)
+            )
+    , _itEffect = NoItEffect
+    , _itID = Nothing
+    }
+    & itUse . eqUse .~ createHeadLamp
+    & itUse . eqSite .~ GoesOnHead
+
+createHeadLamp :: Creature -> Int -> World -> World
+createHeadLamp cr _ w = w
+    & tempLightSources .:~ tlsTimeRadColPos 1 200 0.5 
+        ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+
 powerLegs :: Item
 powerLegs = defaultEquipment
     { _itType = POWERLEGS