Commit 94f90b0f authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 8c205201
......@@ -12,31 +12,8 @@ derive gParse MachineState, Output, Product
//Start world = doHtml coffeemachine world
Start world = doHtmlServer coffeemachine world
coffeemachine hst
# (input ,hst) = ListFuncBut (nFormId "cb") (Init allbuttons) hst
# (options ,hst) = ListFuncCheckBox (nFormId "op") (Init (optionbuttons False False)) hst
# (optionfun,optionbool)= options.value
# (machine ,hst) = mkStoreForm (nFormId "hidden") (Init initmachine) (optionfun o input.value) hst
# (checkboxf,hst) = ListFuncCheckBox (nFormId "op") (Set (optionbuttons machine.value.milk machine.value.sugar)) hst
= mkHtml "Coffee Machine"
[ H1 [] "Fancy Coffee Machine ..."
, Br
, [ mkSTable [[bTxt "Content:", bTxt "Value:",bTxt "Input:"]]
, toHtml ("money ",machine.value.money) <.=.> mkRowForm (input.form%MoneyButtons)
, toHtml ("beans ",machine.value.beans) <.=.> input.form!!BeansButton
, toHtml ("trash ",machine.value.trash) <.=.> input.form!!TrashButton
, Br
, bTxt "Options: "
, Br
, checkboxf.form!!MilkOption <.=.> bTxt "Milk"
, checkboxf.form!!SugarOption <.=.> bTxt "Sugar"
, Br
, mkSTable [[bTxt "Product:", bTxt "Prize:"]]
, mkColForm (input.form%ProductButtons) <.=.> mkColForm (map toHtml prizes)
, Br
, bTxt "Message: ", bTxt (print machine.value.out optionbool)
] <=> [displayMachineImage machine.value.out]
] hst
myCommandsId :: (InIDataId [(Button,(MachineState -> MachineState))])
myCommandsId = (Init,nFormId "cb" allbuttons)
where
allbuttons =
[ (butp "CoffeeBeans.jpg", \m -> CoffeeMachine (AddBeans, m))
......@@ -53,14 +30,46 @@ where
but s = LButton defpixel s
butp s = PButton (defpixel/2,defpixel/2) ("images/" +++ s)
optionbuttons milk sugar=
myOptionsId :: Init Bool Bool -> (InIDataId [(CheckBox,(Bool [Bool] MachineState -> MachineState))])
myOptionsId init milk sugar = (init,nFormId "ob" optionbuttons)
where
optionbuttons =
[ (check milk "Milk", \b _ m -> CoffeeMachine (AskMilk b, m))
, (check sugar "Sugar", \b _ m -> CoffeeMachine (AskSugar b, m))
]
where
check True = CBChecked
check False = CBNotChecked
myMachineId :: (InIDataId MachineState)
myMachineId = (Init, nFormId "hidden" initmachine)
coffeemachine hst
# (input ,hst) = ListFuncBut myCommandsId hst
# (options ,hst) = ListFuncCheckBox (myOptionsId Init False False) hst
# (optionfun,optionbool)= options.value
# (machine ,hst) = mkStoreForm myMachineId (optionfun o input.value) hst
# (checkboxf,hst) = ListFuncCheckBox (myOptionsId Set machine.value.milk machine.value.sugar) hst
= mkHtml "Coffee Machine"
[ H1 [] "Fancy Coffee Machine ..."
, Br
, [ mkSTable [[bTxt "Content:", bTxt "Value:",bTxt "Input:"]]
, toHtml ("money ",machine.value.money) <.=.> mkRowForm (input.form%MoneyButtons)
, toHtml ("beans ",machine.value.beans) <.=.> input.form!!BeansButton
, toHtml ("trash ",machine.value.trash) <.=.> input.form!!TrashButton
, Br
, bTxt "Options: "
, Br
, checkboxf.form!!MilkOption <.=.> bTxt "Milk"
, checkboxf.form!!SugarOption <.=.> bTxt "Sugar"
, Br
, mkSTable [[bTxt "Product:", bTxt "Prize:"]]
, mkColForm (input.form%ProductButtons) <.=.> mkColForm (map toHtml prizes)
, Br
, bTxt "Message: ", bTxt (print machine.value.out optionbool)
] <=> [displayMachineImage machine.value.out]
] hst
where
prizes = [cost Coffee,cost Capuccino, cost Espresso]
displayMachineImage (Prod x) = machineImage 4
......@@ -68,7 +77,6 @@ where
machineImage i = Img [Img_Src ("images/coffeemachine0" +++ toString i +++ ".jpg"), Img_Width (RelLength 560) ,Img_Height (RelLength 445)]
bTxt = B []
print output [milkoption,sugaroption]
......
module ConfManager
import StdEnv, StdHtml
import loginAdminIData, stateHandlingIData, confIData
// Here it starts ....
Start world = doHtmlServer mainEntrance world
mainEntrance hst
# (body,hst) = loginhandling hst
= mkHtml "Conference Manager"
[ BodyTag body
] hst
// login page
loginhandling :: *HSt -> ([BodyTag],*HSt)
loginhandling hst
# (loginStates,hst) = LoginStatesStore id hst // read out login database store
# (mbloginState,loginBody,hst) = loginPage loginStates.value hst // set up a login page
= case mbloginState of
Nothing = (loginBody,hst) // show login page if not yet logged in
Just loginState = doMemberPage loginState loginStates.value hst // show member page if logged in
// iData defs
doMemberPage :: (LoginState State) (LoginStates State) *HSt -> ([BodyTag],*HSt)
doMemberPage (login,state) states hst
# (navButtons,hst) = if (isRoot state) rootNavigation memberNavigation hst // setup proper set of navigation buttons
# (currPage,hst) = currPageStore state.initialPage navButtons.value hst // determine current page to display
# (states,navBody,hst) = doNavigation (login,state) states currPage.value hst // and show the corresponding page
# (_,hst) = LoginStatesStore (\_.states) hst // store new states in global database
= ( [ BodyTag navButtons.form
, Br
, Hr []
, BodyTag navBody
] , hst)
where
rootNavigation hst = ListFuncBut (Init, sFormId "rootNavigation" mbuttons) hst
where
mbuttons =
[ (LButton defpixel "RootHome", \_.RootHomePage)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ListPapers", \_.ListPapers)
, (LButton defpixel "AssignPapers", \_.AssignPapers)
, (LButton defpixel "AssignConflict", \_.AssignConflict)
, (LButton defpixel "ModStates", \_.ModifyStates)
]
memberNavigation hst = ListFuncBut (Init, sFormId "memberNavigation" mbuttons) hst
where
mbuttons =
[ (LButton defpixel "Home", \_.MemberHomePage)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ListPapers", \_.ListPapers)
]
doNavigation :: (LoginState State) (LoginStates State) CurrPage *HSt -> (LoginStates State,[BodyTag],*HSt)
doNavigation loginState=:(login,state) states currPage hst
# (papers,hst) = papersStore [initPaper (toString i) \\ i <- [0..3]] id hst
# (states,body,hst)
= case currPage of
RootHomePage -> states <~ rootHomePage hst
ModifyStates -> modifyStatesPage loginState states hst
AssignPapers -> assignPapersPage states papers.value hst
AssignConflict -> assignConflictsPage states papers.value hst
ChangePassword -> changePasswrdPage loginState states hst
// ChangeInfo -> mkSubStateForm (nFormId "info") state.person states
// (\person states = changeState (login,{state & person = person}) states) hst
ListPapers -> states <~ showPapersPage loginState (Init, nFormId "papers" papers.value) [state \\ (login,state) <- states] hst
MemberHomePage -> states <~ memberHomePage hst
_ -> states <~ ([],hst)
= ( states
, [ Txt ("Welcome " +++ login.loginName +++ " , current page is : ")
<.=.> toHtml currPage
, Br
, Hr []
, BodyTag body
]
, hst )
// the different pages the super user can choose from
rootHomePage hst =
( [ Txt "Home of root ... "
]
, hst )
// the different pages a member can choose from
memberHomePage hst =
( [ Txt "Home page of a member ... "
]
, hst )
changePasswrdPage loginState=:(login,state) states hst
# (mblogin,body,hst) = changePasswordPage login hst
= case mblogin of
Nothing -> (states, body, hst)
Just nlogin -> doNavigation (nlogin,state)
(changePassword loginState nlogin.password states) state.initialPage hst
// small utility stuf
(<~) infix
(<~) states (body,hst) = (states,body,hst)
definition module confIData
import htmlHandler, loginAdmin, stateHandling
derive gForm []
derive gUpd []
// global stores
LoginStatesStore :: !((LoginStates State) -> (LoginStates State)) *HSt -> (!Form (LoginStates State),!*HSt) // login administration database
currPageStore :: !CurrPage !(CurrPage -> CurrPage) *HSt -> (!Form CurrPage,!*HSt) // current page to display
papersStore :: !Papers !(Papers -> Papers) *HSt -> (!Form Papers,!*HSt) // papers to referee
implementation module confIData
import htmlHandler, StdList
import loginAdmin, stateHandling
import stateHandlingIData, loginAdminIData
gForm {|[]|} gHa formid hst
= case formid.ival of
[x:xs]
# (x,hst) = gHa (reuseFormId formid x) hst
# (xs,hst) = gForm {|*->*|} gHa (subFormId formid (toString (length xs)) xs) hst
= ({changed = x.changed||xs.changed,form = x.form ++ xs.form,value = [x.value:xs.value]},hst)
[]
= ({changed = False,form = [],value = []},hst)
derive gUpd []
LoginStatesStore :: !((LoginStates State) -> (LoginStates State)) *HSt -> (!Form (LoginStates State),!*HSt) // login administration database
LoginStatesStore upd hst = mkStoreForm (Init,pFormId "loginDatabase" initState) upd hst
currPageStore :: !CurrPage !(CurrPage -> CurrPage) *HSt -> (!Form CurrPage,!*HSt) // current page to display
currPageStore currpage cbf hst = mkStoreForm (Init, sFormId "currPage" currpage) cbf hst
papersStore :: !Papers !(Papers -> Papers) *HSt -> (!Form Papers,!*HSt) // papers to referee
papersStore papers cbf hst = mkStoreForm (Init, pFormId "papersDatabase" papers) cbf hst
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment