Add C2 demo to Applications examples

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Core.dcl

+definition module C2.Apps.ShipAdventure.Core
+
+import iTasks
+
+myTasks :: [Workflow]
+
+currentUserWalkAround :: Task ()
+
+giveInstructions :: Task ()

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Editor.dcl

+definition module C2.Apps.ShipAdventure.Editor
+
+import iTasks
+import C2.Framework.MapEnvironment
+import C2.Apps.ShipAdventure.Types
+
+shipEditorTabs  :: Task ()
+sharedMapAction :: RWShared () (MapAction SectionStatus) (MapAction SectionStatus)

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Images.dcl

+definition module C2.Apps.ShipAdventure.Images
+
+import C2.Framework.MapEnvironment
+import C2.Apps.ShipAdventure.Types
+
+:: RenderMode
+  = PickRoomMode
+  | KitchenMode
+  | WalkAroundMode
+  | EditMode
+  | DOffMode
+
+derive class iTask RenderMode
+
+:: EditHilite = MapHilite !Maps2DIndex | SectionHilite !Maps2DIndex !Coord2D
+
+mapTitleImage :: !Maps2DIndex !(Maybe EditHilite) !Size2D !String -> Image m
+
+maps2DImage :: !(Set Coord3D) !(MapAction SectionStatus) !RenderMode !Maps2D !SectionExitLockMap !SectionHopLockMap !MySectionInventoryMap !MySectionStatusMap !SectionUsersMap !(UserActorMap ObjectType ActorStatus) !(IntMap Device) !Network !*TagSource
+            -> Image (Maps2D, MapAction SectionStatus)
+
+map2DImage :: !(Set Coord3D) !(MapAction SectionStatus) !RenderMode !SectionExitLockMap !SectionHopLockMap !MySectionInventoryMap !MySectionStatusMap !SectionUsersMap !(UserActorMap ObjectType ActorStatus) !(IntMap Device) !Network !(!Maps2DIndex, !Map2D)
+           -> Image (Maps2D, MapAction SectionStatus)
+
+roomImage :: !Coord3D !SectionExitLockMap !SectionHopLockMap !MyInventory !SectionStatus !MyActors !(IntMap Device) !Network !Bool !Section !Map2D !(MapAction SectionStatus) !*TagSource
+          -> Image (Maps2D, MapAction SectionStatus)
+
+editLayoutImage :: !(MapAction SectionStatus) !(IntMap Device) !Network !MySectionInventoryMap !Maps2DIndex !Map2D
+                -> Image (Maps2D, MapAction SectionStatus)

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/PathFinding.dcl

+definition module C2.Apps.ShipAdventure.PathFinding
+
+import C2.Apps.ShipAdventure.Types
+
+
+// given object to search for, current location and current map
+smartShipPathToClosestObject :: !ObjectType !MySectionInventoryMap !Coord3D !Coord3D !MySectionStatusMap !SectionExitLockMap !SectionHopLockMap !Graph
+                             -> (!Maybe MyObject, !Int, !Distance, !Int, !(!Coord3D, !Distance, !Maybe [Coord3D]))
+
+// given object to search for, current location, target room to move to with object, and current map
+shipShortestPath :: !Coord3D !Coord3D !MySectionStatusMap !SectionExitLockMap !SectionHopLockMap !Graph
+                 -> Maybe (![Coord3D], !Distance)
+
+// shortest path given the alarms set on the ship
+

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/PathFinding.icl

+implementation module C2.Apps.ShipAdventure.PathFinding
+
+import C2.Framework.MapEnvironment
+import C2.Apps.ShipAdventure.Types
+
+// returns: distance, number of objects found, location of object, distance to object, shortest path to obejct
+//shipPathToClosestObject :: Object Coord3D MyMap -> (Int,(Coord3D,Distance, Maybe ([Exit], Distance)))  
+//shipPathToClosestObject kind actorLoc curMap = pathToClosestObject shipShortestPath kind actorLoc curMap
+
+smartShipPathToClosestObject :: !ObjectType !MySectionInventoryMap !Coord3D !Coord3D !MySectionStatusMap !SectionExitLockMap !SectionHopLockMap !Graph
+                             -> (!Maybe MyObject, !Int, !Distance, !Int, !(!Coord3D, !Distance, !Maybe [Coord3D]))
+smartShipPathToClosestObject kind inventoryMap actorLoc targetLoc statusMap exitLocks hopLocks curMap = smartPathToClosestObject shipShortestPath kind actorLoc targetLoc statusMap inventoryMap exitLocks hopLocks curMap
+
+
+// shortest path given the alarms set on the ship
+
+shipShortestPath :: !Coord3D !Coord3D !MySectionStatusMap !SectionExitLockMap !SectionHopLockMap !Graph -> Maybe (![Coord3D], !Distance)
+shipShortestPath startCoord3D endCoord3D statusMap exitLocks hopLocks graph = shortestPath cost startCoord3D endCoord3D statusMap exitLocks hopLocks graph
+  where
+  cost :: !SectionStatus -> Int
+  cost status = 1 + statusCost status
+  statusCost :: !SectionStatus -> Int
+  statusCost HasSomeWater  = 500
+  statusCost IsFlooded     = 1000
+  statusCost HasSmoke      = 400
+  statusCost HasSmallFire  = 500
+  statusCost HasMediumFire = 750
+  statusCost HasBigFire    = 1000
+  statusCost _             = 0
+

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Scripting.dcl

