Dream API - lander

land.lua

function love.load(arg)
  if arg[#arg] == "-debug" then require("mobdebug").start() end
  
  --love.graphics.setDefaultFilter("nearest", "nearest", 0)
  
  font = love.graphics.newFont("consolas.ttf", 16)
  
  shipSprite = love.graphics.newImage("images/ship.png")
  shipUpSprite = love.graphics.newImage("images/ship_eng_up.png")
 
  position = { x = 400, y = 500 }
  rotation = 0
  velocity = { x = 0, y = 0 }
  
  engineOn = false
  fuel = 500
  
  -- constants
  fuelPerSecond = 50
  gravity = -9.81
  engineThrust = 20 -- per second
  
  terrain = generateTerrain()
end

math.random = love.math.random

function love.keypressed(key)
  if key == 'escape' then
      love.event.quit()
  end
end

function love.update(dt)
  engineOn = love.keyboard.isDown(' ')
  --[[
  local actEngineTrust = Point(-math.cos(rotation) * engineTrust,
                               -math.sin(rotation) * engineTrust)
  local temp = (gravity + actEngineTrust) * dt
  position = posistion + dt*(velocity + temp/2)
  velocity = velocity + temp
  ]]
  -------
  
  if love.keyboard.isDown('right') then
    rotation = rotation + 0.5 * dt
  end
  if love.keyboard.isDown('left') then
    rotation = rotation - 0.5 * dt
  end
  
  position.x = position.x + velocity.x * dt
  position.y = position.y + velocity.y * dt
  
  if engineOn then
    velocity.x = velocity.x - math.cos(rotation + math.pi/2) * engineThrust * dt
    velocity.y = velocity.y + math.sin(rotation + math.pi/2) * engineThrust * dt
    
    fuel = fuel - fuelPerSecond * dt
  end
  
  velocity.y = velocity.y + gravity*dt
  
  -- end condition  
  for i=1,#terrain do
    if terrain[i][1] > position.x then
      local x1 = terrain[i-1][1]
      local x2 = terrain[i][1]
      local y1 = terrain[i-1][2]
      local y2 = terrain[i][2]
      
      local e = (position.x - x1) / (x2 - x1)
      local ty = (y2 - y1) * e + y1
      
      if (position.y-15) <= ty then
        engineOn = false
        love.update = function () end
      end
      
     break
    end
  end
end

function generateTerrain()
  segments = { }
  
  table.insert(segments, { 0, 100 })
  
  local x = 0
  while true do
    local plane = math.random(0,1)
    local lastX = segments[#segments][1]
    local lastY = segments[#segments][2]
    
    if plane == 1 then
      table.insert(segments, { lastX + 50, lastY })
      x = x + 50
    else
      local yDiff = math.random(-30, 30)
      table.insert(segments, { lastX + 10, lastY + yDiff })
      x = x + 10
    end
    
    if x > 800 then break end
  end
  
  return segments
end

function drawTerrain(terrain)
  love.graphics.setColor(180, 180, 180, 255)
  
  for i=1, #terrain-1 do
    love.graphics.line(terrain[i][1], 600-terrain[i][2], terrain[i+1][1], 600-terrain[i+1][2])
  end
end

function love.draw()
  local sprite
  if engineOn then
    sprite = shipUpSprite
  else
    sprite = shipSprite
  end

  love.graphics.setColor(255, 255, 255, 255)
  love.graphics.draw(sprite, position.x, 600-position.y, rotation, 1, 1, 16, 10)
  
  drawTerrain(terrain)
  
  love.graphics.setColor(30, 250, 30, 255)
  love.graphics.setFont(font);
  love.graphics.print("Fuel:     " .. tostring(fuel), 10, 10)
  love.graphics.print("Velocity: " .. tostring(velocity.y), 10, 30)
  love.graphics.print("Rotation: " .. tostring(rotation), 10, 50)
end

sample4.hs

-- Only one import required to reduce hassle
import Hate

-- either Lens or full FRP route. Choose wisely
import Control.Lens

-- constants are actually constant
fuelPerSecond = 50
gravity = -9.81
engineThrust = 20 -- per second (I don't think extended unit conversions should be a part of the library)

-- compared to Lua, we actually lay out our data definitions
data LunarLander = LunarLander {
    position :: Point,
    velocity :: Point,
    rotation :: Rotation, -- up for discussion whether it should be Double, Float or configurable
    engineOn :: Bool,
    fuel :: Number
}

type Terrain = [Point]

data GameState = GameState {
    lander :: LunarLander,
    terrain :: Terrain
}

-- I don't think a signature here wouldn't just be confusing
-- sampleLoad :: DrawFn GameState
sampleLoad = GameState <$> pure createLander <*> generateTerrain

createLander :: LunarLander
createLander = LunarLander { 
    position = Point 400 500,
    velocity = Point 0 0,
    rotation = 0
}

-- this probably shouldn't be IO, but Hate monad, to make easier use of configurable random numbers
-- left at IO to simplify for now
generateTerrain :: IO Terrain
-- different implementation suggestions welcome (refer to lua version for details)
generateTerrain = do
    -- something along the lines of
    -- start with (Point 0 100)
    -- keep adding new points via `addSegment` until you reach x == 800
    -- reverse and return the thing

addSegment :: MonadRandom m => [Point] -> m [Point]
addSegment xs = do
    let lastPoint = head xs
    ascend <- randomBool -- I don't care whether this exists. It's a dream API, after all.
    
    -- this if could be converted to return new point via monadic bind
    -- in that case, the 2nd one should `return` the pure value
    -- dunno if worth it
    if ascend
        then do
            yDiff <- random (-30, 30)
            let newPoint = lastPoint + (Point 10 yDiff)
            return $ newPoint : xs
        else
            let newPoint = lastPoint + (Point 50 0)
            return $ newPoint : xs

-- dunno how that would differ from drawFn to be honest, but love provides it,
-- and it's probably a good idea to split updates from drawing
sampleUpdate :: UpdateFn GameState
    -- no more stringly typed enumerations
    isKeyDown Keys.Space >>= set lander.engineOn -- of course bind makes sense here
    
    -- should that use dt, or do we assume constant logic update step?
    -- I favor the latter typically, if only because it's cleaner to write
    -- (and probably makes it harder to get timings wrong)
    when (isKeyDown Keys.RightArrow) rotation += 0.5
    when (isKeyDown Keys.RightArrow) rotation -= 0.5
    
    -- could that be simpler? of course, with bind again.
    -- is it worth it? up for consideration
    v <- use lander.velocity
    -- yeah, I know this integration is wrong.
    lander.position += v
    
    when (use lander.engineOn) $ do
        rotation <- use lander.rotation
        -- this could be achieved with some matrix operations
        -- should Hate provide them in an easy-to-use way? maybe later
        zoom (lander.velocity) $ do -- couldn't resist
            x += cos(rotation + pi/2) * engineThrust
            y += sin(rotation + pi/2) * engineThrust
    
    lander.fuel -= fuelPerSecond
    checkForTouchdown
    
checkForTouchdown = do
    -- find the line segment we could be colliding with (so that xMin < x < xMax)
    -- interpolate terrain height at a given level
    -- check if we hit it already
    -- end the game (somehow) if yes, depending on the velocity
    -- should Hate provide some ready-to-use primitives for game restart menu? perhaps...
    
-- perhaps that one could use MonadReader instead of MonadState?
-- Sounds hardcore, but I think I like it
sampleDraw :: DrawFn GameState
sampleDraw = do
    drawTerrain
    drawLander

drawTerrain = do 
    t <- use terrain
    -- map a line drawing function 

drawLander = do
    burning <- use lander.engineOn
    let sprite = if burning then shipBurningSprite else shipSprite
    
    draw sprite <$> use lander.position <*> use lander.rotation
    
config :: Config
config = 
    Config
        { windowTitle = "Sample 3"
        , windowSize  = (480, 200)
        }

main :: IO ()
main = runApp config sampleLoad sampleDraw