Verified Commit 4238a8ad authored by Peter Achten's avatar Peter Achten Committed by Camil Staps

Merge branch 'master' into server-and-client-side-svg-rendering

parent e18d87aa
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 iTasks.UI.JS.Encoding
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.UI.JS.Encoding
import iTasks.Extensions.JSONFile
import iTasks.Internal.IWorld
import iTasks.UI.Layout, iTasks.UI.Definition
......@@ -17,10 +17,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(..)
derive JSEncode Map2D, Section, Coord2D, Borders, Border, IntMap, Device, DeviceType, DeviceKind, CableType, Map
derive JSEncode Network, Cable, Object, ObjectType, MapAction, SectionStatus, Dir
......
......@@ -4,8 +4,8 @@ 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 iTasks.UI.JS.Encoding
import qualified Data.List as DL
from Data.Func import mapSt
import StdArray
......@@ -17,7 +17,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
......
......@@ -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.
......@@ -21,6 +21,7 @@ module Trax
import Trax.UoD
import Trax.Tasks
import MultiUser.Tasks
import iTasks.Engine
Start :: *World -> *World
Start world
......
......@@ -2,14 +2,11 @@ implementation module Trax.UI
import StdBool, StdList
from StdFunc import const, flip, id
import Data.List
from Data.List import lookup
import iTasks.WF.Tasks.Interaction
import iTasks.Extensions.SVG.SVGEditor
import Trax.UoD
derive JSEncode TraxSt, User, Trax, TraxTile, TileEdge
derive JSDecode TraxSt, User, Trax, TraxTile, TileEdge
:: RenderMode = ViewMode | PlayMode
updateTraxEditor :: Bool -> UpdateOption TraxSt TraxSt
......@@ -42,7 +39,7 @@ where
board :: Bool Span TraxSt -> Image TraxSt
board it_is_my_turn d st=:{trax}
| nr_of_tiles trax == zero
| no_of_tiles trax == zero
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = const (start_with_this tile), local = False}
\\ tile <- gFDomain{|*|}
......@@ -54,7 +51,7 @@ board it_is_my_turn d st=:{trax}
Just tile = tileImage d tile
\\ row <- [miny - 1 .. maxy + 1]
, col <- [minx - 1 .. maxx + 1]
, let coord = /*fromTuple*/ (col,row)
, let coord = fromTuple (col,row)
] NoHost
where
((minx,maxx),(miny,maxy)) = bounds trax
......
......@@ -7,13 +7,16 @@ from StdClass import class zero, class ~
import Data.Maybe
import Data.GenFDomain
import Data.GenEq, Data.GenLexOrd, Control.GenMap
import iTasks.UI.JS.Encoding
derive class iTask TraxSt, /*Coordinate,*/ TileEdge, LineColor
derive class iTask TraxSt, Coordinate, TileEdge, LineColor
:: TraxTile // a tile connects two edges:
= { end1 :: !TileEdge // the red line at one end and
, end2 :: !TileEdge // the red line at the other end
}
derive JSEncode TraxTile
derive JSDecode TraxTile
derive gEditor TraxTile
derive gText TraxTile
derive JSONEncode TraxTile
......@@ -40,33 +43,35 @@ other_edge :: !TraxTile !TileEdge -> TileEdge
:: TileEdge // an edge is either at:
= North // the north side of a tile, or at
| East // the east side of a tile, or at
| East // the east side of a tile, or at
| South // the south side of a tile, or at
| West // the west side of a tile
derive gFDomain TileEdge
derive gLexOrd TileEdge
instance == TileEdge
instance < TileEdge
instance ~ TileEdge
| West // the west side of a tile
derive JSEncode TileEdge
derive JSDecode TileEdge
derive gFDomain TileEdge
derive gLexOrd TileEdge
instance == TileEdge
instance < TileEdge
instance ~ TileEdge
:: LineColor // a line color is either:
= RedLine // red, or
| WhiteLine // white
derive gFDomain LineColor
instance == LineColor
instance ~ LineColor
derive gFDomain LineColor
instance == LineColor
instance ~ LineColor
:: Coordinate :== (Int,Int) // debugging: use tuple instead of record
/*
:: Coordinate // a coordinate consists of:
= { col :: !Int // a column-coordinate
, row :: !Int // a row-coordinate
}*/
}
derive JSEncode Coordinate
derive JSDecode Coordinate
instance == Coordinate
instance < Coordinate
instance zero Coordinate
//instance fromTuple Int Int Coordinate
//instance toTuple Int Int Coordinate
instance fromTuple Int Int Coordinate
instance toTuple Int Int Coordinate
/** col @{col} = col.
*/
......@@ -77,9 +82,9 @@ col :: !Coordinate -> Int
row :: !Coordinate -> Int
:: Trax // actually, Trax ought to be opaque
= { tiles :: ![(Coordinate,TraxTile)] // tiles that are placed on a certain location
}
:: Trax
derive JSEncode Trax
derive JSDecode Trax
derive gEditor Trax
derive gText Trax
derive JSONEncode Trax
......@@ -89,7 +94,6 @@ derive gEq Trax
instance == Trax
instance zero Trax
class tiles a :: !a -> [(Coordinate,TraxTile)]
/** tiles @trax = @tiles`:
......@@ -98,27 +102,28 @@ class tiles a :: !a -> [(Coordinate,TraxTile)]
instance tiles Trax
instance tiles TraxSt
/** nr_of_tiles @trax = @nr_of_tiles:
returns the current number of tiles (@nr_of_tiles) in @trax.
/** no_of_tiles @trax:
returns the current number of tiles in @trax.
*/
nr_of_tiles :: !Trax -> Int
no_of_tiles :: !Trax -> Int
/** bounds @trax = ((@minx,@maxx),(@miny,@maxy)):
returns the mimimum x-coordinate @minx and minimum y-coordinate @miny
and the maximum x-coordinate @maxx and maximum y-coordinate @maxy of @trax.
It is assumed that (nr_of_tiles @trax > 0).
It is assumed that (no_of_tiles @trax > 0).
*/
bounds :: !Trax -> (!(!Int,!Int), !(!Int,!Int))
/** dimension @trax = (@nr_of_cols,@nr_of_rows):
returns the @nr_of_cols and @nr_of_rows of the collection of @trax.
It is assumed that (nr_of_tiles @trax > 0).
It is assumed that (no_of_tiles @trax > 0).
*/
dimension :: !Trax -> (!Int,!Int)
/** add_tile @coordinate @tile @trax = @trax`:
only if (tile_at @trax @coordinate) = Nothing and linecolors_match (linecolors @trax @coordinate) (tilecolors @tile)
then (@coordinate,@tile) is added to @trax, resulting in @trax`.
only if (tile_at @trax @coordinate) = Nothing and the line colors of @tile match with the
line endings of the neighbouring tiles of @coordinate in @trax, then (@coordinate,@tile)
is added to @trax, resulting in @trax`.
In any other case, @trax` = @trax.
*/
add_tile :: !Coordinate !TraxTile !Trax -> Trax
......@@ -182,7 +187,6 @@ winning_lines :: !Trax -> [(LineColor,Line)]
*/
mandatory_moves :: !Trax !Coordinate -> Trax
:: TraxSt
= { trax :: !Trax // the current set of placed tiles
, names :: ![User] // the current two players
......@@ -190,7 +194,29 @@ mandatory_moves :: !Trax !Coordinate -> Trax
, choice :: !Maybe Coordinate
}
game_over :: TraxSt -> Bool
start_with_this :: TraxTile TraxSt -> TraxSt
setcell :: Coordinate TraxSt -> TraxSt
settile :: Coordinate TraxTile TraxSt -> TraxSt
derive JSEncode TraxSt, User
derive JSDecode TraxSt, User
/** game_over @st:
returns True only if the given configuration in @st.trax contains one or more
lines that connect opposite board edges, or one or more closed loops.
*/
game_over :: !TraxSt -> Bool
/** start_with_this @tile @st = @st`:
@st` has @tile added to @st.trax, assuming that @st.trax is empty;
@st` toggles @st.turn, allowed the other player to put a tile.
*/
start_with_this :: !TraxTile !TraxSt -> TraxSt
/** setcell @choice @st:
sets @st.choice to (Just @choice).
*/
setcell :: !Coordinate !TraxSt -> TraxSt
/** settile @c @t @st = @st`:
@st` has tile @t added to @st.trax on coordinate @c.
In addition, all the mandatory moves have been played as well.
The turn is given to the other player.
*/
settile :: !Coordinate !TraxTile !TraxSt -> TraxSt
......@@ -9,17 +9,16 @@ from Data.List import lookup, deleteFirstsBy, hasDup, qfoldl
import Data.Maybe
import Data.GenFDomain
import Data.GenLexOrd, Control.GenMap, Text.GenPrint
import iTasks.UI.JS.Encoding
import Text
lookup1 x = fromJust o (lookup x)
derive class iTask TraxSt, /*Coordinate,*/ TileEdge, LineColor
derive class iTask TraxSt, Coordinate, TileEdge, LineColor
derive gMap Maybe
:: TraxTile // a tile connects two edges:
= { end1 :: !TileEdge // the red line at one end and
, end2 :: !TileEdge // the red line at the other end
}
derive JSEncode TraxTile
derive JSDecode TraxTile
derive gEditor TraxTile
derive gText TraxTile
derive JSONEncode TraxTile
......@@ -68,68 +67,58 @@ instance ~ TraxTile where ~ tile = lookup1 tile [(horizontal,vertical )
,(southeast, northwest )
]
:: TileEdge // an edge is either at:
= North // the north side of a tile, or at
| East // the east side of a tile, or at
| South // the south side of a tile, or at
| West // the west side of a tile
derive gFDomain TileEdge
derive gLexOrd TileEdge
instance == TileEdge where == e1 e2 = e1 === e2
instance < TileEdge where < e1 e2 = (e1 =?= e2) === LT
instance ~ TileEdge where ~ e = case e of
North = South
South = North
West = East
East = West
:: LineColor // a line color is either:
= RedLine // red, or
| WhiteLine // white
derive gFDomain LineColor
instance == LineColor where == c1 c2 = c1 === c2
instance ~ LineColor where ~ RedLine = WhiteLine
~ WhiteLine = RedLine
:: Coordinate :== (Int,Int) // using a record type gives incorrect results in game: somehow the coordinate values get messed up
/*
:: Coordinate // a coordinate consists of:
= { col :: !Int // a column-coordinate
, row :: !Int // a row-coordinate
}*/
//derive gLexOrd Coordinate
derive JSEncode TileEdge
derive JSDecode TileEdge
derive gFDomain TileEdge
derive gLexOrd TileEdge
instance == TileEdge where == e1 e2 = e1 === e2
instance < TileEdge where < e1 e2 = (e1 =?= e2) === LT
instance ~ TileEdge where ~ e = case e of
North = South
South = North
West = East
East = West
derive gFDomain LineColor
instance == LineColor where == c1 c2 = c1 === c2
instance ~ LineColor where ~ RedLine = WhiteLine
~ WhiteLine = RedLine
derive JSEncode Coordinate
derive JSDecode Coordinate
derive gLexOrd Coordinate
instance == Coordinate where == c1 c2 = c1 === c2
instance < Coordinate where < c1 c2 = (c1 =?= c2) === LT
instance zero Coordinate where zero = (zero,zero)//{col=zero, row=zero}
//derive gPrint Coordinate
instance zero Coordinate where zero = {col=zero, row=zero}//(zero,zero)
derive gPrint Coordinate
instance toString Coordinate where toString c = printToString c
//instance fromTuple Int Int Coordinate where fromTuple (c,r) = {col=c,row=r}
//instance toTuple Int Int Coordinate where toTuple {col,row} = (col,row)
instance fromTuple Int Int Coordinate where fromTuple (c,r) = {col=c,row=r}
instance toTuple Int Int Coordinate where toTuple {col,row} = (col,row)
col :: !Coordinate -> Int
//col coordinate = coordinate.col
col (col,_) = col
col coordinate = coordinate.col
//col (col,_) = col
row :: !Coordinate -> Int
//row coordinate = coordinate.row
row (_,row) = row
row coordinate = coordinate.row
//row (_,row) = row
north :: !Coordinate -> Coordinate
//north coordinate = {coordinate & row = coordinate.row-1}
north (col,row) = (col, row-1)
north coordinate = {coordinate & row = coordinate.row-1}
//north (col,row) = (col, row-1)
south :: !Coordinate -> Coordinate
//south coordinate = {coordinate & row = coordinate.row+1}
south (col,row) = (col, row+1)
south coordinate = {coordinate & row = coordinate.row+1}
//south (col,row) = (col, row+1)
west :: !Coordinate -> Coordinate
//west coordinate = {coordinate & col = coordinate.col-1}
west (col,row) = (col-1, row)
west coordinate = {coordinate & col = coordinate.col-1}
//west (col,row) = (col-1, row)
east :: !Coordinate -> Coordinate
//east coordinate = {coordinate & col = coordinate.col+1}
east (col,row) = (col+1, row)
east coordinate = {coordinate & col = coordinate.col+1}
//east (col,row) = (col+1, row)
go :: !TileEdge -> Coordinate -> Coordinate
go North = north
......@@ -138,9 +127,11 @@ go South = south
go West = west
:: Trax // a collection of tiles consists of:
:: Trax // actually, Trax ought to be opaque
= { tiles :: ![(Coordinate,TraxTile)] // tiles that are placed on a certain location
}
derive JSEncode Trax
derive JSDecode Trax
derive gEditor Trax
derive gText Trax
derive JSONEncode Trax
......@@ -150,7 +141,6 @@ instance == Trax where == t1 t2 = sortBy fst_smaller t1.tiles == sortBy fst_smal
gEq{|Trax|} t1 t2 = t1 == t2
instance zero Trax where zero = { tiles = [] }
class tiles a :: !a -> [(Coordinate,TraxTile)]
instance tiles Trax where tiles trax = trax.tiles
......@@ -162,56 +152,34 @@ instance tiles TraxSt where tiles {trax} = tiles trax
minimum_winning_line_length :== 8 // the minimum length of a winning line
/** nr_of_tiles @trax = @nr_of_tiles:
returns the current number of tiles (@nr_of_tiles) in @trax.
*/
nr_of_tiles :: !Trax -> Int
nr_of_tiles trax
no_of_tiles :: !Trax -> Int
no_of_tiles trax
= length trax.tiles
/** bounds @trax = ((@minx,@maxx),(@miny,@maxy)):
returns the mimimum x-coordinate @minx and minimum y-coordinate @miny
and the maximum x-coordinate @maxx and maximum y-coordinate @maxy of @trax.
It is assumed that (nr_of_tiles @trax > 0).
*/
bounds :: !Trax -> (!(!Int,!Int), !(!Int,!Int))
bounds trax
| nr_of_tiles trax > 0 = ((minList cols,maxList cols), (minList rows,maxList rows))
| no_of_tiles trax > 0 = ((minList cols,maxList cols), (minList rows,maxList rows))
| otherwise = abort "Trax.UoD.bounds: partial function is applied to empty set of tiles.\n"
where
coords = map fst trax.tiles
cols = map col coords
rows = map row coords
/** dimension @trax = (@nr_of_cols,@nr_of_rows):
returns the @nr_of_cols and @nr_of_rows of the collection of @trax.
It is assumed that (nr_of_tiles @trax > 0).
*/
dimension :: !Trax -> (!Int,!Int)
dimension trax
| nr_of_tiles trax > 0 = (maxx - minx + 1, maxy - miny + 1)
| no_of_tiles trax > 0 = (maxx - minx + 1, maxy - miny + 1)
| otherwise = abort "Trax.UoD.dimension: partial function is applied to empty set of tiles.\n"
where
((minx,maxx),(miny,maxy)) = bounds trax
/** add_tile @coordinate @tile @trax = @trax`:
only if (tile_at @trax @coordinate) = Nothing and linecolors_match (linecolors @trax @coordinate) (tilecolors @tile)
then (@coordinate,@tile) is added to @trax, resulting in @trax`.
In any other case, @trax` = @trax.
*/
add_tile :: !Coordinate !TraxTile !Trax -> Trax
add_tile coordinate tile trax
| nr_of_tiles trax == 0 ||
| no_of_tiles trax == 0 ||
isMember coordinate (free_coordinates trax) && linecolors_match (linecolors trax coordinate) (tilecolors tile)
= {trax & tiles = [(coordinate,tile) : trax.tiles]}
| otherwise
= trax
/** tile_at @trax @coordinate = Nothing:
when no tile is present at @coordinate in @trax.
tile_at @trax @coordinate = Just @t:
returns tile @t which is present at @coordinate in @trax.
*/
tile_at :: !Trax !Coordinate -> Maybe TraxTile
tile_at trax coordinate
= lookup coordinate trax.tiles
......@@ -237,15 +205,11 @@ tile_neighbours :: !Trax !Coordinate -> [Coordinate]
tile_neighbours trax coordinate
= [neighbour \\ neighbour <- neighbours coordinate | isJust (tile_at trax neighbour)]
/** free_coordinates @trax = @free:
computes the coordinates in which a new tile can be placed.
These coordinates are all free direct neighbours of all tiles in @trax.
*/
free_coordinates :: !Trax -> [Coordinate]
free_coordinates trax
= removeDupSortedList (sort (flatten (map (free_neighbours trax) (map fst trax.tiles))))
:: LineColors // linecolors contains the colors of the line-endings at the edges of a coordinate:
:: LineColors // linecolors contains the colors of the line-endings at the edges of a coordinate:
:== [(TileEdge,Maybe LineColor)] // at each edge, the corresponding color is determined (might be not present)
linecolors_match :: !LineColors !LineColors -> Bool
......@@ -261,10 +225,6 @@ where
fst_smaller :: !(!a,c) !(!a,d) -> Bool | Ord a
fst_smaller (a,_) (b,_) = a < b
/** linecolors @trax @coordinate = @colors:
computes of a potential tile at @coordinate in @trax the corresponding @colors of the line-endings.
tile_at @trax @coordinate should be Nothing.
*/
linecolors :: !Trax !Coordinate -> LineColors
linecolors trax coordinate
= [ (edge,gMap{|*->*|} (color_at_tile (~edge)) (tile_at trax (go edge coordinate)))
......@@ -293,9 +253,6 @@ color_at_tile :: !TileEdge !TraxTile -> LineColor
color_at_tile edge tile
= fromJust (lookup1 edge (tilecolors tile))
/** possible_tiles @colors = @trax:
returns those @trax that match with @colors.
*/
possible_tiles :: !LineColors -> [TraxTile]
possible_tiles colors
= [tile \\ tile <- gFDomain{|*|} | linecolors_match colors (tilecolors tile)]
......@@ -312,26 +269,13 @@ track trax color edge coordinate
Just tile = let edge` = other_edge (perspective color tile) edge
in [coordinate : track trax color (~edge`) (go edge` coordinate)]
/** is_loop @path = True:
holds only if @path is a closed loop.
is_loop @path = False:
@path is not a closed loop.
*/
is_loop :: !Line -> Bool
is_loop [c:cs] = isMember c cs
is_loop empty = False
/** cut_loop @path = @path`:
turns the infinite @path, forming a loop, into a finite @path` that contains all tiles.
*/
cut_loop :: !Line -> Line
cut_loop [c:cs] = [c : takeWhile ((<>) c) cs]
/** loops @trax = Nothing:
@trax contains no loop of RedLine or WhiteLine.
loops @trax = @loops:
@trax contains @loops, each indicating their color and path.
*/
loops :: !Trax -> [(LineColor,Line)]
loops trax
= [(RedLine, loop) \\ loop <- color_loops trax.tiles RedLine]
......@@ -370,17 +314,14 @@ where
perspective :: !LineColor !TraxTile -> TraxTile
perspective colour tile = if (colour == RedLine) tile (~tile)
/** winning_lines @trax = @lines:
returns all winning @lines that start either at the west or north edge of @trax.
*/
winning_lines :: !Trax -> [(LineColor,Line)]
winning_lines trax
| nr_of_tiles trax == 0 = []
| no_of_tiles trax == 0 = []
| otherwise = winning_lines_at trax West ++ winning_lines_at trax North
/** winning_lines_at @trax @edge = @lines:
returns all winning @lines that start at @edge in @trax.
It is assumed that (nr_of_tiles @trax <> 0).
It is assumed that (no_of_tiles @trax <> 0).
*/