Commit 2e48512a authored by Mart Lubbers's avatar Mart Lubbers

fix shipadventure

fix import _Types

remove vestigial files of old distributed system

fix distributed
parent 89298329
Pipeline #27618 failed with stage
in 4 minutes and 20 seconds
......@@ -2,6 +2,7 @@ definition module C2.Apps.ShipAdventure.Images
import C2.Framework.MapEnvironment
import C2.Apps.ShipAdventure.Types
from Graphics.Scalable.Image import :: Image, :: TagSource, :: Image`, :: ImageTag, :: TagRef
:: RenderMode
= PickRoomMode
......
......@@ -125,6 +125,8 @@ from C2.Apps.ShipAdventure.Images import :: RenderMode
:: CapabilityToDeviceKindMap :== Map Capability CapabilityExpr
derive gEditor IntMap
derive gText IntMap
derive class iTask PPDevice, PPDeviceType, CommandAim, Capability, CapabilityExpr
derive gLexOrd CableType, Capability
derive class iTask ObjectType, ActorStatus, Availability, ActorHealth, ActorEnergy, DeviceType, SectionStatus
......
......@@ -2,8 +2,6 @@ implementation module C2.Apps.ShipAdventure.Types
//import iTasks
import iTasks.Internal.Tonic
import iTasks.Extensions.Admin.TonicAdmin
from iTasks.Extensions.SVG.SVGEditor import :: SVGEditor(..), :: TagSource, fromSVGEditor
import qualified Data.List as DL
from Data.Func import mapSt
......@@ -14,6 +12,7 @@ import qualified Data.Map as DM
import Data.Map.GenJSON
import qualified Data.Set as DS
import Text.HTML
import Data.Functor
import C2.Framework.MapEnvironment
from C2.Framework.Logging import addLog
......@@ -484,3 +483,5 @@ isDetector HeatSensor = True
isDetector WaterSensor = True
isDetector _ = False
derive gEditor IntMap
derive gText IntMap
......@@ -5,6 +5,7 @@ import iTasks
from Data.IntMap.Strict import :: IntMap
import qualified Data.IntMap.Strict as DIS
import C2.Framework.Core
import C2.Apps.ShipAdventure.Types
import C2.Framework.Util
import C2.Framework.Entity
import C2.Framework.ContactPosition
......
......@@ -2,8 +2,6 @@ definition module C2.Framework.MapEnvironment
import iTasks
import iTasks.Internal.Tonic
import iTasks.Extensions.Admin.TonicAdmin
from Data.IntMap.Strict import :: IntMap
import qualified Data.Map as DM
from Data.Map import :: Map
......
......@@ -4,8 +4,6 @@ import StdArray
import iTasks
import iTasks.UI.Definition
import iTasks.Internal.Tonic
import iTasks.Extensions.Admin.TonicAdmin
import iTasks.Extensions.DateTime
import qualified Data.Map as DM
from Data.Map import :: Map, instance Functor (Map k)
......@@ -16,6 +14,7 @@ import qualified Data.Heap as DH
from Data.Heap import :: Heap
import Data.GenLexOrd
from C2.Framework.Logging import addLog
import C2.Apps.ShipAdventure.Types
import Data.List
import Data.Eq
import Data.Maybe
......
implementation module C2.Navy.Roles.Commander
import iTasks
import iTasks.Extensions.Admin.TonicAdmin, iTasks.Internal.Tonic
import Text, C2.Framework.Core, C2.Framework.Util, C2.Framework.Entity
import iTasks.Extensions.Document
from Data.IntMap.Strict import :: IntMap, instance Functor IntMap
......
......@@ -8,7 +8,9 @@ import qualified Data.Set as DS
from Data.IntMap.Strict import instance Functor IntMap
import qualified Data.IntMap.Strict as DIS
import C2.Apps.ShipAdventure.Editor
import C2.Apps.ShipAdventure.Types
import Data.Map.GenJSON
import Data.Functor
dOffRegisterEntity :: [User -> Task Entity]
dOffRegisterEntity = []
......
module main
import iTasks.Extensions.Admin.TonicAdmin, iTasks.Internal.Tonic
import iTasks
import qualified Data.List as DL
import C2.Navy.Roles.DOff, C2.Navy.Roles.Commander, C2.Navy.Roles.Suspect, C2.Navy.Roles.HVU, C2.Navy.Roles.Simulator, C2.Navy.Roles.Sailor
......@@ -15,7 +14,7 @@ Start world = doTasks
,onStartup importDemoUsersFlow
,onStartup (installWorkflows myTasks)
,onRequest "/" (ccMain registerTasks continuousTasks alwaysOnTasks optionalTasks <<@ (Title "C2 System"))
,onRequest "/tonic" (tonicDashboard [])
// ,onRequest "/tonic" (tonicDashboard [])
,onRequest "/debug" showDebug
,onRequest "/adventure" (loginAndManageWork "Adventure" Nothing Nothing False)
,onRequest "/alarm" (setSectionDetectors)
......
implementation module iTasks.Extensions.Distributed._Evaluation
from iTasks.WF.Definition import :: Task(..), :: Event(ResetEvent,DestroyEvent), :: TaskEvalOpts, class iTask, :: TaskResult(..), :: TaskException, :: TaskValue(..), :: Stability, :: InstanceNo, :: TaskId
from iTasks.Internal.TaskState import :: TaskTree(TCInit)
import iTasks.Internal.TaskEval
import iTasks.UI.Definition
from iTasks.WF.Combinators.Common import @!, @?, whileUnchanged, ||-
......@@ -43,20 +42,18 @@ where
= handleValue value @? const NoValue
proxyTask :: (Shared sds (TaskValue a)) (*IWorld -> *IWorld) -> (Task a) | iTask a & RWShared sds
proxyTask value_share onDestroy = Task (eval value_share)
proxyTask value_share onDestroy = Task eval
where
eval :: (Shared sds (TaskValue a)) Event TaskEvalOpts TaskTree *IWorld -> *(!TaskResult a, !*IWorld) | iTask a & RWShared sds
eval value_share DestroyEvent repAs _ iworld
# iworld = onDestroy iworld
= (DestroyedResult,iworld)
eval value_share event evalOpts tree=:(TCInit taskId ts) iworld
# (val,iworld) = readRegister taskId value_share iworld
= case val of
Ok (ReadingDone val) = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap} (rep event) tree, iworld)
Error e = (ExceptionResult e,iworld)
eval DestroyEvent repAs iworld
= (DestroyedResult, onDestroy iworld)
eval event evalOpts=:{TaskEvalOpts|taskId,ts} iworld
# (val,iworld) = readRegister taskId value_share iworld
= case val of
Ok (ReadingDone val) = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap} (rep event) (Task eval), iworld)
Error e = (ExceptionResult e,iworld)
rep ResetEvent = ReplaceUI (ui UIEmpty)
rep _ = NoChange
rep ResetEvent = ReplaceUI (ui UIEmpty)
rep _ = NoChange
taskValueShare :: Int -> SimpleSDSLens (TaskValue a) | iTask a
taskValueShare taskid = sdsFocus store_name (memoryStore store_name (Just NoValue))
......@@ -64,17 +61,17 @@ where
store_name = "taskValueShare_" +++ (toString taskid)
customEval :: (Shared sds (TaskValue a)) (Task a) -> (Task a) | iTask a & RWShared sds
customEval value_share (Task eval) = Task eval`
where
eval` event evalOpts state iworld
= case eval event evalOpts state iworld of
v=:(ValueResult value info rep tree, iworld) -> storeValue v
(ExceptionResult te, iworld) -> (ExceptionResult te, iworld)
(DestroyedResult, iworld) -> (DestroyedResult, iworld)
customEval value_share (Task inner) = Task eval
where
eval event evalOpts iworld
= case inner event evalOpts iworld of
v=:(ValueResult value info rep newtask, iworld) = storeValue v
(ExceptionResult te, iworld) = (ExceptionResult te, iworld)
(DestroyedResult, iworld) = (DestroyedResult, iworld)
storeValue (ValueResult task_value info rep tree, iworld)
# (res, iworld) = write task_value value_share EmptyContext iworld
= case res of
Ok _ = (ValueResult task_value info rep tree, iworld)
Error _ = (ValueResult task_value info rep tree, iworld)
storeValue (ValueResult task_value info rep newtask, iworld)
# (res, iworld) = write task_value value_share EmptyContext iworld
= case res of
Ok _ = (ValueResult task_value info rep newtask, iworld)
Error _ = (ValueResult task_value info rep newtask, iworld)
......@@ -2,7 +2,6 @@ implementation module iTasks.Extensions.Distributed._Types
from iTasks.WF.Definition import :: TaskAttributes, :: Task, class iTask, :: TaskValue, :: TaskResult
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.TaskState import :: TaskTree
from iTasks.Internal.TaskEval import :: TaskEvalOpts
from iTasks.UI.Editor import :: Editor
from iTasks.UI.Editor.Generic import generic gEditor
......
......@@ -6,11 +6,11 @@ import qualified Data.Map as DM
import Data.Map.GenJSON
import qualified Text as T
import Text.Encodings.Base64
import iTasks.Extensions.Distributed._Evaluation
import iTasks.Extensions.Distributed._Formatter
import iTasks.Extensions.Distributed._Util
import iTasks.Extensions.Distributed._Types
import iTasks.Internal.Distributed.Symbols
import iTasks.Extensions.Distributed._Evaluation
from iTasks.Extensions.Distributed.Task import :: Domain(..)
from iTasks.Extensions.Distributed._Util import repeatClient
from iTasks.SDS.Sources.System import topLevelTasks
......
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