summaryrefslogtreecommitdiff
path: root/src/GF/Fudgets
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Fudgets
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Fudgets')
-rw-r--r--src/GF/Fudgets/ArchEdit.hs30
-rw-r--r--src/GF/Fudgets/CommandF.hs134
-rw-r--r--src/GF/Fudgets/EventF.hs51
-rw-r--r--src/GF/Fudgets/FudgetOps.hs59
-rw-r--r--src/GF/Fudgets/UnicodeF.hs37
5 files changed, 0 insertions, 311 deletions
diff --git a/src/GF/Fudgets/ArchEdit.hs b/src/GF/Fudgets/ArchEdit.hs
deleted file mode 100644
index 5bc0dc84b..000000000
--- a/src/GF/Fudgets/ArchEdit.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : (Module)
--- Maintainer : (Maintainer)
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:46:05 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Fudgets.ArchEdit (
- fudlogueEdit, fudlogueWrite, fudlogueWriteUni
- ) where
-
-import GF.Fudgets.CommandF
-import GF.Fudgets.UnicodeF
-
--- architecture/compiler dependent definitions for unix/ghc, if Fudgets works.
--- If not, use the modules in for-ghci
-
-fudlogueEdit font = fudlogueEditF ----
-fudlogueWrite = fudlogueWriteU
-fudlogueWriteUni _ _ = do
- putStrLn "sorry no unicode available in ghc"
-
-
diff --git a/src/GF/Fudgets/CommandF.hs b/src/GF/Fudgets/CommandF.hs
deleted file mode 100644
index 15af12215..000000000
--- a/src/GF/Fudgets/CommandF.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : CommandF
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:15 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.6 $
---
--- a graphical shell for any kind of GF with Zipper editing. AR 20\/8\/2001
------------------------------------------------------------------------------
-
-module GF.Fudgets.CommandF where
-
-import GF.Data.Operations
-
-import GF.UseGrammar.Session
-import GF.Shell.Commands
-
-import Fudgets
-import GF.Fudgets.FudgetOps
-
-import GF.Fudgets.EventF
-
--- a graphical shell for any kind of GF with Zipper editing. AR 20/8/2001
-
-fudlogueEditF :: CEnv -> IO ()
-fudlogueEditF env =
- fudlogue $ gfSizeP $ shellF ("GF 2.0- Fudget Editor") (gfF env)
-
-gfF env = nameLayoutF gfLayout $ (gfOutputF env >==< gfCommandF env) >+< quitButF
-
-( quitN : menusN : newN : transformN : filterN : displayN :
- navigateN : viewN : outputN : saveN : _) = map show [1..]
-
-gfLayout = placeNL verticalP [generics,output,navigate,menus,transform]
- where
- generics = placeNL horizontalP (map leafNL
- [newN,saveN,viewN,displayN,filterN,quitN])
- output = leafNL outputN
- navigate = leafNL navigateN
- menus = leafNL menusN
- transform = leafNL transformN
-
-gfSizeP = spacerF (sizeS (Point 720 640))
-
-gfOutputF env =
- ((nameF outputN $ (writeFileF >+< textWindowF))
- >==<
- (absF (saveSP "EMPTY")
- >==<
- (nameF saveN (popupStringInputF "Save" "foo.tmp" "Save to file:")
- >+<
- mapF (displayJustStateIn env))))
- >==<
- mapF Right
-
-gfCommandF :: CEnv -> F () SState
-gfCommandF env = loopCommandsF env >==< getCommandsF env >==< mapF (\_ -> Click)
-
-loopCommandsF :: CEnv -> F Command SState
-loopCommandsF env = loopThroughRightF (mapGfStateF env) (mkMenusF env)
-
-mapGfStateF :: CEnv -> F (Either Command Command) (Either SState SState)
-mapGfStateF env = mapstateF execFC (initSState) where
- execFC e0 (Left c) = (e,[Right e,Left e]) where e = execECommand env c e0
- execFC e0 (Right c) = (e,[Left e,Right e]) where e = execECommand env c e0
-
-mkMenusF :: CEnv -> F SState Command
-mkMenusF env =
- nameF menusN $
- labAboveF "Select Action on Subterm"
- (mapF fst >==< smallPickListF snd >==< mapF (mkRefineMenu env))
-
-getCommandsF env =
- newF env >*<
- viewF >*<
- menuDisplayF env >*<
- filterF >*<
- navigateF >*<
- transformF
-
-key2command ((key,_),_) = case key of
- "Up" -> CBack 1
- "Down" -> CAhead 1
- "Left" -> CPrevMeta
- "Right" -> CNextMeta
- "space" -> CTop
-
- "d" -> CDelete
- "u" -> CUndo
- "v" -> CView
-
- _ -> CVoid
-
-transformF =
- nameF transformN $
- mapF (either key2command id) >==< (keyboardF $
- placerF horizontalP $
- cPopupStringInputF CRefineParse "Parse" "" "Parse in concrete syntax" >*<
- --- to enable Unicode: ("Refine by parsing" `labLeftOfF` writeInputF)
- cPopupStringInputF CRefineWithTree "Term" "" "Parse term" >*<
- cMenuF "Modify" termCommandMenu >*<
- cPopupStringInputF CAlphaConvert "Alpha" "x_0 x" "Alpha convert" >*<
- cButtonF CRefineRandom "Random" >*<
- cButtonF CUndo "Undo"
- )
-
-quitButF = nameF quitN $ quitF >==< buttonF "Quit"
-
-newF env = nameF newN $ cMenuF "New" (newCatMenu env)
-menuDisplayF env = nameF displayN $ cMenuF "Menus" $ displayCommandMenu env
-filterF = nameF filterN $ cMenuF "Filter" stringCommandMenu
-
-viewF = nameF viewN $ cButtonF CView "View"
-
-navigateF =
- nameF navigateN $
- placerF horizontalP $
- cButtonF CPrevMeta "?<" >*<
- cButtonF (CBack 1) "<" >*<
- cButtonF CTop "Top" >*<
- cButtonF CLast "Last" >*<
- cButtonF (CAhead 1) ">" >*<
- cButtonF CNextMeta ">?"
-
-cButtonF c s = mapF (const c) >==< buttonF s
-cMenuF s css = menuF s css >==< mapF (\_ -> CVoid)
-
-cPopupStringInputF comm lab def msg =
- mapF comm >==< popupStringInputF lab def msg >==< mapF (const [])
-
diff --git a/src/GF/Fudgets/EventF.hs b/src/GF/Fudgets/EventF.hs
deleted file mode 100644
index 7ea058dfa..000000000
--- a/src/GF/Fudgets/EventF.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : EventF
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:16 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Fudgets.EventF where
-import AllFudgets
-
--- | The first string is the name of the key (e.g., "Down" for the down arrow key)
---
--- The modifiers list shift, control and alt keys that were active while the
--- key was pressed.
---
--- The last string is the text produced by the key (for keys that produce
--- printable characters, empty for control keys).
-type KeyPress = ((String,[Modifiers]),String)
-
-keyboardF :: F i o -> F i (Either KeyPress o)
-keyboardF fud = idRightSP (concatMapSP post) >^^=< oeventF mask fud
- where
- post (KeyEvent {type'=Pressed,keySym=sym,state=mods,keyLookup=s}) =
- [((sym,mods),s)]
- post _ = []
-
- mask = [KeyPressMask,
- EnterWindowMask, LeaveWindowMask -- because of CTT implementation
- ]
-
--- | Output events:
-oeventF em fud = eventF em (idLeftF fud)
-
--- | Feed events to argument fudget:
-eventF eventmask = serCompLeftToRightF . groupF startcmds eventK
- where
- startcmds = [XCmd $ ChangeWindowAttributes [CWEventMask eventmask],
- XCmd $ ConfigureWindow [CWBorderWidth 0]]
- eventK = K $ mapFilterSP route
- where route = message low high
- low (XEvt event) = Just (High (Left event))
- low _ = Nothing
- high h = Just (High (Right h))
-
diff --git a/src/GF/Fudgets/FudgetOps.hs b/src/GF/Fudgets/FudgetOps.hs
deleted file mode 100644
index 4aba5eec5..000000000
--- a/src/GF/Fudgets/FudgetOps.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : FudgetOps
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:17 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- auxiliary Fudgets for GF syntax editor
------------------------------------------------------------------------------
-
-module GF.Fudgets.FudgetOps where
-
-import Fudgets
-
--- save and display
-
-showAndSaveF fud = (writeFileF >+< textWindowF) >==< saveF fud
-
-saveF :: F a String -> F (Either String a) (Either (String,String) String)
-saveF fud =
- absF (saveSP "EMPTY")
- >==<
- (popupStringInputF "Save" "foo.tmp" "Save to file:" >+< fud)
-
-saveSP :: String -> SP (Either String String) (Either (String,String) String)
-saveSP contents = getSP $ \msg -> case msg of
- Left file -> putSP (Left (file,contents)) (saveSP contents)
- Right string -> putSP (Right string) (saveSP string)
-
-textWindowF = writeOutputF
-
--- | to replace stringInputF by a pop-up slot behind a button
-popupStringInputF :: String -> String -> String -> F String String
-popupStringInputF label deflt msg =
- mapF snd
- >==<
- (popupSizeP $ stringPopupF deflt)
- >==<
- mapF (\_ -> (Just msg,Nothing))
- >==<
- decentButtonF label
- >==<
- mapF (\_ -> Click)
-
-decentButtonF = spacerF (sizeS (Point 80 20)) . buttonF
-
-popupSizeP = spacerF (sizeS (Point 240 100))
-
---- the Unicode stuff should be inserted here
-
-writeOutputF = moreF >==< mapF lines
-
-writeInputF = stringInputF
-
-
diff --git a/src/GF/Fudgets/UnicodeF.hs b/src/GF/Fudgets/UnicodeF.hs
deleted file mode 100644
index 024205698..000000000
--- a/src/GF/Fudgets/UnicodeF.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : UnicodeF
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:17 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Fudgets.UnicodeF (fudlogueWriteU) where
-import Fudgets
-
-import GF.Data.Operations
-import GF.Text.Unicode
-
--- AR 12/4/2000, 18/9/2001 (added font parameter)
-
-fudlogueWriteU :: String -> (String -> String) -> IO ()
-fudlogueWriteU fn trans =
- fudlogue $
- shellF "GF Unicode Output" (writeF fn trans >+< quitButtonF)
-
-writeF fn trans = writeOutputF fn >==< mapF trans >==< writeInputF fn
-
-displaySizeP = placerF (spacerP (sizeS (Point 440 500)) verticalP)
-
-writeOutputF fn = moreF' (setFont fn) >==< justWriteOutputF
-
-justWriteOutputF = mapF (map (wrapLines 0) . filter (/=[]) . map mkUnicode . lines)
-
-writeInputF fn = stringInputF' (setShowString mkUnicode . setFont fn)
-