Verified Commit 4b67e3b6 authored by Camil Staps's avatar Camil Staps 🚀

Merge remote-tracking branch 'origin/master' into...

Merge remote-tracking branch 'origin/master' into server-and-client-side-svg-rendering-with-abc-interpreter
parent 9f3512a4
...@@ -17,7 +17,7 @@ Start world = doTasks ...@@ -17,7 +17,7 @@ Start world = doTasks
,onRequest "/" (ccMain registerTasks continuousTasks alwaysOnTasks optionalTasks <<@ (Title "C2 System")) ,onRequest "/" (ccMain registerTasks continuousTasks alwaysOnTasks optionalTasks <<@ (Title "C2 System"))
,onRequest "/tonic" (tonicDashboard []) ,onRequest "/tonic" (tonicDashboard [])
,onRequest "/debug" showDebug ,onRequest "/debug" showDebug
,onRequest "/adventure" (loginAndManageWork "Adventure") ,onRequest "/adventure" (loginAndManageWork "Adventure" Nothing Nothing False)
,onRequest "/alarm" (setSectionDetectors) ,onRequest "/alarm" (setSectionDetectors)
,onRequest "/log" showLog ,onRequest "/log" showLog
//,onRequest "/devices" (manageDevices True) //,onRequest "/devices" (manageDevices True)
......
...@@ -9,7 +9,7 @@ import iTasks.UI.Definition, iTasks.Extensions.Admin.UserAdmin ...@@ -9,7 +9,7 @@ import iTasks.UI.Definition, iTasks.Extensions.Admin.UserAdmin
Start :: *World -> *World Start :: *World -> *World
Start world = doTasks Start world = doTasks
[onStartup (installWorkflows workflows) [onStartup (installWorkflows workflows)
,onRequest "/" (loginAndManageWork "The Taxman") ,onRequest "/" (loginAndManageWork "The Taxman" Nothing Nothing True)
] world ] world
workflows :: [Workflow] workflows :: [Workflow]
......
This diff was suppressed by a .gitattributes entry.
.welcome-itasks-example-collection {
background: url('/itasks.png') no-repeat top center;
padding-top: 100px;
}
.welcome-itasks-example-collection > div {
max-width: 600px;
border-radius: 5px;
padding: 5px 10px;
}
.welcome-itasks-example-collection h1 {
font-weight: normal;
font-size: 32pt;
color: #74a1d5;
}
...@@ -18,7 +18,7 @@ multiUserExample ...@@ -18,7 +18,7 @@ multiUserExample
-||- -||-
viewInformation "and then Select \"new\" to create a new Task..." [] "" viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| installWorkflows [wf "chat"] >>| installWorkflows [wf "chat"]
>>| loginAndManageWork "Chat_4_2 Example" >>| loginAndManageWork "Chat_4_2 Example" Nothing Nothing False
where where
mkUserAccount name mkUserAccount name
= {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] } = {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
......
...@@ -21,7 +21,7 @@ multiUserExample ...@@ -21,7 +21,7 @@ multiUserExample
-||- -||-
viewInformation "and then Select \"new\" to create a new Task..." [] "" viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| installWorkflows [wf "Meeting date"] >>| installWorkflows [wf "Meeting date"]
>>| loginAndManageWork "Meeting_4_3 Example" >>| loginAndManageWork "Meeting_4_3 Example" Nothing Nothing False
where where
mkUserAccount name mkUserAccount name
= {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] } = {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
......
...@@ -21,7 +21,7 @@ multiUserExample ...@@ -21,7 +21,7 @@ multiUserExample
-||- -||-
viewInformation "and then Select \"new\" to create a new Task..." [] "" viewInformation "and then Select \"new\" to create a new Task..." [] ""
>>| installWorkflows [wf "Chat with options"] >>| installWorkflows [wf "Chat with options"]
>>| loginAndManageWork "Chat_4_2 Example" >>| loginAndManageWork "Chat_4_2 Example" Nothing Nothing False
where where
mkUserAccount name mkUserAccount name
= {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] } = {UserAccount| credentials = {Credentials| username = Username name, password = Password name}, title = Nothing, roles = ["manager"] }
......
...@@ -34,19 +34,46 @@ makeExs :: [FilePath] -> [String] ...@@ -34,19 +34,46 @@ makeExs :: [FilePath] -> [String]
makeExs i = makeExs i =
[ "module BasicAPIExamples\n" [ "module BasicAPIExamples\n"
, "\n" , "\n"
, "import iTasks" , "import iTasks\n"
, "import Text.HTML\n"
, "import qualified iTasks.Extensions.Admin.UserAdmin\n"
, "\n" , "\n"
, join "\n" ["import qualified " +++ toDots i\\i<-i] , join "\n" ["import qualified " +++ toDots i\\i<-i]
, "\n\n" , "\n\n"
, "Start :: *World -> *World\n" , "Start :: *World -> *World\n"
, "Start world = doTasks {WorkflowCollection|name=name,workflows=basicAPIExamples} world\n" , "Start world = doTasks {WorkflowCollection|name=name,loginMessage=Just loginMessage,welcomeMessage=Just welcomeMessage,allowGuests=False,workflows=basicAPIExamples} world\n"
, "where\n" , "where\n"
, "\tname = \"iTasks Example Collection\"\n" , "\tname = \"iTasks Example Collection\"\n"
, "\tloginMessage = DivTag []\n"
, "\t\t[Text \"iTasks is a framework to create information systems from task specifications.\",BrTag []\n"
, "\t\t,Text \"Although useful for support of individual tasks, information systems add even more value when a task \"\n"
, "\t\t,Text \"requires multiple people to work together to accomplish it.\"\n"
, "\t\t,Text \"Therefore this example application is a multi-user demonstration of tasks expressed in iTasks.\",BrTag [],BrTag[]\n"
, "\t\t,Text \"You can log in with a demonstration user account:\",BrTag []\n"
, "\t\t\t,UlTag []\n"
, "\t\t\t\t[LiTag [] [Text \"Alice (username: alice, password: alice)\"]\n"
, "\t\t\t\t,LiTag [] [Text \"Bob (username: bob, password: bob)\"]\n"
, "\t\t\t\t,LiTag [] [Text \"Carol (username: carol, password: carol)\"]\n"
, "\t\t\t\t,LiTag [] [Text \"An administrator with full access (username: root, password: root)\"]\n"
, "\t\t\t\t]\n"
, "\t\t\t]\n"
, "\n"
, "\twelcomeMessage = DivTag []\n"
, "\t\t[H1Tag [] [Text \"Welcome\"],PTag []\n"
, "\t\t\t[Text \"In this generic application you can work on multiple tasks concurrently.\", BrTag []\n"
, "\t\t\t,Text \"In the list above you can see the set of ongoing tasks that you can choose to work on.\", BrTag []\n"
, "\t\t\t,Text \"Additionally you can add tasks to this list with the 'New' button. This will open a window with a collection of predefined tasks.\", BrTag []\n"
, "\t\t\t,Text \"These tasks range from simple TODO items, to complex multi-user workflows.\", BrTag []\n"
, "\t\t\t]\n"
, "\t\t]\n"
, "\n" , "\n"
, "basicAPIExamples :: [Workflow]\n" , "basicAPIExamples :: [Workflow]\n"
, "basicAPIExamples =\n" , "basicAPIExamples =\n"
, "\t[",join "\n\t," (map (\i->concat ["'", toDots i, "'.wf \"", toString (insertSpaces 0 (dropExtension i)), "\""]) i), "\n\t]\n"] , "\t[",join "\n\t," (defaultWfs ++ exampleWfs), "\n\t]\n"]
where where
defaultWfs = ["restrictedTransientWorkflow \"Users\" \"User management\" [\"admin\"] 'iTasks.Extensions.Admin.UserAdmin'.manageUsers"]
exampleWfs = map (\i->concat ["'", toDots i, "'.wf \"", toString (insertSpaces 0 (dropExtension i)), "\""]) i
toDots = join "." o split (toString pathSeparator) o dropExtension toDots = join "." o split (toString pathSeparator) o dropExtension
insertSpaces i s insertSpaces i s
| i == size s = [] | i == size s = []
......
...@@ -25,7 +25,7 @@ Global ...@@ -25,7 +25,7 @@ Global
Stack: False Stack: False
Dynamics: True Dynamics: True
GenericFusion: False GenericFusion: False
DescExL: False DescExL: True
Output Output
Output: NoReturnType Output: NoReturnType
Font: Courier Font: Courier
......
...@@ -108,7 +108,7 @@ startMode executable ...@@ -108,7 +108,7 @@ startMode executable
>>- \role = case role of >>- \role = case role of
DomainServer domain -> startAuthEngine domain DomainServer domain -> startAuthEngine domain
>>| installWorkflows (myTasks True) >>| installWorkflows (myTasks True)
>>| loginAndManageWork "Service engineer application" >>| loginAndManageWork "Service engineer application" Nothing Nothing False
Server domain -> startAuthEngine domain >>| loginRemote (myTasks False) Server domain -> startAuthEngine domain >>| loginRemote (myTasks False)
_ -> viewInformation "Welcome" [] "Chose what this iTasks instance is." _ -> viewInformation "Welcome" [] "Chose what this iTasks instance is."
>>* [ OnAction (Action "Domain server") (always (domainServer)) >>* [ OnAction (Action "Domain server") (always (domainServer))
...@@ -127,7 +127,7 @@ where ...@@ -127,7 +127,7 @@ where
>>= \domain -> set (DomainServer domain) serverRoleShare >>= \domain -> set (DomainServer domain) serverRoleShare
>>| startAuthEngine domain >>| startAuthEngine domain
>>| installWorkflows (myTasks True) >>| installWorkflows (myTasks True)
>>| loginAndManageWork "Service engineer application" >>| loginAndManageWork "Service engineer application" Nothing Nothing False
loginRemote :: ![Workflow] -> Task () loginRemote :: ![Workflow] -> Task ()
loginRemote workflows loginRemote workflows
...@@ -140,7 +140,7 @@ where ...@@ -140,7 +140,7 @@ where
browseAuthenticated workflows {Credentials|username,password} browseAuthenticated workflows {Credentials|username,password}
= remoteAuthenticateUser username password = remoteAuthenticateUser username password
>>= \mbUser -> case mbUser of >>= \mbUser -> case mbUser of
Just user = workAs user manageWorkOfCurrentUser Just user = workAs user (manageWorkOfCurrentUser Nothing)
Nothing = viewInformation (Title "Login failed") [] "Your username or password is incorrect" >>| return () Nothing = viewInformation (Title "Login failed") [] "Your username or password is incorrect" >>| return ()
Start :: *World -> *World Start :: *World -> *World
......
...@@ -24,8 +24,8 @@ Global ...@@ -24,8 +24,8 @@ Global
Profile Profile
Memory: False Memory: False
MemoryMinimumHeapSize: 0 MemoryMinimumHeapSize: 0
Time: True Time: False
Stack: True Stack: False
Dynamics: True Dynamics: True
DescExL: True DescExL: True
Output Output
......
...@@ -3,7 +3,7 @@ import iTasks ...@@ -3,7 +3,7 @@ import iTasks
import iTasks.Extensions.GIS.Leaflet import iTasks.Extensions.GIS.Leaflet
import iTasks.Extensions.GIS.LeafletNavalIcons import iTasks.Extensions.GIS.LeafletNavalIcons
import iTasks.UI.Definition import iTasks.UI.Definition
import Data.List import Data.List, Text.HTML
playWithMaps :: Task () playWithMaps :: Task ()
playWithMaps = withShared {defaultValue & icons = shipIcons} (\m -> playWithMaps = withShared {defaultValue & icons = shipIcons} (\m ->
...@@ -38,6 +38,7 @@ where ...@@ -38,6 +38,7 @@ where
,("Polygon from current markers",addMarkerConnectingPolygon m) ,("Polygon from current markers",addMarkerConnectingPolygon m)
,("Circle at cursor position",addCircleAtCursor m) ,("Circle at cursor position",addCircleAtCursor m)
,("Rectangle around current perspective",addRectangleAroundCurrentPerspective m) ,("Rectangle around current perspective",addRectangleAroundCurrentPerspective m)
,("Some window",addWindow m)
] ]
addRandomMarker m addRandomMarker m
...@@ -93,4 +94,15 @@ where ...@@ -93,4 +94,15 @@ where
withRectangleAroundCurrentPerspective Nothing objects = objects withRectangleAroundCurrentPerspective Nothing objects = objects
withRectangleAroundCurrentPerspective (Just bounds) objects = objects ++ [Rectangle {rectangleId = LeafletObjectID "RECT_PERSPECTIVE", bounds = bounds, editable = True, style = []}] withRectangleAroundCurrentPerspective (Just bounds) objects = objects ++ [Rectangle {rectangleId = LeafletObjectID "RECT_PERSPECTIVE", bounds = bounds, editable = True, style = []}]
addWindow m
= upd (\l=:{LeafletMap|objects} -> {LeafletMap| l & objects = [Window window:objects]}) m
where
window =
{ windowId = LeafletObjectID "WINDOW"
, initPosition = {x = 100, y = 100}
, title = "Test Window"
, content = H1Tag [] [Text "This is test content!"]
, relatedMarkers = [(LeafletObjectID "home", [])]
}
Start world = doTasks playWithMaps world Start world = doTasks playWithMaps world
...@@ -4,23 +4,29 @@ module Ligretto ...@@ -4,23 +4,29 @@ module Ligretto
When creating a project, include the following paths: When creating a project, include the following paths:
(i) {Application}\Examples\iTasks\Games\ (i) {Application}\Examples\iTasks\Games\
(ii) {Application}\Examples\iTasks\Graphics\ (ii) {Application}\Examples\iTasks\Graphics\
To run the example playing as two persons, do the following:
(a) first log in as root / root
(b) select the 'Manage users' task
(c) import a user community
(d) logout
(e) login as the key player who is going to invite 1, 2, or 3 players
(f) select the 'Ligretto' task
(g) select 1, 2, or 3 users to play Ligretto with
(h) open the newly created task
(i) in other browser( tab)s, login as the invited player(s) and open the task received from the key player
(j) have fun
*/ */
import Ligretto.Tasks import Ligretto.Tasks
import MultiUser.Tasks import iTasks.Extensions.Admin.WorkflowAdmin, Text.HTML
Start :: *World -> *World Start :: *World -> *World
Start world Start world = doTasks
= startMultiUserTasks [ workflow "Ligretto" "Play Ligretto" play_Ligretto ] [] world {WorkflowCollection
|name = "Ligretto"
,workflows = [ workflow "Host Ligretto" "Host a Ligretto game" play_Ligretto ]
,loginMessage = Just loginMessage
,welcomeMessage = Nothing
,allowGuests = False
} world
where
loginMessage = DivTag []
[Text "This example implements a simplified version of the card game Ligretto.", BrTag []
,Text "To play the game do the following:"
,OlTag []
[LiTag [] [Text "Log in as a demo user for example 'alice' (password alice), 'bob' (password bob) or 'carol' (password carol)"]
,LiTag [] [Text "Choose New -> 'Host Ligretto' -> 'Create task'"]
,LiTag [] [Text "Open the task in the task list and invite other players"]
,LiTag [] [Text "The others can also log in and will find the game waiting for them in their task list."]
,LiTag [] [Text "Have fun"]
]
]
definition module MultiUser.Tasks
import iTasks.Extensions.Admin.UserAdmin
startMultiUserTasks :: [Workflow] [StartableTask] *World -> *World
implementation module MultiUser.Tasks
import iTasks
import iTasks.Extensions.Admin.UserAdmin
startMultiUserTasks :: [Workflow] [StartableTask] *World -> *World
startMultiUserTasks workflows tasks world
= startTask [ workflow "Manage users" "Manage system users..." manageUsers
: workflows
] tasks world
startTask taskList tasks world
= doTasks [ onStartup (installWorkflows taskList)
, onRequest "/" browseExamples
: tasks
] world
where
browseExamples = forever (
enterInformation "Enter your credentials and login or press continue to remain anonymous" []
>>* [OnAction (Action "Login") (hasValue browseAuthenticated)
] )
browseAuthenticated {Credentials|username,password}
= authenticateUser username password
>>= \mbUser -> case mbUser of
Just user = workAs user manageWorkOfCurrentUser
Nothing = viewInformation (Title "Login failed") [] "Your username or password is incorrect" >>| return ()
module Trax module Trax
/** This example implements the two-person tile game Trax. /** This example implements the two-person tile game Trax.
When creating a project, include the following paths: When creating a project, include the following paths:
{Application}\Examples\iTasks\Games\ {Application}\Examples\iTasks\Games\
To run the example playing as two persons, do the following:
(a) first log in as root / root
(b) select the 'Manage users' task
(c) import a user community
(d) logout
(e) login as the key player who is going to invite another player
(f) select the 'Trax' task
(g) select a user to play Trax with
(h) open the newly created task
(i) in another browser( tab), login as the invited player and open the task received from the key player
(j) have fun
*/ */
import Trax.UoD import Trax.UoD
import Trax.Tasks import Trax.Tasks
import MultiUser.Tasks import iTasks.Extensions.Admin.WorkflowAdmin, Text.HTML
import iTasks.Engine
Start :: *World -> *World Start :: *World -> *World
Start world Start world = doTasks
= startMultiUserTasks [ workflow "Trax" "Play Trax" play_trax ] [] world {WorkflowCollection
|name = "Trax"
,workflows = [ workflow "Host Trax" "Host a Trax game" play_trax ]
,loginMessage = Just loginMessage
,welcomeMessage = Nothing
,allowGuests = False
} world
where
loginMessage = DivTag []
[Text "This example implements the two-person tile game Trax.", BrTag []
,Text "To play the game do the following:"
,OlTag []
[LiTag [] [Text "Log in as a demo user for example 'alice' (password alice), 'bob' (password bob) or 'carol' (password carol)"]
,LiTag [] [Text "Choose New -> 'Host Trax' -> 'Create task'"]
,LiTag [] [Text "Open the task in the task list and invite another player"]
,LiTag [] [Text "The invited player can also log in and will find the game waiting for her in the task list."]
,LiTag [] [Text "Have fun"]
]
]
...@@ -24,8 +24,8 @@ Global ...@@ -24,8 +24,8 @@ Global
Profile Profile
Memory: False Memory: False
MemoryMinimumHeapSize: 0 MemoryMinimumHeapSize: 0
Time: True Time: False
Stack: True Stack: False
Dynamics: True Dynamics: True
GenericFusion: False GenericFusion: False
DescExL: True DescExL: True
......
<!DOCTYPE html>
<html style="width: 100%; height: 100%;">
<head>
<meta charset="UTF-8">
<title></title>
<link rel="stylesheet" href="/css/itasks.css" type="text/css" >
<link rel="stylesheet" href="/css/WorkflowAdmin.css" type="text/css" >
<!-- ABC interpreter -->
<script type="text/javascript" src="/js/abc-instructions.js"></script>
<script type="text/javascript" src="/js/abc-interpreter.js"></script>
<!-- iTasks framework -->
<script type="text/javascript" src="/js/itasks-core.js"></script>
<script type="text/javascript" src="/js/itasks-components-raw.js"></script>
<script type="text/javascript" src="/js/itasks-components-form.js"></script>
<script type="text/javascript" src="/js/itasks-components-display.js"></script>
<script type="text/javascript" src="/js/itasks-components-selection.js"></script>