Reimplement floor item label cursors

app/Main.hs

@@ -51,9 +51,7 @@ main = do
         doPreload
         cleanUpPreload
         (initializeWorld $ generateFromTree lev1 $ initWorld)
-        (-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
+        ( \preData w -> do
-         \preData w -> --do render setparams w egFade
-                        do
                       startTicks <- SDL.ticks
                       (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) 
                                             (_cameraRot w) (_cameraZoom w) 

src/Dodge/Rendering.hs

@@ -24,12 +24,13 @@ import qualified Data.Set as S
 -- }}}
 fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = pictures
-             [ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
+            -- [ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
+             [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
              , scaler $ hudDrawings w
              , scaler $ onLayer MenuLayer menuScreen
              ]
     where scaler = scale (2 / _windowX w) (2 / _windowY w)
-          itLabels     = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
+--          itLabels     = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
           ppLabels     = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
           btLabels     = pictures $ map (drawButText w) (IM.elems (_buttons w))
           menuScreen :: Picture
@@ -69,6 +70,7 @@ worldPictures w
                         , wlPicts
                         , wallShadows
                         , smokeShadows
+                        , itLabels
                         ]
     where
           decPicts      = IM.elems $ _decorations w
@@ -88,94 +90,9 @@ worldPictures w
           yourRad = _crRad $ you w
          -- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w)))
          --                                       (map (_itFloorPict . _flIt) (IM.elems (_floorItems w)))
-          itLabels     = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
+         --
-          ppLabels     = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
+          scaler = onLayer LabelLayer . setLayer 1
-          btLabels     = pictures $ map (drawButText w) (IM.elems (_buttons w))
+          itLabels     = map (scaler . drawItemName w) (IM.elems (_floorItems w))
-          menuScreen :: Picture
-          menuScreen = case _menuState w of
-                        InGame -> blank 
-                        LevelMenu x -> 
-                            pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
-                            tst (-100) 100 0.4 ("LEVEL "++show x)
-                            ,controlsList
-                            ]
-                        PauseMenu   -> pictures 
-                                    [--color (withAlpha 0.5 black) $ polygon $ screenBox w
-                                    tst (-100) 100 0.4 "PAUSED"
-                                    ,tst (-100) 50 0.2 "n - new level"
-                                    ,tst (-100) 0 0.2 "r - restart"
-                                    , controlsList
-                                    ]
-                        GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
-                                    ,tst (-100) 100 0.4 "GAME OVER"
-                                    ,tst (-100) 50 0.2 "n - new level"
-                                    ,tst (-100) 0 0.2 "r - restart"
-                                    ,controlsList
-                                    ]
-                where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
-
-draw :: World -> Picture
-draw w
-    = case _mapDisplay w of
-         (True, z) -> scaler $ pictures [color white $ circleSolid 3
-                                ,scale z z $ rotate (0 - (_cameraRot w))
-                                    $ uncurry translate ((0,0) -.- _cameraCenter w) 
-                                    $ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
-         _ -> collectDrawings w
-    where yourPos = _crPos $ you w
-          f = scale (2/_windowX w) (2/_windowY w)
-          pathsTest = map drawPair $ _pathGraph' w
-          drawPair (x,y) = color cyan $ pictures [line [x,y]
-                           --         , uncurry translate x $ scale 0.05 0.05 $ text $ show x
-                                    ]
-          drawNode (i,x) = color yellow $ uncurry translate x $ scale 0.05 0.05 $ text $ show i
-          scaler = scale (2 / _windowX w) (2 / _windowY w)
-
-collectDrawings :: World -> Picture
-collectDrawings w = pictures $ (map screenShift $
-                                 concat
-                                 [ decPicts 
-                                 , ppPicts 
-                                 , itFloorPicts 
-                                 , crPicts
-                                 , clPicts
-                                 , buttonPicts 
-                                 , ptPicts 
-                                 , ptPicts'
-                                 , afterPtPicts'
-                                 , wlPicts
-                                 , wallShadows
-                                 , smokeShadows
-                                 ]) ++
-             [ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
-             , scaler $ hudDrawings w
-             , scaler $ onLayer MenuLayer menuScreen
-             ]
---                                <> [onLayer GloomLayer $ theLighting w]
-    where
-          screenShift = scale zoomx zoomy . rotate (0 - (_cameraRot w) )
-                                            . uncurry translate ((0,0) -.- _cameraPos w)
-          zoomx =  2 * _cameraZoom w / _windowX w
-          zoomy =  2 * _cameraZoom w / _windowY w
-          scaler = scale (2 / _windowX w) (2 / _windowY w)
-          decPicts      = IM.elems $ _decorations w
-          ptPicts       = map _ptPict (IM.elems (_particles w))
-          ptPicts'      = map _ptPict' $ _particles' w
-          afterPtPicts' = map _ptPict' $ _afterParticles' w
-          buttonPicts   = map btDraw (IM.elems (_buttons w))
-          ppPicts       = map ppDraw (IM.elems (_pressPlates w))
-          crPicts       = map crDraw $ IM.elems $ _creatures w
-          clPicts       = map clDraw $ IM.elems $ _clouds w
-          wallShadows   = map (setLayer 0 . drawWallShadow w) $ wallShadowsToDraw w
-          smokeShadows  = map (drawSmokeShadow w) $ _smoke w
-          wlPicts       = map (setLayer 0 . drawWall) (wallsToDraw w)
-          itFloorPicts  = map (drawItem) (IM.elems (_floorItems w))
-          yourPos = _crPos $ you w
-          yourRot = _crDir $ you w
-          yourRad = _crRad $ you w
-         -- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w)))
-         --                                       (map (_itFloorPict . _flIt) (IM.elems (_floorItems w)))
-          itLabels     = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
           ppLabels     = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
           btLabels     = pictures $ map (drawButText w) (IM.elems (_buttons w))
           menuScreen :: Picture
