Commit e17dde2b authored by Camil Staps's avatar Camil Staps 🚀

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

Server and client side SVG rendering

Closes #282 and #298

See merge request !278
parents 7eedec78 fcea9eaf
Pipeline #25369 passed with stage
in 5 minutes and 8 seconds
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
......
......@@ -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.
......@@ -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)
where
winners = loops trax ++ winning_lines trax
prev_player_color = if turn WhiteLine RedLine
winner = if (isMember prev_player_color (map fst winners)) (not turn) turn
definition module SinglePlayerTrax.UI
import SinglePlayerTrax.UoD
import iTasks.WF.Tasks.Interaction
/** updateTraxEditor @flag:
yields a customized view on a game of trax using Graphics.Scalable.
The view is interactive only if @flag is True.
*/
updateTraxEditor :: UpdateOption TraxSt TraxSt
/** viewTraxEditor:
yields a customized, non-interactive, view on a game of trax using Graphics.Scalable.
*/
viewTraxEditor :: ViewOption TraxSt
implementation module SinglePlayerTrax.UI
import StdBool, StdFunctions, StdList
from Data.List import lookup
import iTasks.WF.Tasks.Interaction
import iTasks.Extensions.SVG.SVGEditor
import SinglePlayerTrax.UoD
:: RenderMode = ViewMode | PlayMode
updateTraxEditor :: UpdateOption TraxSt TraxSt
updateTraxEditor = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode
, updModel = flip const
})
viewTraxEditor :: ViewOption TraxSt
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode
, updModel = flip const
})
whiteColor = toSVGColor "white"
redColor = toSVGColor "red"
freeTileColor = toSVGColor "lightgrey"
transparentColor = toSVGColor "none"
toImage :: RenderMode TraxSt *TagSource -> Image TraxSt
toImage ViewMode st _
= board tileSize st
toImage PlayMode st=:{turn} _
= above (repeat AtMiddleX) [] Nothing [] [text font (toString turn), board tileSize st] NoHost
board :: Span TraxSt -> Image TraxSt
board d st=:{trax}
| no_of_tiles trax == zero
= grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = const (start_with_this tile), local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise
= grid (Rows (maxy - miny + 3)) (RowMajor, LeftToRight, TopToBottom) (repeat (AtMiddleX,AtMiddleY)) [] [] []
[ case tile_at trax coord of
Nothing = if (isMember coord free_coords) (freeImage d coord st) (voidImage d)
Just tile = tileImage d tile
\\ row <- [miny - 1 .. maxy + 1]
, col <- [minx - 1 .. maxx + 1]
, let coord = fromTuple (col,row)
] NoHost
where
((minx,maxx),(miny,maxy)) = bounds trax
(o_x, o_y) = (abs (min 0 (minx-1)), abs (min 0 (miny-1)))
free_coords = free_coordinates trax
voidImage :: Span -> Image a
voidImage d = empty d d
freeImage :: Span Coordinate TraxSt -> Image TraxSt
freeImage d coord {trax,choice}
| maybe True (\c -> coord <> c) choice
= unselected
| otherwise = above (repeat AtMiddleX) [] (Just d) []
[tileImage (d /. nr_of_candidates) tile <@< {onclick = const (settile coord tile), local = False} \\ tile <- candidates]
(Host unselected)
where
candidates = possible_tiles (linecolors trax coord)
nr_of_candidates = length candidates
unselected = tileShape d <@< {fill = freeTileColor} <@< {onclick = const (setcell coord), local = False}
tileImage :: Span TraxTile -> Image a
tileImage d tile = fromJust (lookup tile [ (horizontal,rotate (deg 0.0) horizontal_tile)
, (vertical, rotate (deg 90.0) horizontal_tile)
, (northwest, rotate (deg 0.0) northwest_tile)
, (northeast, rotate (deg 90.0) northwest_tile)
, (southeast, rotate (deg 180.0) northwest_tile)
, (southwest, rotate (deg 270.0) northwest_tile)
])
where
brick = Host (tileShape d <@< {stroke = whiteColor} <@< {strokewidth = d /. 20})
horizontal_tile = overlay (repeat (AtMiddleX,AtMiddleY)) [] [bar yline whiteColor, bar xline redColor] brick
northwest_tile = (overlay [] [(d /. 2, d /. 2),(d /. -2, d /. -2)]
[ arc whiteColor, arc redColor ]
brick
) <@< { MaskAttr | mask = tileShape d <@< {fill = whiteColor}}
bar line c = line d <@< {stroke = c} <@< {strokewidth = d /. 5}
arc c = circle d <@< {stroke = c} <@< {strokewidth = d /. 5} <@< {fill = transparentColor}
tileShape :: Span -> Image a
tileShape d = square d <@< {xradius = d /. 10} <@< {yradius = d /. 10}
font = normalFontDef "Arial" 14.0
tileSize = px 50.0
definition module SinglePlayerTrax.UoD
import iTasks.WF.Definition
from iTasks.Extensions.User import :: User
import PlatformExts.Tuple
from StdClass import class zero, class ~
import Data.Maybe
import Data.GenFDomain
import Data.GenEq, Data.GenLexOrd, Control.GenMap
import iTasks.UI.JS.Encoding
:: 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 JSONEncode TraxTile
derive JSONDecode TraxTile
derive gDefault TraxTile
derive gEditor TraxTile
derive gText TraxTile
derive gEq TraxTile
derive gFDomain TraxTile
instance fromTuple TileEdge TileEdge TraxTile
instance toTuple TileEdge TileEdge TraxTile
instance == TraxTile
instance toString TraxTile
horizontal :: TraxTile // tile with a straight horizontal red line
vertical :: TraxTile // tile with a straight vertical red line
northwest :: TraxTile // tile with an elbow red line at north-west
northeast :: TraxTile // tile with an elbow red line at north-east
southeast :: TraxTile // tile with an elbow red line at south-east
southwest :: TraxTile // tile with an elbow red line at south-west
/** other_edge @tile @edge = @edge`:
the tile connects @edge and @edge`.
*/
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
| South // the south side of a tile, or at
| West // the west side of a tile
derive class iTask TileEdge
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 class iTask LineColor
derive gFDomain LineColor
instance == LineColor
instance ~ LineColor
:: Coordinate // a coordinate consists of:
= { col :: !Int // a column coordinate
, row :: !Int // a row coordinate
}
derive class iTask Coordinate
derive JSEncode Coordinate
derive JSDecode Coordinate
instance == Coordinate
instance < Coordinate
instance zero Coordinate
instance fromTuple Int Int Coordinate
instance toTuple Int Int Coordinate
/** col @{col} = col.
*/
col :: !Coordinate -> Int
/** row @{row} = row.
*/
row :: !Coordinate -> Int
:: Trax
derive JSEncode Trax
derive JSDecode Trax
derive JSONEncode Trax
derive JSONDecode Trax
derive gDefault Trax
derive gEditor Trax
derive gText Trax
instance == Trax
instance zero Trax
class tiles a :: !a -> [(Coordinate,TraxTile)]
/** tiles @trax = @tiles`:
@tiles` is a finite map of all current tiles of @trax.
*/
instance tiles Trax
instance tiles TraxSt
/** no_of_tiles @trax:
returns the current number of tiles in @trax.
*/
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 (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 (no_of_tiles @trax > 0).
*/
dimension :: !Trax -> (!Int,!Int)
/** add_tile @coordinate @tile @trax = @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
/** 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
/** 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]
:: LineColors
/** 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
/** possible_tiles @colors = @trax:
returns those @trax that match with @colors.
*/
possible_tiles :: !LineColors -> [TraxTile]
:: Line
/** 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
/** cut_loop @path = @path`:
turns the infinite @path, forming a loop, into a finite @path` that contains all tiles.
*/
cut_loop :: !Line -> Line
/** 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)]
/** winning_lines @trax = @lines:
returns all winning @lines that start either at the west or north edge of @trax.
*/
winning_lines :: !Trax -> [(LineColor,Line)]
/** mandatory_moves @trax @coordinate = @trax`:
assumes that the tile at @coordinate in @trax is the most recently placed tile.
It performs the mandatory moves that require filling empty places next to this
tile, and all subsequent other empty places, thus resulting in @trax`.
*/
mandatory_moves :: !Trax !Coordinate -> Trax
:: TraxSt
= { trax :: !Trax // the current set of placed tiles
, turn :: !Bool // the turn of the player (True for game initiator, False for invitee)
, choice :: !Maybe Coordinate
}
derive class iTask TraxSt
derive JSEncode TraxSt
derive JSDecode TraxSt
/** 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
This diff is collapsed.
......@@ -2,9 +2,8 @@ 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 Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import Trax.UoD
......@@ -40,9 +39,9 @@ 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}
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}