darcs - INblobs

1 module INTextualUI

2 ( genTextual

3 , changeExt

4 ) where

6 import Operations

7 import SafetyNet

8 import INTextual

9 import InfoKind

10 import State

11 import qualified PersistentDocument as PD

13 import Graphics.UI.WXCore hiding (Document)

14 import Graphics.UI.WX

16 import Data.Maybe

18 data What = Everything | JustRules | JustNet

20 -- Generate textual description

21 genTextual :: (InfoKind n g, InfoKind e g) => IOOp g n e

22 genTextual doc state =

23 do mRes <- genTextualDialog state

24 pDoc <- getDocument state

25 inName <- PD.getFileName pDoc

26 case mRes of

27 Nothing -> return ()

28 Just (what, simp, wher, tool) ->

29 do let simpF = if simp then simplify else id

30 filt = case what of

31 Everything -> id

32 JustRules -> filterRules

33 JustNet -> filterNet

34 net = filt . simpF $ doc2net doc

36 if wher

37 then -- save to file

38 do w <- getNetworkFrame state

39 safetyNet w $

40 do

41 let filename = changeExt ".INblobs" ('-':show tool ++ ".net") $ fromMaybe "" inName

42 mf <- fileSaveDialog w

43 rememberCurrentDir overwritePrompt

44 "Save net equations"

45 [("Net Files", ["*.net"])]

46 directory filename

47 case mf of

48 Nothing -> return ()

49 Just fn -> writeFile fn . showRepresentation tool $ net

51 else -- print to screen

52 do logMessage "printing Net"

53 logMessage (showRepresentation tool net)

54 putStr $ showRepresentation tool net

55 where rememberCurrentDir = True

56 overwritePrompt = True

57 directory = ""

59 -- | Change file extension and suffix filename.

60 changeExt :: String -- ^ \".INblobs\"

61 -> String -- ^ \"-TOOL.net\"

62 -> String -- ^ file.INblobs

63 -> String -- ^ file-TOOL.net

64 changeExt old suffix = aux . span (/= '.')

65 where

66 aux (str,"") = str ++ suffix

67 aux (str1, str2)

68 | str2 == old = str1 ++ suffix

69 | otherwise = let (str3,str4) = span (/='.') (tail str2)

70 in aux (str1 ++ '.':str3, str4)

72 genTextualDialog :: State g n e -> IO (Maybe (What, Bool, Bool, Representation))

73 genTextualDialog state =

74 do theFrame <- getNetworkFrame state

76 dialog <- dialog theFrame

77 [ text := "Generate Textual Description"

78 -- , visible := True

79 ]

80 p <- panel dialog []

82 let infoWhat = [ ("interaction system and net", Everything)

83 , ("interaction system only", JustRules)

84 , ("interaction net only",JustNet)

85 ]

86 (labelsWhat,dataWhat) = unzip infoWhat

88 rWhat <- radioBox p Vertical labelsWhat

89 [ text := "Of :"

90 , selection := 0 ]

92 let infoSimp = [ ("simplified", True)

93 , ("not simplified", False)

94 ]

95 (labelsSimp,dataSimp) = unzip infoSimp

97 rSimp <- radioBox p Vertical labelsSimp

98 [ text := "Version :"

99 , selection := 0 ]

100

101 let infoWhere = [ ("save to file", True)

102 , ("print to screen", False)

103 ]

104 (labelsWhere,dataWhere) = unzip infoWhere

105

106 rWhere <- radioBox p Vertical labelsWhere

107 [ text := "To :"

108 , selection := 0 ]

109 let infoTool = [ ("AMIN", AMIN)

110 , ("PIN", PIN)

111 ]

112 (labelsTool,dataTool) = unzip infoTool

113

114 rTool <- radioBox p Vertical labelsTool

115 [ text := "Output Tool :"

116 , selection := 0 ]

117

118 ok <- button p [ text := "Ok" ]

119

120 set dialog [ layout := container p $

121 margin 10 $

122 column 5 [ label "Generate textual description"

123 , widget rWhat

124 , widget rSimp

125 , widget rWhere

126 , widget rTool

127 , hfloatCentre $ widget ok

128 ]

129 ]

130

131 showModal dialog $ \stop ->

132 do set ok [on command :=

133 do iWhat <- get rWhat selection

134 iSimp <- get rSimp selection

135 iWhere <- get rWhere selection

136 iTool <- get rTool selection

137

138 stop (Just ( dataWhat !! iWhat

139 , dataSimp !! iSimp

140 , dataWhere !! iWhere

141 , dataTool !! iTool

142 )

143 ) ]