Commit e72c0164 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into simplified-interaction-api

parents 81e85876 032b64dc
Version: 1.5
Global
ProjectRoot: .
Target: iTasks
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 167772160
StackSize: 1048576
ExtraMemory: 81920
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
ShowExecutionTime: False
ShowGC: False
ShowStackSize: False
MarkingCollector: False
DisableRTSFlags: False
StandardRuntimeEnv: True
Profile
Memory: False
MemoryMinimumHeapSize: 0
Time: False
Stack: False
Dynamics: True
GenericFusion: False
DescExL: True
Output
Output: ShowConstructors
Font: Courier
FontSize: 9
WriteStdErr: False
Link
LinkMethod: Static
GenerateRelocations: False
GenerateSymbolTable: False
GenerateLinkMap: False
LinkResources: False
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Precompile:
Postlink:
# Building an iTask project #
iTask programs are just regular Clean programs that happen to use the iTask framework. Compiling an iTask program does require some specific project configuration settings though. Luckily you can easily get started by using a project template.
In this guide we'll walk you through the steps to build your first iTask project. We assume you have already installed Clean and the iTask framework.
## Building on Windows ##
On windows, you can use the Clean IDE to build your iTask programs.
### Step 1: Creating a main module ###
Open the Clean IDE and use `File -> New File` from the main menu to create a new file called `myprogram.icl`.
Write the following code in the new file (the yellow window).
```Clean
module myprogram
import iTasks
Start world = doTasks (viewInformation (Title "Hello") [] "Hello, world") world
```
Save the file using `File -> Save myprogram.icl` from the main menu.
### Step 2: Creating a project file ###
You now need to create a project file. A project file contains all search paths and compilation settings for building a Clean program.
The iTask framework provides a template with default settings for an iTask project. You can create your own project file using this template by choosing `File -> New Project Using Template...` from the main menu.
You are then asked to select a project template (.prt) file. You can find the `iTasks.prt` template file in the `Config` subdirectory of your Clean system.
After selecting the template file you are asked to choose a name for the project file. By default it will be `myprogram.prj` (for the module `myprogram.icl`) which you don't have to change.
### Step 3: Building and running your project ###
You can build and run your program by choosing `Project -> Update and Run` from the main menu. After compilation is completed you should see a console window displaying an URL that you can open in your web browser.
## Building on Linux or Mac ##
On Linux and macOS you can use a command line tool called `cpm` to create and build Clean projects.
### Step 1: Creating a main module ###
First create a Clean source module with a minimal program. Write the following code to a file called `myprogram.icl`.
```Clean
module myprogram
import iTasks
Start world = doTasks (viewInformation (Title "Hello") [] "Hello, world") world
```
### Step 2: Creating a project file ###
Using the `cpm` tool we can create a new project file. A project file contains all search paths and compilation settings for building a Clean program.
The iTask framework provides a template with default settings for an iTask project. You can create your own project file using this template with the following command:
```
cpm project myprogram create $CLEAN_HOME/etc/iTasks.prt
```
This will create a file called `myprogram.prj` which is the project file for your program.
### Step3: Building your project ###
To build your program, you can again use `cpm`:
```
cpm myprogram.prj
```
This will create a number of output files in your current directory. The most important one is `myprogram`, the executable program. There will also be additional resources that are needed at runtime: A bytecode version of your program: `myprogram.bc`, a version of that bytecode for the browser: `myprogram.pbc` and a directory with all the public web assets your program needs: `myprogram-www`.
### Step 4: Running your program ###
Simply run the `myprogram` executable and use a web browser to open the URL that is displayed.
```
./myprogram
```
...@@ -94,7 +94,7 @@ where ...@@ -94,7 +94,7 @@ where
eqBounds _ _ = False eqBounds _ _ = False
gDefault{|ContactMapPerspective|} gDefault{|ContactMapPerspective|}
= {ContactMapPerspective|center = (52.948300, 4.776007), zoom = 7, cursor = Nothing, bounds = Nothing} //(Full coast centered on Den Helder) = {ContactMapPerspective|center = (52.948300, 4.776007), zoom = 7, bounds = Nothing, cursor = Nothing} //(Full coast centered on Den Helder)
contactToMapMarker :: Bool Bool Contact -> ContactMapMarker contactToMapMarker :: Bool Bool Contact -> ContactMapMarker
...@@ -142,8 +142,8 @@ where ...@@ -142,8 +142,8 @@ where
tilesUrls layers = [url \\ {ContactMapLayer|def=CMTileLayer url} <- layers] tilesUrls layers = [url \\ {ContactMapLayer|def=CMTileLayer url} <- layers]
convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers | hasLatLng position] convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers | hasLatLng position]
conv {ContactMapMarker|markerId,title,position,heading,type,selected} conv {ContactMapMarker|markerId,title,position,heading,type}
= Marker {LeafletMarker|markerId = markerId, title = title, position = pos position, icon = Nothing /* fmap (\t -> iconIndex heading t selected) type */, selected = selected, popup = Nothing} = Marker {LeafletMarker|markerId = markerId, title = title, position = pos position, icon = Nothing /* fmap (\t -> iconIndex heading t selected) type */, popup = Nothing}
pos (PositionLatLng (lat,lng)) = {LeafletLatLng|lat=lat,lng=lng} pos (PositionLatLng (lat,lng)) = {LeafletLatLng|lat=lat,lng=lng}
pos (PositionDescription _ (Just(lat,lng))) = {LeafletLatLng|lat=lat,lng=lng} pos (PositionDescription _ (Just(lat,lng))) = {LeafletLatLng|lat=lat,lng=lng}
...@@ -183,7 +183,7 @@ where ...@@ -183,7 +183,7 @@ where
toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
toLeafletPerspective {ContactMapPerspective|center,zoom,cursor,bounds} toLeafletPerspective {ContactMapPerspective|center,zoom,cursor,bounds}
= {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,cursor=fmap toLeafletLatLng cursor,bounds=fmap toLeafletBounds bounds} = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,bounds=fmap toLeafletBounds bounds}
toLeafletLatLng :: !(!Real,!Real) -> LeafletLatLng toLeafletLatLng :: !(!Real,!Real) -> LeafletLatLng
toLeafletLatLng (lat,lng) = {LeafletLatLng|lat=lat,lng=lng} toLeafletLatLng (lat,lng) = {LeafletLatLng|lat=lat,lng=lng}
...@@ -199,8 +199,8 @@ fromLeafletMap contactMap leafletMap ...@@ -199,8 +199,8 @@ fromLeafletMap contactMap leafletMap
} }
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
fromLeafletPerspective {LeafletPerspective|center,cursor,zoom,bounds} fromLeafletPerspective {LeafletPerspective|center,zoom,bounds}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor,bounds=fmap fromLeafletBounds bounds} = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing,bounds=fmap fromLeafletBounds bounds}
/* /*
fromLeafletLayer :: ContactMapLayer LeafletLayer -> ContactMapLayer fromLeafletLayer :: ContactMapLayer LeafletLayer -> ContactMapLayer
...@@ -216,8 +216,8 @@ fromLeafletLayer cl ll = cl ...@@ -216,8 +216,8 @@ fromLeafletLayer cl ll = cl
*/ */
selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID] selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
selectionFromLeafletMap {LeafletMap|objects} = selectionFromLeafletMap {LeafletMap|objects} = []
[markerId \\ Marker {LeafletMarker|markerId,selected} <- objects | selected] //[markerId \\ Marker {LeafletMarker|markerId} <- objects | selected]
fromLeafletLatLng :: !LeafletLatLng -> (!Real,!Real) fromLeafletLatLng :: !LeafletLatLng -> (!Real,!Real)
fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng) fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
......
...@@ -9,8 +9,8 @@ ...@@ -9,8 +9,8 @@
<link rel="stylesheet" href="/Incidone.css" type="text/css" > <link rel="stylesheet" href="/Incidone.css" type="text/css" >
<!-- ABC interpreter --> <!-- ABC interpreter -->
<script type="text/javascript" src="/js/abc-instructions.js"></script>
<script type="text/javascript" src="/js/abc-interpreter.js"></script> <script type="text/javascript" src="/js/abc-interpreter.js"></script>
<script type="text/javascript" src="/js/itasks-abc-interpreter.js"></script>
<!-- iTasks framework --> <!-- iTasks framework -->
<script type="text/javascript" src="/js/itasks-core.js"></script> <script type="text/javascript" src="/js/itasks-core.js"></script>
......
implementation module C2.Apps.ShipAdventure.Core implementation module C2.Apps.ShipAdventure.Core
import iTasks.Extensions.DateTime import iTasks.Extensions.DateTime
import iTasks.Extensions.SVG.SVGEditor from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
//import Graphics.Scalable
import qualified Data.List as DL import qualified Data.List as DL
import qualified Data.Map as DM import qualified Data.Map as DM
import Data.Map.GenJSON import Data.Map.GenJSON
......
implementation module C2.Apps.ShipAdventure.Editor implementation module C2.Apps.ShipAdventure.Editor
import iTasks from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
import iTasks.Extensions.SVG.SVGEditor
import iTasks.Extensions.JSONFile import iTasks.Extensions.JSONFile
import iTasks.Internal.IWorld import iTasks.Internal.IWorld
import iTasks.UI.Layout, iTasks.UI.Definition import iTasks.UI.Layout, iTasks.UI.Definition
...@@ -17,10 +16,8 @@ import Data.Map.GenJSON ...@@ -17,10 +16,8 @@ import Data.Map.GenJSON
import qualified Data.IntMap.Strict as DIS import qualified Data.IntMap.Strict as DIS
import qualified Data.Set as DS import qualified Data.Set as DS
import Graphics.Scalable.Image => qualified grid from Graphics.Scalable.Image import class margin(..), instance margin (!Span,!Span), above, :: Host(..)
import Graphics.Scalable.Types import Graphics.Scalable.Types
//from Graphics.Scalable import normalFontDef, above, class margin(..), instance margin (Span,Span), px
//from Graphics.Scalable import :: ImageOffset, :: Host(..)
shipEditorTabs :: Task () shipEditorTabs :: Task ()
shipEditorTabs = allTasks [ viewLayout <<@ Title "View Ship" shipEditorTabs = allTasks [ viewLayout <<@ Title "View Ship"
......
...@@ -166,7 +166,7 @@ sectionImage disabledSections hilite mngmnt zoomed exitLocks hopLocks inventoryM ...@@ -166,7 +166,7 @@ sectionImage disabledSections hilite mngmnt zoomed exitLocks hopLocks inventoryM
= { fill = toSVGColor (if isLocked "black" "white") } = { fill = toSVGColor (if isLocked "black" "white") }
doorClick :: !Bool !Coord3D !Dir !(Image (a, MapAction SectionStatus)) -> Image (a, MapAction SectionStatus) doorClick :: !Bool !Coord3D !Dir !(Image (a, MapAction SectionStatus)) -> Image (a, MapAction SectionStatus)
doorClick False c3d dir img = img doorClick False c3d dir img = img
doorClick _ c3d dir img = img <@< { onclick = \_ (x, _) -> (x, ToggleDoor c3d dir), local = False} doorClick _ c3d dir img = img <@< { onclick = \(x, _) -> (x, ToggleDoor c3d dir), local = False}
sectionImage` :: !(Bool Coord3D [Object ObjectType] [Device] Real (Image a) [Image a] (Image b) (Image (Maps2D, MapAction SectionStatus)) sectionImage` :: !(Bool Coord3D [Object ObjectType] [Device] Real (Image a) [Image a] (Image b) (Image (Maps2D, MapAction SectionStatus))
(Image d) (Image e) (Image f) (Image g) -> Image (Maps2D, MapAction SectionStatus)) (Image d) (Image e) (Image f) (Image g) -> Image (Maps2D, MapAction SectionStatus))
...@@ -359,10 +359,10 @@ editSectionImage hilite mngmnt zoomed allDevices network inventoryMap doorDims s ...@@ -359,10 +359,10 @@ editSectionImage hilite mngmnt zoomed allDevices network inventoryMap doorDims s
#! vwally = rect (px 5.0) (px height) <@< { fill = toSVGColor "white" } #! vwally = rect (px 5.0) (px height) <@< { fill = toSVGColor "white" }
<@< { opacity = 0.1 } <@< { opacity = 0.1 }
<@< { stroke = toSVGColor "none" } <@< { stroke = toSVGColor "none" }
#! wallyN = hwally <@< {onclick = \_ -> rotateWall floorIdx c N, local = False} #! wallyN = hwally <@< {onclick = rotateWall floorIdx c N, local = False}
#! wallyE = vwally <@< {onclick = \_ -> rotateWall floorIdx c E, local = False} #! wallyE = vwally <@< {onclick = rotateWall floorIdx c E, local = False}
#! wallyW = vwally <@< {onclick = \_ -> rotateWall floorIdx c W, local = False} #! wallyW = vwally <@< {onclick = rotateWall floorIdx c W, local = False}
#! wallyS = hwally <@< {onclick = \_ -> rotateWall floorIdx c S, local = False} #! wallyS = hwally <@< {onclick = rotateWall floorIdx c S, local = False}
= 'GS'.overlay [ ('GS'.AtMiddleX, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtMiddleY), ('GS'.AtMiddleX, 'GS'.AtTop), ('GS'.AtLeft, 'GS'.AtMiddleY) = 'GS'.overlay [ ('GS'.AtMiddleX, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtMiddleY), ('GS'.AtMiddleX, 'GS'.AtTop), ('GS'.AtLeft, 'GS'.AtMiddleY)
, ('GS'.AtLeft, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom) , ('GS'.AtLeft, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom)
] ]
...@@ -406,5 +406,5 @@ rotateWall m c d (maps, edit) ...@@ -406,5 +406,5 @@ rotateWall m c d (maps, edit)
rotate Wall = Door rotate Wall = Door
rotate Door = Open rotate Door = Open
onClick :: !(MapAction SectionStatus) Int !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus) onClick :: !(MapAction SectionStatus) !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus)
onClick clck _ (m, _) = (m, clck) onClick clck (m, _) = (m, clck)
...@@ -4,8 +4,7 @@ implementation module C2.Apps.ShipAdventure.Types ...@@ -4,8 +4,7 @@ implementation module C2.Apps.ShipAdventure.Types
import iTasks.Internal.Tonic import iTasks.Internal.Tonic
import iTasks.Extensions.Admin.TonicAdmin import iTasks.Extensions.Admin.TonicAdmin
import iTasks.Extensions.SVG.SVGEditor from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
//import Graphics.Scalable
import qualified Data.List as DL import qualified Data.List as DL
from Data.Func import mapSt from Data.Func import mapSt
import StdArray import StdArray
...@@ -17,7 +16,7 @@ import qualified Data.Set as DS ...@@ -17,7 +16,7 @@ import qualified Data.Set as DS
import Text.HTML import Text.HTML
import C2.Framework.MapEnvironment import C2.Framework.MapEnvironment
from C2.Framework.Logging import addLog from C2.Framework.Logging import addLog
import C2.Apps.ShipAdventure.PathFinding import C2.Apps.ShipAdventure.PathFinding
import C2.Apps.ShipAdventure.Images import C2.Apps.ShipAdventure.Images
import C2.Apps.ShipAdventure.Editor import C2.Apps.ShipAdventure.Editor
......
...@@ -96,9 +96,9 @@ mapView` currentUser es = (updateSharedInformation [UpdateSharedAs toMap fromMap ...@@ -96,9 +96,9 @@ mapView` currentUser es = (updateSharedInformation [UpdateSharedAs toMap fromMap
# mid = toInt contactMarker.ContactMapMarker.markerId # mid = toInt contactMarker.ContactMapMarker.markerId
= case 'DIS'.get mid markers of = case 'DIS'.get mid markers of
Just m Just m
# st = if contactMarker.ContactMapMarker.selected //# st = if contactMarker.ContactMapMarker.selected
{st & selection = mid} // {st & selection = mid}
st // st
//= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) // TODO FIXME //= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) // TODO FIXME
= (markers, st) = (markers, st)
_ = (markers, st) _ = (markers, st)
...@@ -120,9 +120,9 @@ mapView sh radarWorks currentUser es = (updateSharedInformation [UpdateSharedAs ...@@ -120,9 +120,9 @@ mapView sh radarWorks currentUser es = (updateSharedInformation [UpdateSharedAs
# mid = toInt contactMarker.ContactMapMarker.markerId # mid = toInt contactMarker.ContactMapMarker.markerId
= case 'DIS'.get mid markers of = case 'DIS'.get mid markers of
Just m Just m
# st = if contactMarker.ContactMapMarker.selected //# st = if contactMarker.ContactMapMarker.selected
{st & selection = mid} // {st & selection = mid}
st // st
//= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) TODO FIXME //= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) TODO FIXME
= (markers, st) = (markers, st)
_ = (markers, st) _ = (markers, st)
......
...@@ -116,15 +116,15 @@ toLeafletMap {ContactMap|perspective,markers} ...@@ -116,15 +116,15 @@ toLeafletMap {ContactMap|perspective,markers}
} }
where where
convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers] convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers]
conv {ContactMapMarker|markerId,title,position,heading,type,selected} conv {ContactMapMarker|markerId,title,position,heading,type}
= Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t selected)) type, selected = selected, popup = Nothing} = Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t False)) type,popup = Nothing}
icon i = {LeafletIcon|iconId=LeafletIconID (toString i),iconUrl ="/ship-icons/"+++toString i+++".png",iconSize=(24,24)} icon i = {LeafletIcon|iconId=LeafletIconID (toString i),iconUrl ="/ship-icons/"+++toString i+++".png",iconSize=(24,24)}
iconIndex heading type selected = toString (cat type + ( (maybe 24 (\d -> toInt d / 15) heading) + (if selected 25 0)) * 5) iconIndex heading type selected = toString (cat type + ( (maybe 24 (\d -> toInt d / 15) heading) + (if selected 25 0)) * 5)
toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
toLeafletPerspective {ContactMapPerspective|center,zoom,cursor} toLeafletPerspective {ContactMapPerspective|center,zoom,cursor}
= {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,cursor=fmap toLeafletLatLng cursor,bounds=Nothing} = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,bounds=Nothing}
toLeafletLatLng :: !LatLng -> LeafletLatLng toLeafletLatLng :: !LatLng -> LeafletLatLng
toLeafletLatLng (lat,lng) = {LeafletLatLng | lat = toDeg lat, lng = toDeg lng} toLeafletLatLng (lat,lng) = {LeafletLatLng | lat = toDeg lat, lng = toDeg lng}
...@@ -138,11 +138,11 @@ fromLeafletMap {LeafletMap|perspective,objects} ...@@ -138,11 +138,11 @@ fromLeafletMap {LeafletMap|perspective,objects}
,markers=toMarkers objects} ,markers=toMarkers objects}
where where
toMarkers objects toMarkers objects
= [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=selected} = [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=False}
\\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position,selected} <- objects] \\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position} <- objects]
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
fromLeafletPerspective {LeafletPerspective|center,cursor,zoom} fromLeafletPerspective {LeafletPerspective|center,zoom}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor} = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing}
...@@ -122,10 +122,7 @@ convertExampleData ...@@ -122,10 +122,7 @@ convertExampleData
>>| readLinesFromFile (examplefilepath curDir "officers.txt") >>| readLinesFromFile (examplefilepath curDir "officers.txt")
>>- \officers -> importDemoUsersFlow >>- \officers -> importDemoUsersFlow
>>- \demoAccounts -> allTasks >>- \demoAccounts -> allTasks
(createUser <$> [{UserAccount | credentials = { username = Username "root", password = Password "root"} (createUser <$>
, title = Just "root", roles = ["admin","programmer","god"]
}] ++
[{UserAccount | demo & roles = ["admin"]} \\ demo <- demoAccounts] ++
[{UserAccount | credentials = { username = Username officer, password = Password officer} [{UserAccount | credentials = { username = Username officer, password = Password officer}
, title = Just officer, roles = ["officer"] , title = Just officer, roles = ["officer"]
} }
......
...@@ -26,10 +26,7 @@ If you wish to customize it for your demo, then you should check the files in di ...@@ -26,10 +26,7 @@ If you wish to customize it for your demo, then you should check the files in di
<coc number>\t<company name>\n <coc number>\t<company name>\n
When running a demo, login as 'root', and perform the administration tasks: When running a demo, login as 'root', and perform the "SDS setup" administration tasks.
(1) "SDS setup": This will read the above files and create the appropriate SDS's for the demo.
this will read the above files and create the appropriate SDS's for the demo
(2) "Login Administration":
this will use the above accounts to set-up a population of users
You can then log out, and re-login as a citizen, company, or tax officer. You can then log out, and re-login as a citizen, company, or tax officer.
...@@ -3,29 +3,39 @@ import iTasks ...@@ -3,29 +3,39 @@ 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, Text.HTML import StdFunctions, Data.List, Text.HTML
playWithMaps :: Task () playWithMaps :: Task ()
playWithMaps = withShared {defaultValue & icons = shipIcons} (\m -> playWithMaps = withShared ({defaultValue & icons = shipIcons, tilesUrls = ["/tiles/{z}/{x}/{y}.png"]},defaultValue) (\m ->
(allTasks [managePerspective m, manageMapObjects m]) ((allTasks [managePerspective m, manageState m, manageMapObjects m]) <<@ ScrollContent)
-&&- -&&-
manipulateMap m manipulateMap m
) <<@ ArrangeWithSideBar 0 LeftSide True @! () ) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
manipulateMap :: (Shared sds LeafletMap) -> Task () | RWShared sds manipulateMap :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation () [] m manipulateMap m = updateSharedInformation () [UpdateUsing id (flip const) (customLeafletEditor eventHandlers)] m
<<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! () <<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! ()
where
eventHandlers = {simpleStateEventHandlers & onHtmlEvent = onHtmlEvent}
onHtmlEvent "closewindows" (l,s) = ({LeafletMap|l & objects = [o \\ o <- l.LeafletMap.objects | not (o =: (Window _))]},s)
onHtmlEvent _ (l,s) = (l,s)
managePerspective :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
managePerspective m = updateSharedInformation (Title "Perspective") []
(mapReadWrite (\(x,s) -> x.LeafletMap.perspective, \p (x,s) -> Just ({x & perspective = p},s)) Nothing m) @! ()
managePerspective :: (Shared sds LeafletMap) -> Task () | RWShared sds manageState :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
managePerspective m = updateSharedInformation (Title "Perspective") [] (mapReadWrite (\x -> x.LeafletMap.perspective,\p x -> Just {x & perspective = p}) Nothing m) @! () manageState m = updateSharedInformation (Title "State") []
(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 // objects can currently only be viewed, as the editor for `HtmlTag` only works in view mode
manageMapObjects :: (Shared sds LeafletMap) -> Task () | RWShared sds manageMapObjects :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manageMapObjects m = viewSharedInformation (Title "View objects") [ViewAs toPrj] m manageMapObjects m = viewSharedInformation (Title "View objects") [ViewAs toPrj] m
-|| addDemoObjects m -|| addDemoObjects m
@! () @! ()
where where
toPrj m = m.LeafletMap.objects toPrj (m,_) = m.LeafletMap.objects
addDemoObjects m addDemoObjects m
= enterChoiceAs "Add objects:" [ChooseFromCheckGroup fst] options snd = enterChoiceAs "Add objects:" [ChooseFromCheckGroup fst] options snd
...@@ -43,10 +53,10 @@ where ...@@ -43,10 +53,10 @@ where
addRandomMarker m addRandomMarker m
= get randomInt -&&- get randomInt @ toRandomMarker = get randomInt -&&- get randomInt @ toRandomMarker
>>- \marker -> upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [marker]}) m >>- \marker -> upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [marker]},s)) m
toRandomMarker (rLat,rLng) toRandomMarker (rLat,rLng)
= Marker {markerId = LeafletObjectID markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, selected = False, popup = Nothing} = Marker {markerId = LeafletObjectID markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, popup = Nothing}
where where
lat = 52.0 + (toReal (500 + (rLat rem 1000)) / 1000.0) lat = 52.0 + (toReal (500 + (rLat rem 1000)) / 1000.0)
lng = 6.0 + (toReal (500 + (rLng rem 1000)) / 1000.0) lng = 6.0 + (toReal (500 + (rLng rem 1000)) / 1000.0)
...@@ -54,7 +64,7 @@ where ...@@ -54,7 +64,7 @@ where
icon = shipIconId (Just (rLat rem 360)) OrangeShip False icon = shipIconId (Just (rLat rem 360)) OrangeShip False
addMarkerConnectingLine m addMarkerConnectingLine m
= upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [line objects]}) m = upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [line objects]},s)) m
where where
line objects = Polyline { polylineId = LeafletObjectID "markerConnection" line objects = Polyline { polylineId = LeafletObjectID "markerConnection"
, style = [Style (LineStrokeColor "#f0f"), Style (LineStrokeWidth 4)] , style = [Style (LineStrokeColor "#f0f"), Style (LineStrokeWidth 4)]
...@@ -64,7 +74,7 @@ where ...@@ -64,7 +74,7 @@ where
points objects = [position \\ Marker {LeafletMarker|position} <- objects] points objects = [position \\ Marker {LeafletMarker|position} <- objects]
addMarkerConnectingPolygon m addMarkerConnectingPolygon m
= upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [polygon objects]}) m = upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [polygon objects]},s)) m
where where
polygon objects = Polygon { polygonId = LeafletObjectID "markerConnection" polygon objects = Polygon { polygonId = LeafletObjectID "markerConnection"
, style = [ Style (AreaLineStrokeColor "#000") , style = [ Style (AreaLineStrokeColor "#000")
...@@ -77,31 +87,34 @@ where ...@@ -77,31 +87,34 @@ where
points objects = [position \\ Marker {LeafletMarker|position} <- objects] points objects = [position \\ Marker {LeafletMarker|position} <- objects]
addMarkerAtCursor m addMarkerAtCursor m
= upd (\l=:{LeafletMap|perspective={LeafletPerspective|cursor},objects} -> {LeafletMap|l & objects = withMarkerFromCursor cursor objects}) m = upd (\(l=:{LeafletMap|objects},s=:{LeafletSimpleState|cursor}) -> ({LeafletMap|l & objects = withMarkerFromCursor cursor objects},s)) m
where where
withMarkerFromCursor Nothing objects = objects withMarkerFromCursor Nothing objects = objects
withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, selected = False, popup = Nothing}]