+definition module C2.Apps.ShipAdventure.Scripting
+ 
+import iTasks
+ 
+import C2.Apps.ShipAdventure.Types
+
+
+// script language
+
+
+:: Target		= 	Section Coord3D
+				|	Nearest ObjectType
+				|	TargetSection
+:: Script		=	MoveTo Target
+				|	Take ObjectType
+				|	Drop ObjectType
+				|	Use ObjectType
+				|	ReSetTargetDetector 
+				|	If Condition [Script] [Script]
+:: Condition	=	ObjectInCurrentSection ObjectType
+				|	CarriesObject ObjectType
+				|	ActorStatus ActorStatus
+				|	And Condition Condition
+				|	Or Condition Condition
+
+derive class iTask Target, Script, Condition
+
+handleFireScript 	:: Shared [Script]
+handleFloodScript 	:: Shared [Script]
+handleSmokeScript 	:: Shared [Script]
+
+changeFireScript	:: Task ()
+changeFloodScript 	:: Task ()
+changeSmokeScript 	:: Task ()
+
+interperScript 		:: !(!Coord3D, !SectionStatus) !User ![Script] -> Task Bool
+

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Scripting.icl

+implementation module C2.Apps.ShipAdventure.Scripting
+
+import iTasks
+
+import C2.Apps.ShipAdventure.Types
+import C2.Apps.ShipAdventure.PathFinding
+import C2.Apps.ShipAdventure.Util
+import qualified Data.IntMap.Strict as DIS
+import qualified Data.Map as DM
+
+// scripted simulation
+
+derive class iTask Target, Script, Condition
+
+handleFireScript :: Shared [Script]
+handleFireScript = sharedStore "handleFireScript" []
+
+handleFloodScript :: Shared [Script]
+handleFloodScript = sharedStore "handleFloodScript" []
+
+handleSmokeScript :: Shared [Script]
+handleSmokeScript = sharedStore "handleSmokeScript" []
+
+changeFireScript :: Task ()
+changeFireScript = changeScript "Handling Fire" handleFireScript 
+
+changeFloodScript :: Task ()
+changeFloodScript = changeScript "Handling Flood" handleFloodScript 
+
+changeSmokeScript :: Task ()
+changeSmokeScript = changeScript "Handling Smoke" handleSmokeScript 
+
+changeScript :: !String !(Shared [Script]) -> Task ()
+changeScript prompt script
+  =   viewSharedInformation ("Current Script: " <+++ prompt) [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script
+  >>* [ OnAction (Action "Fine" []) (always (return ()))
+      , OnAction (Action "Change" []) (always (   updateSharedInformation ("Change Script: " <+++ prompt) [] script
+                                              >>| changeScript prompt script
+                                              ))
+      ]
+
+interperScript :: !(!Coord3D, !SectionStatus) !User ![Script] -> Task Bool
+interperScript (targetSection, status) user script
+  =                get (sectionUsersShare |*| myUserActorMap)
+  >>- \(sectionUsersMap, userActorMap) -> case findUser user sectionUsersMap userActorMap of
+                     Just user -> perform script user
+                     _         -> return False
+  where
+  perform :: ![Script] !(!Coord3D, !MyActor) -> Task Bool
+  perform [] _ = return True
+
+  perform [MoveTo target:next] (actorLoc,actor)
+    =   get (myStatusMap |*| myInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| sharedGraph)
+    >>- \((((statusMap, invMap), exitLocks), hopLocks), graph) ->
+          let newLoc = whereIs targetSection target actorLoc statusMap invMap exitLocks hopLocks graph
+          in      autoMove actorLoc newLoc shipShortestPath actor.userName myStatusMap myUserActorMap
+              >>| perform next (newLoc,actor)
+  perform [Take objType`:next] (actorLoc,actor)
+    =              get myInventoryMap
+    >>- \invMap -> case 'DM'.get actorLoc invMap of
+                      Just inv
+                        = case [obj \\ obj=:{Object | objType } <- 'DIS'.elems inv | objType` == objType] of
+                            [obj : _] =   pickupObject actorLoc obj actor.userName myUserActorMap inventoryInSectionShare
+                                      >>| perform next (actorLoc,actor)
+                            _ = perform next (actorLoc, actor)
+                      _ = perform next (actorLoc, actor)
+  perform [Drop objType`:next] (actorLoc,actor)
+      = case [obj \\ obj=:{Object | objType } <- actor.carrying | objType` == objType] of
+          [obj : _]
+            =   dropObject actorLoc obj actor.userName myUserActorMap inventoryInSectionShare
+            >>| perform next (actorLoc,actor)
+          _ = perform next (actorLoc,actor)
+  perform [Use objType`:next] (actorLoc,actor)
+      = case [obj \\ obj=:{Object | objType } <- actor.carrying | objType` == objType] of
+          [obj : _]
+            =   useObject actorLoc obj actor.userName myUserActorMap inventoryInSectionShare
+            >>| perform next (actorLoc,actor)
+          _ = perform next (actorLoc,actor)
+  perform [ReSetTargetDetector:next] (actorLoc,actor)
+    =   setAlarm actor.userName (targetSection, NormalStatus) myStatusMap
+    >>| perform next (actorLoc,actor)
+  perform [If condition script1 script2:next] (actorLoc,actor)
+    =              get myInventoryMap
+    >>= \invMap -> case 'DM'.get actorLoc invMap of
+                     Just inv
+                       | isTrue ('DIS'.elems inv) condition (actorLoc,actor) = perform (script1 ++ next) (actorLoc, actor)
+                     _                                                       = perform (script2 ++ next) (actorLoc, actor)
+  isTrue :: ![MyObject] !Condition !(!Coord3D, !MyActor) -> Bool
+  isTrue inv (ObjectInCurrentSection object) (actorLoc,actor)
+    = objTypeInList object inv
+  isTrue inv (CarriesObject object) (actorLoc,actor)
+  	= isCarrying object actor
+  isTrue inv (ActorStatus status) (actorLoc,actor)
+  	= status === actor.actorStatus
+  isTrue inv (And cond1 cond2) (actorLoc,actor)
+  	= and [isTrue inv cond1 (actorLoc,actor), isTrue inv cond2 (actorLoc,actor)]
+  isTrue inv (Or cond1 cond2) (actorLoc,actor)
+  	= or [isTrue inv cond1 (actorLoc,actor), isTrue inv cond2 (actorLoc,actor)]
+
+  whereIs :: Coord3D !Target Coord3D MySectionStatusMap MySectionInventoryMap SectionExitLockMap SectionHopLockMap Graph -> Coord3D
+  whereIs _ (Section nr) _ _ _ _ _ _                                = nr
+  whereIs targetSection (Nearest object) actorLoc statusMap inventoryMap exitLocks hopLocks graph
+    #! (_,_,_,_,(objectLoc,_,_)) = smartShipPathToClosestObject object inventoryMap actorLoc targetSection statusMap exitLocks hopLocks graph
+    = objectLoc
+  whereIs targetSection TargetSection _ _ _ _ _ _                               = targetSection
+

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Types.dcl

+definition module C2.Apps.ShipAdventure.Types
+ 
+import C2.Framework.MapEnvironment
+import GenLexOrd
+from C2.Apps.ShipAdventure.Images import :: RenderMode
+
+:: MyActor  :== Actor ObjectType ActorStatus
+:: MyObject :== Object ObjectType
+
+:: MySectionStatusMap    :== SectionStatusMap SectionStatus
+:: MySectionInventoryMap :== SectionInventoryMap ObjectType
+
+:: MyInventory :== IntMap (Object ObjectType)
+:: MyActors    :== [Actor ObjectType ActorStatus]
+
+:: MyDrawMapForActor :== DrawMapForActor SectionStatus ObjectType ActorStatus
+
+:: SectionStatus
+  = NormalStatus
+  | HasSomeWater
+  | IsFlooded
+  | HasSmoke
+  | HasSmallFire
+  | HasMediumFire
+  | HasBigFire
+
+:: ObjectType   =   FireExtinguisher
+                |   FireBlanket
+                |   Plug
+
+:: ActorStatus  =   { occupied :: !Availability
+                    , health   :: !ActorHealth
+                    , energy   :: !ActorEnergy
+                    }
+:: Availability =   Available  | NotAvailable | Busy
+:: ActorHealth  =   FullHealth | AScratch | CompletelyWorn
+:: ActorEnergy  =   FullEnergy | SomewhatTired | Fatigued
+
+:: Priority     =   Low | Normal | High | Highest
+
+// logical devices
+
+:: DeviceType =
+  { kind            ::  !DeviceKind
+  , requires        ::  !Map CableType Capacity
+  , produces        ::  !Map CableType Capacity
+  }
+:: DeviceKind       =   Radar
+                    |   Apar
+                    |   Sonar
+                    |   Hydrophone
+                    |   Radio
+                    |   PowerGenerator
+                    |   CoolingPump
+                    |   Gun
+                    |   GasTurbine
+                    |   DieselEngine
+                    |   SmokeDetector
+                    |   HeatSensor
+                    |   WaterSensor
+:: CableType        =   PowerCable | CoolingPipe | DataCable
+:: Capacity         :== Int
+
+// physical devices
+
+:: Network =
+  { devices         ::  !Map Coord3D [DeviceId]            // [Coord3D |-> DeviceIds]
+  , cables          ::  !IntMap Cable                      // [CableId |-> Cable]
+  , cableMapping    ::  !IntMap [(!Operational, !Coord3D)] // [CableId |-> Coord3Ds]
+  }
+:: Device =
+  { description     ::  !String
+  , deviceType      ::  !DeviceType
+  , deviceId        ::  !DeviceId
+  , inCables        ::  ![CableId]
+  , outCables       ::  ![CableId]
+  }
+:: DeviceId         :== Int
+:: CableId          :== Int
+:: Cable =                                                  // Edge
+  { description     :: !String
+  , cableId         :: !CableId
+  , capacity        :: !Capacity
+  , cableType       :: !CableType
+  }
+:: Operational :== Bool
+
+:: PPDevice =
+  { description :: !String
+  , deviceType  :: !PPDeviceType
+  , deviceId    :: !DeviceId
+  , inCables    :: ![CableId]
+  , outCables   :: ![CableId]
+  }
+
+:: PPDeviceType =
+  { kind     :: !DeviceKind
+  , requires :: ![(!CableType, !Capacity)]
+  , produces :: ![(!CableType, !Capacity)]
+  }
+
+:: CommandAim =
+  { aimDescription       :: !String
+  , requiredCapabilities :: ![Capability]
+  }
+
+:: Capability
+  = Propulsion
+  | RadioCommunication
+  | SatelliteCommunication
+  | AirSensors
+  | SurfaceSensors
+  | SubsurfaceSensors
+  | SurfaceToAirOffence
+  | SurfaceToSurfaceOffence
+  | SurfaceToSubsurfaceOffence
+  | AirDefence
+  | SurfaceDefence
+  | SubsurfaceDefence
+
+:: CapabilityExpr
+  = DeviceExpr DeviceKind
+  | CapAndExpr CapabilityExpr CapabilityExpr
+  | CapOrExpr  CapabilityExpr CapabilityExpr
+
+:: CapabilityToDeviceKindMap :== Map Capability CapabilityExpr
+
+derive class iTask PPDevice, PPDeviceType, CommandAim, Capability, CapabilityExpr
+derive gLexOrd CableType, Capability
+derive class iTask ObjectType, ActorStatus, Availability, ActorHealth, ActorEnergy, DeviceType, SectionStatus
+derive class iTask Cable, Priority, Network, Device, CableType, DeviceKind
+
+instance == ObjectType
+instance == Priority
+instance == CableType
+instance == Device
+instance == DeviceType
+instance == DeviceKind
+instance == Capability
+
+instance <  CableType
+instance <  Capability
+
+instance toString ObjectType
+//instance toString Exit
+instance toString SectionStatus
+instance toString Device
+
+// shared stores:
+
+myUserActorMap   :: UserActorShare ObjectType ActorStatus
+myStatusMap      :: RWShared () MySectionStatusMap        MySectionStatusMap
+myInventoryMap   :: RWShared () MySectionInventoryMap     MySectionInventoryMap
+myNetwork        :: RWShared () Network                   Network
+myCables         :: RWShared () (IntMap Cable)            (IntMap Cable)
+myDevices        :: RWShared () (IntMap Device)           (IntMap Device)
+commandAims      :: RWShared () [CommandAim]              [CommandAim]
+capabilityMap    :: RWShared () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
+disabledSections :: RWShared () (Set Coord3D)             (Set Coord3D)
+
+deviceKindsForCapability      :: RWShared Capability CapabilityExpr    CapabilityExpr
+statusInSectionShare          :: RWShared Coord3D    SectionStatus     SectionStatus
+inventoryInSectionShare       :: FocusedSectionInventoryShare ObjectType
+deviceIdInNetworkSectionShare :: RWShared Coord3D    [DeviceId]        [DeviceId]
+devicesInSectionShare         :: RWShared Coord3D    [Device]          [Device]
+deviceWithIdShare             :: RWShared DeviceId   Device            Device
+cableWithIdShare              :: RWShared CableId    Cable             Cable
+cablesInSectionShare          :: RWShared Coord3D    [Cable]           [Cable]
+
+cablesForSection              :: !Coord3D !Network -> [Cable]
+
+allActiveAlarms    :: ReadOnlyShared [(!Coord3D, !SectionStatus)]
+allAvailableActors :: ReadOnlyShared [(!Coord3D, !MyActor)]
+
+// setting and resetting of the detection systems:
+
+setAlarm         :: !User !(!Coord3D, !SectionStatus) !(Shared MySectionStatusMap) -> Task ()
+
+// making images from a map
+
+setSectionDetectors :: Task ()
+
+cutCable   :: !Coord3D !CableId !Network -> Network
+patchCable :: !Coord3D !CableId !Network -> Network
+
+viewDisabledDevices :: Task ()
+
+hasFire :: !SectionStatus -> Bool
+
+hasSmoke :: !SectionStatus -> Bool
+
+hasWater :: !SectionStatus -> Bool
+
+deviceIsEnabled :: !Device !(IntMap Device) !Network -> Bool
+
+isDetector :: !DeviceKind -> Bool
+
+updateMapStatus :: !RenderMode -> Task (MapAction SectionStatus)
+
+allDisabledDevices :: !(IntMap Device) !Network -> [Device]
+
+allImperiledCommandAims :: !(IntMap Device) !CapabilityToDeviceKindMap ![CommandAim] !Network -> [CommandAim]
+
+deviceIsDisabledInSection :: !Coord3D !Device !(IntMap Device) !Network -> Bool
+
+isOperational :: !CableId !(IntMap [(!Operational, !Coord3D)]) -> Bool
+
+devicesForCable :: !Cable !(IntMap Device) !Network -> [Device]
+
+devicesForCableInSection :: !Coord3D !Cable !(IntMap Device) !Network -> [Device]
+
+toPPDevice :: !Device -> PPDevice

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Util.dcl

+definition module C2.Apps.ShipAdventure.Util
+
+import C2.Apps.ShipAdventure.Types
+
+isCarrying :: !ObjectType !MyActor -> Bool
+
+objTypeInList :: !ObjectType ![MyObject] -> Bool

Examples/Applications/c2-demo/C2/Apps/ShipAdventure/Util.icl

+implementation module C2.Apps.ShipAdventure.Util
+
+import C2.Apps.ShipAdventure.Types
+
+isCarrying :: !ObjectType !MyActor -> Bool
+isCarrying objType` {Actor | carrying } = objTypeInList objType` carrying
+
+objTypeInList :: !ObjectType ![MyObject] -> Bool
+objTypeInList objType` objs = length [0 \\ {Object | objType } <- objs | objType == objType`] > 0

Examples/Applications/c2-demo/C2/Framework/Common.dcl

+definition module C2.Framework.Common
+
+import iTasks
+
+from Data.IntMap.Strict import :: IntMap
+from C2.Framework.Entity import :: Entity
+from C2.Framework.ContactPosition import :: ContactMapPerspective
+
+:: EntityMap :== IntMap Entity
+
+:: MapState =
+  { perspective :: ContactMapPerspective
+  , entities    :: IntMap Entity
+  , selection   :: Int
+  }
+
+derive class iTask MapState
+
+mapState :: RWShared () MapState MapState
+
+entityMap :: RWShared () EntityMap EntityMap
+
+registerEntity :: (Int -> Entity) -> Task Entity
+
+updateEntity :: Int (Entity -> Entity) -> Task ()
+
+contactWithId :: RWShared Int (Maybe Entity) Entity
+
+selectedContactShare :: RWShared () (Maybe Entity) Entity
+
+resetMapState :: Task ()
+
+periodicallyUpdateEntity :: !Int -> Task ()
+
+mapView :: (RWShared () r w) (r -> Bool) User [Entity] -> Task () | iTask r
+
+userMapState :: User -> Shared MapState