Commit e803865d authored by Bas Lijnse's avatar Bas Lijnse

Removed interaction options for setting attributes

parent 173a9ccf
Pipeline #26180 failed with stage
in 2 minutes and 15 seconds
......@@ -448,7 +448,7 @@ where
(viewSharedInformation [ViewAs (\{ActionStatus|description} -> description)] status
-&&-
//View communications tried to complete this action
(enterChoiceWithShared [ChooseWithHint "Attempts:",ChooseFromGrid viewAttempt] attempts
(Hint "Attempts:" @>> enterChoiceWithShared [ChooseFromGrid viewAttempt] attempts
>^* [OnAction (Action "Make Phone Call") (always (addPhoneCall status attempts))
,OnAction (Action "Send P2000 Message") (always (addP2000Message status attempts))
]
......@@ -793,7 +793,7 @@ where
= doOrClose (
(get userActionCatalog -&&- get currentDateTime)
>>- \(catalog,now) -> createJSONFile ("Incidone-actions-" +++ paddedDateTimeString now +++ ".json") catalog
>>- viewInformation [ViewWithHint "An export file has been created"]
>>- \file -> Hint "An export file has been created" @>> viewInformation [] file
@! ()
) <<@ Title "Export actions"
where
......
......@@ -48,9 +48,10 @@ where
@! WallClock
configure "Countdown"
= get currentDateTime
>>- updateInformation [UpdateWithTitle title,UpdateWithHint "Set the countdown date and time"]
>>- \datetime ->
Title title @>> Hint "Set the countdown date and time" @>> updateInformation [] datetime
@ WallCountDown
configure _
= viewInformation [ViewWithTitle title, ViewWithHint "This option is not available yet..."] () @? const NoValue
= Title title @>> Hint "This option is not available yet..." @>> viewInformation [] () @? const NoValue
bigLabel l = SpanTag [StyleAttr "font-size: 24px; font-weight: bold; margin-bottom: 5px;"] [Text (toSingleLineText l)]
......@@ -48,7 +48,7 @@ where
= whileUnchanged databaseConfig
\config ->
checkDatabaseConfig config
>>- viewInformation [ViewWithTitle "Database configuration", ViewAs databaseStatusView]
>>- \status -> Title "Database configuration" @>> viewInformation [ViewAs databaseStatusView] status
databaseStatusView (Ok InternalSQLiteDB) = (LightOnGreen, "Incidone is correctly configured to use an internal SQLite database.")
databaseStatusView (Ok (ExternalMySQLDB _)) = (LightOnGreen, "Incidone is correctly configured to use an external MySQL database.")
......@@ -119,7 +119,9 @@ where
createIncidoneTables db
= (sequence [sqlExecuteCreateTable db table \\ table <- IncidoneDB]
>>- viewInformation [ViewWithHint "Incidone schema created"]) <<@ Title "Creating Incidone tables..."
>>- \result ->
Hint "Incidone schema created" @>> viewInformation [] result
) <<@ Title "Creating Incidone tables..."
>>* [OnAction ActionOk (always (return ()))]
emptyDatabase db
......@@ -128,7 +130,8 @@ where
get (sdsFocus db sqlTables)
>>- \tables ->
sequence [sqlExecuteDropTable db table \\ table <- tables]
>>- viewInformation [ViewWithTitle "Empty database",ViewWithHint "All data deleted"]
>>- \result ->
Title "Empty database" @>> Hint "All data deleted" @>> viewInformation [] result
>>* [OnAction ActionOk (always (return ()))]
manageUsers :: Task ()
......@@ -243,7 +246,7 @@ where
= doOrClose (
get (webLinksConfig |*| currentDateTime)
>>- \(config,now) -> createJSONFile ("Incidone-weblinks-" +++ paddedDateTimeString now +++ ".json") config
>>- viewInformation [ViewWithHint "An export file has been created"]
>>- \result -> Hint "An export file has been created" @>> viewInformation [] result
@! ()
) <<@ Title "Export web links"
where
......@@ -257,7 +260,7 @@ where
importJSONDocument doc
>>- \config ->
set config webLinksConfig
>-| viewInformation [ViewWithHint "Succesfully imported web links"] () @! ()
>-| Hint "Succesfully imported web links" @>> viewInformation [] () @! ()
) (\e -> (Hint "Failed import of web links" @>> viewInformation [] e) @! ())
) <<@ Title "Import web links"
where
......
......@@ -13,5 +13,5 @@ main = enterDateTime @! ()
enterDateTime :: Task [(Date, Time)]
enterDateTime
= enterInformation [EnterWithHint "Enter a date and time"]
>>= viewInformation [ViewWithHint "You Entered:"]
= Hint "Enter a date and time" @>> enterInformation []
>>= \result -> Hint "You Entered:" @>> viewInformation [] result
......@@ -12,5 +12,5 @@ main = enterInt @! ()
enterInt :: Task Int
enterInt
= enterInformation [EnterWithHint "Enter an Integer number:"]
>>= viewInformation [ViewWithHint "You entered:"]
= Hint "Enter an Integer number:" @>> enterInformation []
>>= \result -> Hint "You entered:" @>> viewInformation [] result
......@@ -12,5 +12,5 @@ main = enterListOfInt @! ()
enterListOfInt :: Task [Int]
enterListOfInt
= enterInformation [EnterWithHint "Enter a list of Integer numbers:"]
>>= viewInformation [ViewWithHint "You Entered:"]
= Hint "Enter a list of Integer numbers:" @>> enterInformation []
>>= \result -> Hint "You Entered:" @>> viewInformation [] result
......@@ -12,5 +12,5 @@ main = enterText @! ()
enterText :: Task String
enterText
= enterInformation [EnterWithHint "Enter text:", EnterUsing id textArea]
>>= viewInformation [ViewWithHint "You entered:", ViewUsing id textArea]
= Hint "Enter text:" @>> enterInformation [EnterUsing id textArea]
>>= \result -> Hint "You entered:" @>> viewInformation [ViewUsing id textArea] result
......@@ -12,4 +12,4 @@ main = helloWorld @! ()
helloWorld :: Task String
helloWorld
= viewInformation [ViewWithHint "You have a message from iTasks:"] "Hello, world!"
= Hint "You have a message from iTasks:" @>> viewInformation [] "Hello, world!"
......@@ -13,5 +13,5 @@ main = leafletMap @! ()
leafletMap :: Task LeafletMap
leafletMap
= enterInformation [EnterWithHint "Enter a Leaflet map:"]
>>= viewInformation [ViewWithHint "You entered:", ViewAs (gText{|*|} AsMultiLine o Just)]
= Hint "Enter a Leaflet map:" @>> enterInformation []
>>= \result -> Hint "You entered:" @>> viewInformation [ViewAs (gText{|*|} AsMultiLine o Just)] result
......@@ -27,5 +27,5 @@ derive class iTask Family, Person, Gender
enterFamily :: Task Family
enterFamily
= enterInformation [EnterWithHint "Enter a family tree:"]
>>= viewInformation [ViewWithHint "You Entered:"]
= Hint "Enter a family tree:" @>> enterInformation []
>>= \result -> Hint "You Entered:" @>> viewInformation [] result
......@@ -22,5 +22,5 @@ derive class iTask Person, Gender
enterPerson :: Task Person
enterPerson
= enterInformation [EnterWithHint "Enter a person:"]
>>= viewInformation [ViewWithHint "You Entered:"]
= Hint "Enter a person:" @>> enterInformation []
>>= \result -> Hint "You Entered:" @>> viewInformation [] result
......@@ -14,7 +14,7 @@ main = browseAndViewLeafletMap @! ()
browseAndViewLeafletMap :: Task LeafletMap
browseAndViewLeafletMap
= withShared defaultValue // create shared default value for the map
(\smap -> updateSharedInformation [UpdateSharedWithHint "Browse Map"] smap // update it here
(\smap -> (Hint "Browse Map" @>> updateSharedInformation [] smap) // update it here
-||
viewSharedInformation [ViewWithHint "View Browsing Map"] smap ) // while viewing it here
>>= viewInformation [ViewWithHint "Resulting map looks as follows"] // show final result
(Hint "View Browsing Map" @>> viewSharedInformation [] smap) ) // while viewing it here
>>= \result -> Hint "Resulting map looks as follows" @>> viewInformation [] result // show final result
......@@ -15,5 +15,5 @@ main = showDateAndTime @! ()
showDateAndTime :: Task Time
showDateAndTime
= viewSharedInformation [ViewWithHint "The current Date and Time is:"] currentDateTime
>>| viewSharedInformation [ViewWithHint "The current time is:", ViewAs AnalogClock] currentTime
= Hint "The current Date and Time is:" @>> viewSharedInformation [] currentDateTime
>>| Hint "The current time is:" @>> viewSharedInformation [ViewAs AnalogClock] currentTime
......@@ -16,11 +16,11 @@ sharedNoteAsList
= withShared "" doEditor
where
doEditor state
= updateSharedInformation [UpdateSharedWithTitle "Text",UpdateSharedWithHint "Edit text",noteEditor] state
= (Title "Text" @>> Hint "Edit text" @>> updateSharedInformation [noteEditor] state)
-||-
updateSharedInformation [UpdateSharedWithTitle "Lines",UpdateSharedWithHint "Edit lines",listEditor] state
(Title "Lines" @>> Hint "Edit lines" @>> updateSharedInformation [listEditor] state)
<<@ ArrangeHorizontal
>>= viewInformation [ViewWithHint "Result:"]
>>= \result -> Hint "Result:" @>> viewInformation [] result
>>= return
noteEditor = UpdateSharedUsing id (const id) const textArea
......
......@@ -14,14 +14,18 @@ main = sharedNotes @! ()
sharedNotes :: Task String
sharedNotes
= withShared "" // create an initial empty shared string
(\note -> viewSharedInformation [ViewWithHint "View on note", ViewUsing id textArea] note // one to view the resulting string
-||-
( updateSharedInformation [UpdateSharedWithHint "Update shared note 1", UpdateSharedUsing id (const id) const textArea] note // an editor to update the shared string
-||-
updateSharedInformation [UpdateSharedWithHint "Update shared note 2", UpdateSharedUsing id (const id) const textArea] note // and an other updating editor
<<@ ArrangeHorizontal
)
// create an initial empty shared string
= withShared ""
(\note -> // one to view the resulting string
(Hint "View on note" @>> viewSharedInformation [ViewUsing id textArea] note)
-||-
// an editor to update the shared string
((Hint "Update shared note 1" @>> updateSharedInformation [UpdateSharedUsing id (const id) const textArea] note)
-||-
// and an other updating editor
(Hint "Update shared note 2" @>> updateSharedInformation [UpdateSharedUsing id (const id) const textArea] note)
) <<@ ArrangeHorizontal
)
>>= viewInformation [ViewWithHint "Resulting string is:", ViewUsing id textArea]
>>= \result -> Hint "Resulting string is:" @>> viewInformation [ViewUsing id textArea] result
>>= return
......@@ -23,9 +23,9 @@ derive class iTask Person, Gender
enterSharedPersons :: Task [Person]
enterSharedPersons
= withShared [] // create an empty shared list
\sharedList -> updateSharedInformation [UpdateSharedWithHint "Modify the Shared List of Persons:"] sharedList // update that list
\sharedList -> (Hint "Modify the Shared List of Persons:" @>> updateSharedInformation [] sharedList) // update that list
-||
viewSharedInformation [ViewWithHint "Current Content of this Shared List:"] sharedList // while showing that list
(Hint "Current Content of this Shared List:" @>> viewSharedInformation [] sharedList) // while showing that list
<<@ ArrangeHorizontal // show both list next to each other (default is below)
>>= viewInformation [ViewWithHint "The List contains the following:"] // show the final result
>>= \result -> Hint "The List contains the following:" @>> viewInformation [] result // show the final result
>>= return // done
......@@ -11,5 +11,5 @@ main :: Task ()
main = runProcess @! ()
runProcess :: Task Int
runProcess = enterInformation [EnterWithHint "Command"] -&&- enterInformation [EnterWithHint "Arguments"]
runProcess = (Hint "Command" @>> enterInformation []) -&&- (Hint "Arguments" @>> enterInformation [])
>>= \(cmd, args)->runProcessInteractive zero cmd args Nothing
......@@ -13,10 +13,10 @@ main = myExample @! ()
multiUserExample
= allTasks (map (createUser o mkUserAccount) players)
>>| viewInformation [ViewWithHint "Login under one of the following names (password = login name)"]
(foldl (+++) "" (map (\n -> n +++ ", ") players))
>>| (Hint "Login under one of the following names (password = login name)" @>> viewInformation []
(foldl (+++) "" (map (\n -> n +++ ", ") players)))
-||-
viewInformation [ViewWithHint "and then Select \"new\" to create a new Task..."] ""
(Hint "and then Select \"new\" to create a new Task..." @>> viewInformation [] "")
>>| installWorkflows [wf "chat"]
>>| loginAndManageWork "Chat_4_2 Example" Nothing Nothing False
where
......@@ -32,7 +32,7 @@ myExample
= createChatSession enter update
where
enter :: Task String
enter = enterInformation [EnterWithHint "Type in a message"]
enter = Hint "Type in a message" @>> enterInformation []
update :: User String -> Task String
update user chat = return (toString user +++ " says : " +++ chat)
......@@ -40,7 +40,7 @@ where
createChatSession :: (Task a) (User a -> Task b) -> Task [b] | iTask a & iTask b
createChatSession enter update
= get currentUser
>>= \me -> enterMultipleChoiceWithShared [ChooseWithHint "select chatters", ChooseFromCheckGroup id] users
>>= \me -> Hint "select chatters" @>> enterMultipleChoiceWithShared [ChooseFromCheckGroup id] users
>>= \others -> withShared [] (startChats enter update [me:others])
startChats :: (Task a) (User a -> Task b) [User] (Shared sds [b]) -> Task [b] | iTask a & iTask b & RWShared sds
......@@ -50,7 +50,7 @@ startChats enter update chatters chatStore
chatWith :: User (Task a) (User a -> Task b) (Shared sds [b]) -> Task () | iTask a & iTask b & RWShared sds
chatWith me enter update chatStore
= viewSharedInformation [ViewWithHint "Chat History:"] chatStore
= Hint "Chat History:" @>> viewSharedInformation [] chatStore
||-
oneChat
where
......
......@@ -16,10 +16,10 @@ main = multiUserExample @! ()
multiUserExample
= allTasks (map (createUser o mkUserAccount) players)
>>| viewInformation [ViewWithHint "Login under one of the following names (password = login name)"]
(join ", " players)
>>| (Hint "Login under one of the following names (password = login name)" @>> viewInformation []
(join ", " players))
-||-
viewInformation [ViewWithHint "and then Select \"new\" to create a new Task..."] ""
(Hint "and then Select \"new\" to create a new Task..." @>> viewInformation [] "")
>>| installWorkflows [wf "Meeting date"]
>>| loginAndManageWork "Meeting_4_3 Example" Nothing Nothing False
where
......@@ -52,15 +52,15 @@ derive class iTask DateOption, MeetingOption
DefineMeetingPurpose :: Task String
DefineMeetingPurpose
= enterInformation [EnterWithHint "What is the purpose of the meeting?"]
= Hint "What is the purpose of the meeting?" @>> enterInformation []
SelectDatesToPropose :: Task [DateOption]
SelectDatesToPropose
= enterInformation [EnterWithHint "Select the date(s) and time you propose to meet..."]
= Hint "Select the date(s) and time you propose to meet..." @>> enterInformation []
SelectAttendencees :: Task [User]
SelectAttendencees
= enterMultipleChoiceWithShared [ChooseWithHint "Who do you want to invite for the meeting?", ChooseFromCheckGroup id] users
= Hint "Who do you want to invite for the meeting?" @>> enterMultipleChoiceWithShared [ChooseFromCheckGroup id] users
AskOthers :: String [User] [DateOption] -> Task MeetingOption
AskOthers purpose others dates
......@@ -72,13 +72,15 @@ where
askAll table
= allTasks[(user, purpose) @: checkOptions (toString user) \\ user <- others]
>-| enterChoiceWithShared [ChooseWithHint "Select the date for the meeting:", ChooseFromGrid id] table
>>= viewInformation [ViewWithHint "Date chosen:"]
>-| (Hint "Select the date for the meeting:" @>> enterChoiceWithShared [ChooseFromGrid id] table)
>>= \result -> Hint "Date chosen:" @>> viewInformation [] result
where
checkOptions user
= viewSharedInformation [ViewWithHint "Current Responses:"] table
= (Hint "Current Responses:" @>> viewSharedInformation [] table)
||-
enterMultipleChoice [ChooseWithHint "Select the date(s) you can attend the meeting (ctrl alt):", ChooseFromGrid (\i -> dates!!i)] [0..length dates - 1]
(Hint "Select the date(s) you can attend the meeting (ctrl alt):"
@>> enterMultipleChoice [ChooseFromGrid (\i -> dates!!i)] [0..length dates - 1])
>>= \ids -> upd (\table -> [{t & users = if (isMember j ids) [user:t.users] t.users} \\ j <- [0..] & t <- table]) table
......
......@@ -16,10 +16,10 @@ main = multiUserExample @! ()
multiUserExample
= allTasks (map (createUser o mkUserAccount) logins)
>>| viewInformation [ViewWithHint "Login under one of the following names (password = login name)"]
(foldl (+++) "" (map (\n -> n +++ ", ") logins))
>>| (Hint "Login under one of the following names (password = login name)" @>> viewInformation []
(foldl (+++) "" (map (\n -> n +++ ", ") logins)))
-||-
viewInformation [ViewWithHint "and then Select \"new\" to create a new Task..."] ""
(Hint "and then Select \"new\" to create a new Task..." @>> viewInformation [] "")
>>| installWorkflows [wf "Chat with options"]
>>| loginAndManageWork "Chat_4_2 Example" Nothing Nothing False
where
......@@ -55,7 +55,7 @@ genChat = createChatSession myChat updateChat
createChatSession :: (Task a) (User a -> Task b) -> Task [b] | iTask a & iTask b
createChatSession enter update
= get currentUser
>>= \me -> enterMultipleChoiceWithShared [ChooseWithHint "select chatters", ChooseFromCheckGroup id] users
>>= \me -> Hint "select chatters" @>> enterMultipleChoiceWithShared [ChooseFromCheckGroup id] users
>>= \others -> withShared [] (startChats enter update [me:others])
where
startChats :: (Task a) (User a -> Task b) [User] (Shared sds [b]) -> Task [b] | iTask a & iTask b & RWShared sds
......@@ -65,7 +65,7 @@ where
chatWith :: User (Task a) (User a -> Task b) (Shared sds [b]) -> Task () | iTask a & iTask b & RWShared sds
chatWith me enter update chatStore
= viewSharedInformation [ViewWithHint "Chat History:"] chatStore
= Hint "Chat History:" @>> viewSharedInformation [] chatStore
||-
oneChat
where
......@@ -81,14 +81,14 @@ where
myChat
= enterChoice [ChooseWithHint "select message kind"] ["Text","Doc + Text","NewChat"]
= Hint "select message kind" @>> enterChoice [] ["Text","Doc + Text","NewChat"]
>>= \sel -> case sel of
"Text" -> oneChat @ Text o ((+++) "\t")
"Doc + Text" -> oneChat @ DocWithText
"NewChat" -> genChat @ Chats
where
oneChat :: Task a | iTask a
oneChat = enterInformation [EnterWithHint "Type in a message: "]
oneChat = Hint "Type in a message: " @>> enterInformation []
updateChat :: User a -> Task (ChatMsg a) | iTask a
updateChat user chat
......
......@@ -24,7 +24,7 @@ derive class iTask Statistics, Replace
editWithStatistics :: Task ()
editWithStatistics
= enterInformation [EnterWithHint "Give name of text file you want to edit..."]
= Hint "Give name of text file you want to edit..." @>> enterInformation []
>>= \fileName -> let file = sharedStore fileName ""
in editFile fileName file
-||-
......@@ -34,10 +34,10 @@ editWithStatistics
editFile :: String (Shared sds String) -> Task () | RWShared sds
editFile fileName sharedFile
= updateSharedInformation [UpdateSharedWithHint ("edit " +++ fileName), UpdateSharedUsing id (const id) const textArea] sharedFile @! ()
= Hint ("edit " +++ fileName) @>> updateSharedInformation [UpdateSharedUsing id (const id) const textArea] sharedFile @! ()
showStatistics :: (Shared sds String) -> Task () | RWShared sds
showStatistics sharedFile = viewSharedInformation [ViewWithHint "Statistics:", ViewAs stat] sharedFile @! ()
showStatistics sharedFile = Hint "Statistics:" @>> viewSharedInformation [ViewAs stat] sharedFile @! ()
where
stat text = {lineCount = lengthLines text, wordCount = lengthWords text}
where
......@@ -49,7 +49,7 @@ where
replace :: Replace (Shared sds String) -> Task () | RWShared sds
replace cmnd sharedFile
= ( updateInformation [UpdateWithHint "Replace:"] cmnd
= ( Hint "Replace:" @>> updateInformation [] cmnd
>>* [ OnAction (Action "Replace") (hasValue substitute)
]
)
......
......@@ -18,9 +18,8 @@ derive class iTask MySum
calculateSumInRecord :: Task Int
calculateSumInRecord
= withShared (0,0)
(\sum -> updateSharedInformation
[UpdateSharedWithTitle "Sum of 2 numbers, with view"
,UpdateSharedAs (\(i,j) -> {firstNumber = i, secondNumber = j, sum = (i+j)})
(\sum -> Title "Sum of 2 numbers, with view" @>> updateSharedInformation
[UpdateSharedAs (\(i,j) -> {firstNumber = i, secondNumber = j, sum = (i+j)})
(\_ res -> (res.firstNumber,res.secondNumber)) const] sum
)
>>= \(i,j) -> return (i+j)
......@@ -12,7 +12,7 @@ main = calculateSumStepwise @! ()
calculateSumStepwise :: Task Int
calculateSumStepwise
= enterInformation [EnterWithTitle "Number 1", EnterWithHint "Enter a number"]
>>= \num1 -> enterInformation [EnterWithTitle "Number 2", EnterWithHint "Enter another number"]
>>= \num2 -> viewInformation [ViewWithTitle "Sum", ViewWithHint "The sum of those numbers is:"] (num1 + num2)
= Title "Number 1" @>> Hint "Enter a number" @>> enterInformation []
>>= \num1 -> Title "Number 2" @>> Hint "Enter another number" @>> enterInformation []
>>= \num2 -> Title "Sum" @>> Hint "The sum of those numbers is:" @>> viewInformation [] (num1 + num2)
>>= return
......@@ -13,13 +13,13 @@ main = calculateSumSteps @! ()
calculateSumSteps :: Task Int
calculateSumSteps = step1 0 0
where
step1 n1 n2 = updateInformation [UpdateWithTitle "Number 1", UpdateWithHint "Enter the first number"] n1
step1 n1 n2 = Title "Number 1" @>> Hint "Enter the first number" @>> updateInformation [] n1
>>* [ OnAction ActionNext (hasValue (\n1 -> step2 n1 n2))
]
step2 n1 n2 = updateInformation [UpdateWithTitle "Number 2", UpdateWithHint "Enter the second number"] n2
step2 n1 n2 = Title "Number 2" @>> Hint "Enter the second number" @>> updateInformation [] n2
>>* [ OnAction ActionPrevious (always (step1 n1 n2))
, OnAction ActionNext (hasValue (\n2 -> step3 n1 n2))]
step3 n1 n2 = viewInformation [ViewWithTitle "Sum",ViewWithHint "The sum of those numbers is:"] (n1 + n2)
step3 n1 n2 = Title "Sum" @>> Hint "The sum of those numbers is:" @>> viewInformation [] (n1 + n2)
>>* [ OnAction ActionPrevious (always (step2 n1 n2))
, OnAction ActionOk (always (return (n1 + n2)))
]
......@@ -18,7 +18,7 @@ calculator :: Task Int
calculator = calc initSt
where
calc st
= viewInformation [ViewWithHint "Calculator"] st
= Hint "Calculator" @>> viewInformation [] st
>>* [ OnAction (Action "7") (always (updateDigit 7 st))
, OnAction (Action "8") (always (updateDigit 8 st))
, OnAction (Action "9") (always (updateDigit 9 st))
......
......@@ -15,7 +15,7 @@ coffeemachine :: Task (String,EUR)
coffeemachine
=
forever
( enterChoice [ChooseWithTitle "Product",ChooseWithHint "Choose your product:"]
( Title "Product" @>> Hint "Choose your product:" @>> enterChoice []
[("Coffee", EUR 100)
,("Cappucino", EUR 150)
,("Tea", EUR 50)
......@@ -27,9 +27,9 @@ coffeemachine
getCoins :: EUR (String,EUR) -> Task (String,EUR)
getCoins paid (product,toPay)
= viewInformation [ViewWithHint "Coffee Machine",ViewAs view1] toPay
= (Title "Coffee Machine" @>> viewInformation [ViewAs view1] toPay)
||-
enterChoice [ChooseWithTitle "Insert coins",ChooseWithHint "Please insert a coin...", ChooseFromCheckGroup id] coins
(Title "Insert coins" @>> Hint "Please insert a coin..." @>> enterChoice [ChooseFromCheckGroup id] coins)
>>* [ OnAction ActionCancel (always (stop ("Product Cancelled",paid)))
, OnAction (Action "Insert") (hasValue handleMoney)
]
......@@ -40,7 +40,7 @@ where
| toPay > coin = getCoins (paid+coin) (product, toPay-coin)
| otherwise = stop (product,coin-toPay)
stop (product, money) = viewInformation [ViewWithHint "Coffee Machine",ViewAs view2] (product,money)
stop (product, money) = Title "Coffee Machine" @>> viewInformation [ViewAs view2] (product,money)
view1 toPay = [(DivTag [] [Text ("Chosen product: " <+++ product), BrTag [], Text ("To pay: " <+++ toPay)])]
view2 (product,money) = [(DivTag [] [Text ("Enjoy your: " <+++ product), BrTag [], Text ("Money returned: " <+++ money)])]
......@@ -22,9 +22,9 @@ derive class iTask Person, Gender
person1by1 :: [Person] -> Task [Person]
person1by1 persons
= enterInformation [EnterWithHint "Add a person"]
= (Hint "Add a person" @>> enterInformation [])
-||
viewInformation [ViewWithHint "List so far.."] persons
(Hint "List so far.." @>> viewInformation [] persons)
>>* [ OnAction (Action "Add") (hasValue (\v -> person1by1 [v : persons]))
, OnAction (Action "Finish") (always (return persons))
, OnAction ActionCancel (always (return []))
......
......@@ -12,11 +12,11 @@ main = palindrome @! ()
palindrome :: Task (Maybe String)
palindrome
= enterInformation [EnterWithHint "Enter a palindrome"]
= Hint "Enter a palindrome" @>> enterInformation []
>>* [ OnAction ActionOk (ifValue palindrome (\v -> return (Just v)))
, OnAction ActionCancel (always (return Nothing))
]
>>= viewInformation [ViewWithHint "Result is:"]
>>= \result -> Hint "Result is:" @>> viewInformation [] result
>>= return
where
palindrome s = lc == reverse lc
......
......@@ -13,7 +13,7 @@ playWithMaps = withShared ({defaultValue & icons = shipIcons, tilesUrls = ["/til
) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
manipulateMap :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation () [UpdateUsing id (flip const) (customLeafletEditor eventHandlers)] m
manipulateMap m = updateSharedInformation [UpdateSharedUsing id (flip const) const (customLeafletEditor eventHandlers)] m
<<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! ()
where
eventHandlers = {simpleStateEventHandlers & onHtmlEvent = onHtmlEvent}
......@@ -22,23 +22,23 @@ where
onHtmlEvent _ (l,s) = (l,s)
managePerspective :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
managePerspective m = updateSharedInformation (Title "Perspective") []
managePerspective m = Title "Perspective" @>> updateSharedInformation []
(mapReadWrite (\(x,s) -> x.LeafletMap.perspective, \p (x,s) -> Just ({x & perspective = p},s)) Nothing m) @! ()
manageState :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manageState m = updateSharedInformation (Title "State") []
manageState m = Title "State" @>> updateSharedInformation []
(mapReadWrite (\(x,s) -> s, \sn (x,s) -> Just (x,sn)) Nothing m) @! ()
// objects can currently only be viewed, as the editor for `HtmlTag` only works in view mode
manageMapObjects :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manageMapObjects m = viewSharedInformation (Title "View objects") [ViewAs toPrj] m
manageMapObjects m = Title "View objects" @>> viewSharedInformation [ViewAs toPrj] m
-|| addDemoObjects m
@! ()
where
toPrj (m,_) = m.LeafletMap.objects
addDemoObjects m
= enterChoiceAs "Add objects:" [ChooseFromCheckGroup fst] options snd
= Hint "Add objects:" @>> enterChoiceAs [ChooseFromCheckGroup fst] options snd
>^* [OnAction (Action "Add") (hasValue id)]
where
options =
......
......@@ -17,7 +17,7 @@ play_Ligretto
invite_friends :: Task [User]
invite_friends
= enterMultipleChoiceWithShared "Select 1, 2, or 3 friends to play with" [] users
= Hint "Select 1, 2, or 3 friends to play with" @>> enterMultipleChoiceWithShared [] users
>>* [OnAction ActionContinue (withValue (\them -> if (isMember (length them) [1..3]) (Just (return them)) Nothing))]
play_game :: ![(Color,User)] !(Shared sds GameSt) -> Task (Color,String) | RWShared sds
......@@ -28,7 +28,7 @@ play_game users game_st
play :: !(!Color,!String) !(Shared sds GameSt) -> Task (Color,String) | RWShared sds
play (me,name) game_st
= updateSharedInformation name [ligrettoEditor me] game_st
= Hint name @>> updateSharedInformation [ligrettoEditor me] game_st
>>* [OnValue (withValue (\gameSt -> determine_winner gameSt
>>= \winner -> return (accolades winner me game_st >>| return winner)))]
......@@ -47,4 +47,4 @@ game_over me game_st gameSt
accolades :: !(!Color,!String) !Color !(Shared sds GameSt) -> Task GameSt | RWShared sds
accolades winner me game_st
= updateSharedInformation ("The winner is " <+++ winner) [accoladesEditor me] game_st
= Hint ("The winner is " <+++ winner) @>> updateSharedInformation [accoladesEditor me] game_st
......@@ -7,10 +7,10 @@ import Ligretto.UoD
yields a customized UI for an interactive game of Ligretto using Graphics.Scalable, rendered from
the perspective of a player using @player_color cards.
*/
ligrettoEditor :: !Color -> UpdateOption GameSt GameSt
ligrettoEditor :: !Color -> UpdateSharedOption GameSt GameSt
/** accoladesEditor player_color:
yields a customized UI for a display of the given state of Ligretto using Graphics.Scalable, rendered from
the perspective of a player using @player_color cards.
*/
accoladesEditor :: !Color -> UpdateOption GameSt GameSt
accoladesEditor :: !Color -> UpdateSharedOption GameSt GameSt
......@@ -8,15 +8,15 @@ import Graphics.Scalable.Extensions
import iTasks.Extensions.SVG.SVGEditor
import Ligretto.UoD
ligrettoEditor :: !Color -> UpdateOption GameSt GameSt
ligrettoEditor me = UpdateUsing id (const id) (fromSVGEditor
ligrettoEditor :: !Color -> UpdateSharedOption GameSt GameSt
ligrettoEditor me = UpdateSharedUsing id (const id) const (fromSVGEditor
{ initView = id
, renderImage = const (player_perspective me)
, updModel = const id
})
accoladesEditor :: !Color -> UpdateOption GameSt GameSt
accoladesEditor me = UpdateUsing id (const id) (fromSVGEditor
accoladesEditor :: !Color -> UpdateSharedOption GameSt GameSt
accoladesEditor me = UpdateSharedUsing id (const id) const (fromSVGEditor
{ initView = id
, renderImage = const (player_perspective me)
, updModel = const id
......
......@@ -7,27 +7,28 @@ import Trax.UI
play_trax :: Task User
play_trax
= get currentUser
>>= \me -> enterChoiceWithShared "Who do you want to play Trax with:" [] users
>>= \me -> Hint "Who do you want to play Trax with:" @>> enterChoiceWithShared [] users
>>= \you -> play_game me you {trax=zero,names=[me,you],turn=True,choice=Nothing}
play_game :: User User TraxSt -> Task User
play_game me you traxSt
= withShared traxSt
(\share ->
(me @: ( updateSharedInformation (toString me +++ " plays with red") [updateTraxEditor True] share
(me @: ( Hint (toString me +++ " plays with red") @>> updateSharedInformation [updateTraxEditor True] share
>>* [OnValue (ifValue game_over game_winner)])
)
-&&-
(you @:( updateSharedInformation (toString you +++ " plays with white") [updateTraxEditor False] share
(you @:( Hint (toString you +++ " plays with white") @>> updateSharedInformation [updateTraxEditor False] share
>>* [OnValue (ifValue game_over game_winner)])
)
) @ fst
game_winner :: TraxSt -> Task User
game_winner st=:{trax,turn,names=[me,you]}
= viewInformation "The winner is:" [] (toString winner)
= (Hint "The winner is:" @>> viewInformation [] (toString winner))
-&&-
viewInformation "Final board:" [viewTraxEditor] st @ (const winner)
(Hint "Final board:" @>> viewInformation [viewTraxEditor] st)
@ (const winner)
where
winners = loops trax ++ winning_lines trax
prev_player_color = if turn WhiteLine RedLine
......
......@@ -7,7 +7,7 @@ import iTasks.WF.Tasks.Interaction
yields a customized view on a game of trax using Graphics.Scalable.
The view is interactive only if @flag is True.
*/
updateTraxEditor :: Bool -> UpdateOption TraxSt TraxSt
updateTraxEditor :: Bool -> UpdateSharedOption TraxSt TraxSt
/** viewTraxEditor:
yields a customized, non-interactive, view on a game of trax using Graphics.Scalable.
......
......@@ -9,8 +9,8 @@ import Trax.UoD
:: RenderMode = ViewMode | PlayMode
updateTraxEditor :: Bool -> UpdateOption TraxSt TraxSt
updateTraxEditor turn = UpdateUsing id (const id) (fromSVGEditor
updateTraxEditor :: Bool -> UpdateSharedOption TraxSt TraxSt
updateTraxEditor turn = UpdateSharedUsing id (const id) const (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updModel = flip const
......
......@@ -2,8 +2,9 @@ module Transformations
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.UI.Prompt
import iTasks.Extensions.SVG.SVGEditor
import iTasks.UI.Definition, iTasks.UI.Tune
import StdFunctions, StdList
// shorthand definitions for the used fonts in these examples
......@@ -12,11 +13,12 @@ times = normalFontDef "Times New Roman"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Transformations" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const transformed_images
, updModel = \_ v = v
})] 0) world
= doTasks (Title "Transformations" @>> viewInformation
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const transformed_images
, updModel = \_ v = v
})] 0) world
/** transformed_images model tags = image:
@image shows all possible transformations on (composite) Image-s.
......
......@@ -54,101 +54,101 @@ where
, publish "/doubleRemote" (const doubleRemoteTest)
, publish "/singleRemote" (const singleRemoteTest)]
sdsSelectRemoteTest = ((enterInformation "Enter the value to be SET for SDSSelect" [] >>= \v. set v (sdsFocus 0 selectShare))
sdsSelectRemoteTest = ((Hint "Enter the value to be SET for SDSSelect" @>> enterInformation [] >>= \v. set v (sdsFocus 0 selectShare))
-&&-
(get (sdsFocus 0 selectShare) >>= viewInformation "View the value gotten for SDSSelect by GET" []))
(get (sdsFocus 0 selectShare) >>= \value -> Hint "View the value gotten for SDSSelect by GET" @>> viewInformation [] value))
-&&-
((enterInformation "Enter the new value for the lens" [] >>= \n. upd (\_. n) (sdsFocus 0 selectShare))
((Hint "Enter the new value for the lens" @>> enterInformation [] >>= \n. upd (\_. n) (sdsFocus 0 selectShare))
-&&-
(viewSharedInformation "View value by viewSharedInformation" [] (sdsFocus 0 selectShare)))
(Hint "View value by viewSharedInformation" @>> viewSharedInformation [] (sdsFocus 0 selectShare)))
@! ()
sdsSelectTest = ((enterInformation "Enter the value to be SET for SDSSelect" [] >>= \v. set v (sdsFocus 1 selectShare))
sdsSelectTest = ((Hint "Enter the value to be SET for SDSSelect" @>> enterInformation [] >>= \v. set v (sdsFocus 1 selectShare))
-&&-
(get (sdsFocus 1 selectShare) >>= viewInformation "View the value gotten for SDSSelect by GET" []))
(get (sdsFocus 1 selectShare) >>= \value -> Hint "View the value gotten for SDSSelect by GET" @>> viewInformation [] value))
-&&-
((enterInformation "Enter the new value for the lens" [] >>= \n. upd (\_. n) (sdsFocus 1 selectShare))
((Hint "Enter the new value for the lens" @>> enterInformation [] >>= \n. upd (\_. n) (sdsFocus 1 selectShare))