Commit e14d7b04 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent f973df62
......@@ -2,76 +2,43 @@ module coffeemachine
import StdEnv, StdHtml
Start world = doHtmlServer (singleUserTask CoffeeMachineInf2) world
Start world = doHtmlServer (singleUserTask CoffeeMachineInf) world
CoffeeMachineInf2 :: *TSt -> (Int,*TSt)
CoffeeMachineInf2 tst
= ( Coffeemachine2
#>> mkTask CoffeeMachineInf2
) tst
CoffeeMachineInf :: Task Int
CoffeeMachineInf
= CoffeeMachine
#>> mkTask CoffeeMachineInf
Coffeemachine2 tst
= ( [Txt "Choose product:", Br]
CoffeeMachine :: Task (String,Int)
CoffeeMachine
= [Txt "Choose product:",Br,Br]
?>> CTask_button
[ ("Coffee: 100", returnV (100,"Coffee"))
, ("Cappucino: 150", returnV (150,"Cappucino"))
, ("Tee: 50", returnV (50, "Tee"))
, ("Choclate: 100", returnV (100,"Choclate"))
]
=>> \(toPay,product) -> [Txt ("Chosen product: " <+++ product), Br]
=>> \(toPay,product) -> [Txt ("Chosen product: " <+++ product),Br,Br]
?>> getCoins (toPay,0)
=>> \(cancel,returnMoney)-> let nproduct = if cancel "Cancelled" product in
[Txt ("product = " <+++ product <+++ ", returned money = " <+++ returnMoney), Br]
=>> \(cancel,returnMoney)-> let nproduct = if cancel "Cancelled" product
in
[Txt ("product = " <+++ product <+++ ", returned money = " <+++ returnMoney),Br,Br]
?>> STask_button "Thanks" (returnV Void)
#>> returnV (nproduct,returnMoney)
) tst
where
getCoins (toPay,paid) tst
= ( [Txt ("To pay: " <+++ toPay), Br]
?>> PCTask2
( CTask_button [(toString i <+++ " cts", returnV (False,i)) \\ i <- [5,10,20,50,100,200]]
, STask_button "Cancel" (returnV (True,0))
)
=>> \(cancel,coin) -> if cancel (returnV (cancel,paid))
(if (toPay - coin > 0) (mkTask (getCoins (toPay - coin,paid + coin)))
(returnV (cancel,coin - toPay))
)
) tst
CoffeeMachineInf :: *TSt -> (Int,*TSt)
CoffeeMachineInf tst
# (_,tst) = Coffeemachine tst
= mkTask CoffeeMachineInf tst
Coffeemachine tst
# ((toPay,product),tst) = ( [Txt "Choose product:", Br] ?>>
CTask_button
[ ("Coffee: 100", returnV (100,"Coffee"))
, ("Cappucino: 150", returnV (150,"Cappucino"))
, ("Tee: 50", returnV (50, "Tee"))
, ("Choclate: 100", returnV (100,"Choclate"))
]
)tst
# ((cancel,returnMoney),tst) = ( [Txt ("Chosen product: " <+++ product), Br] ?>>
getCoins (toPay,0)
) tst
# product = if cancel "Cancelled" product
# (_,tst) = ( [Txt ("product = " <+++ product <+++ ", returned money = " <+++ returnMoney), Br] ?>>
STask_button "Thanks" (returnV Void)
) tst
= returnV (product,returnMoney) tst
where
getCoins (toPay,paid) tst
# ((cancel,coin),tst)= ( [Txt ("To pay: " <+++ toPay), Br] ?>>
PCTask2 ( CTask_button [(toString i <+++ " cts", returnV (False,i)) \\ i <- [5,10,20,50,100,200]]
, STask_button "Cancel" (returnV (True,0))
)
) tst
| cancel = returnV (cancel,paid) tst
| toPay - coin > 0 = mkTask (getCoins (toPay - coin,paid + coin)) tst
= returnV (cancel,coin - toPay) tst
getCoins :: (Int,Int) -> Task (Bool,Int)
getCoins (toPay,paid)
= [Txt ("To pay: " <+++ toPay),Br,Br]
?>> PCTask2
( CTask_button [(toString i <+++ " cts", returnV (False,i)) \\ i <- [5,10,20,50,100,200]]
, STask_button "Cancel" (returnV (True,0))
)
=>> \(cancel,coin) -> handleCoin (cancel,coin)
where
handleCoin (cancel,coin)
| cancel = returnV (cancel,paid)
| toPay - coin > 0 = mkTask (getCoins (toPay - coin,paid + coin))
= returnV (cancel,coin - toPay)
......
......@@ -11,6 +11,60 @@ npersons = 5
Start world = doHtmlServer (multiUserTask npersons [] findDate) world
findDate :: Task (HtmlDate,HtmlTime)
findDate
= [Txt "Choose person you want to date:",Br]
?>> STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
=>> \whomPD -> let whom = toInt(toString whomPD)
in
[Txt "Determining date:",Br,Br]
?>> findDate` whom (Date 1 1 2007,Time 9 0 0)
=>> \datetime -> []
?>> PTask2 (confirm 0 whom datetime,confirm whom 0 datetime)
#>> returnV datetime
//# (me,tst) = myId tst
where
findDate` :: Int (HtmlDate,HtmlTime) -> Task (HtmlDate,HtmlTime)
findDate` whom daytime
= proposeDateTime daytime
=>> \daytime -> (whom,"Meeting Request") @: determineDateTime daytime
=>> \(ok,daytime)-> if ok (returnV daytime)
( isOkDateTime daytime
=>> \ok -> if ok (returnV daytime)
(mkTask (findDate` whom daytime))
)
where
proposeDateTime :: (HtmlDate,HtmlTime) -> Task (HtmlDate,HtmlTime)
proposeDateTime (date,time)
= STask "Set" input
=>> \(_,date,_,time) -> returnV (date,time)
where
input = (showHtml [Txt "Propose date: "], date, showHtml [Txt "Propose time: "], time)
determineDateTime :: (HtmlDate,HtmlTime) -> Task (Bool,(HtmlDate,HtmlTime))
determineDateTime daytime
= isOkDateTime daytime
=>> \ok -> if ok (returnV (ok,daytime))
( proposeDateTime daytime
=>> \daytime -> returnV (ok,daytime)
)
isOkDateTime :: (HtmlDate,HtmlTime) -> Task Bool
isOkDateTime (date,time)
= [Txt ("Can we meet on the " <+++ date <+++ " at " <+++ time <+++ "?"),Br] ?>>
CTask_button [ ("Accept",returnV True)
, ("Sorry",returnV False)
]
confirm :: Int Int (HtmlDate,HtmlTime) -> Task Void
confirm me you (date,time)
= me @:: ( [Txt ("Person " <+++ me <+++ " and person " <+++ you <+++ " will meet on " <+++ date <+++ " at " <+++ time),Br,Br]
?>> STask "OK" Void
)
/*
findDate tst
# (whomPD,tst) = ( [Txt "Choose person you want to date:",Br]
?>> STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
......@@ -55,9 +109,7 @@ where
?>> STask "OK" Void
)
) tst
*/
......
......@@ -11,31 +11,25 @@ Start world = doHtmlServer (multiUserTask npersons [] (deadline mytask)) world
mytask = STask "Press" 0
deadline task tst
# (whomPD,tst) = ( [Txt "Choose person you want to shift work to:",Br,Br]
deadline :: (Task a) -> (Task a) | iData a
deadline task
= [Txt "Choose person you want to shift work to:",Br,Br]
?>> STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
) tst
# who = toInt(toString whomPD)
# (time,tst) = ( [Txt "Until what time do you want to wait today?",Br,Br]
=>> \whomPD -> [Txt "Until what time do you want to wait today?",Br,Br]
?>> STask "SetTimer" (Time 0 0 0)
) tst
# ((ok,value),tst) = ( []
?>> shifttask who time task
) tst
# (_,tst) = ( if ok [Txt ("Result of task: " <+++ value),Br,Br] [Txt "Task Expired !",Br,Br]
?>> STask "OK" Void
) tst
= (value,tst)
=>> \time -> []
?>> shifttask (toInt(toString whomPD)) time task
=>> \(ok,value) -> if ok [Txt ("Result of task: " +++ printToString value),Br,Br] [Txt "Task Expired, default value chosen !",Br,Br]
?>> STask "OK" value
where
shifttask who time task tst
= ((who,"Timed Task")
shifttask who time task
= (who,"Timed Task")
@: PCTask2
( waitForTimeTask time // wait for deadline
#>> returnV (False,createDefault) // return default
#>> returnV (False,createDefault) // return default value
, [Txt ("Please finish task before" <+++ time),Br,Br] // tell deadline
?>> (task =>> \v -> returnV (True,v)) // do task and return its result
)
) tst
......@@ -10,7 +10,7 @@ derive gerda QForm, QState
derive gEq QState
Start world = doHtmlServer (multiUserTask 2 [] (Quotation createDefault)) world
Start world = doHtmlServer (multiUserTask 2 [] (Quotation 1 createDefault)) world
:: QForm = { fromComp :: String
, toComp :: String
......@@ -22,19 +22,20 @@ Start world = doHtmlServer (multiUserTask 2 [] (Quotation createDefault)) world
}
:: QState = Submitted | Approved | Cancelled | NeedsRework | Draft
Quotation :: (QState,QForm) TSt -> ((QState,QForm),TSt)
Quotation (state,form) tst
# (form,tst) = ([Txt "Fill in Form:",Br,Br] ?>> id (STask "Submit" form)) tst
# (state,tst) = (1 @:: review (state,form)) tst
# (_,tst) = ([Txt ("Quotation " <+++ printToString state),Br,Br] ?>> STask "OK" Void) tst
| state === NeedsRework = mkTask (Quotation (state,form)) tst
= returnV (state,form) tst
Quotation :: Int (QState,QForm) -> Task (QState,QForm)
Quotation reviewer (state,form)
= [Txt "Fill in Form:",Br,Br] ?>> id (STask "Submit" form)
=>> \form -> reviewer @:: review (state,form)
=>> \state -> [Txt ("Reviewer " <+++ reviewer <+++ " says quotation " <+++ printToString state),Br,Br] ?>> STask "OK" Void
#>> case state of
NeedsRework -> mkTask (Quotation reviewer (state,form))
else -> returnV (state,form)
where
review (state,form) tst
= ( [toHtml form,Br,Br]?>>
review :: (QState,QForm) -> Task QState
review (state,form)
= [toHtml form,Br,Br]?>>
CTask_button
[ ("Rework", returnV NeedsRework)
, ("Approved", returnV Approved)
, ("Cancel", returnV Cancelled)
] )tst
]
......@@ -10,43 +10,42 @@ Start world = doHtmlServer (singleUserTask count2) world
//Start world = doHtmlServer (multiUserTask 3 [setTaskAttribute Persistent] countMU) world
//Start world = doHtmlServer countIData world
// Change the type to any type one can apply addition to
// single user, give first value, then give second, then show sum
// monadic style
initVal :: Int
initVal = createDefault
// single user: give first value, then give second, then show sum
count tst
# (v1,tst) = STask "Set" initVal tst
# (v2,tst) = STask "Set" initVal tst
# tst = returnF [Txt "+",Hr []] tst
= returnTask (v1 + v2) tst
// single user, monadic style
count2
= STask "Set" initVal
=>> \v1 -> STask "Set" initVal
count :: Task Int
count
= STask "Set" 0
=>> \v1 -> STask "Set" 0
=>> \v2 -> [Txt "+",Hr []]
!>> returnTask (v1 + v2)
// multi user variant
countMU tst
# (v1,tst) = ((1,"number") @: STask "Set" initVal) tst // user 1
# (v2,tst) = ((2,"number") @: STask "Set" initVal) tst // user 2
# tst = returnF [Txt "+",Hr []] tst // user 0
= returnTask (v1 + v2) tst // user 0
// multi user variant, monadic atyle
count2MU
= (1,"number") @: STask "Set" initVal
=>> \v1 -> (2,"number") @: STask "Set" initVal
countMU :: Task Int
countMU
= (1,"number") @: STask "Set" 0
=>> \v1 -> (2,"number") @: STask "Set" 0
=>> \v2 -> [Txt "+",Hr []]
!>> returnTask (v1 + v2)
// single user, normal Clean style
count2 :: TSt -> (Int,TSt)
count2 tst
# (v1,tst) = STask "Set" 0 tst
# (v2,tst) = STask "Set" 0 tst
# tst = returnF [Txt "+",Hr []] tst
= returnTask (v1 + v2) tst
// multi user variant, normal Clean style
count2MU :: TSt -> (Int,TSt)
count2MU tst
# (v1,tst) = ((1,"number") @: STask "Set" 0) tst
# (v2,tst) = ((2,"number") @: STask "Set" 0) tst
# tst = returnF [Txt "+",Hr []] tst
= returnTask (v1 + v2) tst
// iData variant to show what iTasks do for you
countIData hst
......
......@@ -5,34 +5,42 @@ import StdEnv, StdHtml
derive gForm []
derive gUpd []
Start world = doHtmlServer (singleUserTask travel) world
Start world = doHtmlServer (singleUserTask travelInf) world
travel tst
# (booked,tst)= PCTask2
travelInf :: (Task Void)
travelInf = travel
#>> mkTask travelInf
travel :: (Task Void)
travel
= [Txt "Book your journey:",Br,Br]
?>> PCTask2
( STasks
[ ( "Choose Booking options"
[ ( "Choose Booking options:"
, MCTask_ckbox [ ("Book_Flight",BookFlight)
, ("Book_Hotel", BookHotel)
, ("Book_Car", BookCar)
]
)
, ( "Booking confirmation"
, ( "Confirm Booking:"
, STask_button "Confirm" (returnV [])
)
]
, STask_button "Cancel" (returnV [])
) tst
| isNil booked = returnTask "Cancelled" tst
# (_,tst) = STask "Pay" (Dsp (calcCosts booked)) tst
= returnTask "Paid" tst
)
=>> \booking -> [Txt "Handling bookings:",Br,Br]
?>> handleBookings booking
where
BookFlight tst = STask "BookFlight" (Dsp "Flight Number","",Dsp "Costs",0) tst
BookHotel tst = STask "BookHotel" (Dsp "Hotel Name","",Dsp "Costs",0) tst
BookCar tst = STask "BookCar" (Dsp "Car Brand","",Dsp "Costs",0) tst
Pay booked bookings tst = returnTask "OK" tst
calcCosts booked = sum [cost \\ (_,_,_,cost) <- hd booked]
handleBookings booking
| isNil booking = STask "Cancelled" Void
| otherwise = STask "Pay" (Dsp (calcCosts booking))
#>> STask "Paid" Void
where
calcCosts booked = sum [cost \\ (_,_,_,cost) <- hd booked]
BookFlight = STask "BookFlight" (Dsp "Flight Number","",Dsp "Costs",0)
BookHotel = STask "BookHotel" (Dsp "Hotel Name","",Dsp "Costs",0)
BookCar = STask "BookCar" (Dsp "Car Brand","",Dsp "Costs",0)
isNil [] = True
isNil _ = False
......
Version: 1.4
Global
Built: True
Target: Everything
Target: Web Applications
Exec: {Project}\projectAdmin.exe
CodeGen
CheckStacks: False
......@@ -220,7 +220,13 @@ OtherModules
ReuseUniqueNodes: True
Fusion: False
DclOpen: False
IclOpen: False
Icl
WindowPosition
X: 10
Y: 10
SizeX: 1137
SizeY: 624
IclOpen: True
LastModified: No 0 0 0 0 0 0
Module
Name: httpSubServer
......@@ -2804,7 +2810,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2821,7 +2827,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2838,7 +2844,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2906,7 +2912,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2923,7 +2929,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2940,7 +2946,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -2957,7 +2963,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListTypes: NoTypes
ListAttributes: True
Warnings: True
Verbose: True
......@@ -3235,10 +3241,6 @@ Static
Path: {Application}\Libraries\StdEnv\Clean System Files\StdTuple.o
Path: {Application}\Libraries\StdEnv\Clean System Files\StdCharList.o
Path: {Application}\Libraries\StdEnv\Clean System Files\StdFunc.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\Debug.o
Path: {Application}\Libraries\StdEnv\Clean System Files\StdDebug.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\Wrap.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\ShowWrapped.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\StdHtml.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\htmlSettings.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\htmlHandler.o
......@@ -3250,6 +3252,7 @@ Static
Path: {Application}\Libraries\StdLib\Clean System Files\StdMaybe.o
Path: {Application}\Libraries\Gerda\Clean System Files\odbc.o
Path: {Application}\Libraries\Gerda\Clean System Files\odbccp.o
Path: {Application}\Libraries\StdEnv\Clean System Files\StdDebug.o
Path: {Application}\Libraries\StdEnv\Clean System Files\StdStrictLists.o
Path: {Application}\Libraries\StdEnv\Clean System Files\_SystemStrictLists.o
Path: {Application}\Libraries\StdEnv\Clean System Files\_SystemEnumStrict.o
......@@ -3262,8 +3265,8 @@ Static
Path: {Application}\Libraries\htmlGEC\Clean System Files\iDataState.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\EncodeDecode.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\htmlTrivial.o
Path: {Application}\Libraries\Directory\Clean System Files\Directory.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdLibMisc.o
Path: {Application}\Libraries\Directory\Clean System Files\Directory.o
Path: {Application}\Libraries\htmlGEC\graph_copy\Clean System Files\dynamic_string.o
Path: {Application}\Libraries\Dynamics\extension\Clean System Files\StdDynamic.o
Path: {Application}\Libraries\Dynamics\implementation\windows\Clean System Files\DynamicGraphConversion.o
......@@ -3283,9 +3286,16 @@ Static
Path: {Application}\Libraries\Hilde\Clean System Files\EstherParser.o
Path: {Application}\Libraries\ExceptionsWindows\Clean System Files\StdException.o
Path: {Application}\Libraries\Hilde\Parser combinators 2002\Clean System Files\StdParsComb.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\Debug.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\Wrap.o
Path: {Application}\Libraries\WrapDebug\Clean System Files\ShowWrapped.o
Path: {Application}\Libraries\Generics\Clean System Files\GenMap.o
Path: {Application}\Libraries\Generics\Clean System Files\_Array.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\httpServer.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\httpUtil.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdLib.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdListExtensions.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdArrayExtensions.o
Path: {Application}\Libraries\Tcp\Clean System Files\StdTCP.o
Path: {Application}\Libraries\Tcp\Clean System Files\StdChannels.o
Path: {Application}\Libraries\Tcp\Clean System Files\tcp.o
......@@ -3354,11 +3364,11 @@ Static
Path: {Application}\Libraries\ObjectIO\Clean System Files\world.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\StdReceiverDef.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\StdReceiver.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\receiverid.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\receiveraccess.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\receiverdefaccess.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\StdReceiverAttribute.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\receiverdevice.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\receiverid.o
Path: {Application}\Libraries\ObjectIO\OS Windows\Clean System Files\receiverevent.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\scheduler.o
Path: {Application}\Libraries\ObjectIO\Clean System Files\StdPStClass.o
......@@ -3370,10 +3380,6 @@ Static
Path: {Application}\Libraries\Tcp\Clean System Files\ostcp.o
Path: {Application}\Libraries\Tcp\Clean System Files\StdEventTCP.o
Path: {Application}\Libraries\Tcp\Clean System Files\StdStringChannels.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\httpUtil.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdLib.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdListExtensions.o
Path: {Application}\Libraries\StdLib\Clean System Files\StdArrayExtensions.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\httpSubServer.o
Path: {Application}\Libraries\htmlGEC\Clean System Files\htmlButtons.o
Path: {Application}\Libraries\Generics\Clean System Files\GenLexOrd.o
......@@ -3449,28 +3455,23 @@ Static
Path: {Application}\Libraries\StdLib
Path: {Application}\Libraries\ObjectIO
Path: {Application}\Libraries\ObjectIO\OS Windows
Path: {Application}\Libraries\Directory
Path: {Application}\Libraries\Dynamics\extension
Path: {Application}\Libraries\Dynamics\general
Path: {Application}\Libraries\Dynamics\implementation
Path: {Application}\Libraries\Dynamics\implementation\windows
Path: {Application}\Libraries\Generics
Path: {Application}\Libraries\ArgEnvWindows
Path: {Application}\Libraries\Gast
Path: {Application}\Libraries\Directory
Path: {Application}\Libraries\Tcp
Path: {Application}\Libraries\ExceptionsWindows
Path: {Application}\Libraries\MersenneTwister
Path: {Application}\Libraries\WrapDebug
Path: {Application}\Libraries\ExtendedArith\ExtendedArith
Path: {Application}\Libraries\GameLib
Path: {Application}\Libraries\htmlGEC
Path: {Application}\Libraries\GEC\GEC Implementation
Path: {Application}\Libraries\Hilde
Path: {Application}\Libraries\GEC
Path: {Application}\Libraries\htmlGEC
Path: {Application}\Libraries\htmlGEC\graph_copy