Created
January 31, 2019 22:40
-
-
Save darcykimball/57ad1e20a3d15cafc6aa8073a2823081 to your computer and use it in GitHub Desktop.
Shake a circle in gloss
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Shake where | |
| import Graphics.Gloss.Interface.Pure.Game | |
| -- An animation is represented as a function of time on some interval | |
| data Animation a = Animation { | |
| _animationDuration :: Float | |
| , _animationFunction :: Float -> a | |
| , _animationProgress :: Maybe Float | |
| } | |
| data SingleDot = SingleDot { | |
| _xpos :: Float | |
| , _ypos :: Float | |
| } deriving (Show) | |
| shakeHorizontal :: | |
| SingleDot -> -- Initial state | |
| Float -> -- Time | |
| SingleDot | |
| shakeHorizontal (SingleDot x y) t = | |
| SingleDot (10 * sin (100 * t) + x) y | |
| type World = Animation SingleDot | |
| shakeDotAnimation :: World | |
| shakeDotAnimation = Animation 0.2 (shakeHorizontal initState) Nothing | |
| where | |
| initState = SingleDot 0 0 | |
| handleEvent :: Event -> World -> World | |
| handleEvent (EventKey (MouseButton LeftButton) Down _ _) anim@(Animation duration f progress) = | |
| case progress of | |
| Just _ -> anim | |
| Nothing -> anim { _animationProgress = Just 0.0 } | |
| handleEvent _ anim = anim | |
| update :: Float -> World -> World | |
| update step anim@(Animation duration f progress) = | |
| case progress of | |
| Just soFar -> | |
| if soFar + step > duration | |
| then anim { _animationProgress = Nothing } | |
| else anim { _animationProgress = Just $ soFar + step } | |
| Nothing -> anim | |
| render :: World -> Picture | |
| render (Animation _ f progress) = | |
| renderSingleDot $ f timeArg | |
| where | |
| dotPicture = Circle 10.0 | |
| timeArg = maybe 0.0 id progress | |
| renderSingleDot :: SingleDot -> Picture | |
| renderSingleDot (SingleDot x y) = Translate x y dotPicture | |
| where | |
| dotPicture = Circle 30.0 | |
| testShake :: IO () | |
| testShake = play displayMode white fps initWorld render handleEvent update | |
| where | |
| displayMode = InWindow "testShake" (640, 480) (0, 0) | |
| fps = 60 | |
| initWorld = shakeDotAnimation |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment