module UserEvent (userEvent) where import Config import Model as M import Data.Array.Repa as R import Graphics.Gloss.Interface.Pure.Game as G -- | Handle user events for the Gloss `playIO` wrapper. userEvent :: Config -> Event -> Model -> Model userEvent config (EventKey key keyState _mods (x, y)) (Model df ds vf vs cl sp _cb) | MouseButton G.LeftButton <- key , Down <- keyState , (x',y') <- windowToModel config (x, y) = Model { densityField = df , densitySource = Just (Source (Z:.y':.x') 1) , velocityField = vf , velocitySource = vs , clickLoc = cl , stepsPassed = sp , currButton = M.LeftButton } | MouseButton G.LeftButton <- key , Up <- keyState = Model { densityField = df , densitySource = ds , velocityField = vf , velocitySource = vs , clickLoc = cl , stepsPassed = sp , currButton = M.None } | MouseButton G.RightButton <- key , Down <- keyState , (x',y') <- windowToModel config (x,y) = Model { densityField = df , densitySource = ds , velocityField = vf , velocitySource = vs , clickLoc = Just (x',y') , stepsPassed = sp , currButton = M.RightButton } | MouseButton G.RightButton <- key , Up <- keyState , Just (locX, locY) <- cl , (x',y') <- windowToModel config (x,y) = Model { densityField = df , densitySource = ds , velocityField = vf , velocitySource = Just (Source (Z:.locY:.locX) (fromIntegral (locX-x'),fromIntegral (locY-y'))) , clickLoc = Nothing , stepsPassed = sp , currButton = M.None } -- Reset model | Char 'r' <- key , Down <- keyState = initModel (configInitialDensity config) (configInitialVelocity config) -- Quit program | Char 'q' <- key , Down <- keyState = error "Quitting" userEvent config (EventMotion (x, y)) (Model df _ds vf vs cl sp M.LeftButton) | (x',y') <- windowToModel config (x, y) = Model { densityField = df , densitySource = Just (Source (Z:.y':.x') 1) , velocityField = vf , velocitySource = vs , clickLoc = cl , stepsPassed = sp , currButton = M.LeftButton } userEvent config (EventMotion (x, y)) (Model df ds vf _vs (Just (clx, cly)) sp M.RightButton) | (x', y') <- windowToModel config (x,y) = Model { densityField = df , densitySource = ds , velocityField = vf , velocitySource = Just (Source (Z:.y':.x') (fromIntegral (clx-x'), fromIntegral (cly-y'))) , clickLoc = Just (x',y') , stepsPassed = sp , currButton = M.RightButton } userEvent _ _ m = m -- Converts a window location to the corresponding location in the -- simulation. windowToModel :: Config -> (Float, Float) -> (Int, Int) windowToModel config (x, y) = (x', y') where (scaleX, scaleY) = configScale config (windowWidth, windowHeight) = configWindowSize config x' = round ((x + (fromIntegral windowWidth / 2)) / scaleX) y' = round ((y + (fromIntegral windowHeight / 2)) / scaleY)