Commit 136bdfbc authored by Mart Lubbers's avatar Mart Lubbers

Merge branch 'master' of gitlab.science.ru.nl:clean-and-itasks/iTasks-SDK into parametrize-clock

Moreover, implement the clock and add a default timeout
parents 6b613f46 3584cff6
**/Clean System Files
Examples/**/*-data
Examples/**/*-sapl
Examples/**/*-www
Examples/**/*.prj
Examples/**/*.exe
Tests/**/*-data
Tests/**/*-sapl
Tests/**/*-www
Tests/**/*.prj
Tests/**/*.exe
Tools/**/*-data
Tools/**/*-sapl
Tools/**/*-www
Tools/**/*.prj
Tools/**/*.exe
**/.sass-cache
*-data
*-sapl
*-www
*.prj
*.prp
*.prp
Examples/Graphics/BasicImagesExamples/out.txt
Examples/Graphics/BasicImagesExamples/out2.txt
Examples/Graphics/BasicImagesExamples/Test.icl
Examples/Graphics/BasicImagesExamples/Test.prp
*.exe
.sass-cache
......@@ -11,7 +11,7 @@ Version: 1.0
Path: {Application}/lib/Sapl
Path: {Application}/lib/GraphCopy
Path: {Application}/lib/iTasks
EnvironmentCompiler: lib/exe/cocl:-dynamics -sapl
EnvironmentCompiler: lib/exe/cocl::-dynamics -sapl
EnvironmentCodeGen: lib/exe/cg
EnvironmentLinker: lib/exe/linker|lib/exe/sapl-collector-linker|lib/exe/itasks-web-collector
EnvironmentDynLink: lib/exe/linker
......
definition module C2.Apps.ShipAdventure.Types
import C2.Framework.MapEnvironment
import Data.Generics.GenLexOrd
import Data.GenLexOrd
from C2.Apps.ShipAdventure.Images import :: RenderMode
:: MyActor :== Actor ObjectType ActorStatus
......
......@@ -7,7 +7,7 @@ import iTasks.Extensions.Admin.TonicAdmin
from Data.IntMap.Strict import :: IntMap
import qualified Data.Map as DM
from Data.Map import :: Map
import Data.Generics.GenLexOrd
import Data.GenLexOrd
:: Maps2D :== [Map2D] // enumerate sub-maps, order is assumed `lowest' to `highest', mapID identifies map
......
......@@ -13,7 +13,7 @@ import qualified Data.IntMap.Strict as DIS
from Data.IntMap.Strict import :: IntMap
import qualified Data.Heap as DH
from Data.Heap import :: Heap
import Data.Generics.GenLexOrd
import Data.GenLexOrd
from C2.Framework.Logging import addLog
import Data.List
import Data.Eq
......
......@@ -23,6 +23,8 @@ Global
MemoryMinimumHeapSize: 0
Time: False
Stack: False
Dynamics: True
DescExL: False
Output
Output: ShowConstructors
Font: Courier
......
This diff is collapsed.
......@@ -2,7 +2,7 @@ implementation module Ligretto.UI
import StdBool, StdEnum, StdList
from StdFunc import id, const
import Data.Generics.GenEq
import Data.GenEq
import iTasks.UI.JS.Encoding
import iTasks.WF.Tasks.Interaction
import ScalableExts.Scalable
......
......@@ -5,7 +5,7 @@ import Data.Maybe // for the Maybe type
import Math.Random // for generating random numbers
import iTasks.WF.Definition // for the iTask infrastructure
import iTasks.Extensions.User // for the User data type
import Data.Generics.GenEq
import Data.GenEq
from iTasks.Internal.Generic.Visualization import <+++ // <+++ shouldn't be imported from here
// Make iTask infrastructure available for Ligretto model data types:
......
implementation module Ligretto.UoD
import StdBool, StdInt, StdList, StdMisc, StdOrdList, StdString, StdTuple
import Data.Maybe // for the Maybe type
import Math.Random // for generating random numbers
import iTasks.WF.Definition // for the iTask infrastructure
import iTasks.Extensions.User // for the User data type
import GenEq
from iTasks.Internal.Generic.Visualization import <+++ // <+++ shouldn't be imported from here
// Make iTask infrastructure available for Ligretto model data types:
derive class iTask GameSt, Player, Color, Hand, Card, SideUp
init_gameSt :: ![(Color,User)] [Int] -> GameSt
init_gameSt us rs
= { middle = repeatn (4*length us) []
, players = [ initial_player (length us) c (toString u) (abs r)
\\ (c,u) <- us
& r <- rs
]
}
play_concealed_pile :: !Color !GameSt -> GameSt
play_concealed_pile color gameSt
= set_player player` gameSt
where
player = get_player color gameSt
player` = case player.hand.conceal of
[] = shuffle_hand player
_ = swap_discards player
play_hand_card :: !Color !GameSt -> GameSt
play_hand_card color gameSt=:{GameSt | middle}
= case top_discard player of
Nothing
= gameSt
(Just card)
= case matching_piles card middle of
[] = gameSt
[(pileno, pile):_] = let player` = remove_top_of_discard player
middle` = updateAt pileno [card:pile] middle
in set_player player` {GameSt | gameSt & middle = middle`}
where
player = get_player color gameSt
play_row_card :: !Color !Int !GameSt -> GameSt
play_row_card color cardno gameSt=:{GameSt | middle}
= case matching_piles card middle of
[] = gameSt
[(pileno, pile):_] = let player` = move_ligretto_card_to_row cardno player
middle` = updateAt pileno [card:pile] middle
in set_player player` {GameSt | gameSt & middle = middle`}
where
player = get_player color gameSt
card = row_card cardno player
get_player :: !Color !GameSt -> Player
get_player color gameSt=:{GameSt | players}
= case [player \\ player <- players | player.color === color] of
[player : _] = player
ouch = abort ("Ligretto.UoD.get_player: could not find player with color " <+++ color)
set_player :: !Player !GameSt -> GameSt
set_player player gameSt=:{GameSt | players}
= {GameSt | gameSt & players = [if (p.Player.color === player.Player.color) player p \\ p <- players]}
no_of_cards_in_row :: !NoOfPlayers -> Int
no_of_cards_in_row 2 = 5
no_of_cards_in_row 3 = 4
no_of_cards_in_row 4 = 3
no_of_cards_in_row n = abort ("Ligretto.UoD.no_of_cards_in_row: illegal integer argument (" +++ toString n +++ ").\n")
all_colors :: [Color]
all_colors = [Red,Green,Blue,Yellow]
colors :: !NoOfPlayers -> [Color]
colors no_of_players = take no_of_players all_colors
initial_player_cards :: !NoOfPlayers !Color -> Pile
initial_player_cards no_of_players back
= [{back=back,front=color,no=no} \\ color <- all_colors, no <- [1..10]]
shuffle :: ![a] !Int -> [a]
shuffle xs seed
= fst (unzip (sortBy (\(_,r1) (_,r2) -> (r1 < r2)) (zip2 xs (genRandInt (abs seed + 1)))))
initial_player :: !NoOfPlayers !Color !String !Int -> Player
initial_player no_of_players back name seed
= { color = back, name = name, row = row, ligretto = ligretto, hand = { conceal = hand, discard = [] }, seed = seed }
where
cards = shuffle (initial_player_cards no_of_players back) seed
(row,rest) = splitAt (no_of_cards_in_row no_of_players) cards
(ligretto,hand) = splitAt 10 rest
row_card :: !Int !Player -> Card
row_card row_no player=:{row}
| row_no <= 0 || row_no > length row
= abort ("Ligretto.UoD.row_card: illegal integer argument (" <+++ row_no <+++ ").\n")
| otherwise
= row !! (row_no-1)
move_ligretto_card_to_row :: !Int !Player -> Player
move_ligretto_card_to_row row_no player=:{row,ligretto}
| row_no <= 0 || row_no > length row
= abort ("Ligretto.UoD.move_ligretto_card_to_row: illegal integer argument (" <+++ row_no <+++ ").\n")
| isEmpty ligretto
= abort "Ligretto.UoD.move_ligretto_card_to_row: trying to take card from empty ligretto.\n"
| otherwise
= {player & row = updateAt (row_no-1) (hd ligretto) row, ligretto = tl ligretto}
top_discard :: !Player -> Maybe Card
top_discard {hand={discard}}
| isEmpty discard = Nothing
| otherwise = Just (hd discard)
shuffle_hand :: !Player -> Player
shuffle_hand player=:{hand=hand=:{conceal,discard},seed}
| isEmpty conceal = {player & hand = { hand & conceal = shuffle discard r1
, discard = []
}
, seed = r2
}
| otherwise = abort ("Ligretto.UoD.shuffle_hand: not allowed to shuffle non-empty concealed pile.\n")
where
[r1,r2:_] = genRandInt (abs seed + 1)
remove_top_of_discard :: !Player -> Player
remove_top_of_discard player=:{hand=hand=:{conceal,discard}}
| isEmpty discard = abort ("Ligretto.UoD.remove_top_of_discard: no discarded card to pick.\n")
| otherwise = {player & hand = { hand & discard = tl discard }}
swap_discards :: !Player -> Player
swap_discards player=:{hand=hand=:{conceal,discard}}
| isEmpty conceal = abort ("Ligretto.UoD:swap_discards: not allowed to take cards from an empty conceal pile.\n")
| otherwise = { player & hand = { hand & conceal = rest
, discard = reverse top3 ++ discard
} }
where
(top3,rest) = splitAt 3 conceal
card_matches_top_of_pile :: !Card !Pile -> Bool
card_matches_top_of_pile card pile
| isEmpty pile = card.no == 1
| otherwise = let top_card = hd pile in
card.front === top_card.front && card.no == top_card.no+1
matching_piles :: !Card !Middle -> [(Int,Pile)]
matching_piles card middle
= [(pileno,pile) \\ pile <- middle & pileno <- [0..] | card_matches_top_of_pile card pile]
and_the_winner_is :: !GameSt -> Maybe Player
and_the_winner_is {players}
= case [player \\ player=:{ligretto} <- players | isEmpty ligretto] of
[p : _] = Just p
_ = Nothing
determine_winner :: !GameSt -> Maybe (Color, String)
determine_winner {players}
= case [player \\ player=:{ligretto} <- players | isEmpty ligretto] of
[{color, name} : _] = Just (color, name)
_ = Nothing
This diff is collapsed.
......@@ -5,8 +5,8 @@ from iTasks.Extensions.User import :: User
import PlatformExts.Tuple
from StdClass import class zero, class ~
import Data.Maybe
import Data.Generics.GenFDomain
import Data.Generics.GenEq, Data.Generics.GenLexOrd, Data.Generics.GenMap
import Data.GenFDomain
import Data.GenEq, Data.GenLexOrd, Control.GenMap
derive class iTask TraxSt, /*Coordinate,*/ TileEdge, LineColor
......
definition module Trax.UoD
import iTasks.WF.Definition
from iTasks.Extensions.User import :: User
import PlatformExts.Tuple
from StdClass import class zero, class ~
import Data.Maybe
import GenericExts.GenFDomain
import GenEq, GenLexOrd, GenMap
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 gEditor TraxTile
derive gText TraxTile
derive JSONEncode TraxTile
derive JSONDecode TraxTile
derive gDefault 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 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
:: Coordinate :== (Int,Int) // debugging: use tuple instead of record
/*
:: Coordinate // a coordinate consists of:
= { col :: !Int // a column-coordinate
, row :: !Int // a row-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 // actually, Trax ought to be opaque
= { tiles :: ![(Coordinate,TraxTile)] // tiles that are placed on a certain location
}
derive gEditor Trax
derive gText Trax
derive JSONEncode Trax
derive JSONDecode Trax
derive gDefault Trax
derive gEq 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
/** nr_of_tiles @trax = @nr_of_tiles:
returns the current number of tiles (@nr_of_tiles) in @trax.
*/
nr_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).
*/
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).
*/
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`.
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
, 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
......@@ -7,8 +7,8 @@ import StdMisc
from StdFunc import flip
from Data.List import lookup, deleteFirstsBy, hasDup, qfoldl
import Data.Maybe
import Data.Generics.GenFDomain
import Data.Generics.GenLexOrd, Data.Generics.GenMap, Data.Generics.GenPrint
import Data.GenFDomain
import Data.GenLexOrd, Control.GenMap, Text.GenPrint
import Text
lookup1 x = fromJust o (lookup x)
......
......@@ -4,7 +4,7 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Data.Generics.GenPrint
import Text.GenPrint
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -4,7 +4,7 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Data.Generics.GenPrint // printing via <+++ has a known bug, so we use printToString instead
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
......
This diff is collapsed.
......@@ -4,7 +4,7 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Data.Generics.GenPrint // printing via <+++ has a known bug, so we use printToString instead
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
......
This diff is collapsed.
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
Start :: *World -> *World
Start world
= startEngine [publish "/" (const (viewInformation "Mask" [ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const image
, updView = \m _ = m
, updModel = \_ v = v
})] 0))] world
/** image model tags = image:
@image displays a triangle that is masked with a circle.
*/
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"})}
where
d = px 88.0
m = px 10.0
This diff is collapsed.
......@@ -4,7 +4,7 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Data.Generics.GenPrint // printing via <+++ has a known bug, so we use printToString instead
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
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -4,7 +4,7 @@ import iTasks.Engine
import iTasks.WF.Tasks.Interaction
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Store
import Data.Generics.GenPrint
import Text.GenPrint
import iTasks.UI.Prompt
import Graphics.Scalable.Image
import iTasks.Extensions.SVG.SVGEditor
......
......@@ -34,7 +34,7 @@ import
, iTasks.UI.Editor.Modifiers
// Miscellaneous machinery
, Text.JSON // JSON is used for serializing/deserializing strings
, Text.GenJSON // JSON is used for serializing/deserializing strings
, iTasks.UI.Prompt // Standard for creating prompts
, iTasks.UI.Layout.Common // Standard layout patterns
......