{-# 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