scroll-1.20150313: View.hs

module View where

import qualified Data.Vector as V
import Control.Applicative
import Control.Monad.ST

import Types

mkView :: S -> ST RealWorld View
mkView s = View
	<$> freezeWorld (world s)
	<*> pure (player s)
	<*> pure (windows s)
	<*> pure False

freezeWorld :: World -> ST RealWorld (V.Vector (V.Vector Char))
freezeWorld w = V.mapM V.freeze =<< V.freeze w

-- (x, y) offset to use for viewport
type ViewOffset = (ViewDelta, ViewDelta)
type ViewDelta = Int

-- maximum (x, y) position of the screen
type MaxPos = Pos

initialViewOffset :: ViewOffset
initialViewOffset = (0, 0)

{- Adjust the offset to keep the player head in view.
 -
 - Method: If the player head comes near the screen border, bump the view
 - over by a few characters. Otherside, don't adjust the view, to avoid
 - excessive scrolling.
 -}
adjustOffset :: View -> ViewOffset -> MaxPos -> ViewOffset
adjustOffset v offset maxpos = (calc fst, calc snd)
  where
	hpos = playerHead (viewPlayer v)

	calc f
		| n >= maxn - 3 = offn + maxn - n - 3
		-- this is not symetric behavior, but I want to snap
		-- the left side of the ViewPort to the left of the screen
		-- when possible.
		| n <= 0 = 0
		| otherwise = offn
	  where
		n = hn + offn
		hn = f hpos
		offn = f offset
		maxn = f maxpos

{- Calculates a viewport into a vector that may be larger than the screen.
 - 
 - Given an delta to shift the viewport and the number of items that will
 - fit on the screen, and the length of the vectors being viewed,
 - returns a function to trim vectors to fit on the screen,
 - and the offset to use when displaying a trimmed vector.
 -}
viewPort :: ViewDelta -> Int -> Int -> (V.Vector a -> V.Vector a, Int)
viewPort delta num vlen
	| vis <= 0 = (const V.empty, 0)
	| delta < 0 = (V.slice (abs delta) vis, 0)
	| otherwise = (V.slice 0 vis, delta)
  where
	vis
		| delta < 0 = min num (vlen + delta)
		| num > vlen = if delta > num then 0 else vlen
		| otherwise = min (num - delta) (vlen - delta)