[Fencommits] fenfire-hs: page up and down try to rotate 10 steps at a time

[Tuukka Hastrup]

Thu Mar 15 18:10:06 EET 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * page up and down try to rotate 10 steps at a time
diff -rN -u old-fenfire-hs/Fenfire/Main.hs new-fenfire-hs/Fenfire/Main.hs
--- old-fenfire-hs/Fenfire/Main.hs	2007-03-15 18:11:12.000000000 +0200
+++ new-fenfire-hs/Fenfire/Main.hs	2007-03-15 18:11:12.000000000 +0200
@@ -170,6 +170,8 @@
         x | x == "Down"  || x == "comma" -> handleAction "down"
         x | x == "Left"  || x == "j"     -> handleAction "left"
         x | x == "Right" || x == "l"     -> handleAction "right"
+        x | x == "Page_Up" -> handleAction "pageup"
+        x | x == "Page_Down" -> handleAction "pagedown"
         "g" -> handleAction "goto"
         "v" -> handleAction "chgview"
         "p" -> handleAction "resetprop"
@@ -195,7 +197,8 @@
         n f x = do state' <- liftIO (f x state); put state'; setInterp True
         o f x = do put (f x state); setInterp True
     case action of
-        "up"    -> b rotate (-1)    ; "down"  -> b rotate 1
+        "up"    -> b tryRotate (-1) ; "down"  -> b tryRotate 1
+        "pageup"-> b tryRotate (-10); "pagedown" -> b tryRotate 10
         "left"  -> b tryMove Neg    ; "right" -> b tryMove Pos
         "nodel" -> n newNode Neg    ; "noder" -> n newNode Pos
         "connl" -> o connect Neg    ; "connr" -> o connect Pos
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs	2007-03-15 18:11:12.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs	2007-03-15 18:11:12.000000000 +0200
@@ -31,7 +31,8 @@
 import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Set (Set)
-import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, catMaybes)
+import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, catMaybes, 
+                   listToMaybe)
 import Data.Monoid(Monoid(mempty, mconcat))
 
 import Control.Applicative
@@ -142,6 +143,10 @@
     vob = pad 30 $ translate #0 #(-y) $ vbox $ vobs
 
 
+tryRotate :: (?vs :: ViewSettings, ?graph :: Graph) =>
+          Rotation -> Int -> Maybe Rotation
+tryRotate rot dir = listToMaybe $ catMaybes 
+    [rotate rot dir' | dir' <- reverse $ map (signum dir*) [1..abs dir]]
 
 tryMove :: (?vs :: ViewSettings, ?graph :: Graph) =>
            Rotation -> Dir -> Maybe Rotation