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
eqBounds _ _ = False
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
......@@ -142,8 +142,8 @@ where
tilesUrls layers = [url \\ {ContactMapLayer|def=CMTileLayer url} <- layers]
convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers | hasLatLng position]
conv {ContactMapMarker|markerId,title,position,heading,type,selected}
= Marker {LeafletMarker|markerId = markerId, title = title, position = pos position, icon = Nothing /* fmap (\t -> iconIndex heading t selected) type */, selected = selected, popup = Nothing}
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 */, popup = Nothing}
pos (PositionLatLng (lat,lng)) = {LeafletLatLng|lat=lat,lng=lng}
pos (PositionDescription _ (Just(lat,lng))) = {LeafletLatLng|lat=lat,lng=lng}
......@@ -183,7 +183,7 @@ where
toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
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 (lat,lng) = {LeafletLatLng|lat=lat,lng=lng}
......@@ -199,8 +199,8 @@ fromLeafletMap contactMap leafletMap
}
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
fromLeafletPerspective {LeafletPerspective|center,cursor,zoom,bounds}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor,bounds=fmap fromLeafletBounds bounds}
fromLeafletPerspective {LeafletPerspective|center,zoom,bounds}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing,bounds=fmap fromLeafletBounds bounds}
/*
fromLeafletLayer :: ContactMapLayer LeafletLayer -> ContactMapLayer
......@@ -216,8 +216,8 @@ fromLeafletLayer cl ll = cl
*/
selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
selectionFromLeafletMap {LeafletMap|objects} =
[markerId \\ Marker {LeafletMarker|markerId,selected} <- objects | selected]
selectionFromLeafletMap {LeafletMap|objects} = []
//[markerId \\ Marker {LeafletMarker|markerId} <- objects | selected]
fromLeafletLatLng :: !LeafletLatLng -> (!Real,!Real)
fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
......
......@@ -9,8 +9,8 @@
<link rel="stylesheet" href="/Incidone.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>
<script type="text/javascript" src="/js/itasks-abc-interpreter.js"></script>
<!-- iTasks framework -->
<script type="text/javascript" src="/js/itasks-core.js"></script>
......
implementation module C2.Apps.ShipAdventure.Core
import iTasks.Extensions.DateTime
import iTasks.Extensions.SVG.SVGEditor
//import Graphics.Scalable
from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
import qualified Data.List as DL
import qualified Data.Map as DM
import Data.Map.GenJSON
......
implementation module C2.Apps.ShipAdventure.Editor
import iTasks
import iTasks.Extensions.SVG.SVGEditor
from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
import iTasks.Extensions.JSONFile
import iTasks.Internal.IWorld
import iTasks.UI.Layout, iTasks.UI.Definition
......@@ -17,10 +16,8 @@ import Data.Map.GenJSON
import qualified Data.IntMap.Strict as DIS
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
//from Graphics.Scalable import normalFontDef, above, class margin(..), instance margin (Span,Span), px
//from Graphics.Scalable import :: ImageOffset, :: Host(..)
shipEditorTabs :: Task ()
shipEditorTabs = allTasks [ viewLayout <<@ Title "View Ship"
......
......@@ -166,7 +166,7 @@ sectionImage disabledSections hilite mngmnt zoomed exitLocks hopLocks inventoryM
= { fill = toSVGColor (if isLocked "black" "white") }
doorClick :: !Bool !Coord3D !Dir !(Image (a, MapAction SectionStatus)) -> Image (a, MapAction SectionStatus)
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))
(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
#! vwally = rect (px 5.0) (px height) <@< { fill = toSVGColor "white" }
<@< { opacity = 0.1 }
<@< { stroke = toSVGColor "none" }
#! wallyN = hwally <@< {onclick = \_ -> rotateWall floorIdx c N, local = False}
#! wallyE = vwally <@< {onclick = \_ -> rotateWall floorIdx c E, local = False}
#! wallyW = vwally <@< {onclick = \_ -> rotateWall floorIdx c W, local = False}
#! wallyS = hwally <@< {onclick = \_ -> rotateWall floorIdx c S, local = False}
#! wallyN = hwally <@< {onclick = rotateWall floorIdx c N, local = False}
#! wallyE = vwally <@< {onclick = rotateWall floorIdx c E, local = False}
#! wallyW = vwally <@< {onclick = rotateWall floorIdx c W, 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'.AtLeft, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom), ('GS'.AtRight, 'GS'.AtBottom)
]
......@@ -406,5 +406,5 @@ rotateWall m c d (maps, edit)
rotate Wall = Door
rotate Door = Open
onClick :: !(MapAction SectionStatus) Int !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus)
onClick clck _ (m, _) = (m, clck)
onClick :: !(MapAction SectionStatus) !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus)
onClick clck (m, _) = (m, clck)
......@@ -4,8 +4,7 @@ implementation module C2.Apps.ShipAdventure.Types
import iTasks.Internal.Tonic
import iTasks.Extensions.Admin.TonicAdmin
import iTasks.Extensions.SVG.SVGEditor
//import Graphics.Scalable
from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
import qualified Data.List as DL
from Data.Func import mapSt
import StdArray
......@@ -17,7 +16,7 @@ import qualified Data.Set as DS
import Text.HTML
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.Images
import C2.Apps.ShipAdventure.Editor
......
......@@ -96,9 +96,9 @@ mapView` currentUser es = (updateSharedInformation [UpdateSharedAs toMap fromMap
# mid = toInt contactMarker.ContactMapMarker.markerId
= case 'DIS'.get mid markers of
Just m
# st = if contactMarker.ContactMapMarker.selected
{st & selection = mid}
st
//# st = if contactMarker.ContactMapMarker.selected
// {st & selection = mid}
// st
//= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) // TODO FIXME
= (markers, st)
_ = (markers, st)
......@@ -120,9 +120,9 @@ mapView sh radarWorks currentUser es = (updateSharedInformation [UpdateSharedAs
# mid = toInt contactMarker.ContactMapMarker.markerId
= case 'DIS'.get mid markers of
Just m
# st = if contactMarker.ContactMapMarker.selected
{st & selection = mid}
st
//# st = if contactMarker.ContactMapMarker.selected
// {st & selection = mid}
// st
//= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) TODO FIXME
= (markers, st)
_ = (markers, st)
......
......@@ -116,15 +116,15 @@ toLeafletMap {ContactMap|perspective,markers}
}
where
convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers]
conv {ContactMapMarker|markerId,title,position,heading,type,selected}
= Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t selected)) type, selected = selected, popup = Nothing}
conv {ContactMapMarker|markerId,title,position,heading,type}
= 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)}
iconIndex heading type selected = toString (cat type + ( (maybe 24 (\d -> toInt d / 15) heading) + (if selected 25 0)) * 5)
toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
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 (lat,lng) = {LeafletLatLng | lat = toDeg lat, lng = toDeg lng}
......@@ -138,11 +138,11 @@ fromLeafletMap {LeafletMap|perspective,objects}
,markers=toMarkers objects}
where
toMarkers objects
= [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=selected}
\\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position,selected} <- objects]
= [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=False}
\\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position} <- objects]
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
fromLeafletPerspective {LeafletPerspective|center,cursor,zoom}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor}
fromLeafletPerspective {LeafletPerspective|center,zoom}
= {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing}
......@@ -122,10 +122,7 @@ convertExampleData
>>| readLinesFromFile (examplefilepath curDir "officers.txt")
>>- \officers -> importDemoUsersFlow
>>- \demoAccounts -> allTasks
(createUser <$> [{UserAccount | credentials = { username = Username "root", password = Password "root"}
, title = Just "root", roles = ["admin","programmer","god"]
}] ++
[{UserAccount | demo & roles = ["admin"]} \\ demo <- demoAccounts] ++
(createUser <$>
[{UserAccount | credentials = { username = Username officer, password = Password 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
<coc number>\t<company name>\n
When running a demo, login as 'root', and perform the administration tasks:
(1) "SDS setup":
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
When running a demo, login as 'root', and perform the "SDS setup" administration tasks.
This will read the above files and create the appropriate SDS's for the demo.
You can then log out, and re-login as a citizen, company, or tax officer.
......@@ -3,29 +3,39 @@ import iTasks
import iTasks.Extensions.GIS.Leaflet
import iTasks.Extensions.GIS.LeafletNavalIcons
import iTasks.UI.Definition
import Data.List, Text.HTML
import StdFunctions, Data.List, Text.HTML
playWithMaps :: Task ()
playWithMaps = withShared {defaultValue & icons = shipIcons} (\m ->
(allTasks [managePerspective m, manageMapObjects m])
playWithMaps = withShared ({defaultValue & icons = shipIcons, tilesUrls = ["/tiles/{z}/{x}/{y}.png"]},defaultValue) (\m ->
((allTasks [managePerspective m, manageState m, manageMapObjects m]) <<@ ScrollContent)
-&&-
manipulateMap m
) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
manipulateMap :: (Shared sds LeafletMap) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation () [] m
manipulateMap :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation () [UpdateUsing id (flip const) (customLeafletEditor eventHandlers)] m
<<@ 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
managePerspective m = updateSharedInformation (Title "Perspective") [] (mapReadWrite (\x -> x.LeafletMap.perspective,\p x -> Just {x & perspective = p}) Nothing m) @! ()
manageState :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
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
manageMapObjects :: (Shared sds LeafletMap) -> Task () | RWShared sds
manageMapObjects :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manageMapObjects m = viewSharedInformation (Title "View objects") [ViewAs toPrj] m
-|| addDemoObjects m
@! ()
where
toPrj m = m.LeafletMap.objects
toPrj (m,_) = m.LeafletMap.objects
addDemoObjects m
= enterChoiceAs "Add objects:" [ChooseFromCheckGroup fst] options snd
......@@ -43,10 +53,10 @@ where
addRandomMarker m
= 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)
= 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
lat = 52.0 + (toReal (500 + (rLat rem 1000)) / 1000.0)
lng = 6.0 + (toReal (500 + (rLng rem 1000)) / 1000.0)
......@@ -54,7 +64,7 @@ where
icon = shipIconId (Just (rLat rem 360)) OrangeShip False
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
line objects = Polyline { polylineId = LeafletObjectID "markerConnection"
, style = [Style (LineStrokeColor "#f0f"), Style (LineStrokeWidth 4)]
......@@ -64,7 +74,7 @@ where
points objects = [position \\ Marker {LeafletMarker|position} <- objects]
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
polygon objects = Polygon { polygonId = LeafletObjectID "markerConnection"
, style = [ Style (AreaLineStrokeColor "#000")
......@@ -77,31 +87,34 @@ where
points objects = [position \\ Marker {LeafletMarker|position} <- objects]
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
withMarkerFromCursor Nothing objects = objects
withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, selected = False, popup = Nothing}]
withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, popup = Nothing}]
addCircleAtCursor m
= upd (\l=:{LeafletMap|perspective={LeafletPerspective|cursor},objects} -> {LeafletMap|l & objects = withCircleFromCursor cursor objects}) m
= upd (\(l=:{LeafletMap|objects},s=:{LeafletSimpleState|cursor}) -> ({LeafletMap|l & objects = withCircleFromCursor cursor objects},s)) m
where
withCircleFromCursor Nothing objects = objects
withCircleFromCursor (Just position) objects = objects ++ [Circle {circleId = LeafletObjectID "CIRCLE_CURSOR", center = position, radius = 100000.0, editable = True, style = []}]
addRectangleAroundCurrentPerspective m
= upd (\l=:{LeafletMap|perspective={LeafletPerspective|bounds},objects} -> {LeafletMap|l & objects = withRectangleAroundCurrentPerspective bounds objects}) m
= upd (\(l=:{LeafletMap|perspective={LeafletPerspective|bounds},objects},s) -> ({LeafletMap|l & objects = withRectangleAroundCurrentPerspective bounds objects},s)) m
where
withRectangleAroundCurrentPerspective Nothing objects = objects
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
= upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap| l & objects = [Window window:objects]},s)) m
where
window =
{ windowId = LeafletObjectID "WINDOW"
, initPosition = {x = 100, y = 100}
, title = "Test Window"
, content = H1Tag [] [Text "This is test content!"]
, content = DivTag []
[H1Tag [] [Text "This is test content!"]
,ATag [HrefAttr "#",OnclickAttr "itasks.htmlEvent(event, 'closewindows')"] [Text "Close windows"]
]
, relatedMarkers = [(LeafletObjectID "home", [])]
}
......
......@@ -17,10 +17,8 @@ play_Ligretto
invite_friends :: Task [User]
invite_friends
= enterMultipleChoiceWithShared "Select friends to play with" [] users
>>= \them -> if (not (isMember (length them) [1..3]))
(viewInformation "Oops" [] "number of friends must be 1, 2, or 3" >>| invite_friends)
(return them)
= enterMultipleChoiceWithShared "Select 1, 2, or 3 friends to play with" [] 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
play_game users game_st
......
......@@ -74,7 +74,7 @@ pile_image side pile
row_images :: !Bool !RowPlayer -> [Image GameSt]
row_images interactive row
= [ tuneIf interactive (card_image Front row_card)
{onclick = const (play_row_card row_card.back no), local = False}
{onclick = play_row_card row_card.back no, local = False}
\\ row_card <- row
& no <- [1..]
]
......@@ -83,8 +83,8 @@ hand_images :: !Bool !Hand !Color -> [Image GameSt]
hand_images interactive {conceal,discard} color
#! conceal_pile = pile_image Back conceal
#! discard_pile = pile_image Front discard
= [ tuneIf interactive conceal_pile {onclick = const (play_concealed_pile color), local = False}
, tuneIf interactive discard_pile {onclick = const (play_hand_card color), local = False}
= [ tuneIf interactive conceal_pile {onclick = play_concealed_pile color, local = False}
, tuneIf interactive discard_pile {onclick = play_hand_card color, local = False}
]
player_arc :== 0.45 * pi
......@@ -112,7 +112,7 @@ name_image {Player | name,color}
# width = card_height *. 1.8
# height = card_width *. 0.4
= overlay [(AtMiddleX,AtMiddleY)] []
[text {FontDef | cardfont 16.0 & fontweight = "bold"} name <@< { FillAttr | fill = if (color === Yellow) black white}]
[text (setfontweight "bold" (cardfont 16.0)) name <@< { FillAttr | fill = if (color === Yellow) black white}]
(Host (rect width height <@< { FillAttr | fill = toSVGColor color}))
<@< { MaskAttr | mask = rect width height <@< { FillAttr | fill = white} <@< { StrokeAttr | stroke = white}}
......
module SinglePlayerTrax
/** This example implements the two-person tile game Trax.
When creating a project, include the following paths:
{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 SinglePlayerTrax.Tasks
import iTasks.Engine
Start :: *World -> *World
Start world
= doTasks play_trax world
definition module SinglePlayerTrax.Tasks
import SinglePlayerTrax.UoD
play_trax :: Task Bool
implementation module SinglePlayerTrax.Tasks
import iTasks
import SinglePlayerTrax.UoD
import SinglePlayerTrax.UI
play_trax :: Task Bool
play_trax = play_game {trax=zero,turn=True,choice=Nothing}
play_game :: TraxSt -> Task Bool
play_game traxSt
= updateInformation "play trax" [updateTraxEditor] traxSt
>>* [OnValue (ifValue game_over game_winner)]
game_winner :: TraxSt -> Task Bool
game_winner st=:{trax,turn}
= viewInformation "The winner is:" [] (toString turn)
-&&-
viewInformation "Final board:" [viewTraxEditor] st @ (const winner)