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

For easy testing of trax, no setting up user community, just go ahead and click in trax

parent d5ddcd45
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.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment