Commit 1b66842d authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into simplified-interaction-api

parents c25db9d5 17af588b
Pipeline #28171 failed with stage
in 1 minute and 12 seconds
......@@ -25,6 +25,8 @@ import Incidone.Extensions.CrewLists
derive class iTask CommunicationAttempt
derive class iTask ActionPlan
derive gDefault ActionStatus, ItemMeta, ActionProgress
actionStatuses :: SDSLens () [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatuses = mapRead (map toActionStatus) detachedTaskInstances
......
......@@ -7,6 +7,8 @@ import Text, Text.HTML, Data.List, iTasks.Internal.HtmlUtil
derive class iTask WallContent
derive gDefault ContactMap, ContactMapLayer, ContactMapLayerDefinition, ContactMapMarker, ContactMapRegion, ContactTrack, ContactMapMarkerType, DateTime
wallContent :: SimpleSDSLens WallContent
wallContent = sharedStore "WallContent" (WallOverview defaultValue)
......
......@@ -7,6 +7,8 @@ import Incidone.Util.TaskPatterns
import qualified Data.Map as DM
import Data.Functor
derive gDefault AISContact, DateTime, ContactTrack, Degrees, AIVDM5, AIVDMCNB
syncAISStream :: Task ()
syncAISStream = withShared ([],False,[],False) (\channel -> (sync channel -&&- consume channel) @! ())
where
......
......@@ -21,5 +21,4 @@ derive JSONEncode Temperature, Meters, Feet, Miles, Knots, Degrees, Contac
derive JSONDecode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gText Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEditor Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gDefault Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEq Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
......@@ -29,6 +29,4 @@ gText{|IncidentShort|} _ i = [maybe "" incidentTitle i]
derive JSONEncode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive JSONDecode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEditor Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gDefault Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEq Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
......@@ -13,6 +13,8 @@ import Data.Map.GenJSON
import Text, Text.HTML, Data.Either, Data.Functor
import iTasks.UI.Editor.Controls
derive gDefault Contact, ContactMap, ContactStatus, ContactAccessLevel, Credentials, ContactPhoto, ContactTrack, ContactType, Degrees, Document, ContactMapLayer, DateTime, ContactMapLayerDefinition, ContactMapMarker, ContactMapRegion, ContactMapMarkerType
CONVERT_BIN :== "/opt/local/bin/convert"
//CONVERT_BIN :== "/usr/bin/convert"
......
......@@ -4,6 +4,9 @@ import Incidone.OP.Concepts
import Text, Text.HTML
import iTasks.Extensions.DateTime
derive gDefault ContactGeo, CommunicationMean, NewCommunicationMean, ContactStatus, ContactAccessLevel, Credentials, ContactPhoto, ContactTrack, ContactType
derive gDefault DateTime, Contact, Degrees, CommunicationMeanType, Document
class contactTitle a :: a -> String
instance contactTitle Contact
where
......
......@@ -5,6 +5,8 @@ import Incidone.OP.IncidentManagementTasks
import Incidone.OP.ContactManagementTasks
import Incidone.OP.CommunicationManagementTasks
derive gDefault NewContact, IncidentShort, ContactType
generateTestIncident :: Bool -> Task IncidentNo
generateTestIncident closed
= randomChoice [YachtEngineProblems,YachtAground,Medevac]
......
......@@ -9,6 +9,7 @@ import Incidone.Util.SQLSDS
import Data.Functor, Data.Either, Data.Tuple, Data.Func
derive class iTask ContactFilter
derive gDefault PhoneCall, RadioCall, EmailMessage, P2000Message, WeatherData, PersonDetails, VesselDetails, SurferDetails, DiverDetails, AirplaneDetails, HelicopterDetails, CommunicationMean, WeatherType, Gender, VesselType, CommunicationMeanType, Feet, Knots, Meters, Temperature, Degrees, Miles
dbReadSDS :: String -> SDSSequence QueryDef [r] () | mbFromSQL r & TC r
dbReadSDS notifyId = databaseDef >++> sqlReadSDS notifyId
......
......@@ -22,6 +22,7 @@ import Text.HTML
| IncorrectDatabaseTables
derive class iTask DatabaseProblem
derive gDefault ContactMap, ContactMapLayer, ContactMapLayerDefinition, ContactMapMarker, ContactMapRegion, ContactTrack, ContactMapMarkerType, DateTime
configureIncidone :: [Workspace -> Task ()]
configureIncidone = map const [configureDatabase <<@ (Title "Database")
......
......@@ -23,9 +23,7 @@
<!-- load iTasks viewport -->
<script type="text/javascript">
window.onload = function() {
ABC.loading_promise.finally(function(){
itasks.viewport({syncTitle: true}, document.body);
});
itasks.viewport({syncTitle: true}, document.body);
};
</script>
</head>
......
......@@ -149,8 +149,8 @@ editDeviceToDevice dev
:: EditDeviceType =
{ kind :: !DeviceKind
, requires :: ![(!CableType, !Capacity)]
, produces :: ![(!CableType, !Capacity)]
, requires :: ![(CableType, Capacity)]
, produces :: ![(CableType, Capacity)]
}
:: EditDevice =
......
......@@ -64,9 +64,9 @@ from C2.Apps.ShipAdventure.Images import :: RenderMode
// physical devices
:: Network =
{ devices :: !Map Coord3D [DeviceId] // [Coord3D |-> DeviceIds]
, cables :: !IntMap Cable // [CableId |-> Cable]
, cableMapping :: !IntMap [(!Operational, !Coord3D)] // [CableId |-> Coord3Ds]
{ devices :: !Map Coord3D [DeviceId] // [Coord3D |-> DeviceIds]
, cables :: !IntMap Cable // [CableId |-> Cable]
, cableMapping :: !IntMap [(Operational, Coord3D)] // [CableId |-> Coord3Ds]
}
:: Device =
{ description :: !String
......@@ -95,8 +95,8 @@ from C2.Apps.ShipAdventure.Images import :: RenderMode
:: PPDeviceType =
{ kind :: !DeviceKind
, requires :: ![(!CableType, !Capacity)]
, produces :: ![(!CableType, !Capacity)]
, requires :: ![(CableType, Capacity)]
, produces :: ![(CableType, Capacity)]
}
:: CommandAim =
......@@ -169,8 +169,8 @@ cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesForSection :: !Coord3D !Network -> [Cable]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allActiveAlarms :: SDSLens () [(Coord3D, SectionStatus)] ()
allAvailableActors :: SDSLens () [(Coord3D, MyActor)] ()
// setting and resetting of the detection systems:
......@@ -203,7 +203,7 @@ allImperiledCommandAims :: !(IntMap Device) !CapabilityToDeviceKindMap ![Command
deviceIsDisabledInSection :: !Coord3D !Device !(IntMap Device) !Network -> Bool
isOperational :: !CableId !(IntMap [(!Operational, !Coord3D)]) -> Bool
isOperational :: !CableId !(IntMap [(Operational, Coord3D)]) -> Bool
devicesForCable :: !Cable !(IntMap Device) !Network -> [Device]
......
......@@ -224,7 +224,7 @@ toPPDeviceType { DeviceType | kind, requires, produces } = { PPDeviceType
, produces = 'DM'.toList produces
}
isOperational :: !CableId !(IntMap [(!Operational, !Coord3D)]) -> Bool
isOperational :: !CableId !(IntMap [(Operational, Coord3D)]) -> Bool
isOperational cableId cableMapping = and [b \\ (b, _) <- fromMaybe [] ('DIS'.get cableId cableMapping)]
smokeDetector :: DeviceType
......@@ -383,22 +383,22 @@ patchCable roomNo cableId network = { network & cableMapping = 'DIS'.alter (fmap
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
inventoryInSectionShare = mapLens "inventoryInSectionShare" myInventoryMap (Just 'DIS'.newMap)
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allAvailableActors :: SDSLens () [(Coord3D, MyActor)] ()
allAvailableActors
= /*toReadOnly */ (sdsProject (SDSLensRead readActors) (SDSBlindWrite \_. Ok Nothing) Nothing (sectionUsersShare |*| myUserActorMap))
where
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(!Coord3D, !MyActor)]
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(Coord3D, MyActor)]
readActors (sectionUsersMap, userActorMap)
= Ok [(c3d, a) \\ us <- 'DM'.elems sectionUsersMap
, u <- us
, Just (c3d, a) <- [findUser u sectionUsersMap userActorMap]
| a.actorStatus.occupied === Available]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allActiveAlarms :: SDSLens () [(Coord3D, SectionStatus)] ()
allActiveAlarms
= /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) (SDSBlindWrite \_. Ok Nothing) Nothing myStatusMap)
where
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(!Coord3D, !SectionStatus)]
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(Coord3D, SectionStatus)]
readAlarms statusMap = Ok [ (number, status) \\ (number, status) <- 'DM'.toList statusMap
| isHigh status]
......
......@@ -29,7 +29,7 @@ import Data.GenLexOrd
:: MapID :== String // identification of one map
:: Border = Open | Door | Wall
:: Size2D :== (!Real, !Real) // width and height
:: Shape2D :== [(!Real, !Real)] // outline in terms of Map2D.size coordinates (origin at left-top, max at right-bottom)
:: Shape2D :== [(Real, Real)] // outline in terms of Map2D.size coordinates (origin at left-top, max at right-bottom)
:: Maps2DIndex :== Int // index in Maps2D (0..length Maps2D-1)
:: Coord2D = { col :: !Int // x-coordinate (0.., identifies column)
, row :: !Int // y-coordinate (0.., identifies row)
......@@ -37,7 +37,7 @@ import Data.GenLexOrd
:: Coord3D :== (!Maps2DIndex, !Coord2D) // (index in Maps2D, {col,row} in map)
:: Dir = N | E | W | S // north, east, west, south
:: Graph :== Map Coord3D [(!Maybe Dir, !Coord3D)]
:: Graph :== Map Coord3D [(Maybe Dir, Coord3D)]
/********************************************************************************************************************
*
......@@ -145,7 +145,7 @@ moveAround :: !(DrawMapForActor r o a) !User
// finds all actors currently walking on the map, find all objects in the map
findAllObjects :: !(SectionInventoryMap o) -> [(!Coord3D, !Object o)] | iTask o
findAllObjects :: !(SectionInventoryMap o) -> [(Coord3D, Object o)] | iTask o
findUser :: !User !SectionUsersMap !(UserActorMap o a) -> Maybe (!Coord3D, !Actor o a) | iTask o & iTask a
// update the status of an actor, unique username is used as identification
......
......@@ -132,7 +132,7 @@ colToGraph floorIdx rowIdx (graph, colIdx) section
#! graph = 'DM'.put (floorIdx, currCoord2D) (getCoord3Ds section floorIdx currCoord2D section.borders) graph
= (graph, colIdx + 1)
getCoord3Ds :: !Section !Int !Coord2D !Borders -> [(!Maybe Dir, !Coord3D)]
getCoord3Ds :: !Section !Int !Coord2D !Borders -> [(Maybe Dir, Coord3D)]
getCoord3Ds section floorIdx currCoord2D borders
#! acc = []
#! acc = addOnOpening floorIdx borders.n N currCoord2D acc
......@@ -142,7 +142,7 @@ getCoord3Ds section floorIdx currCoord2D borders
#! acc = acc ++ map (\h -> (Nothing, h)) section.hops
= acc
where
addOnOpening :: !Int !Border !Dir !Coord2D ![(!Maybe Dir, !Coord3D)] -> [(!Maybe Dir, !Coord3D)]
addOnOpening :: !Int !Border !Dir !Coord2D ![(Maybe Dir, Coord3D)] -> [(Maybe Dir, Coord3D)]
addOnOpening _ Wall _ _ acc = acc
addOnOpening floorIdx b dir coord2D acc = [(Just dir, (floorIdx, twin dir coord2D)) : acc]
......@@ -684,7 +684,7 @@ doorIsLocked roomNo exit lockMap
// utility functions to find things located in the map
findAllObjects :: !(SectionInventoryMap o) -> [(!Coord3D, !Object o)] | iTask o
findAllObjects :: !(SectionInventoryMap o) -> [(Coord3D, Object o)] | iTask o
findAllObjects objectMap = [ (roomNo, object)
\\ (roomNo, objects) <- 'DM'.toList objectMap
, object <- 'DIS'.elems objects
......
......@@ -9,6 +9,8 @@ import System.Directory, System.FilePath
import Cadastre.SDS, ChamberOfCommerce.SDS, Compensation.SDS, CivilAffairs.SDS
import StdArray, StdFile
derive gDefault Date
batchProcessing :: Task ()
batchProcessing
= pay
......
......@@ -23,7 +23,7 @@ filterDirs _ = True
seq [] = tuple (Ok [])
seq [e:es] = e >>= \a->seq es >>= \as->tuple (Ok [a:as])
recurse :: FilePath -> .(*World -> *(MaybeError OSError [FilePath], !*World))
recurse :: FilePath -> .(*World -> *(MaybeError OSError [FilePath], *World))
recurse root
| endsWith ".dcl" root = tuple (Ok [root])
= getFileInfo root >>= \fi->if fi.directory
......
......@@ -6,14 +6,15 @@ import iTasks.UI.Definition
import StdFunctions, Data.List, Text.HTML
playWithMaps :: Task ()
playWithMaps = withShared ({defaultValue & icons = shipIcons, tilesUrls = ["/tiles/{z}/{x}/{y}.png"]},defaultValue) (\m ->
playWithMaps = withShared ({defaultValue & icons = shipIcons},defaultValue) (\m ->
((allTasks [managePerspective m, manageState m, manageMapObjects m]) <<@ ScrollContent)
-&&-
manipulateMap m
) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
derive gDefault LeafletSimpleState, LeafletObjectID
manipulateMap :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation [UpdateSharedUsing id (flip const) const (customLeafletEditor eventHandlers)] m
manipulateMap m = updateSharedInformation [UpdateSharedUsing id (flip const) const (customLeafletEditor eventHandlers defaultValue)] m
<<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! ()
where
eventHandlers = {simpleStateEventHandlers & onHtmlEvent = onHtmlEvent}
......
......@@ -10,23 +10,26 @@ import Trax.UoD
:: RenderMode = ViewMode | PlayMode
updateTraxEditor :: Bool -> UpdateSharedOption TraxSt TraxSt
updateTraxEditor turn = UpdateSharedUsing id (const id) const (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updModel = flip const
})
updateTraxEditor turn = UpdateSharedUsing id (const id) const (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updModel = flip const
})
viewTraxEditor :: ViewOption TraxSt
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode False
, updModel = flip const
})
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode False
, updModel = flip const
})
whiteColor = toSVGColor "white"
redColor = toSVGColor "red"
freeTileColor = toSVGColor "lightgrey"
transparentColor = toSVGColor "none"
whiteColor = toSVGColor "white"
redColor = toSVGColor "red"
freeTileColor = toSVGColor "lightgrey"
transparentColor = toSVGColor "none"
font = normalFontDef "Arial" 14.0
tileSize = px 50.0
toImage :: RenderMode Bool TraxSt *TagSource -> Image TraxSt
toImage ViewMode _ st _
......@@ -34,65 +37,67 @@ toImage ViewMode _ st _
toImage PlayMode my_turn st=:{turn} _
= above (repeat AtMiddleX) [] Nothing [] [text font message, board it_is_my_turn tileSize st] NoHost
where
it_is_my_turn = my_turn == turn
message = if it_is_my_turn "Select a tile" "Wait for other player..."
it_is_my_turn = my_turn == turn
message = if it_is_my_turn "Select a tile" "Wait for other player..."
board :: Bool Span TraxSt -> Image TraxSt
board it_is_my_turn d st=:{trax}
| no_of_tiles trax == zero
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise = voidImage d
| otherwise = grid (Rows (maxy - miny + 3)) (RowMajor, LeftToRight, TopToBottom) (repeat (AtMiddleX,AtMiddleY)) [] [] []
[ case tile_at trax coord of
Nothing = if (it_is_my_turn && 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
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise = voidImage d
| otherwise = grid (Rows (maxy - miny + 3)) (RowMajor, LeftToRight, TopToBottom) (repeat (AtMiddleX,AtMiddleY)) [] [] []
[ case tile_at trax coord of
Nothing = if (it_is_my_turn && 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
((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
voidImage d = empty d d
illegalImage :: Span -> Image a
illegalImage d = tileShape d <@< {fill = transparentColor}
unselectedImage :: Span -> Image a
unselectedImage d = tileShape d <@< {fill = freeTileColor}
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 = settile coord tile, local = False} \\ tile <- candidates]
(Host unselected)
| isEmpty candidates = illegalImage d
| maybe True ((<>) coord) choice = unselectedImage d <@< {onclick = setcell coord, local = False}
| otherwise = above (repeat AtMiddleX) [] (Just d) []
[tileImage (d /. no_of_candidates) tile <@< {onclick = settile coord tile, local = False} \\ tile <- candidates]
(Host (unselectedImage d))
where
candidates = possible_tiles (linecolors trax coord)
nr_of_candidates = length candidates
unselected = tileShape d <@< {fill = freeTileColor} <@< {onclick = setcell coord, local = False}
candidates = [tile \\ tile <- possible_tiles trax coord | isJust (mandatory_moves (add_tile coord tile trax) coord)]
no_of_candidates = length candidates
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)
])
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}
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
tileShape d = square d <@< {xradius = d /. 10} <@< {yradius = d /. 10}
......@@ -18,7 +18,6 @@ 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
......@@ -74,13 +73,11 @@ col :: !Coordinate -> Int
*/
row :: !Coordinate -> Int
:: Trax
derive gEditor Trax
derive gText Trax
derive JSONEncode Trax
derive JSONDecode Trax
derive gDefault Trax
derive gEq Trax
instance == Trax
instance zero Trax
......@@ -140,10 +137,10 @@ free_coordinates :: !Trax -> [Coordinate]
*/
linecolors :: !Trax !Coordinate -> LineColors
/** possible_tiles @colors = @trax:
returns those @trax that match with @colors.
/** possible_tiles @trax @coordinate = @tiles:
returns those @tiles that constitute a legal move in @trax at @coordinate.
*/
possible_tiles :: !LineColors -> [TraxTile]
possible_tiles :: !Trax !Coordinate -> [TraxTile]
:: Line
......@@ -171,13 +168,6 @@ loops :: !Trax -> [(LineColor,Line)]
*/
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
......@@ -185,6 +175,16 @@ mandatory_moves :: !Trax !Coordinate -> Trax
, choice :: !Maybe Coordinate
}
/** mandatory_moves @trax @coordinate = Just @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, resulting in @trax`.
mandatory_moves @trax @coordinate = Nothing:
at least one mandatory move occurred that resulted in an illegal configuration:
an empty tile with three or four of the same line colors.
*/
mandatory_moves :: !Trax !Coordinate -> Maybe Trax
/** 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.
......
......@@ -20,7 +20,6 @@ derive gEditor TraxTile
derive gText TraxTile
derive JSONEncode TraxTile
derive JSONDecode TraxTile
derive gDefault TraxTile
gFDomain{|TraxTile|} = map fromTuple [(West,East),(North,South),(North,West),(North,East),(South,East),(South,West)]
instance fromTuple TileEdge TileEdge TraxTile where fromTuple (e1,e2) = {end1 = e1, end2 = e2}
instance toTuple TileEdge TileEdge TraxTile where toTuple tile = (tile.end1, tile.end2)
......@@ -57,22 +56,22 @@ other_edge :: !TraxTile !TileEdge -> TileEdge
other_edge tile edge = if (edge == tile.end1) tile.end2 tile.end1
instance ~ TraxTile where ~ tile = lookup1 tile [(horizontal,vertical )
,(vertical, horizontal)
,(northwest, southeast )