Example of hovering over a grid

hoveringGridExample.elm

import Graphics.Collage (..)
import Graphics.Element (..)
import Graphics.Input (..)
import Color (..)
import Signal (..)

import Text
import List
import Mouse


--------
-- Model
--------

type alias Cell = 
  { position      : { x : Float, y : Float }
  , dimensions    : { width : Float, height : Float }
  , isHoveredOver : Bool
  }
  
type alias Grid = List Cell

type alias Model = 
  { grid : Grid }



grid : (Int, Int) -> (Float, Float) -> (Float, Float) -> Float -> Grid
grid (rows, columns) (width, height) (offsetX, offsetY) margin = 
  if 
    rows <= 0 || columns <= 0
  then 
    []
  else
    let
        gridIter : List (Int, List Int)
        gridIter = List.map (\x -> (x, [1..columns])) [1..rows]
        
        makeCell : (Int, Int) -> Cell
        makeCell (row, column) = 
          { position = 
            { x = offsetX + toFloat (column) * width + (margin * toFloat column)
            , y = offsetY + toFloat (row) * height + (margin * toFloat row)
            }
          , dimensions = 
            { width  = width
            , height = height
            }
          , isHoveredOver = False
          }
          
        makeRow : (Int, List Int) -> List Cell
        makeRow (row, columns) = 
          List.map (\column -> makeCell (row, column)) columns
          
        makeGrid : List (Int, List Int) -> Grid
        makeGrid = 
          List.concat << List.map makeRow
         
        
    in 
        makeGrid gridIter


initialModel : Model
initialModel = 
  { grid = grid (10,10) (20,20) (-50, -100) 2 }
  
  
-------
-- View
-------

drawCell : Cell -> Form 
drawCell cell = 
  let 
      cellColor = 
        if 
          cell.isHoveredOver
        then 
          blue
        else
          red
           
  in
      move (cell.position.x, cell.position.y) <|
        filled cellColor <|
          rect cell.dimensions.width cell.dimensions.height



drawGrid : Grid -> List Form 
drawGrid grid = 
  List.map drawCell grid
  
  
view : Model -> Element
view model = 
  collage 400 400 (drawGrid model.grid) 
  
--------
-- Input  
--------

type alias Input = 
  { mousePosition : (Int, Int) }
  
  
convertToViewCoordinates : (Int, Int) -> (Int, Int) 
convertToViewCoordinates (x,y) =
  (x - 200, 200 - y)

input : Signal Input
input = 
  Input << convertToViewCoordinates <~ Mouse.position
  
  
---------
-- Update
---------


stepCell : Input -> Cell -> Cell
stepCell input cell = 
  let
      (mouseX, mouseY) = input.mousePosition
      
  in
      if 
        toFloat mouseX > cell.position.x - cell.dimensions.width / 2 &&
        toFloat mouseX < cell.position.x + cell.dimensions.width / 2 &&
        toFloat mouseY > cell.position.y - cell.dimensions.height / 2 &&
        toFloat mouseY < cell.position.y + cell.dimensions.height / 2
      then
        { cell | isHoveredOver <- True }
      else 
        { cell | isHoveredOver <- False }
    


step : Input -> Model -> Model
step input model = 
  { model | grid <- List.map (stepCell input) model.grid }


-------
-- Main
-------

main : Signal Element
main = 
  view <~ foldp step initialModel input