-- This module describes the basic terrain features of a level.

module Landscape (
  Landscape,
  FeatureType(..),
  Feature(..),
  is_wall, is_floor,
  opacity, transparency,
  get_glyph,
  get_feature,
  get_feature_type,
  open_door, close_door,
  new_landscape,
  shortest_path
) where

import Data.Array

import Util.Search
import Util.Grid
import Util
import Materials
import Glyph
import BoxChar

-- At some point, maybe have separate floor material and feature material,
-- so that we can have a wooden door in a stone doorway.
data FeatureType
  = Floor
  | Wall
  | ClosedDoor | LockedDoor | OpenDoor | BrokenDoor | Doorway

data Feature = Feature FeatureType Material

type Landscape = Array Position Feature

featureChar :: FeatureType -> Char
featureChar Floor = '.'
featureChar Wall = '#'
featureChar ClosedDoor = '+'
featureChar LockedDoor = '+'
featureChar OpenDoor = '\''
featureChar BrokenDoor = '.'
featureChar Doorway = '.'

instance Glyphable Feature where
  glyph (Feature f m) = Glyph (colorOf m) (featureChar f)

get_feature :: Landscape -> Position -> Feature
get_feature land pos = lookupA land def pos
  where def = Feature Wall Stone

get_feature_type :: Landscape -> Position -> FeatureType
get_feature_type land pos = ft
  where (Feature ft _) = get_feature land pos

is_wall :: Landscape -> Position -> Bool
is_wall land pos =
  case get_feature_type land pos of
    Wall -> True
    _ -> False

is_floor :: Landscape -> Position -> Bool
is_floor land pos =
  case get_feature_type land pos of
    Floor -> True
    _ -> False

-- 1.0 is fully opaque, 0 is fully transparent
opacity :: Feature -> Double
opacity (Feature ft m) =
  let ft_trans = case ft of
        Floor -> 0
        Wall -> 1.0
        ClosedDoor -> 1.0
        LockedDoor -> 1.0
        OpenDoor -> 0.5
        BrokenDoor -> 0.2
        Doorway -> 0.1
      m_trans = case m of
        Glass -> 0.5
        Liquid -> 0.75
        _ -> 1.0
  in ft_trans * m_trans

transparency :: Feature -> Double
transparency f = 1.0 - opacity f

-- Fetch a glyph from the landscape, while applying a "wall filter"
-- which uses line drawing characters for the walls.
-- The wall filter makes the shape of each wall depend on whether
-- its horizontal and vertical neighbors are walls.
get_glyph :: Landscape -> Position -> Glyph
get_glyph land (x, y) =
  case get_feature land (x, y) of
    (Feature Wall m) -> Glyph (colorOf m) wallChar
    feature -> glyph feature
  where
    l = is_wall land (x-1,y)
    r = is_wall land (x+1,y)
    a = is_wall land (x,y-1)
    b = is_wall land (x,y+1)
    solidl = is_wall land (x-1,y-1) && is_wall land (x-1,y+1)
    solidr = is_wall land (x+1,y-1) && is_wall land (x+1,y+1)
    solida = is_wall land (x-1,y-1) && is_wall land (x+1,y-1)
    solidb = is_wall land (x-1,y+1) && is_wall land (x+1,y+1)
    wallChar = case (l, r, a, b) of
      -- (left, right, above, below)
      (False, False, False, False) -> ch_bullet
      (False, False, _, _) -> ch_vline
      (_, _, False, False) -> ch_hline
      (False, True, False, True) -> ch_ulcorner
      (False, True, True, False) -> ch_llcorner
      (False, True, True, True) -> if solidr then ch_vline else ch_ltee
      (True, False, False, True) -> ch_urcorner
      (True, False, True, False) -> ch_lrcorner
      (True, False, True, True) -> if solidl then ch_vline else ch_rtee
      (True, True, False, True) -> if solidb then ch_hline else ch_ttee 
      (True, True, True, False) -> if solida then ch_hline else ch_btee
      (True, True, True, True) -> 
        case (solidl, solidr, solida, solidb) of
          (False, False, False, False) -> ch_plus
          (False, False, False, True) -> ch_btee
          (False, False, True, False) -> ch_ttee
          (_, _, True, True) -> ' '
          (False, True, False, False) -> ch_rtee
          (False, True, False, True) -> ch_lrcorner
          (False, True, True, False) -> ch_urcorner
          (True, False, False, False) -> ch_ltee
          (True, False, False, True) -> ch_llcorner
          (True, False, True, False) -> ch_ulcorner
          (True, True, _, _) -> ' '

-- Create a new landscape with each position initialized to the same feature.
new_landscape :: Position -> Position -> Feature -> Landscape
new_landscape from to feature = listArray (from, to) (repeat feature)

-- If there's a ClosedDoor at the specified position, open it.
open_door :: Position -> Landscape -> Landscape
open_door pos land =
  let (Feature ft m) = land ! pos in
  case ft of
    ClosedDoor -> land // [ (pos, Feature OpenDoor m) ]
    _ -> land

-- If there's an OpenDoor at the specified position, close it.
close_door :: Position -> Landscape -> Landscape
close_door pos land =
  let (Feature ft m) = land ! pos in
  case ft of
    OpenDoor -> land // [ (pos, Feature ClosedDoor m) ]
    _ -> land

type CostF = Position -> Int
shortest_path :: CostF -> Position -> Position -> [Position]
shortest_path costf from to = 
  let next parent pos = zip n (map costf n)
        where n = next_steps parent pos
  in astar next (posdist to) (to ==) from