marionetta-0.1.0.1: Run.hs

module Run (Run, run, Geometrici (..), Grafici (..), Descrizione, Implementazione (..)) where

import Data.Tree (Tree)
import Data.Monoid (Monoid)
import Model (Pezzo (Pezzo), Punto (Punto), Assoluto, relativizza)

import View (Render, Colore, RenderHelp, renderWorld)
import Controller (World(World), Evento, mkWorld, catchEvento)


data Geometrici = Ge
	{	centroRotazioneX :: Float
	,	centroRotazioneY :: Float
	,	origineX :: Float
	,	origineY :: Float
	,	angolo	:: Float
	}

data Grafici = Gr
	{	lunghezza :: Float
	, 	schiacciamento :: Float
	}


type Descrizione = Tree (Geometrici, Grafici)

mkPezzo :: Geometrici -> Pezzo Assoluto 
mkPezzo (Ge x y xo yo beta) = (Pezzo (Punto (x,y)) (Punto (xo, yo)) alpha) where
                alpha = beta * pi / 180

data Implementazione b e = Implementazione
	{	mkSprite :: Grafici -> Render b
	,	colora :: Colore b
	,	mostraAiuto :: RenderHelp b 
	,	catturaEvento :: e -> Evento
	}

type Run b e = World -> (World -> b) -> (e -> World -> World) -> IO ()

run :: Monoid b => Run b e -> Implementazione b e -> Descrizione -> IO ()
run f (Implementazione mks co mo ca) de = f w rew cat where
	rew = renderWorld co mo (fmap (mks . snd) de) . (\(World ifig _) -> ifig)
	cat = catchEvento . ca 
	w = mkWorld (relativizza $ fmap (mkPezzo . fst) de)