[Fencommits] fenfire-hs: page up and down keys scroll to where the property changes

[Tuukka Hastrup]

Sun Mar 18 15:57:38 EET 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * page up and down keys scroll to where the property changes
diff -rN -u old-fenfire-hs-1/Fenfire/Main.hs new-fenfire-hs-1/Fenfire/Main.hs
--- old-fenfire-hs-1/Fenfire/Main.hs	2007-03-18 16:01:04.000000000 +0200
+++ new-fenfire-hs-1/Fenfire/Main.hs	2007-03-18 16:01:04.000000000 +0200
@@ -192,6 +192,8 @@
         x | x == "Right" || x == "l"     -> handleAction "right"
         x | x == "Page_Up" -> handleAction "pageup"
         x | x == "Page_Down" -> handleAction "pagedown"
+        x | x == "Home" -> handleAction "propup"
+        x | x == "End" -> handleAction "propdown"
         "g" -> handleAction "goto"
         "v" -> handleAction "chgview"
         "p" -> handleAction "resetprop"
@@ -219,6 +221,7 @@
     case action of
         "up"    -> b tryRotate (-1) ; "down"  -> b tryRotate 1
         "pageup"-> b tryRotate (-10); "pagedown" -> b tryRotate 10
+        "propup"-> b findChange (-1); "propdown" -> b findChange 1
         "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-1/Fenfire.fhs new-fenfire-hs-1/Fenfire.fhs
--- old-fenfire-hs-1/Fenfire.fhs	2007-03-18 16:01:04.000000000 +0200
+++ new-fenfire-hs-1/Fenfire.fhs	2007-03-18 16:01:04.000000000 +0200
@@ -146,7 +146,7 @@
 
 
 tryRotate :: (?vs :: ViewSettings, ?graph :: Graph) =>
-          Rotation -> Int -> Maybe Rotation
+             Rotation -> Int -> Maybe Rotation
 tryRotate rot dir = listToMaybe $ catMaybes 
     [rotate rot dir' | dir' <- reverse $ map (signum dir *) [1..abs dir]]
 
@@ -159,6 +159,22 @@
             | otherwise = 0 - min (len `div` 2) (maxCenter ?vs)
     len = (length $ conns n dir)
     
+findChange :: (?vs :: ViewSettings, ?graph :: Graph) =>
+              Rotation -> Int -> Maybe Rotation
+findChange rot@(Rotation n r) dir = fmap (Rotation n . (r+)) change where
+    change = listToMaybe $ List.sortBy (\x y -> abs x `compare` abs y)
+                 $ catMaybes [findChange' Neg, findChange' Pos]
+    findChange' dir' = fmap (subtract r) r' where
+        len = length $ conns n dir'
+        index = r + min (len `div` 2) (maxCenter ?vs)
+        later = if dir > 0 then           drop (index+1) $ conns n dir'
+                           else reverse $ take  index    $ conns n dir'
+        pathToProp (Path _ [Conn prop _ _]) = prop
+        pathToProp (Path _ _) = error "pathToProp undefined for long paths"
+        currentProperty = fmap pathToProp $ toPath rot dir'
+        (same,next) = span ((== currentProperty) . Just . pathToProp) later
+        r' = listToMaybe $ map (rotationOffs . fromPath) $ reverse same ++ next
+
 modifyGraph :: Graph -> Path -> Endo FenState
 modifyGraph graph' path' state = 
     state { fsGraph=graph', fsPath=path', fsGraphModified=True,