restart on escape

2018-09-21 22:25:23 +02:00 · 2018-09-21 22:25:23 +02:00 · e0a272fb4e
parent 086302be5e
commit e0a272fb4e
1 changed files with 9 additions and 1 deletions
--- a/src/Main.hs
+++ b/src/Main.hs
@ -68,7 +68,15 @@ pre = do

 quitGame :: KeyboardMessage -> Affection UserData ()
 quitGame (MsgKeyboardEvent _ _ SDL.Pressed False sym)
-  | SDL.keysymKeycode sym == SDL.KeycodeEscape = quit
+  | SDL.keysymKeycode sym == SDL.KeycodeEscape = do
+    ad <- A.get
+    ud <- getAffection
+    SDL.glMakeCurrent (drawWindow ad) (glContext ad)
+    (ws, _) <- yieldSystemT (0, defStorage) (return ())
+    putAffection ud
+      { worldState = ws
+      }
+    smLoad Load
  | otherwise                                  = return ()
 quitGame _ = return ()