@@ -206,8 +123,7 @@ hudDrawings w = setLayer 1 $ (onLayer InvLayer)
                         $ pictures
                           [ displayInv 0 w
                           , dShadCol white $ displayHP 0 w
-                          , --color (itCol (yourItem w)) 
+                          , drawCursor (itCol (yourItem w)) w
-                                drawCursor (itCol (yourItem w)) w
                           , translate (-390) 20 
                                 $ scale 0.05 0.05 $ dShadCol white $ text (_testString w)
                           ]
@@ -450,8 +366,8 @@ displayAmount n | n > 1 = "-x" ++show n
 rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
 
 drawItem :: FloorItem -> Drawing
-drawItem (FlAm {_flItPos = p}) = uncurry translateDrawing p $ onLayer FlItLayer $ rectangleSolid 5 5
+drawItem (FlAm {_flItPos = p}) = uncurry translate p $ onLayer FlItLayer $ rectangleSolid 5 5
-drawItem flIt = uncurry translateDrawing (_flItPos flIt) 
+drawItem flIt = uncurry translate (_flItPos flIt) 
                     $ rotateDrawing (radToDeg $ _flItRot flIt)  (_itFloorPict (_flIt flIt))
 
 drawButText :: World -> Button -> Picture
@@ -486,19 +402,30 @@ drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100
 drawItemName :: World -> FloorItem -> Picture
 drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
                         && hasLOS (_flItPos flIt) (_crPos (you w)) w
-                                = t $ rotate (_cameraRot w)
+                                = pictures 
-                                    $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
+                                    [ scale (2/_windowX w) (2/_windowY w) 
-                                                 , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
+                                        . tranItPos
-                                                 ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
+                                        . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
                                         $ scale 0.1 0.1 $ text $ nameOfItem
+                                    , tranItPos' $ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
+                                    , tranItPos' $ scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
                                     ]
+                                   -- ,
+                                   -- t $ rotate (_cameraRot w)
+                                   -- $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
+                                   --              , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
+                                   --              ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
+                                   --              $ scale 0.1 0.1 $ text $ nameOfItem
+                                   --              ]
                     | otherwise = blank
-    where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
+    where tranItPos = uncurry translate $ zoom *.* (_flItPos flIt -.- _cameraPos w)
+          tranItPos' = uncurry translate $ (_flItPos flIt)
+          t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
           nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
                                     FlAm {_flAm = PistolBullet} -> "Bullets"
                                     FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
           zoom = _cameraZoom w
-          scLine = dShadCol white . line . fmap (sqrt zoom *.*)
+          scLine = line -- . fmap ( zoom *.*)
 
 ringPict :: Drawing
 ringPict = onLayer LabelLayer $ dShadCol white $ pictures [line [(-8,10),(-15,10),(-15,-10),(-8,-10)]