marionetta-0.1: Controller.hs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GADTs #-}

module Controller (Evento (..), catchEvento, mkWorld, World (..), Lasso (..), Verso (..)) where


import Data.Maybe (fromMaybe)

import Data.List.Zipper (mkZipper, Zipper , inserisci, elimina, destra, sinistra, modifica)
import Data.Tree.Missing (inspectTop , forward, backward)
import Model (Figura,  Punto)
import IFigura (IFigura(IFigura), traslazione, rotazione, movimentoCentroTop, modificaSelettori, ricentra, iselectors)

data MoveEffect = Ruotando Punto | Traslando Punto | SpostandoCentro Punto | Niente

data World = World (Zipper IFigura) MoveEffect

mkWorld :: Figura -> World 
mkWorld fig = World 
	(mkZipper $ IFigura fig [] (forward (inspectTop fig) fig) (backward (inspectTop fig) fig))
	Niente

data Lasso = Inizio | Fine
data Verso = Destra | Sinistra

data Evento where
	Refresh ::  Evento 
	Puntatore :: Punto -> Evento 
	Rotazione :: Punto -> Lasso -> Evento 
	Traslazione :: Punto -> Lasso -> Evento 
	SpostamentoCentro :: Punto -> Lasso -> Evento 
	Cancella :: Evento 
	Clona :: Evento 
	Fuoco :: Verso -> Evento 
	Ricentra :: Punto -> Evento 
	Seleziona :: Punto -> Evento 
	Deseleziona :: Evento
	Silent :: Evento

catchEvento :: Evento -> World -> World
catchEvento Refresh (World z _) = World z Niente
catchEvento (Puntatore p) (World z Niente) = World z Niente
catchEvento (Puntatore p) (World z (Traslando q)) = World (modifica (traslazione q p) z) $ Traslando p 
catchEvento (Puntatore p) (World z (Ruotando q)) = World (modifica (rotazione q p) z) $ Ruotando p 
catchEvento (Puntatore p) (World z (SpostandoCentro q)) = World (modifica (movimentoCentroTop q p) z) $ SpostandoCentro p 
catchEvento (Rotazione p Inizio) (World z _) = World z (Ruotando p)
catchEvento (Rotazione p Fine) (World z (Ruotando _)) = World z Niente
catchEvento (Rotazione p Fine) w = w
catchEvento (Traslazione p Inizio) (World z _) = World z (Traslando p)
catchEvento (Traslazione p Fine) (World z (Traslando _)) = World z Niente
catchEvento (Traslazione p Fine) w = w
catchEvento (SpostamentoCentro p Inizio) (World z _) = World z (SpostandoCentro p)
catchEvento (SpostamentoCentro p Fine) (World z (SpostandoCentro _)) = World z Niente
catchEvento (SpostamentoCentro p Fine) w = w
catchEvento Cancella (World z m) = World (fromMaybe z $ elimina z) m
catchEvento Clona (World z m) = World (inserisci id z) m
catchEvento (Fuoco Destra) (World z m) = World (destra z) m
catchEvento (Fuoco Sinistra) (World z m) = World (sinistra z) m
catchEvento (Seleziona p) (World z m) = World (modifica (modificaSelettori p) z) m
catchEvento Deseleziona (World z m) = World (modifica f z) m where
	f ifig = ifig {iselectors = []}
catchEvento (Ricentra p) (World z m)  = World (modifica (ricentra p) z) m
catchEvento Silent w = w