Let the user set the target output format (defaults to PS; used to select the format of images that are inserted into the dot graph).

1 files changed, 27 insertions, 3 deletions

diff --git a/tools/resolver-visualize/Main.hs b/tools/resolver-visualize/Main.hs
index 61ceab32..d2799e92 100755
--- a/tools/resolver-visualize/Main.hs
+++ b/tools/resolver-visualize/Main.hs
@@ -218,6 +218,9 @@ type TreeViewStore  = TreeStore TreeViewEntry
 type ChronViewStore = ListStore ChronViewEntry
 type RunListStore   = ListStore (Integer, [ProcessingStep])
 
+data TargetFormat = PS | PNG
+    deriving(Eq, Ord, Show, Read)
+
 -- | Parameters the user can set at the command-line.
 data Params =
     Params {
@@ -227,11 +230,14 @@ data Params =
       -- | The first step to start rendering.
       firstStep :: Maybe Integer,
       -- | Where and whether to send dot output.
-      dotOutput :: Maybe String
+      dotOutput :: Maybe String,
+      -- | The target output format.
+      targetFormat :: Maybe TargetFormat
     } deriving(Eq, Ord, Show)
 defaultParams = Params { maxSteps  = Nothing,
                          firstStep = Nothing,
-                         dotOutput = Nothing }
+                         dotOutput = Nothing,
+                         targetFormat = Nothing }
 
 -- | Shared context for the visualizer.
 data VisualizeContext =
@@ -950,6 +956,11 @@ filterUserParams ("--first-step":(n:args)) params = let params' = params { first
                                                     filterUserParams args params'
 filterUserParams ("--dot-output":(fn:args)) params = let params' = params { dotOutput = Just $ fn } in
                                                      filterUserParams args params'
+filterUserParams ("--target-format":(fmt:args)) params =
+    case reads fmt of
+      []             -> error (printf "Unknown target format %s" (show fmt))
+      ((fmt', _):_)  -> let params' = params { targetFormat = Just fmt' } in
+                        filterUserParams args params'
 filterUserParams (arg:args) params = let (args', params') = filterUserParams args params in
                                      (arg:args', params')
 
@@ -974,6 +985,19 @@ dotChoiceLabel :: LinkChoice -> String
 dotChoiceLabel lc@(LinkChoice c) = choiceText lc
 dotChoiceLabel Unknown           = ""
 
+inferTargetFormat :: Params -> TargetFormat
+inferTargetFormat (Params { targetFormat = fmt,
+                            dotOutput    = output }) =
+    case fmt of
+      Nothing -> PS
+      Just fmt' -> fmt'
+
+cloudImage :: Params -> String
+cloudImage params =
+    case inferTargetFormat params of
+      PS -> "cloud.eps"
+      PNG -> "cloud.png"
+
 dotStepNode :: Params -> ProcessingStep -> Node
 dotStepNode params step = let n = node (name $ printf "step%d" (stepOrder step))
                                   ..= ("label", printf "Step: %d\nScore: %d\nTier: %s"
@@ -1004,7 +1028,7 @@ dotUnprocessedSuccs params step = unprocessed ++ excluded
           excluded    = [ node (name $ printf "step%d" (stepOrder step))
                                    ..= ("label", printf "%d nodes..." (stepBranchSize step))
                                    ..= ("shape", "plaintext")
-                                   ..= ("image", "cloud.png")
+                                   ..= ("image", cloudImage params)
                           | (Successor { successorStep = step }) <- stepSuccessors step,
                             not $ inBounds params (stepOrder step) ]