1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.4 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module CommandF where
import Operations
import Session
import Commands
import Fudgets
import FudgetOps
import 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 [])
|
