...
 
Commits (48)
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.
......@@ -23,10 +23,8 @@ limitInt n
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
......
......@@ -116,7 +116,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.
......@@ -21,6 +21,7 @@ module Trax
import Trax.UoD
import Trax.Tasks
import MultiUser.Tasks
import iTasks.Engine
Start :: *World -> *World
Start world
......
......@@ -2,15 +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 Graphics.Scalable.Image
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
......@@ -43,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{|*|}
......@@ -55,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
......@@ -98,12 +94,5 @@ where
tileShape :: Span -> Image a
tileShape d = square d <@< {xradius = d /. 10} <@< {yradius = d /. 10}
font = { fontfamily = "Arial"
, fontysize = 14.0
, fontstretch = ""
, fontstyle = ""
, fontvariant = ""
, fontweight = ""
}
font = normalFontDef "Arial" 14.0
tileSize = px 50.0
......@@ -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,15 +187,36 @@ 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
, turn :: Bool
, choice :: Maybe Coordinate
= { trax :: !Trax // the current set of placed tiles
, names :: ![User] // the current two players
, turn :: !Bool
, 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
This diff is collapsed.
......@@ -2,14 +2,9 @@ module BasicImages
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Text.GenPrint
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList, StdTuple
from StdFunc import id, o, const
import StdFunctions, StdList
// shorthand definitions for the used fonts in these examples
lucida = normalFontDef "Lucida Console"
......
......@@ -2,13 +2,9 @@ module Box
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdReal
from StdFunctions import id, const
import StdFunctions
// shorthand definitions for the used colours in these examples
none = toSVGColor "none"
......@@ -28,11 +24,11 @@ Start world
box2 :: m *TagSource -> Image m
box2 _ tags = pair (arrow, arrow`) tags
where
arrow = polygon [(px zero,px -10.0),(px 55.0,px -10.0),(px 50.0,px -30.0),(px 85.0,px zero)
,(px 50.0,px 30.0),(px 55.0,px 10.0),(px zero,px 10.0)
arrow = polygon [(px 0.0,px -10.0),(px 55.0,px -10.0),(px 50.0,px -30.0),(px 85.0,px 0.0)
,(px 50.0,px 30.0),(px 55.0,px 10.0),(px 0.0,px 10.0)
]
arrow` = polygon [(px -10.0,px zero),(px -10.0,px 55.0),(px -30.0,px 50.0),(px zero,px 85.0)
,(px 30.0,px 50.0),(px 10.0,px 55.0),(px 10.0,px zero)
arrow` = polygon [(px -10.0,px 0.0),(px -10.0,px 55.0),(px -30.0,px 50.0),(px 0.0,px 85.0)
,(px 30.0,px 50.0),(px 10.0,px 55.0),(px 10.0,px 0.0)
]
/** pair (img1,img2) tags = image:
......
......@@ -4,10 +4,9 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
from StdFunc import id, o, const
import StdInt, StdReal
from StdFunc import id, const
import StdReal
from StdList import repeat, repeatn
Start :: *World -> *World
......
module Character
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.UI.Prompt
import iTasks.Extensions.SVG.SVGEditor
import StdFunctions
Start :: *World -> *World
Start world
= startEngine [publish "/" (const (viewInformation "A char" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const char
, updModel = \_ v = v
})] 'F'))] world
char :: Char *TagSource -> Image Char
char c tags
= margin (px 20.0) (
text (normalFontDef "Times New Roman" 72.0) (toString c)
)
module CharacterShare
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.SDS
import iTasks.UI.Prompt
import iTasks.Extensions.SVG.SVGEditor
import StdFunctions
from iTasks import instance Identifiable SDSLens, instance Modifiable SDSLens, instance Registrable SDSLens, instance Readable SDSLens, instance Writeable SDSLens
Start :: *World -> *World
Start world
= startEngine [publish "/" (const
(withShared 'F' (\share ->
viewSharedInformation "A char" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const char
, updModel = \_ v = v
})] share
-||-
updateSharedInformation "This char" [] share
)))] world
char :: Char *TagSource -> Image Char
char c tags
= margin (px 100.0) (
text (normalFontDef "Times New Roman" 72.0) (toString c)
)
......@@ -2,13 +2,10 @@ module Clean
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Extensions
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList
from StdFunc import id, const, o
import StdArray, StdEnum, StdFunctions, StdList
// shorthand definitions for the used fonts in these examples
arial = normalFontDef "Arial"
......@@ -35,14 +32,14 @@ clean model tags
[ star 31 (r_in,r_out)
, circle (px r_in *. 1.6) <@< {strokewidth = px bandwidth} <@< {stroke = white}
, rotate (rad (pi * 0.25)) (circular (px r_in *. 0.8) (2.0 * pi) (repeatn 4 (circle (px bandwidth *. 0.8))))
, rotate (rad (pi * 0.32)) (circular (px zero) (2.0 * pi) (map (arctext (px r_in *. 1.10) (0.4 * pi) narrowfont) ["NO VIRUSES","NO SPYWARE","NO VIRUSES","NO SPYWARE"]))
, rotate (rad (pi * 0.32)) (circular (px zero) (2.0 * pi) (map (arctext (px r_in *. 0.8) (0.4 * pi) narrowfont) ["NO VIRUSES","NO SPYWARE","NO VIRUSES","NO SPYWARE"]))
, above (repeat AtMiddleX) [] Nothing [] (map (((>@>) {fill = white}) o ((>@>) {stroke = white}) o (text bigfont)) ["100%", "CLEAN"]) NoHost
] NoHost
where
r_out = 100.0
r_in = 90.0
bandwidth = r_in * 0.2
bigfont = {arial (r_in * 0.35) & fontweight = "bolder"}
bigfont = setfontweight "bolder" (arial (r_in * 0.35))
narrowfont = arial_narrow (r_in * 0.22)
/** star n (r_in,r_out) = image:
......
......@@ -2,14 +2,9 @@ module Grids
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Text.GenPrint // printing via <+++ has a known bug, so we use printToString instead
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList, StdTuple
from StdFunc import id, o, const, seqList, :: St(..)
import StdFunctions, StdList
import Text
// shorthand definitions for the used fonts in these examples
......@@ -34,7 +29,7 @@ grids model tags
[ grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] [] [] []
[ above (repeat AtMiddleX) [] Nothing []
[ margin (px 5.0,px zero) (grid (Columns 2) (major,x_fill,y_fill) [] [] [] [] discs NoHost)
, txt (" (" <+ major <+ "," <+ x_fill <+ "," <+ y_fill <+ ") ")
, txt (" (" <+++ major <+++ "," <+++ x_fill <+++ "," <+++ y_fill <+++ ") ")
] NoHost
\\ major <- [ColumnMajor,RowMajor ]
, x_fill <- [LeftToRight,RightToLeft]
......@@ -66,7 +61,4 @@ where
discs :: [Image m]
discs = [circle (px 15.0 + px 8.0 *. d) <@< {fill = toSVGColor {r=255-d*25,g=210-d*70,b=210-d*70}} \\ d <- [3,2,1,0]]
derive gPrint GridMajor, GridXLayout, GridYLayout
instance toString GridMajor where toString x = printToString x
instance toString GridXLayout where toString x = printToString x
instance toString GridYLayout where toString x = printToString x
derive gText GridMajor, GridXLayout, GridYLayout
......@@ -2,14 +2,9 @@ module Linears
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Text.GenPrint // printing via <+++ has a known bug, so we use printToString instead
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList, StdTuple
from StdFunc import id, o, const, seqList, :: St(..)
import StdFunctions, StdList
import Text
// shorthand definitions for the used fonts in these examples
......@@ -20,12 +15,11 @@ blue = toSVGColor "blue"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Linears"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const linears
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Linears" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const linears
, updModel = \_ v = v
})] 0) world
/** linears model tags = image:
@image shows all beside and above combinations.
......@@ -40,7 +34,7 @@ linears model tags
, above (repeat AtLeft) [] Nothing []
[ beside (repeat AtMiddleY) [] Nothing []
[ beside (repeat y_align) [] Nothing [] discs NoHost
, txt (" " <+ y_align <+ "*")
, txt (" " <+++ y_align <+++ "*")
] NoHost
\\ y_align <- [AtTop,AtMiddleY,AtBottom]
] NoHost
......@@ -49,7 +43,7 @@ linears model tags
[ txt " above " <@< {stroke = blue} <@< {fill = blue}
, beside (repeat AtTop) [] Nothing []
[ above (repeat AtMiddleX) [] Nothing []
[ txt (" " <+ x_align <+ "*")
[ txt (" " <+++ x_align <+++ "*")
, above (repeat x_align) [] Nothing [] discs NoHost
] NoHost
\\ x_align <- [AtLeft,AtMiddleX,AtRight]
......@@ -82,6 +76,4 @@ where
discs :: [Image m]
discs = [circle (px 15.0 + px 8.0 *. d) <@< {fill = toSVGColor {r=255-d*25,g=210-d*70,b=210-d*70}} \\ d <- [3,2,1,0]]
derive gPrint XAlign, YAlign
instance toString XAlign where toString x = printToString x
instance toString YAlign where toString x = printToString x
derive gText XAlign, YAlign
......@@ -3,7 +3,6 @@ module Mask
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdReal
from StdFunc import const, id
......@@ -22,8 +21,8 @@ Start world
*/
image :: m *TagSource -> Image m
image model tags
= flipy (polygon [(zero,zero),(d,zero),(d /. 2, d)])
<@< {mask = margin (d *. 0.3,px zero,px zero,d *. 0.1) (circle (d *. 0.8) <@< {fill = toSVGColor "white"})}
= flipy (polygon [(px 0.0,px 0.0),(d,px 0.0),(d /. 2, d)])
<@< {mask = margin (d *. 0.3,px 0.0,px 0.0,d *. 0.1) (circle (d *. 0.8) <@< {fill = toSVGColor "white"})}
where
d = px 88.0
m = px 10.0
......@@ -2,13 +2,9 @@ module OnClick
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdInt, StdReal
from StdFunc import id, const
import StdArray, StdClass, StdFunctions, StdInt, StdList, StdReal
import Text
// shorthand definitions for the used fonts in these examples
......@@ -30,13 +26,15 @@ Start world
@image displays the number of times that you've clicked on the text. The initial value is @n.
*/
count :: Int *TagSource -> Image Int
count n _
= margin (px 20.0) (
overlay [(AtMiddleX,AtMiddleY)] []
[ text font (toString n) <@< {fill = white}]
(Host (rect (textxspan font (" " <+ n)) (px (h + m))))
<@< {onclick = (+), local = False}
)
count n _ = margin (px 20.0) (beside [] [] Nothing [] (map digit (digits n)) NoHost <@< {onclick = (+), local = False})
digits :: Int -> [Int]
digits n = [toInt c - toInt '0' \\ c <-: toString n]
digit :: Int -> Image Int
digit n = overlay [(AtMiddleX,AtMiddleY)] []
[ text font (toString n) <@< {fill = white}]
(Host (rect (textxspan font (toString n) + px m) (px (h+m))))
where
font = times h
h = 100.0
......
module OnClicks
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.SDS
import iTasks.UI.Prompt
import iTasks.Extensions.SVG.SVGEditor
import StdFunctions, StdArray, StdInt, StdList, StdReal, StdTuple
from iTasks import instance Identifiable SDSLens, instance Modifiable SDSLens, instance Registrable SDSLens, instance Readable SDSLens, instance Writeable SDSLens
// shorthand definitions for the used fonts in these examples
times = normalFontDef "Times New Roman"
// shorthand definitions for the used colours in these examples
black = toSVGColor "black"
white = toSVGColor "white"
yellow = toSVGColor "yellow"
none = toSVGColor "none"
Start :: *World -> *World
Start world
= startEngine [publish "/" (const on_clicks)] world
:: Toggles = {value_in_sds :: Int, update_a_locally :: Bool, update_b_locally :: Bool}
derive class iTask Toggles
derive JSEncode Toggles
derive JSDecode Toggles
:: Who = A | B
derive class iTask Who
derive JSEncode Who
toggleOf :: Who Toggles -> Bool
toggleOf A t = t.Toggles.update_a_locally
toggleOf B t = t.Toggles.update_b_locally
toggleIncr :: Int Toggles -> Toggles
toggleIncr n t=:{Toggles | value_in_sds = m} = {Toggles | t & value_in_sds = n+m}
toggle :: Who Toggles -> Toggles
toggle A t=:{Toggles | update_a_locally} = {Toggles | t & update_a_locally = not update_a_locally}
toggle B t=:{Toggles | update_b_locally} = {Toggles | t & update_b_locally = not update_b_locally}
/** on_clicks:
creates three parallel tasks that are connected to the same SDS of type Toggles.
The first two parallel tasks allow the user to alter the shared value by means of mouse clicks.
The third parallel task allows the user to view and update the same value.
Toggles contains an Int value (initially 0) and two Bool values that cause edits to the Int value to
be local (True) or shared (False) in the first two parallel tasks.
*/
on_clicks :: Task Toggles
on_clicks
= withShared {Toggles | value_in_sds = 0, update_a_locally = False, update_b_locally = False}
(\sds = on_click A sds -||- on_click B sds -||- edit_value sds)
/** on_click who sds = task:
@task is connected with @sds to display its current Int value, and allows the user to increase that value
by clicking on the rendering. If the corresponding Bool value of @who is True, then these edits are local,
and if it is False, then these edits are shared.
*/
on_click :: Who (sds () Toggles Toggles) -> Task Toggles | RWShared sds
on_click label sds
= updateSharedInformation ("On Click " <+++ label)
[UpdateUsing id (\_ v = v) (fromSVGEditor
{ initView = id
, renderImage = const (count label)
, updModel = \_ v = v
})] sds
/** count who toggles tags = image:
@image displays the number in @toggles and allows the user to alter the value by means of mouse clicks.
These edits are propagated to the shared value only if @who in @toggles indicates False.
*/
count :: Who Toggles *TagSource -> Image Toggles
count label toggles _
= margin (px 20.0) (
beside (repeat AtMiddleY) [] Nothing [] (
[ beside [] [] Nothing [] (map digit (digits n)) NoHost <@< {onclick = toggleIncr, local = toggleOf label toggles}
, margin (px 10.0) (
circle (h /. 5)
<@< {onclick = const (toggle label), local = False}
<@< {stroke = if (toggleOf label toggles) black none}
<@< {strokewidth = if (toggleOf label toggles) (h /. 25) (h /. 50)}
<@< {fill = yellow}
)
, margin (px 10.0) (text small_font (if (toggleOf label toggles) "local edits ON" "local edits OFF"))
]) NoHost
)
where
big_font = times h
small_font = times (h / 10.0)
h = 100.0
m = 6.0
n = toggles.Toggles.value_in_sds
digits :: Int -> [Int]
digits n = [toInt c - toInt '0' \\ c <-: toString n]
digit :: Int -> Image m
digit n = overlay [(AtMiddleX,AtMiddleY)] []
[ text big_font (toString n) <@< {fill = white}]
(Host (rect (textxspan big_font (toString n) + px m) (px (h+m))))
/** edit_value sds = task:
@task allows the user to view and alter the Int value of the Toggles SDS.
*/
edit_value :: (sds () Toggles Toggles) -> Task Toggles | RWShared sds
edit_value sds
= updateSharedInformation "Current value in SDS" [UpdateAs (\t = t.Toggles.value_in_sds) (\t v = {Toggles | t & value_in_sds=v})] sds
......@@ -2,14 +2,9 @@ module Overlays
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Text.GenPrint // printing via <+++ has a known bug, so we use printToString instead
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList, StdTuple
from StdFunc import id, o, const
import StdFunc, StdList
import Text
// shorthand definitions for the used fonts in these examples
......@@ -17,12 +12,11 @@ lucida = normalFontDef "Lucida Console"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Overlays"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const overlays
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Overlays" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const overlays
, updModel = \_ v = v
})] 0) world
/** overlays model tags = image:
@image shows all overlay-combinations.
......@@ -34,7 +28,7 @@ overlays model tags
[ grid (Rows 3) (RowMajor,LeftToRight,TopToBottom) [] [] [] []
[ beside (repeat AtMiddleY) [] Nothing []
[ margin (px 5.0) (overlay (repeat (x_align,y_align)) [] discs NoHost)
, txt ("(" <+ x_align <+ "," <+ y_align <+ ")*")
, txt ("(" <+++ x_align <+++ "," <+++ y_align <+++ ")*")
] NoHost
\\ x_align <- [AtLeft,AtMiddleX,AtRight]
, y_align <- [AtTop, AtMiddleY,AtBottom]
......@@ -65,6 +59,4 @@ where
discs :: [Image m]
discs = [circle (px 15.0 + px 8.0 *. d) <@< {fill = toSVGColor {r=255-d*25,g=210-d*70,b=210-d*70}} \\ d <- [3,2,1,0]]
derive gPrint XAlign, YAlign
instance toString XAlign where toString x = printToString x
instance toString YAlign where toString x = printToString x
derive gText XAlign, YAlign
......@@ -2,24 +2,20 @@ module Polyline
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
from StdFunc import id, const
import StdFunctions
// shorthand definitions for the used colours in these examples
white = toSVGColor "white"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Polyline"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const polyline_in_host
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Polyline" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const polyline_in_host
, updModel = \_ v = v
})] 0) world
/** polyline_in_host model tags = image:
@image shows a polyline within a host.
......
......@@ -2,13 +2,9 @@ module Rosetree
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdList, StdString, StdTuple
from StdFunc import id, o, const, seqList, :: St(..)
import StdFunc, StdList, StdTuple
// shorthand definitions for the used fonts in these examples
arial = normalFontDef "Arial"
......@@ -18,12 +14,11 @@ white = toSVGColor "white"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Rose tree"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const roses
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Rose tree" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const roses
, updModel = \_ v = v
})] 0) world
/** roses model tags = image:
......
......@@ -2,22 +2,17 @@ module Rotates
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdEnum, StdReal
from StdFunc import id
import StdEnum, StdFunctions, StdReal
Start :: *World -> *World
Start world
= doTasks (viewInformation "Rotates"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const rotates
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Rotates" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const rotates
, updModel = \_ v = v
})] 0) world
/** rotates model tags = image:
@image displays a sequence of rotated rectangles
......
......@@ -2,14 +2,9 @@ module Transformations
import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Text.GenPrint
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
import StdArray, StdEnum, StdList, StdTuple
from StdFunc import id, o, const
import StdFunctions, StdList
// shorthand definitions for the used fonts in these examples
lucida = normalFontDef "Lucida Console"
......@@ -17,12 +12,11 @@ times = normalFontDef "Times New Roman"
Start :: *World -> *World
Start world
= doTasks (viewInformation "Transformations"
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const transformed_images
, updModel = \_ v = v
})] 0) world
= doTasks (viewInformation "Transformations" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const transformed_images
, updModel = \_ v = v
})] 0) world
/** transformed_images model tags = image:
@image shows all possible transformations on (composite) Image-s.
......@@ -34,11 +28,11 @@ transformed_images model tags
[above (repeat AtMiddleX) [] Nothing [] [transform img, txt (line +++ " img")] NoHost \\ (transform,line) <- transformations] NoHost
)
where
// img = text (times 64.0) "F"
img = polyline [(px 0.0,px 0.0),(px 7.5,px 12.5),(px 15.0,px 0.0),(px 22.5,px 12.5)
img = text (times 64.0) "F"
/* img = polyline [(px 0.0,px 0.0),(px 7.5,px 12.5),(px 15.0,px 0.0),(px 22.5,px 12.5)
,(px 30.0,px 0.0),(px 25.0,px 70.0),(px 5.0,px 70.0),(px 0.0,px 0.0)
]
txt s = text (lucida 10.0) s
*/ txt s = text (lucida 10.0) s
transformations = [(id, "id")
,(fit (px 60.0) (px 70.0), "fit (px 60.0) (px 70.0)")
,(fitx (px 60.0), "fitx (px 60.0)")
......
initServerSideUI of task with taskId = 1-0
initServerSideUI of task with taskId = 1-0
serverHandleEditFromClient ClientNeedsSVG
attributesToUIChange: attributes to set = [height,svgPart,width]
serverHandleEditFromClient (ClientHasNewTextMetrics [{FontDef | Times New Roman,100}] [" 0","0"]
attributesToUIChange: attributes to set = [height,svgPart,width]
serverHandleEditFromClient (ClientHasNewModel 1)
attributesToUIChange: attributes to set = [height,svgPart,width]
serverHandleEditFromClient (ClientHasNewTextMetrics [] [" 1","1"]
attributesToUIChange: attributes to set = [height,svgPart,width]
function __Graphics_Scalable_Internal_Image$60_getImgAtNodePath(__img_0,___x_1)
{
var ys=___x_1;
switch(ys[0]){
case 1:
return [1,__Data_Maybe_Just$n,__img_0];
case 0:
var ___x_1_0_1=ys[2],__p_1_1_1=ys[3];
var ys=Sapl.feval(___x_1_0_1);
switch(ys[0]){
case 0:
var __i_2_0_2=ys[2];
var __imgs_3_0_3=__Graphics_Scalable_Internal_Image$60_imgChildNodes(__img_0);
if (((__i_2_0_2 < 0)
? true
: (! (__i_2_0_2 < __StdList_length_47(__imgs_3_0_3)))))
{
return __StdDebug_trace_n_6(("getImgAtNodePath [ViaChild " + ((__i_2_0_2 + "") + ":p] illegal index")),__Data_Maybe_Nothing);
} else{
var __img$60_5_0_4=__StdList_$21$21(__imgs_3_0_3,__i_2_0_2);
return __StdDebug_trace_n_6((
"getImgAtNodePath [ViaChild " + ((__i_2_0_2 + "") + ":p] legal index")),[__Graphics_Scalable_Internal_Image$60_getImgAtNodePath$eval,[__img$60_5_0_4,__p_1_1_1]]);;};case 1: var __nothing_3_0_3=__Graphics_Scalable_Internal_Image$60_imgHostNode(__img_0);
return __Graphics_Scalable_Internal_Image$60__c$3B89$3B7_782(__nothing_3_0_3,__p_1_1_1);;case 2: var __nothing_3_0_3=__Graphics_Scalable_Internal_Image$60_imgAttrNode(__img_0);
return __Graphics_Scalable_Internal_Image$60__c$3B93$3B7_783(__nothing_3_0_3,__p_1_1_1);;};};};
\ No newline at end of file
definition module iTasks.Extensions.SVG.SVGEditor
import Graphics.Scalable.Internal.Image`
from iTasks.UI.Editor import :: Editor
import Graphics.Scalable.Image
from iTasks.UI.Editor import :: Editor
import iTasks.UI.JS.Encoding
// An SVGEditor let's you specify an editor as an interactive SVG image (Graphics.Scalable.Image)
:: SVGEditor m v =
{ initView :: m -> v // Initialize a 'view' value that holds temporary data while editing
, renderImage :: m v *TagSource -> Image` v // Render an interactive image that
, updModel :: m v -> m // When the view is updated (using the image), the change needs to be merged back into the view
{ initView :: m -> v // Generate the view value from the current model value
, renderImage :: m v *TagSource -> Image v // Render an interactive image from the current model and view value
, updModel :: m v -> m // When the view is updated (using the interactive image), update the model
}
fromSVGEditor :: (SVGEditor s v) -> Editor s
| gEq{|*|}, JSONEncode{|*|}, JSONDecode{|*|}, JSEncode{|*|}, JSDecode{|*|} s
fromSVGEditor :: !(SVGEditor s v) -> Editor s | gEq{|*|}, gText{|*|}, JSONEncode{|*|}, JSONDecode{|*|}, JSEncode{|*|}, JSDecode{|*|} s
......@@ -47,37 +47,10 @@ TonicBlack =: toSVGColor "#000000" // "black"
TonicRed =: toSVGColor "#ff4500" // "OrangeRed"
TonicGrey =: toSVGColor "#dcdcdc" // "Gainsboro"
ArialRegular10px :== { fontfamily = "Arial"
, fontysize = 10.0
, fontstretch = "normal"
, fontstyle = "normal"
, fontvariant = "normal"
, fontweight = "normal"
}
ArialBold6px :== { fontfamily = "Arial"
, fontysize = 6.0
, fontstretch = "normal"
, fontstyle = "normal"
, fontvariant = "normal"
, fontweight = "bold"
}
ArialBold10px :== { fontfamily = "Arial"
, fontysize = 10.0
, fontstretch = "normal"
, fontstyle = "normal"
, fontvariant = "normal"
, fontweight = "bold"
}
ArialItalic10px :== { fontfamily = "Arial"
, fontysize = 10.0
, fontstretch = "normal"
, fontstyle = "italic"
, fontvariant = "normal"
, fontweight = "normal"
}
ArialRegular10px :== normalFontDef "Arial" 10.0
ArialBold6px :== normalFontDef "Arial" 6.0
ArialBold10px :== setfontweight "bold" (normalFontDef "Arial" 10.0)
ArialItalic10px :== setfontstyle "italic" (normalFontDef "Arial" 10.0)
:: InhMkImg i =
{ inh_bpinst :: !Maybe i
......@@ -310,7 +283,7 @@ tFApp inh eid fn args assoc tsrc
, tsrc)
| otherwise
#! pp = ppTExpr (TFApp eid fn args assoc)
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (ArialRegular10px.fontysize + 10.0)) <@< { dash = [5, 5] }
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (getfontysize ArialRegular10px + 10.0)) <@< { dash = [5, 5] }
#! img = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text ArialRegular10px pp] NoHost
= ( { syn_img = img
, syn_status = TNotActive
......@@ -358,7 +331,7 @@ tPPExpr inh pp tsrc
}
, tsrc)
| otherwise
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (ArialRegular10px.fontysize + 10.0)) <@< { dash = [5, 5] }
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (getfontysize ArialRegular10px + 10.0)) <@< { dash = [5, 5] }
#! img = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text ArialRegular10px pp] NoHost
= ( { syn_img = img
, syn_status = TNotActive
......@@ -387,7 +360,7 @@ tVar inh eid pp ptr tsrc
}
, tsrc)
| otherwise
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (ArialRegular10px.fontysize + 10.0)) <@< { dash = [5, 5] }
#! box = tRoundedRect (textxspan ArialRegular10px pp + px 10.0) (px (getfontysize ArialRegular10px + 10.0)) <@< { dash = [5, 5] }
#! img = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, txtImg] NoHost
= ( { syn_img = img
, syn_status = TNotActive
......@@ -1206,7 +1179,7 @@ someActivity _ = False
tTextWithGreyBackground :: !FontDef !String -> Image ModelTy
tTextWithGreyBackground font txt
#! textWidth = textxspan font txt + px 10.0
= overlay (repeat (AtMiddleX, AtMiddleY)) [] [rect textWidth (px (font.fontysize + 10.0)) <@< {fill = toSVGColor "#ebebeb"} <@< {strokewidth = px 0.0}, text font txt] NoHost
= overlay (repeat (AtMiddleX, AtMiddleY)) [] [rect textWidth (px (getfontysize font + 10.0)) <@< {fill = toSVGColor "#ebebeb"} <@< {strokewidth = px 0.0}, text font txt] NoHost
littleman :: Image a
littleman
......
......@@ -12,7 +12,6 @@ import Data.Error
from Data.IntMap.Strict import :: IntMap
import iTasks.Internal.Tonic.Blueprints
import iTasks.Extensions.Admin.TonicAdmin
import iTasks.Extensions.SVG.SVGEditor
import iTasks.UI.JS.Encoding
import iTasks.Extensions.DateTime
import iTasks.Internal.Tonic.AbsSyn
......
......@@ -156,4 +156,3 @@ withClientSideInit ::
!(UIAttributes DataPath a *VSt -> *(!MaybeErrorString (!UI, !st), !*VSt))
!UIAttributes !DataPath !a !*VSt ->
*(!MaybeErrorString (!UI, !st), !*VSt)
implementation module iTasks.UI.Editor
import StdBool, StdMisc, StdList, StdTuple
import StdArray, StdBool, StdMisc, StdList, StdTuple
import iTasks.Internal.Client.LinkerSupport, Data.Maybe, Data.Functor, Data.Tuple, Data.Func, Data.Error
import iTasks.Internal.IWorld
import iTasks.UI.Definition, iTasks.WF.Definition, iTasks.UI.JS.Encoding
......@@ -146,19 +146,24 @@ isCompound (LeafState _) = False
isCompound (AnnotatedState _ childSt) = isCompound childSt
isCompound (CompoundState _ _) = True
import StdDebug
withClientSideInit ::
!((JSObj ()) *JSWorld -> *JSWorld)
!(UIAttributes DataPath a *VSt -> *(!MaybeErrorString (!UI, !st), !*VSt))
!UIAttributes !DataPath !a !*VSt -> *(!MaybeErrorString (!UI, !st), !*VSt)
withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) = case editorLinker initUI iworld of
withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case trace_n ("withClientSideInit genUI of task " +++ taskId +++ " started") (genUI attr dp val vst) of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) = case trace_n ("withClientSideInit editorLinker of task " +++ taskId +++ " started") (editorLinker initUI iworld) of
(Ok (saplDeps, saplInit),iworld)
# extraAttr = 'DM'.fromList [("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("saplDeps",JSONString saplDeps)
,("saplInit",JSONString saplInit)
]
= (Ok (UI type ('DM'.union extraAttr attr) items,mask), {VSt|vst & iworld = iworld})
= trace_n ("withClientSideInit editorLinker succeeded [size saplDeps = " +++ toString (size saplDeps) +++ "; size saplInit = " +++ toString (size saplInit))
(Ok (UI type ('DM'.union extraAttr attr) items,mask), {VSt|vst & iworld = iworld})
(Error e,iworld)
= (Error e, {VSt|vst & iworld = iworld})
(Error e,vst) = (Error e,vst)
= trace_n ("withClientSideInit editorLinker failed with Error " +++ toString e)
(Error e, {VSt|vst & iworld = iworld})
(Error e,vst) = trace_n ("withClientSideInit genUI failed with Error " +++ toString e)
(Error e,vst)
......@@ -42,7 +42,7 @@ tabset2 :: !(Editor a) !(Editor b) -> Editor (a,b)
tabset3 :: !(Editor a) !(Editor b) !(Editor c) -> Editor (a,b,c)
tabset4 :: !(Editor a) !(Editor b) !(Editor c) !(Editor d) -> Editor (a,b,c,d)
tabset5 :: !(Editor a) !(Editor b) !(Editor c) !(Editor d) !(Editor e) -> Editor (a,b,c,d,e)
tabsetc :: !(Editor Int) ![((Maybe a) -> a, Editor a)] -> Editor (Int, a)
tabsetc :: !(Editor Int) ![((Maybe a) -> a, Editor a)] -> Editor (Int,a)
//# UIWindow
window :: Editor ()
......@@ -53,7 +53,7 @@ window2 :: !(Editor a) !(Editor b) -> Editor (a,b)
window3 :: !(Editor a) !(Editor b) !(Editor c) -> Editor (a,b,c)
window4 :: !(Editor a) !(Editor b) !(Editor c) !(Editor d) -> Editor (a,b,c,d)