module INTextualUI ( genTextual , changeExt ) where import Operations import SafetyNet import INTextual import InfoKind import State import qualified PersistentDocument as PD import Graphics.UI.WXCore hiding (Document) import Graphics.UI.WX import Data.Maybe data What = Everything | JustRules | JustNet -- Generate textual description genTextual :: (InfoKind n g, InfoKind e g) => IOOp g n e genTextual doc state = do mRes <- genTextualDialog state pDoc <- getDocument state inName <- PD.getFileName pDoc case mRes of Nothing -> return () Just (what, simp, wher, tool) -> do let simpF = if simp then simplify else id filt = case what of Everything -> id JustRules -> filterRules JustNet -> filterNet net = filt . simpF $ doc2net doc if wher then -- save to file do w <- getNetworkFrame state safetyNet w $ do let filename = changeExt ".INblobs" ('-':show tool ++ ".net") $ fromMaybe "" inName mf <- fileSaveDialog w rememberCurrentDir overwritePrompt "Save net equations" [("Net Files", ["*.net"])] directory filename case mf of Nothing -> return () Just fn -> writeFile fn . showRepresentation tool $ net else -- print to screen do logMessage "printing Net" logMessage (showRepresentation tool net) putStr $ showRepresentation tool net where rememberCurrentDir = True overwritePrompt = True directory = "" -- | Change file extension and suffix filename. changeExt :: String -- ^ \".INblobs\" -> String -- ^ \"-TOOL.net\" -> String -- ^ file.INblobs -> String -- ^ file-TOOL.net changeExt old suffix = aux . span (/= '.') where aux (str,"") = str ++ suffix aux (str1, str2) | str2 == old = str1 ++ suffix | otherwise = let (str3,str4) = span (/='.') (tail str2) in aux (str1 ++ '.':str3, str4) genTextualDialog :: State g n e -> IO (Maybe (What, Bool, Bool, Representation)) genTextualDialog state = do theFrame <- getNetworkFrame state dialog <- dialog theFrame [ text := "Generate Textual Description" -- , visible := True ] p <- panel dialog [] let infoWhat = [ ("interaction system and net", Everything) , ("interaction system only", JustRules) , ("interaction net only",JustNet) ] (labelsWhat,dataWhat) = unzip infoWhat rWhat <- radioBox p Vertical labelsWhat [ text := "Of :" , selection := 0 ] let infoSimp = [ ("simplified", True) , ("not simplified", False) ] (labelsSimp,dataSimp) = unzip infoSimp rSimp <- radioBox p Vertical labelsSimp [ text := "Version :" , selection := 0 ] let infoWhere = [ ("save to file", True) , ("print to screen", False) ] (labelsWhere,dataWhere) = unzip infoWhere rWhere <- radioBox p Vertical labelsWhere [ text := "To :" , selection := 0 ] let infoTool = [ ("AMIN", AMIN) , ("PIN", PIN) ] (labelsTool,dataTool) = unzip infoTool rTool <- radioBox p Vertical labelsTool [ text := "Output Tool :" , selection := 0 ] ok <- button p [ text := "Ok" ] set dialog [ layout := container p $ margin 10 $ column 5 [ label "Generate textual description" , widget rWhat , widget rSimp , widget rWhere , widget rTool , hfloatCentre $ widget ok ] ] showModal dialog $ \stop -> do set ok [on command := do iWhat <- get rWhat selection iSimp <- get rSimp selection iWhere <- get rWhere selection iTool <- get rTool selection stop (Just ( dataWhat !! iWhat , dataSimp !! iSimp , dataWhere !! iWhere , dataTool !! iTool ) ) ]