maxent-learner-hw-gui 0.2.0 → 0.2.1
raw patch · 5 files changed
+107/−35 lines, 5 filesdep ~maxent-learner-hw
Dependency ranges changed: maxent-learner-hw
Files
- app/FeatureTableEditor.hs +77/−15
- app/GrammarEditor.hs +9/−6
- app/LexiconEditor.hs +11/−7
- app/Main.hs +8/−5
- maxent-learner-hw-gui.cabal +2/−2
app/FeatureTableEditor.hs view
@@ -13,6 +13,8 @@ import Control.Monad import Control.Exception import Data.Tuple+import Data.List+import Data.Maybe import Text.PhonotacticLearner.PhonotacticConstraints import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -57,6 +59,22 @@ slook = M.fromList (fmap swap (assocs segs)) flook = M.fromList (fmap swap (assocs fnames)) +resegft :: [String] -> FeatureTable String -> FeatureTable String+resegft segs oldft = FeatureTable ftarr fnames segsarr flook slook where+ fnames = featNames oldft+ flook = featLookup oldft+ (fa,fb) = bounds fnames+ uniqsegs = nub segs+ nsegs = length uniqsegs+ segsarr = listArray (Seg 1, Seg nsegs) uniqsegs+ slook = M.fromList (fmap swap (assocs segsarr))+ ftarr = array ((Seg 1,fa), (Seg nsegs,fb)) $ do+ f <- indices fnames+ (sr,s) <- assocs segsarr+ let fs = fromMaybe FOff $ do+ sr' <- M.lookup s (segLookup oldft)+ return $ ftlook oldft sr' f+ return ((sr,f),fs) setFTContents :: TreeView -> FeatureTable String -> IO (Array SegRef String, ListStore FTRow) setFTContents editor newft = do@@ -115,6 +133,32 @@ bincsv <- B.readFile fp evaluate $ force . csvToFeatureTable id . T.unpack =<< either (const Nothing) Just (T.decodeUtf8' bincsv) +runTextDialog :: Maybe Window -> T.Text -> T.Text -> Now (Event (Maybe T.Text))+runTextDialog transwin q defa = do+ (retev, cb) <- callback+ dia <- sync $ dialogNew+ ent <- sync $ entryNew+ sync $ do+ case transwin of+ Just win -> set dia [windowTransientFor := win, windowModal := True]+ Nothing -> return ()+ dialogAddButton dia "gtk-ok" ResponseOk+ dialogAddButton dia "gtk-cancel" ResponseCancel+ ca <- castToBox <$> dialogGetContentArea dia+ entrySetText ent defa+ lbl <- createLabel q+ boxPackStart ca lbl PackGrow 0+ boxPackStart ca ent PackNatural 0+ on dia response $ \resp -> do+ case resp of+ ResponseOk -> do+ txt <- entryGetText ent+ cb (Just txt)+ _ -> cb Nothing+ widgetDestroy dia+ widgetShowAll dia+ return retev+ createEditableFT :: Maybe Window -> FeatureTable String -> Now (VBox, Behavior (FeatureTable String)) createEditableFT transwin initft = do editor <- sync treeViewNew@@ -126,6 +170,7 @@ (addButton, addPressed) <- createButton (Just "list-add") Nothing (delButton, delPressed) <- createButton (Just "list-remove") Nothing (editButton, isEditing) <- createToggleButton (Just "accessories-text-editor") (Just "Edit Table") False+ (segButton, segPressed) <- createButton Nothing (Just "Change Segments") setAttr widgetSensitive addButton isEditing setAttr widgetSensitive delButton isEditing @@ -140,15 +185,6 @@ viewer <- displayDynFeatureTable currentft - bar <- createHBox 2 $ do- bpack addButton- bpack delButton- bspacer- bpack editButton- bpack loadButton- bpack saveButton-- top <- sync stackNew sync $ do stackAddNamed top viewer "False"@@ -157,20 +193,29 @@ vb <- createVBox 2 $ do bstretch =<< createFrame ShadowIn top- bpack bar+ bpack <=< createHBox 2 $ do+ bpack addButton+ bpack delButton+ bspacer+ bpack segButton+ bpack editButton+ bpack loadButton+ bpack saveButton - csvfilter <- sync fileFilterNew+ {-csvfilter <- sync fileFilterNew allfilter <- sync fileFilterNew sync $ do fileFilterAddMimeType csvfilter "text/csv" fileFilterSetName csvfilter "CSV" fileFilterAddPattern allfilter "*" fileFilterSetName allfilter "All Files"+ -} loadDialog <- sync $ fileChooserDialogNew (Just "Open Feature Table") transwin FileChooserActionOpen [("gtk-cancel", ResponseCancel), ("gtk-open", ResponseAccept)]- sync $ fileChooserAddFilter loadDialog csvfilter- sync $ fileChooserAddFilter loadDialog allfilter+ --sync $ fileChooserAddFilter loadDialog csvfilter+ --sync $ fileChooserAddFilter loadDialog allfilter+ sync $ set loadDialog [windowModal := True] flip callStream loadPressed $ \_ -> do filePicked <- runFileChooserDialog loadDialog emft <- planNow . ffor filePicked $ \case@@ -186,8 +231,9 @@ saveDialog <- sync $ fileChooserDialogNew (Just "Save Feature Table") transwin FileChooserActionSave [("gtk-cancel", ResponseCancel), ("gtk-save", ResponseAccept)]- sync $ fileChooserAddFilter saveDialog csvfilter- sync $ fileChooserAddFilter saveDialog allfilter+ --sync $ fileChooserAddFilter saveDialog csvfilter+ --sync $ fileChooserAddFilter saveDialog allfilter+ sync $ set saveDialog [windowModal := True] flip callStream savePressed $ \_ -> do savePicked <- runFileChooserDialog saveDialog planNow . ffor savePicked $ \case@@ -201,6 +247,22 @@ putStrLn $ "Wrote Feature Table " ++ fn return () return ()++ flip callStream segPressed $ \_ -> do+ oldft <- sample currentft+ let oldsegs = T.pack . unwords . elems . segNames $ oldft+ enewsegs <- runTextDialog transwin "Enter a new set of segments." oldsegs+ planNow . ffor enewsegs $ \case+ Nothing -> return ()+ Just newsegs -> let segs = words (T.unpack newsegs) in case segs of+ [] -> return ()+ _ -> sync $ do+ let newft = resegft segs oldft+ newmodel <- setFTContents editor newft+ replaceModel newmodel+ putStrLn "Segments Changed."+ return ()+ flip callStream addPressed $ \_ -> do (segs, store) <- sample currentModel
app/GrammarEditor.hs view
@@ -27,7 +27,7 @@ import Numeric import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Easy hiding (indices, set')+import Graphics.Rendering.Chart.Easy hiding (indices, set', set) import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Geometry import Graphics.Rendering.Chart.Drawing@@ -107,7 +107,7 @@ bpack loadButton bpack saveButton - txtfilter <- sync fileFilterNew+ {-txtfilter <- sync fileFilterNew allfilter <- sync fileFilterNew sync $ do@@ -115,11 +115,13 @@ fileFilterSetName txtfilter "Text Files" fileFilterAddPattern allfilter "*" fileFilterSetName allfilter "All Files"+ -} loadDialog <- sync $ fileChooserDialogNew (Just "Load Grammar") transwin FileChooserActionOpen [("gtk-cancel", ResponseCancel), ("gtk-open", ResponseAccept)]- sync $ fileChooserAddFilter loadDialog txtfilter- sync $ fileChooserAddFilter loadDialog allfilter+ --sync $ fileChooserAddFilter loadDialog txtfilter+ --sync $ fileChooserAddFilter loadDialog allfilter+ sync $ set loadDialog [windowModal := True] flip callStream loadPressed $ \_ -> do filePicked <- runFileChooserDialog loadDialog planNow . ffor filePicked $ \case@@ -135,8 +137,9 @@ saveDialog <- sync $ fileChooserDialogNew (Just "Save Grammar") transwin FileChooserActionSave [("gtk-cancel", ResponseCancel), ("gtk-save", ResponseAccept)]- sync $ fileChooserAddFilter saveDialog txtfilter- sync $ fileChooserAddFilter saveDialog allfilter+ --sync $ fileChooserAddFilter saveDialog txtfilter+ --sync $ fileChooserAddFilter saveDialog allfilter+ sync $ set saveDialog [windowModal := True] flip callStream savePressed $ \_ -> do mg <- sample currentGrammar case mg of
app/LexiconEditor.hs view
@@ -126,18 +126,20 @@ [i] -> listStoreRemove store i _ -> return () - txtfilter <- sync fileFilterNew+ {- txtfilter <- sync fileFilterNew allfilter <- sync fileFilterNew sync $ do fileFilterAddMimeType txtfilter "text/*" fileFilterSetName txtfilter "Text Files" fileFilterAddPattern allfilter "*" fileFilterSetName allfilter "All Files"+ -} saveDialog <- sync $ fileChooserDialogNew (Just "Save Lexicon") transwin FileChooserActionSave [("gtk-cancel", ResponseCancel), ("gtk-save", ResponseAccept)]- sync $ fileChooserAddFilter saveDialog txtfilter- sync $ fileChooserAddFilter saveDialog allfilter+ --sync $ fileChooserAddFilter saveDialog txtfilter+ --sync $ fileChooserAddFilter saveDialog allfilter+ sync $ set saveDialog [windowModal := True] flip callStream savePressed $ \_ -> do (_,segs,rows) <- sample currentLex savePicked <- runFileChooserDialog saveDialog@@ -154,8 +156,9 @@ loadListDialog <- sync $ fileChooserDialogNew (Just "Load Lexicon") transwin FileChooserActionOpen [("gtk-cancel", ResponseCancel), ("gtk-open", ResponseAccept)]- sync $ fileChooserAddFilter loadListDialog txtfilter- sync $ fileChooserAddFilter loadListDialog allfilter+ --sync $ fileChooserAddFilter loadListDialog txtfilter+ --sync $ fileChooserAddFilter loadListDialog allfilter+ sync $ set loadListDialog [windowModal := True] flip callStream loadListPressed $ \_ -> do filePicked <- runFileChooserDialog loadListDialog loaded <- planNow . ffor filePicked $ \case@@ -178,8 +181,9 @@ loadTextDialog <- sync $ fileChooserDialogNew (Just "Load Text For New Lexicon") transwin FileChooserActionOpen [("gtk-cancel", ResponseCancel), ("gtk-open", ResponseAccept)]- sync $ fileChooserAddFilter loadTextDialog allfilter- sync $ fileChooserAddFilter loadTextDialog txtfilter+ --sync $ fileChooserAddFilter loadTextDialog allfilter+ --sync $ fileChooserAddFilter loadTextDialog txtfilter+ sync $ set loadTextDialog [windowModal := True] flip callStream loadTextPressed $ \_ -> do filePicked <- runFileChooserDialog loadTextDialog loaded <- planNow . ffor filePicked $ \case
app/Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeOperators, RecursiveDo, ScopedTypeVariables, TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE TypeOperators, RecursiveDo, ScopedTypeVariables, TemplateHaskell, QuasiQuotes, OverloadedStrings, ExtendedDefaultRules #-} module Main where @@ -28,10 +28,12 @@ import LearnerControls import System.IO +default (T.Text)+ ipaft :: FeatureTable String ipaft = fromJust . csvToFeatureTable id . T.unpack . T.decodeUtf8 $ $(embedFile "app/ft-ipa.csv") -css :: String+css :: T.Text css = [r| #featuretable{ background-color: @theme_base_color;@@ -57,6 +59,7 @@ -- example gtk app -- initialization code window <- sync $ windowNew+ sync $ set window [windowTitle := "Hayes/Wilson Phonotactic Learner."] rec (fteditor, dynft) <- createEditableFT (Just window) ipaft (lexeditor, dynlex) <- createEditableLexicon (Just window) (fmap segsFromFt dynft) lexout@@ -69,9 +72,9 @@ thescreen <- widgetGetScreen window styleContextAddProviderForScreen thescreen sp 600 - centerpanes <- set' [panedWideHandle := False] =<< createVPaned controls fteditor- rpanes <- set' [panedWideHandle := False] =<< createHPaned centerpanes grammareditor- lpanes <- set' [panedWideHandle := False] =<< createHPaned lexeditor rpanes+ centerpanes <- set' [panedWideHandle := True] =<< createVPaned controls fteditor+ rpanes <- set' [panedWideHandle := True] =<< createHPaned centerpanes grammareditor+ lpanes <- set' [panedWideHandle := True] =<< createHPaned lexeditor rpanes box <- createVBox 0 $ do bstretch lpanes bpack =<< liftIO (vSeparatorNew)
maxent-learner-hw-gui.cabal view
@@ -1,5 +1,5 @@ name: maxent-learner-hw-gui-version: 0.2.0+version: 0.2.1 synopsis: GUI for maxent-learner-hw description: This is a GUI frontent for maxent-learner-hw using GTK. homepage: https://github.com/george-steel/maxent-learner@@ -22,7 +22,7 @@ LexiconEditor ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.7 && < 5- , maxent-learner-hw == 0.2.0+ , maxent-learner-hw == 0.2.1 , containers == 0.5.* , text == 1.2.* , file-embed