diff --git a/src/Example.elm b/src/Example.elm new file mode 100644 index 0000000..8237193 --- /dev/null +++ b/src/Example.elm @@ -0,0 +1,61 @@ +module Example exposing (..) + +import Time exposing (Time) +import SimulationTypes exposing (..) +import Simulation exposing (..) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import SimulationUpdate +import SimulationTick +import Machine +import Animation +import Story +import AnimationFrame +import Simulation exposing (..) +import SimulationTypes exposing (..) +import SimulationUpdate exposing (..) +import Machine exposing (..) +import Sensor exposing (..) + + +sim0 = + empty + + +sim1 = + addDevice + 1000 + (MachineType (Machine.create (vec2 0 0))) + sim0 + + +( sim2, msgs2 ) = + update (SetMachineSpeed 1000 1.0) sim1 + + + +--MachineMsg 1000 (Machine.SetSpeed 1.0)) sim1 + + +sim3 = + addDevice + 1001 + (SensorType + (Sensor.create + (\simulation -> + case findDevice 1000 simulation of + Just device -> + case device.type_ of + MachineType machine -> + machine.temperature + + _ -> + Debug.crash "device not a machine" + + Nothing -> + Debug.crash "machine not found" + ) + 1002 + 9000 + ) + ) + sim2 diff --git a/src/ExampleView.elm b/src/ExampleView.elm new file mode 100644 index 0000000..b8a1f6f --- /dev/null +++ b/src/ExampleView.elm @@ -0,0 +1,101 @@ +module ExampleView exposing (..) + +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Task +import Time exposing (Time) +import SimulationTypes exposing (..) +import Simulation exposing (..) +import SimulationUpdate +import SimulationTick +import SimulationStory exposing (..) +import SimulationStoryExample exposing (..) +import Machine +import Animation +import Story +import AnimationFrame +import Example +import VisualizationHtml exposing (..) + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +type alias Model = + { simstory : SimulationStory.Model + } + + +type Msg + = NoOp + | Animate Time + | SimulationMessage SimulationTypes.Msg + + +init : ( Model, Cmd Msg ) +init = + ( { simstory = SimulationStory.create SimulationStoryExample.story1 + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + SimulationMessage simulation_msg -> + let + ( new_simulation, simulation_msgs ) = + SimulationStory.update simulation_msg model.simstory + in + ( { model + | simstory = + new_simulation + } + --, (msgToCmd (SimulationMessage simulation_msgs)) + , Cmd.map (\a -> SimulationMessage a) simulation_msgs + ) + + Animate time -> + let + ( new_simulation, simulation_msgs ) = + SimulationStory.tick time model.simstory + in + ( { model + | simstory = + new_simulation + } + --, (msgToCmd (SimulationMessage simulation_msgs)) + , Cmd.map (\a -> SimulationMessage a) simulation_msgs + ) + + +view : Model -> Html Msg +view model = + Html.div [] + [ Html.div [] + [--Html.button [ HE.onClick (ShowMessage "Neuer SubTitle") ] [ Html.text "Sub-Titel erstellen" ] + ] + --, Html.div [] <| List.map (\error -> Html.div [] [ Html.text error ]) model.simulation.errors + --, Html.div [] [ Html.text <| Simulation.toString model.simulation ] + , VisualizationHtml.view model.simstory.simulation + ] + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ AnimationFrame.diffs Animate + ] diff --git a/src/Machine.elm b/src/Machine.elm new file mode 100644 index 0000000..d4786df --- /dev/null +++ b/src/Machine.elm @@ -0,0 +1,78 @@ +module Machine exposing (..) + +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import SimulationTypes exposing (..) + + +-- type Msg +-- = SetSpeed Float +-- | Animate Time + + +create : Vec2 -> Machine +create position = + { position = position + , speed = 0.0 + , produced = 0.0 + , temperature = 20.0 + } + + + +-- +-- update : Msg -> Machine -> ( Machine, Cmd Msg ) +-- update msg machine = +-- case msg of +-- SetSpeed speed -> +-- if (speed < 0 || 1.5 < speed) then +-- Debug.crash "Machine.SetSpeed out of range" +-- else +-- { machine | speed = speed } ! [] +-- +-- Animate time -> +-- let +-- soll_temperature = +-- (20.0 + (machine.speed * 70.0)) +-- +-- temperature_factor = +-- min 1.0 (0.1 * (Time.inSeconds time)) +-- +-- new_temperature = +-- (machine.temperature * (1.0 - temperature_factor)) + (soll_temperature * temperature_factor) +-- +-- production_rate = +-- 1.0 / (Time.second * 2.0) +-- in +-- { machine +-- | produced = machine.produced + (production_rate * machine.speed * time) +-- , temperature = new_temperature +-- } +-- ! [] + + +setSpeed : Float -> Machine -> Machine +setSpeed speed machine = + { machine | speed = speed } + + +tick : Time -> Simulation -> Machine -> ( Machine, Cmd Msg ) +tick time simulation machine = + let + soll_temperature = + (20.0 + (machine.speed * 70.0)) + + temperature_factor = + min 1.0 (0.1 * (Time.inSeconds time)) + + new_temperature = + (machine.temperature * (1.0 - temperature_factor)) + (soll_temperature * temperature_factor) + + production_rate = + 1.0 / (Time.second * 2.0) + in + { machine + | produced = machine.produced + (production_rate * machine.speed * time) + , temperature = new_temperature + } + ! [] diff --git a/src/Network.elm b/src/Network.elm new file mode 100644 index 0000000..aeb7b0e --- /dev/null +++ b/src/Network.elm @@ -0,0 +1,13 @@ +module Network exposing (..) + +import Dict exposing (Dict) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Task +import SimulationTypes exposing (..) + + +type alias PortXXX = + { receiverId : Id + , cableId : Id + } diff --git a/src/Sensor.elm b/src/Sensor.elm new file mode 100644 index 0000000..978aff1 --- /dev/null +++ b/src/Sensor.elm @@ -0,0 +1,38 @@ +module Sensor exposing (..) + +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (..) +import SimulationTypes exposing (..) +import Simulation exposing (..) + + +create : (Simulation -> Float) -> Id -> Id -> Sensor +create getter portId targetId = + { getter = getter + , lastValue = 0 + , sendInterval = second * 1 + , timeToNextSend = second * 3 + , portId = portId + , targetId = targetId + } + + +tick : Time -> Simulation -> Sensor -> ( Sensor, Cmd Msg ) +tick time simulation sensor = + let + newTimeToNextSend = + sensor.timeToNextSend - time + in + if (0 < newTimeToNextSend) then + { sensor | timeToNextSend = newTimeToNextSend } ! [] + else + let + newValue = + sensor.getter simulation + in + ( { sensor + | timeToNextSend = newTimeToNextSend + sensor.sendInterval + , lastValue = newValue + } + , msgToCmd (SendPackage sensor.portId sensor.targetId (PackageDataSensor newValue)) + ) diff --git a/src/Simulation.elm b/src/Simulation.elm new file mode 100644 index 0000000..c1eca55 --- /dev/null +++ b/src/Simulation.elm @@ -0,0 +1,603 @@ +module Simulation exposing (..) + +import Dict exposing (Dict) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Maybe exposing (..) +import Task +import SimulationTypes exposing (..) +import Machine exposing (..) +import Network exposing (..) + + +-- +-- + + +type MsgXX + = Animate Time + + + +-- | MachineMsg Id Machine.Msg +-- +-- + + +empty : Simulation +empty = + { devices = Dict.empty + , errors = [] + } + + + +-- +-- + + +error : String -> Simulation -> Simulation +error text simulation = + { simulation | errors = simulation.errors ++ [ text ] } + + + +-- +-- + + +addDevice : Id -> DeviceType -> Simulation -> Simulation +addDevice id device_type simulation = + case Dict.get id simulation.devices of + Just existing -> + Debug.crash "already a device with this id" + + Nothing -> + let + new_device = + { id = id, type_ = device_type } + in + { simulation | devices = Dict.insert id new_device simulation.devices } + + +findDevice : Id -> Simulation -> Maybe Device +findDevice id simulation = + Dict.get id simulation.devices + + +getDevice : Id -> Simulation -> Device +getDevice id simulation = + case Dict.get id simulation.devices of + Nothing -> + Debug.crash ("device not found " ++ (Basics.toString id)) + + Just reference -> + reference + + +replaceDevice : Device -> Simulation -> Simulation +replaceDevice device simulation = + case findDevice device.id simulation of + Nothing -> + error "replaceDevice failed because device not found" simulation + + Just existing -> + --if (existing.type_ == device.type_) then + { simulation | devices = Dict.insert device.id device simulation.devices } + + +mapDevices : (Device -> a) -> Simulation -> List a +mapDevices mapper simulation = + List.map mapper (getDevices simulation) + + +getDevices : Simulation -> List Device +getDevices simulation = + Dict.values simulation.devices + + + +-- +-- +-- update : Msg -> Simulation -> ( Simulation, Cmd Msg ) +-- update msg simulation = +-- case msg of +-- Animate time -> +-- animate time simulation +-- +-- MachineMsg id machineMsg -> +-- let +-- device = +-- getDevice id simulation +-- in +-- case device.type_ of +-- MachineType machine -> +-- let +-- ( new_machine, machine_msg ) = +-- Machine.update machineMsg machine +-- in +-- { simulation | devices = Dict.insert id { device | type_ = (MachineType new_machine) } simulation.devices } ! [] +-- +-- _ -> +-- Debug.crash "device not a machine" +-- +-- +-- +-- +-- +-- -- {-| A command to generate a message without performing any action. +-- -- This is useful for implementing components that generate events in the manner +-- -- of HTML elements, but where the event fires from within Elm code, rather than +-- -- by an external trigger. +-- -- -} +-- -- msgToCmd : msg -> Cmd msg +-- -- msgToCmd x = +-- -- --Task.perform identity identity (Task.succeed x) +-- -- Task.perform identity (Task.succeed x) +-- -- simulate time simulation = +-- -- +-- -- +-- -- +-- -- fromList : List Device -> Simulation +-- -- fromList devices = +-- -- { devices = +-- -- --Debug.log "devs" <| +-- -- Dict.fromList <| +-- -- --Debug.log "d2" +-- -- (List.map deviceToIdDeviceTupple devices) +-- -- } +-- -- +-- -- +-- -- +-- -- +-- +-- +-- +-- +-- +-- -- +-- -- +-- -- getConnectedPorts : Simulation -> List Id -> List PortData +-- -- getConnectedPorts simulation portIds = +-- -- List.filter (\port_ -> not (port_.cableId == 0)) <| +-- -- List.map (\portId -> getPort portId simulation) <| +-- -- portIds +-- -- +-- -- +-- -- getPort : Id -> Simulation -> PortData +-- -- getPort id simulation = +-- -- case (getDevice id simulation) of +-- -- Port port_ -> +-- -- port_ +-- -- +-- -- _ -> +-- -- Debug.crash "device is not a port" +-- -- +-- -- +-- -- getCable : Id -> Simulation -> CableData +-- -- getCable id simulation = +-- -- case (getDevice id simulation) of +-- -- Cable cable -> +-- -- cable +-- -- +-- -- _ -> +-- -- Debug.crash "device is not a cable" +-- -- +-- -- +-- -- deviceToIdDeviceTupple : Device -> ( Id, Device ) +-- -- deviceToIdDeviceTupple device = +-- -- ( getDeviceId device, device ) +-- -- +-- -- +-- -- getDeviceId : Device -> Id +-- -- getDeviceId device = +-- -- case device of +-- -- Machine machine -> +-- -- machine.id +-- -- +-- -- TemperatureSensor sensor -> +-- -- sensor.id +-- -- +-- -- Switch switch -> +-- -- switch.id +-- -- +-- -- Router router -> +-- -- router.id +-- -- +-- -- Cable cable -> +-- -- cable.id +-- -- +-- -- Port port_ -> +-- -- port_.id +-- -- +-- -- FloatsVisualizer v -> +-- -- v.id +-- -- +-- -- +-- -- simulate : Time -> Simulation -> ( Simulation, Cmd Msg ) +-- -- simulate time simulation = +-- -- let +-- -- new_devices_whith_cmd = +-- -- Dict.map (\id device -> simulateDevice time simulation device) simulation.devices +-- -- +-- -- new_devices = +-- -- Dict.map (\id ( device, cmd ) -> device) new_devices_whith_cmd +-- -- +-- -- new_cmds = +-- -- Dict.values <| Dict.map (\id ( device, cmd ) -> cmd) new_devices_whith_cmd +-- -- in +-- -- { simulation +-- -- | devices = +-- -- new_devices +-- -- -- Dict.map (\id device -> simulateDevice time simulation device) simulation.devices +-- -- } +-- -- ! (new_cmds) +-- -- +-- -- +-- -- simulateDevice : Time -> Simulation -> Device -> ( Device, Cmd Msg ) +-- -- simulateDevice time simulation device = +-- -- case device of +-- -- Machine machine -> +-- -- Machine { machine | produced = machine.produced + machine.speed * time } ! [] +-- -- +-- -- TemperatureSensor sensor -> +-- -- simulateTemperatureSensor time simulation sensor +-- -- +-- -- Switch switch -> +-- -- Switch switch ! [] +-- -- +-- -- Router router -> +-- -- simulateRouter time simulation router +-- -- +-- -- Cable cable -> +-- -- simulateCable time +-- -- simulation +-- -- cable +-- -- +-- -- Port port_ -> +-- -- Port port_ ! [] +-- -- +-- -- FloatsVisualizer v -> +-- -- FloatsVisualizer v ! [] +-- -- +-- -- +-- -- getRouterTableEntry : Id -> RouterData -> ( RouterTableEntry, RouterData ) +-- -- getRouterTableEntry targetId router = +-- -- case Dict.get targetId router.table of +-- -- Nothing -> +-- -- let +-- -- entry = +-- -- { targetPortId = 0, searchDepth = 0, timeToNextSearch = 0 } +-- -- in +-- -- ( entry, { router | table = Dict.insert targetId entry router.table } ) +-- -- +-- -- Just entry -> +-- -- ( entry, router ) +-- -- +-- -- +-- -- simulateRouterNextPackage : Time -> Simulation -> Package -> RouterData -> ( Device, Cmd Msg ) +-- -- simulateRouterNextPackage time simulation package router = +-- -- -- case Dict.get package.targetId router.table of +-- -- -- Nothing -> +-- -- -- Debug.crash "router has no entry to this target" +-- -- -- +-- -- -- Just entry -> +-- -- (Router router) +-- -- ! [ msgToCmd +-- -- (SendPackage +-- -- { package +-- -- | --senderId = router.id +-- -- --, +-- -- senderPortId = router.outgoingPortId +-- -- } +-- -- ) +-- -- ] +-- -- +-- -- +-- -- simulateRouter : Time -> Simulation -> RouterData -> ( Device, Cmd Msg ) +-- -- simulateRouter time simulation router = +-- -- let +-- -- newTimeToNextSend = +-- -- router.timeToNextSend - time +-- -- in +-- -- if (newTimeToNextSend < 0) then +-- -- case List.head router.packageQueue of +-- -- Nothing -> +-- -- (Router { router | timeToNextSend = 0 }) ! [] +-- -- +-- -- Just package -> +-- -- simulateRouterNextPackage time +-- -- simulation +-- -- package +-- -- { router +-- -- | timeToNextSend = newTimeToNextSend + router.sendInterval +-- -- , packageQueue = List.drop 1 router.packageQueue +-- -- } +-- -- else +-- -- (Router { router | timeToNextSend = newTimeToNextSend }) ! [] +-- -- +-- -- +-- -- simulatePackageOnCable : Time -> Simulation -> CableData -> Package -> Package +-- -- simulatePackageOnCable time simulation cable package = +-- -- let +-- -- ( startPortId, endPortId, dir ) = +-- -- if (package.senderPortId == cable.port0) then +-- -- ( cable.port0, cable.port1, 1.0 ) +-- -- else if (package.senderPortId == cable.port1) then +-- -- ( cable.port1, cable.port0, 1.0 ) +-- -- else +-- -- Debug.crash "package.senderPortId not on cable" +-- -- +-- -- startPos = +-- -- (getPort startPortId simulation).position +-- -- +-- -- endPos = +-- -- (getPort endPortId simulation).position +-- -- +-- -- startPosToEndPos = +-- -- Vec2.sub endPos startPos +-- -- +-- -- newPosOnCable = +-- -- package.positionOnCable + time * dir * cable.speed * 0.1 +-- -- +-- -- newPos = +-- -- Vec2.add startPos (Vec2.scale (newPosOnCable / cable.length) startPosToEndPos) +-- -- in +-- -- --Debug.log "p" +-- -- { package | positionOnCable = newPosOnCable, position = newPos } +-- -- +-- -- +-- -- simulateCable : Time -> Simulation -> CableData -> ( Device, Cmd Msg ) +-- -- simulateCable time simulation cable = +-- -- let +-- -- new_packages = +-- -- List.map +-- -- (\package -> +-- -- simulatePackageOnCable time simulation cable package +-- -- ) +-- -- cable.packages +-- -- +-- -- pend_packages = +-- -- List.filter (\p -> p.positionOnCable < cable.length) new_packages +-- -- +-- -- arr_packages = +-- -- List.filter (\p -> not (p.positionOnCable < cable.length)) new_packages +-- -- +-- -- -- type alias CableData = +-- -- -- WithIdData +-- -- -- { port0 : Id +-- -- -- , port1 : Id +-- -- -- , packages : List Package +-- -- in +-- -- Cable { cable | packages = pend_packages } +-- -- ! (List.map +-- -- (\p -> +-- -- (msgToCmd +-- -- (ReceivePackage p) +-- -- ) +-- -- ) +-- -- arr_packages +-- -- ) +-- -- +-- -- +-- -- simulateTemperatureSensor : Time -> Simulation -> TemperatureSensorData -> ( Device, Cmd Msg ) +-- -- simulateTemperatureSensor time simulation sensor = +-- -- let +-- -- f = +-- -- min 1.0 (0.51 * (Time.inSeconds time)) +-- -- +-- -- new_sensor = +-- -- case Dict.get sensor.machineId simulation.devices of +-- -- Nothing -> +-- -- { sensor | error = "machine ot found" } +-- -- +-- -- Just reference -> +-- -- case reference of +-- -- Machine machine -> +-- -- { sensor +-- -- | temperature = (sensor.temperature * (1.0 - f)) + (f * (20.0 + (machine.speed * 70.0))) +-- -- , timeToNextSend = sensor.timeToNextSend - time +-- -- } +-- -- +-- -- _ -> +-- -- { sensor | error = "reference is not a machine" } +-- -- in +-- -- --Debug.log "sise" <| +-- -- if (new_sensor.timeToNextSend < 0) then +-- -- TemperatureSensor { new_sensor | timeToNextSend = new_sensor.timeToNextSend + new_sensor.sendInterval } +-- -- ! [ (msgToCmd +-- -- (SendPackage +-- -- { senderId = sensor.id +-- -- , senderPortId = sensor.portId +-- -- , positionOnCable = 0 +-- -- , position = vec2 0 0 +-- -- , targetId = sensor.targetId +-- -- , targetPortId = 0 +-- -- , color = temperatureColor new_sensor.temperature +-- -- , glow = 0.5 +-- -- , type_ = PackageTypeWithFloatValue new_sensor.temperature +-- -- } +-- -- ) +-- -- ) +-- -- ] +-- -- else +-- -- TemperatureSensor new_sensor ! [] +-- -- +-- -- +-- -- {-| A command to generate a message without performing any action. +-- -- This is useful for implementing components that generate events in the manner +-- -- of HTML elements, but where the event fires from within Elm code, rather than +-- -- by an external trigger. +-- -- -} +-- -- msgToCmd : msg -> Cmd msg +-- -- msgToCmd x = +-- -- --Task.perform identity identity (Task.succeed x) +-- -- Task.perform identity (Task.succeed x) +-- -- +-- -- +-- -- update : Msg -> Simulation -> ( Simulation, Cmd Msg ) +-- -- update msg simulation = +-- -- case msg of +-- -- NoOp -> +-- -- simulation ! [] +-- -- +-- -- SendPackage package -> +-- -- sendPackage package simulation +-- -- +-- -- ReceivePackage package -> +-- -- receivePackage package simulation +-- -- +-- -- +-- -- opositePortIdOnCable : Id -> CableData -> Id +-- -- opositePortIdOnCable portId cable = +-- -- if (cable.port0 == portId) then +-- -- cable.port1 +-- -- else if (cable.port1 == portId) then +-- -- cable.port0 +-- -- else +-- -- Debug.crash "port not on cable" +-- -- +-- -- +-- -- sendPackage : Package -> Simulation -> ( Simulation, Cmd Msg ) +-- -- sendPackage package simulation = +-- -- let +-- -- senderPort = +-- -- --Debug.log "senderPort" <| +-- -- getPort package.senderPortId simulation +-- -- +-- -- cable = +-- -- getCable senderPort.cableId simulation +-- -- +-- -- targetPortId = +-- -- opositePortIdOnCable senderPort.id cable +-- -- +-- -- new_package = +-- -- { package | position = senderPort.position, positionOnCable = 0, targetPortId = targetPortId } +-- -- +-- -- new_cable = +-- -- { cable | id = cable.id, packages = new_package :: cable.packages } +-- -- in +-- -- { simulation +-- -- | devices = Dict.insert new_cable.id (Cable new_cable) simulation.devices +-- -- } +-- -- ! [] +-- -- +-- -- +-- -- temperatureColor : Float -> String +-- -- temperatureColor temperature = +-- -- if (temperature < 40) then +-- -- "#00ff00" +-- -- else if (temperature < 55) then +-- -- "#ffc600" +-- -- else +-- -- "#ff0000" +-- -- +-- -- +-- -- receivePackage : Package -> Simulation -> ( Simulation, Cmd Msg ) +-- -- receivePackage package simulation = +-- -- let +-- -- receiverPort = +-- -- getPort package.targetPortId simulation +-- -- +-- -- receiver = +-- -- getDevice receiverPort.receiverId simulation +-- -- in +-- -- case receiver of +-- -- TemperatureSensor sensor -> +-- -- simulation ! [] +-- -- +-- -- FloatsVisualizer v -> +-- -- case package.type_ of +-- -- PackageTypeWithFloatValue val -> +-- -- let +-- -- nv = +-- -- { v | values = Dict.insert package.senderId val v.values } +-- -- in +-- -- ({ simulation | devices = Dict.insert nv.id (FloatsVisualizer nv) simulation.devices }) ! [] +-- -- +-- -- _ -> +-- -- Debug.crash "invalid package type for fv" +-- -- +-- -- Router router -> +-- -- let +-- -- newrouter = +-- -- { router | packageQueue = package :: router.packageQueue } +-- -- in +-- -- ({ simulation | devices = Dict.insert newrouter.id (Router newrouter) simulation.devices }) +-- -- ! [] +-- -- +-- -- Switch switch -> +-- -- --Debug.log "receivePackage receiver not handled" <| +-- -- let +-- -- redirectPorts = +-- -- getConnectedPorts simulation <| +-- -- List.filter (\portId -> not (portId == receiverPort.id)) +-- -- switch.ports +-- -- +-- -- redirectCmds = +-- -- List.map +-- -- (\redirectPort -> +-- -- (msgToCmd +-- -- (SendPackage +-- -- { package +-- -- | senderPortId = redirectPort.id +-- -- , positionOnCable = 0 +-- -- , position = vec2 0 0 +-- -- } +-- -- ) +-- -- ) +-- -- ) +-- -- redirectPorts +-- -- in +-- -- simulation +-- -- ! redirectCmds +-- -- +-- -- _ -> +-- -- Debug.log "receivePackage receiver not handled" <| simulation ! [] +-- -- +-- -- +-- -- createCable : Id -> Id -> Id -> Float -> Simulation -> Simulation +-- -- createCable cableId port0Id port1Id speed simulation = +-- -- let +-- -- port0 = +-- -- getPort port0Id simulation +-- -- +-- -- port1 = +-- -- getPort port1Id simulation +-- -- +-- -- cable = +-- -- { id = cableId +-- -- , port0 = port0.id +-- -- , port1 = port1.id +-- -- , length = Vec2.length (Vec2.sub port0.position port1.position) +-- -- , speed = speed +-- -- , packages = [] +-- -- } +-- -- in +-- -- if (not (port0.cableId == 0)) then +-- -- Debug.crash "port has already a cable" +-- -- else if (not (port1.cableId == 0)) then +-- -- Debug.crash "port has already a cable" +-- -- else +-- -- { simulation +-- -- | devices = +-- -- Dict.insert port0.id +-- -- (Port { port0 | cableId = cableId }) +-- -- <| +-- -- Dict.insert port1.id +-- -- (Port { port1 | cableId = cableId }) +-- -- <| +-- -- Dict.insert +-- -- cable.id +-- -- (Cable cable) +-- -- simulation.devices +-- -- } +-- -- +-- -- +-- -- +-- -- -- , portId : Id +-- -- -- , targetId : Id +-- -- -- { senderId : Id +-- -- -- , senderPortId : Id +-- -- -- , targetId : Id +-- -- -- , data : PackageData diff --git a/src/SimulationStory.elm b/src/SimulationStory.elm new file mode 100644 index 0000000..50648b0 --- /dev/null +++ b/src/SimulationStory.elm @@ -0,0 +1,80 @@ +module SimulationStory exposing (..) + +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Task +import Time exposing (..) +import SimulationTypes exposing (..) +import Simulation exposing (..) +import SimulationUpdate +import SimulationTick +import Machine +import Animation +import Story exposing (..) +import AnimationFrame +import Example +import VisualizationHtml exposing (..) + + +type alias Model = + { simulation : Simulation + , player : Story.Player Msg + } + + +create : Story Msg -> Model +create story = + { simulation = Simulation.empty + , player = Story.start story + } + + +init : ( Model, Cmd Msg ) +init = + ( { simulation = Example.sim3 + , player = Story.start Story.empty + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + let + ( new_simulation, simulation_msgs ) = + SimulationUpdate.update msg model.simulation + in + ( { model + | simulation = + new_simulation + } + --, (msgToCmd (SimulationMessage simulation_msgs)) + , simulation_msgs + ) + + +tick : Time -> Model -> ( Model, Cmd Msg ) +tick time model = + let + ( new_simulation, simulation_msgs ) = + SimulationTick.tick time model.simulation + + ( new_player, story_msgs ) = + Story.tick time model.player + + result_msgs = + Cmd.batch + [ simulation_msgs + , Cmd.batch ((List.map (\msg -> msgToCmd msg) story_msgs)) + ] + in + ( { model + | simulation = new_simulation + , player = new_player + } + --, (msgToCmd (SimulationMessage simulation_msgs)) + --, (Cmd.batch ([ simulation_msgs, (msgToCmd story_msgs) ])) + , result_msgs + ) diff --git a/src/SimulationStoryExample.elm b/src/SimulationStoryExample.elm new file mode 100644 index 0000000..3479870 --- /dev/null +++ b/src/SimulationStoryExample.elm @@ -0,0 +1,36 @@ +module SimulationStoryExample exposing (..) + +import Time exposing (..) +import SimulationTypes exposing (..) +import Simulation exposing (..) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import SimulationUpdate +import SimulationTick +import Machine +import Animation +import Story +import AnimationFrame +import Simulation exposing (..) +import SimulationTypes exposing (..) +import SimulationUpdate exposing (..) +import Machine exposing (..) +import Sensor exposing (..) + + +story1 = + Story.create + [ Story.Wait <| 1 * second + , Story.Send <| CreateSampleMachine 2000 (vec2 2 0) + , Story.Wait <| 2 * second + , Story.Send <| SetMachineSpeed 2000 1.0 + , Story.Wait <| 2 * second + , Story.Send <| SetMachineSpeed 2000 0.0 + , Story.Wait <| 1 * second + , Story.Send <| CreateSampleMachine 3000 (vec2 3 0) + , Story.Wait <| 2 * second + , Story.Send <| SetMachineSpeed 2000 1.0 + , Story.Send <| SetMachineSpeed 3000 1.0 + , Story.Wait <| 2 * second + , Story.Send <| SetMachineSpeed 2000 0.0 + , Story.Send <| SetMachineSpeed 3000 0.0 + ] diff --git a/src/SimulationTick.elm b/src/SimulationTick.elm new file mode 100644 index 0000000..514c65e --- /dev/null +++ b/src/SimulationTick.elm @@ -0,0 +1,56 @@ +module SimulationTick exposing (..) + +import Dict exposing (Dict) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Task +import SimulationTypes exposing (..) +import Simulation exposing (..) +import Machine exposing (..) +import Sensor exposing (..) +import Network exposing (..) + + +tick : Time -> Simulation -> ( Simulation, Cmd Msg ) +tick time simulation = + let + ( newdevices, msgs ) = + Dict.foldl + (\id device ( devices, msgs ) -> + let + ( new_device, device_msgs ) = + tickDevice time simulation device + in + ( Dict.insert id new_device devices, msgs ++ [ device_msgs ] ) + ) + ( simulation.devices, [] ) + simulation.devices + in + { simulation | devices = newdevices } ! msgs + + +tickDevice : Time -> Simulation -> Device -> ( Device, Cmd Msg ) +tickDevice time simulation device = + case device.type_ of + MachineType machine -> + let + ( new_machine, machine_msgs ) = + Machine.tick time simulation machine + in + ( { device | type_ = MachineType new_machine } + , --Cmd.map (\m -> MachineMsg device.id m) + machine_msgs + ) + + SensorType sensor -> + let + ( new_sensor, sensor_msgs ) = + Sensor.tick time simulation sensor + in + ( { device | type_ = SensorType new_sensor } + , --Cmd.map (\m -> MachineMsg device.id m) + sensor_msgs + ) + + PortType port_ -> + device ! [] diff --git a/src/SimulationTypes.elm b/src/SimulationTypes.elm new file mode 100644 index 0000000..967f007 --- /dev/null +++ b/src/SimulationTypes.elm @@ -0,0 +1,102 @@ +module SimulationTypes exposing (..) + +import Dict exposing (Dict) +import List exposing (..) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Task + + +type Msg + = --Animate Time + CreateSampleMachine Id Vec2 + | SetMachineSpeed Id Float + --MachineMsg Id Machine.Msg + | SendPackage Id Id PackageData + + + +--SensorChanged Float + + +msgToCmd : msg -> Cmd msg +msgToCmd msg = + Task.perform identity (Task.succeed msg) + + +type alias Id = + Int + + +type alias Simulation = + { devices : Dict Id Device + , errors : List String + } + + +type DeviceType + = MachineType Machine + | SensorType Sensor + | PortType Port + + +type alias Device = + { id : Id + , type_ : DeviceType + } + + +type alias Machine = + { position : Vec2 + , speed : Float + , produced : Float + , temperature : Float + } + + +type alias SensorData = + Float + + +type alias Sensor = + { getter : Simulation -> Float + , lastValue : Float + , sendInterval : Time + , timeToNextSend : Time + , portId : Id + , targetId : Id + } + + +type alias Port = + { receiverId : Id + , cableId : Id + } + + +type alias Cable = + { port0 : Id + , port1 : Id + , length : Float + , speed : Float + , packages : List Package + } + + +type alias Package = + { senderId : Id + , senderPortId : Id + , positionOnCable : Float + , position : Vec2 + , targetId : Id + , targetPortId : Id + , color : String + , glow : Float + , data : PackageData + } + + +type PackageData + = PackageDataFindTarget Id + | PackageDataWithFloatValue Float + | PackageDataSensor SensorData diff --git a/src/SimulationUpdate.elm b/src/SimulationUpdate.elm new file mode 100644 index 0000000..32341c3 --- /dev/null +++ b/src/SimulationUpdate.elm @@ -0,0 +1,43 @@ +module SimulationUpdate exposing (..) + +import Dict exposing (Dict) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Task +import SimulationTypes exposing (..) +import Simulation exposing (..) +import Machine exposing (..) +import Network exposing (..) + + +update : Msg -> Simulation -> ( Simulation, Cmd Msg ) +update msg simulation = + case msg of + CreateSampleMachine id pos -> + (addDevice id + (MachineType (Machine.create pos)) + simulation + ) + ! [] + + SetMachineSpeed id speed -> + case findDevice id simulation of + Just device -> + case device.type_ of + MachineType machine -> + (replaceDevice + { device + | type_ = MachineType <| Machine.setSpeed speed machine + } + simulation + ) + ! [] + + _ -> + (error "device not a machine" simulation) ! [] + + Nothing -> + (error "machine not found" simulation) ! [] + + SendPackage senderPortId targetId data -> + (error "sendPackage not yet implemented" simulation) ! [] diff --git a/src/Story.elm b/src/Story.elm index 7c2953f..4050596 100644 --- a/src/Story.elm +++ b/src/Story.elm @@ -26,6 +26,11 @@ type alias Player msg = } +empty : Story msg +empty = + { events = [] } + + create : List (Action msg) -> Story msg create actions = let diff --git a/src/VisualizationHtml.elm b/src/VisualizationHtml.elm new file mode 100644 index 0000000..0ff6526 --- /dev/null +++ b/src/VisualizationHtml.elm @@ -0,0 +1,48 @@ +module VisualizationHtml exposing (..) + +import VirtualDom as VD +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (..) +import SimulationTypes exposing (..) + + +viewDevice : Device -> Html.Html msg +viewDevice device = + Html.div + [] + [ Html.text + (case device.type_ of + MachineType machine -> + "machine " + ++ (toString device.id) + ++ " speed=" + ++ (toString machine.speed) + ++ " produced=" + ++ (toString machine.produced) + ++ " temperature=" + ++ (toString machine.temperature) + + SensorType sensor -> + "sensor " + ++ (toString device.id) + ++ " lastValue=" + ++ (toString sensor.lastValue) + + _ -> + "a device with unknown type" + ) + ] + + +view : Simulation -> Html.Html msg +view simulation = + Html.div [] + [ Html.div [] <| List.map (\error -> Html.div [] [ Html.text ("Error: " ++ error) ]) simulation.errors + , Html.div [] + (mapDevices viewDevice simulation) + ] diff --git a/src/old/Simulation.elm b/src/old/Simulation.elm new file mode 100644 index 0000000..a7a75d0 --- /dev/null +++ b/src/old/Simulation.elm @@ -0,0 +1,620 @@ +module Simulation exposing (..) + +import Dict exposing (Dict) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Time exposing (Time) +import Task + + +type alias WithIdData data = + { data + | id : Id + } + + +type alias WithPositionData data = + WithIdData + { data + | position : Vec2 + } + + +type alias WithPort data = + { data + | port_ : Id + } + + +type alias WithPorts data = + { data + | ports : List Id + } + + +type alias PortData = + WithPositionData + { receiverId : Id + , cableId : Id + } + + +type alias MachineData = + WithPositionData + { speed : Float + , produced : Float + } + + +type alias TemperatureSensorData = + WithPositionData + { machineId : Id + , temperature : Float + , error : String + , sendInterval : Time + , timeToNextSend : Time + , portId : Id + , targetId : Id + } + + +type alias FloatsVisualizerData = + WithPositionData + { values : Dict Id Float + } + + +type alias SwitchData = + WithPorts (WithPositionData {}) + + +type alias RouterTableEntry = + { targetPortId : Id + , searchDepth : Int + , timeToNextSearch : Time + } + + +type alias RouterData = + WithPorts + (WithPositionData + { packageQueue : List Package + , sendInterval : Time + , timeToNextSend : Time + , table : Dict Id RouterTableEntry + , outgoingPortId : Id + } + ) + + +type alias CableData = + WithIdData + { port0 : Id + , port1 : Id + , length : Float + , speed : Float + , packages : List Package + } + + +type alias Package = + { senderId : Id + , senderPortId : Id + , positionOnCable : Float + , position : Vec2 + , targetId : Id + , targetPortId : Id + , color : String + , glow : Float + , type_ : PackageType + } + + +type PackageType + = PackageTypeFindTarget Id + | PackageTypeWithFloatValue Float + + +type alias Id = + Int + + +type Device + = Machine MachineData + | TemperatureSensor TemperatureSensorData + | Switch SwitchData + | Router RouterData + | Cable CableData + | Port PortData + | FloatsVisualizer FloatsVisualizerData + + +type Msg + = NoOp + | SendPackage Package + | ReceivePackage Package + + +type alias Simulation = + { devices : Dict Id Device } + + +empty : Simulation +empty = + { devices = Dict.empty + } + + +fromList : List Device -> Simulation +fromList devices = + { devices = + --Debug.log "devs" <| + Dict.fromList <| + --Debug.log "d2" + (List.map deviceToIdDeviceTupple devices) + } + + +mapDevices : (Device -> a) -> Simulation -> List a +mapDevices mapper simulation = + List.map mapper (getDevices simulation) + + +getDevices : Simulation -> List Device +getDevices simulation = + Dict.values simulation.devices + + +getDevice : Id -> Simulation -> Device +getDevice id simulation = + case Dict.get id simulation.devices of + Nothing -> + Debug.crash ("device not found " ++ (toString id)) + + Just reference -> + reference + + +getConnectedPorts : Simulation -> List Id -> List PortData +getConnectedPorts simulation portIds = + List.filter (\port_ -> not (port_.cableId == 0)) <| + List.map (\portId -> getPort portId simulation) <| + portIds + + +getPort : Id -> Simulation -> PortData +getPort id simulation = + case (getDevice id simulation) of + Port port_ -> + port_ + + _ -> + Debug.crash "device is not a port" + + +getCable : Id -> Simulation -> CableData +getCable id simulation = + case (getDevice id simulation) of + Cable cable -> + cable + + _ -> + Debug.crash "device is not a cable" + + +deviceToIdDeviceTupple : Device -> ( Id, Device ) +deviceToIdDeviceTupple device = + ( getDeviceId device, device ) + + +getDeviceId : Device -> Id +getDeviceId device = + case device of + Machine machine -> + machine.id + + TemperatureSensor sensor -> + sensor.id + + Switch switch -> + switch.id + + Router router -> + router.id + + Cable cable -> + cable.id + + Port port_ -> + port_.id + + FloatsVisualizer v -> + v.id + + +simulate : Time -> Simulation -> ( Simulation, Cmd Msg ) +simulate time simulation = + let + new_devices_whith_cmd = + Dict.map (\id device -> simulateDevice time simulation device) simulation.devices + + new_devices = + Dict.map (\id ( device, cmd ) -> device) new_devices_whith_cmd + + new_cmds = + Dict.values <| Dict.map (\id ( device, cmd ) -> cmd) new_devices_whith_cmd + in + { simulation + | devices = + new_devices + -- Dict.map (\id device -> simulateDevice time simulation device) simulation.devices + } + ! (new_cmds) + + +simulateDevice : Time -> Simulation -> Device -> ( Device, Cmd Msg ) +simulateDevice time simulation device = + case device of + Machine machine -> + Machine { machine | produced = machine.produced + machine.speed * time } ! [] + + TemperatureSensor sensor -> + simulateTemperatureSensor time simulation sensor + + Switch switch -> + Switch switch ! [] + + Router router -> + simulateRouter time simulation router + + Cable cable -> + simulateCable time + simulation + cable + + Port port_ -> + Port port_ ! [] + + FloatsVisualizer v -> + FloatsVisualizer v ! [] + + +getRouterTableEntry : Id -> RouterData -> ( RouterTableEntry, RouterData ) +getRouterTableEntry targetId router = + case Dict.get targetId router.table of + Nothing -> + let + entry = + { targetPortId = 0, searchDepth = 0, timeToNextSearch = 0 } + in + ( entry, { router | table = Dict.insert targetId entry router.table } ) + + Just entry -> + ( entry, router ) + + +simulateRouterNextPackage : Time -> Simulation -> Package -> RouterData -> ( Device, Cmd Msg ) +simulateRouterNextPackage time simulation package router = + -- case Dict.get package.targetId router.table of + -- Nothing -> + -- Debug.crash "router has no entry to this target" + -- + -- Just entry -> + (Router router) + ! [ msgToCmd + (SendPackage + { package + | --senderId = router.id + --, + senderPortId = router.outgoingPortId + } + ) + ] + + +simulateRouter : Time -> Simulation -> RouterData -> ( Device, Cmd Msg ) +simulateRouter time simulation router = + let + newTimeToNextSend = + router.timeToNextSend - time + in + if (newTimeToNextSend < 0) then + case List.head router.packageQueue of + Nothing -> + (Router { router | timeToNextSend = 0 }) ! [] + + Just package -> + simulateRouterNextPackage time + simulation + package + { router + | timeToNextSend = newTimeToNextSend + router.sendInterval + , packageQueue = List.drop 1 router.packageQueue + } + else + (Router { router | timeToNextSend = newTimeToNextSend }) ! [] + + +simulatePackageOnCable : Time -> Simulation -> CableData -> Package -> Package +simulatePackageOnCable time simulation cable package = + let + ( startPortId, endPortId, dir ) = + if (package.senderPortId == cable.port0) then + ( cable.port0, cable.port1, 1.0 ) + else if (package.senderPortId == cable.port1) then + ( cable.port1, cable.port0, 1.0 ) + else + Debug.crash "package.senderPortId not on cable" + + startPos = + (getPort startPortId simulation).position + + endPos = + (getPort endPortId simulation).position + + startPosToEndPos = + Vec2.sub endPos startPos + + newPosOnCable = + package.positionOnCable + time * dir * cable.speed * 0.1 + + newPos = + Vec2.add startPos (Vec2.scale (newPosOnCable / cable.length) startPosToEndPos) + in + --Debug.log "p" + { package | positionOnCable = newPosOnCable, position = newPos } + + +simulateCable : Time -> Simulation -> CableData -> ( Device, Cmd Msg ) +simulateCable time simulation cable = + let + new_packages = + List.map + (\package -> + simulatePackageOnCable time simulation cable package + ) + cable.packages + + pend_packages = + List.filter (\p -> p.positionOnCable < cable.length) new_packages + + arr_packages = + List.filter (\p -> not (p.positionOnCable < cable.length)) new_packages + + -- type alias CableData = + -- WithIdData + -- { port0 : Id + -- , port1 : Id + -- , packages : List Package + in + Cable { cable | packages = pend_packages } + ! (List.map + (\p -> + (msgToCmd + (ReceivePackage p) + ) + ) + arr_packages + ) + + +simulateTemperatureSensor : Time -> Simulation -> TemperatureSensorData -> ( Device, Cmd Msg ) +simulateTemperatureSensor time simulation sensor = + let + f = + min 1.0 (0.51 * (Time.inSeconds time)) + + new_sensor = + case Dict.get sensor.machineId simulation.devices of + Nothing -> + { sensor | error = "machine ot found" } + + Just reference -> + case reference of + Machine machine -> + { sensor + | temperature = (sensor.temperature * (1.0 - f)) + (f * (20.0 + (machine.speed * 70.0))) + , timeToNextSend = sensor.timeToNextSend - time + } + + _ -> + { sensor | error = "reference is not a machine" } + in + --Debug.log "sise" <| + if (new_sensor.timeToNextSend < 0) then + TemperatureSensor { new_sensor | timeToNextSend = new_sensor.timeToNextSend + new_sensor.sendInterval } + ! [ (msgToCmd + (SendPackage + { senderId = sensor.id + , senderPortId = sensor.portId + , positionOnCable = 0 + , position = vec2 0 0 + , targetId = sensor.targetId + , targetPortId = 0 + , color = temperatureColor new_sensor.temperature + , glow = 0.5 + , type_ = PackageTypeWithFloatValue new_sensor.temperature + } + ) + ) + ] + else + TemperatureSensor new_sensor ! [] + + +{-| A command to generate a message without performing any action. +This is useful for implementing components that generate events in the manner +of HTML elements, but where the event fires from within Elm code, rather than +by an external trigger. +-} +msgToCmd : msg -> Cmd msg +msgToCmd x = + --Task.perform identity identity (Task.succeed x) + Task.perform identity (Task.succeed x) + + +update : Msg -> Simulation -> ( Simulation, Cmd Msg ) +update msg simulation = + case msg of + NoOp -> + simulation ! [] + + SendPackage package -> + sendPackage package simulation + + ReceivePackage package -> + receivePackage package simulation + + +opositePortIdOnCable : Id -> CableData -> Id +opositePortIdOnCable portId cable = + if (cable.port0 == portId) then + cable.port1 + else if (cable.port1 == portId) then + cable.port0 + else + Debug.crash "port not on cable" + + +sendPackage : Package -> Simulation -> ( Simulation, Cmd Msg ) +sendPackage package simulation = + let + senderPort = + --Debug.log "senderPort" <| + getPort package.senderPortId simulation + + cable = + getCable senderPort.cableId simulation + + targetPortId = + opositePortIdOnCable senderPort.id cable + + new_package = + { package | position = senderPort.position, positionOnCable = 0, targetPortId = targetPortId } + + new_cable = + { cable | id = cable.id, packages = new_package :: cable.packages } + in + { simulation + | devices = Dict.insert new_cable.id (Cable new_cable) simulation.devices + } + ! [] + + +temperatureColor : Float -> String +temperatureColor temperature = + if (temperature < 40) then + "#00ff00" + else if (temperature < 55) then + "#ffc600" + else + "#ff0000" + + +receivePackage : Package -> Simulation -> ( Simulation, Cmd Msg ) +receivePackage package simulation = + let + receiverPort = + getPort package.targetPortId simulation + + receiver = + getDevice receiverPort.receiverId simulation + in + case receiver of + TemperatureSensor sensor -> + simulation ! [] + + FloatsVisualizer v -> + case package.type_ of + PackageTypeWithFloatValue val -> + let + nv = + { v | values = Dict.insert package.senderId val v.values } + in + ({ simulation | devices = Dict.insert nv.id (FloatsVisualizer nv) simulation.devices }) ! [] + + _ -> + Debug.crash "invalid package type for fv" + + Router router -> + let + newrouter = + { router | packageQueue = package :: router.packageQueue } + in + ({ simulation | devices = Dict.insert newrouter.id (Router newrouter) simulation.devices }) + ! [] + + Switch switch -> + --Debug.log "receivePackage receiver not handled" <| + let + redirectPorts = + getConnectedPorts simulation <| + List.filter (\portId -> not (portId == receiverPort.id)) + switch.ports + + redirectCmds = + List.map + (\redirectPort -> + (msgToCmd + (SendPackage + { package + | senderPortId = redirectPort.id + , positionOnCable = 0 + , position = vec2 0 0 + } + ) + ) + ) + redirectPorts + in + simulation + ! redirectCmds + + _ -> + Debug.log "receivePackage receiver not handled" <| simulation ! [] + + +createCable : Id -> Id -> Id -> Float -> Simulation -> Simulation +createCable cableId port0Id port1Id speed simulation = + let + port0 = + getPort port0Id simulation + + port1 = + getPort port1Id simulation + + cable = + { id = cableId + , port0 = port0.id + , port1 = port1.id + , length = Vec2.length (Vec2.sub port0.position port1.position) + , speed = speed + , packages = [] + } + in + if (not (port0.cableId == 0)) then + Debug.crash "port has already a cable" + else if (not (port1.cableId == 0)) then + Debug.crash "port has already a cable" + else + { simulation + | devices = + Dict.insert port0.id + (Port { port0 | cableId = cableId }) + <| + Dict.insert port1.id + (Port { port1 | cableId = cableId }) + <| + Dict.insert + cable.id + (Cable cable) + simulation.devices + } + + + +-- , portId : Id +-- , targetId : Id +-- { senderId : Id +-- , senderPortId : Id +-- , targetId : Id +-- , data : PackageData diff --git a/src/old/SimulationExample.elm b/src/old/SimulationExample.elm new file mode 100644 index 0000000..2b2289b --- /dev/null +++ b/src/old/SimulationExample.elm @@ -0,0 +1,132 @@ +module SimulationExample exposing (..) + +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import List exposing (..) +import Dict exposing (..) +import Time exposing (..) +import Simulation exposing (..) + + +createMachineWithSensorsAndSwitch : Id -> Vec2 -> Id -> List Device +createMachineWithSensorsAndSwitch startId position sensorTargetId = + [ Machine + { id = startId + , position = position + , speed = + if (startId == 200) then + 0.4 + else if (startId == 300) then + 1.0 + else if (startId == 100) then + 0.3 + else + 0.0 + , produced = 0.0 + } + , TemperatureSensor + { id = startId + 1 + , position = Vec2.add position (vec2 0 30) + , machineId = startId + , temperature = 0 + , error = "" + , sendInterval = Time.second * 1.5 + , timeToNextSend = Time.second * 0.1 + , targetId = sensorTargetId + , portId = startId + 2 + } + , Port { id = startId + 2, position = Vec2.add position (vec2 57.05 45.5), cableId = 0, receiverId = startId + 1 } + ] + ++ (createSwitch (startId + 10) (Vec2.add position (vec2 40 80))) + + + +-- ++ [ Cable { id = startId + 20, port0 = startId + 2, port1 = startId + 13, packages = [] } +-- ] + + +createSwitch : Id -> Vec2 -> List Device +createSwitch startId position = + [ Switch + { id = startId + , position = position + , ports = [ startId + 1, startId + 2, startId + 3, startId + 4 ] + } + , Port { id = startId + 1, position = Vec2.add position (vec2 -10 -11), cableId = 0, receiverId = startId } + , Port { id = startId + 2, position = Vec2.add position (vec2 0 -11), cableId = 0, receiverId = startId } + , Port { id = startId + 3, position = Vec2.add position (vec2 10 -11), cableId = 0, receiverId = startId } + , Port { id = startId + 4, position = Vec2.add position (vec2 0 11), cableId = 0, receiverId = startId } + ] + + +createRouter : Id -> Vec2 -> List Device +createRouter startId position = + [ Router + { id = startId + , position = position + , sendInterval = Time.second * 0.2 + , packageQueue = [] + , table = Dict.empty + , timeToNextSend = Time.second * 0.1 + , ports = [ startId + 1, startId + 2, startId + 3, startId + 4, startId + 5 ] + , outgoingPortId = startId + 5 + } + , Port { id = startId + 1, position = Vec2.add position (vec2 -10 0), cableId = 0, receiverId = startId } + , Port { id = startId + 2, position = Vec2.add position (vec2 -5 0), cableId = 0, receiverId = startId } + , Port { id = startId + 3, position = Vec2.add position (vec2 0 0), cableId = 0, receiverId = startId } + , Port { id = startId + 4, position = Vec2.add position (vec2 5 0), cableId = 0, receiverId = startId } + , Port { id = startId + 5, position = Vec2.add position (vec2 10 0), cableId = 0, receiverId = startId } + ] + + +machineSimulation : Simulation +machineSimulation = + Simulation.fromList + ((createMachineWithSensorsAndSwitch 100 (vec2 100 100) 6000) + ++ (createMachineWithSensorsAndSwitch 200 (vec2 200 100) 6000) + ++ (createMachineWithSensorsAndSwitch 300 (vec2 300 100) 6000) + ++ (createMachineWithSensorsAndSwitch 400 (vec2 20 250) 6000) + ++ (createMachineWithSensorsAndSwitch 500 (vec2 80 200) 6000) + ++ (createMachineWithSensorsAndSwitch 600 (vec2 20 550) 6000) + ++ (createMachineWithSensorsAndSwitch 700 (vec2 80 500) 6000) + ++ (createMachineWithSensorsAndSwitch 800 (vec2 180 500) 6000) + ++ (createRouter 1000 (vec2 240 280)) + ++ (createRouter 2000 (vec2 140 380)) + ++ (createRouter 2100 (vec2 280 380)) + ++ (createRouter 2200 (vec2 340 480)) + ++ (createRouter 2300 (vec2 540 480)) + ++ (createRouter 2400 (vec2 280 680)) + ++ [ (FloatsVisualizer { id = 6000, position = vec2 540 200, values = Dict.empty }) ] + ++ [ Port { id = 6001, position = vec2 540 210, cableId = 0, receiverId = 6000 } ] + ) + + +simulation1 : Simulation +simulation1 = + --List.foldl (\sourceP) + List.foldl (\( cableId, port0Id, port1Id, speed ) sim -> createCable cableId port0Id port1Id speed sim) + machineSimulation + [ ( 120, 102, 113, 0.1 ) + , ( 220, 202, 213, 0.1 ) + , ( 320, 302, 313, 0.1 ) + , ( 420, 402, 413, 0.1 ) + , ( 421, 414, 2001, 1.0 ) + , ( 422, 502, 513, 0.1 ) + , ( 423, 514, 2003, 0.19 ) + , ( 1101, 114, 1001, 1.0 ) + , ( 1102, 214, 1002, 1.0 ) + , ( 1103, 314, 1003, 1.0 ) + --, ( 1104, 1004, 2002, 1.0 ) + , ( 1105, 1005, 2102, 1.0 ) + --, ( 1106, 2004, 2201, 1.0 ) + , ( 1107, 2005, 2103, 1.0 ) + , ( 1108, 2105, 2202, 1.0 ) + , ( 1109, 2205, 2301, 1.0 ) + , ( 1110, 2305, 6001, 1.0 ) + , ( 1111, 2405, 2203, 1.0 ) + , ( 1112, 614, 2401, 2.0 ) + , ( 1113, 714, 2402, 2.0 ) + , ( 1114, 602, 613, 2.0 ) + , ( 1115, 702, 713, 2.0 ) + , ( 1116, 814, 2403, 2.0 ) + , ( 1117, 802, 813, 2.0 ) + ] diff --git a/src/old/Story.elm b/src/old/Story.elm new file mode 100644 index 0000000..d9dcfa0 --- /dev/null +++ b/src/old/Story.elm @@ -0,0 +1,147 @@ +module Story exposing (..) + +import Time exposing (Time) + + +type alias Story msg = + { events : List (Event msg) + } + + + +-- type alias Event msg = +-- { occursAt : Time +-- , msg : msg +-- } + + +type Event msg + = Empty msg + | Soon Time { occursAt : Time, msg : msg } + + +type alias Player msg = + { story : Story msg + , time : Time + , paused : Bool + , speed : Float + } + + +empty : msg -> Story msg +empty msg = + { events = [] } + + +andThen : msg -> Story msg -> Story msg +andThen message story = + andIn 0 message story + + +andInS : Float -> Story msg -> Story msg +andInS secs message story = + andIn (Time.second * secs) message story + + +andIn : Time -> Story msg -> Story msg +andIn time message story = + let + event = + Soon time { occursAt = (lastEventOccursAt story), msg = message } + in + { story + | events = story.events ++ [ event ] + } + + +andAt : Time -> Story msg -> Story msg +andAt time message story = + let + newEvent = + Soon time { occursAt = 0, msg = message } + in + { story | events = newEvent :: story.events } + + +lastEventOccursAt : Story msg -> Time +lastEventOccursAt story = + List.foldl maxEventTime 0 story.events + + +maxEventTime event acc = + case event of + Empty message -> + 0 + + Soon time data -> + max time data.occursAt + + +start : Story msg -> Player msg +start story = + { story = story + , time = 0 + , paused = False + , speed = 1 + } + + +setPaused : Bool -> Player msg -> Player msg +setPaused paused player = + { player | paused = paused } + + +setSpeed : Float -> Player msg -> Player msg +setSpeed speed player = + if (speed <= 0 || 100 < speed) then + Debug.crash "speed out of range" + else + { player | speed = speed } + + +tick : Time -> (msg -> model -> ( model, Cmd msg )) -> Player msg -> model -> ( Player msg, model, Cmd msg ) +tick time update player model = + if (player.paused) then + ( player, model, Cmd.none ) + else + let + newtime = + player.time + time * player.speed + + events = + List.filter (occursIn player.time newtime) player.story.events + + ( newmodel, msg ) = + executeEvents update events model + in + ( { player + | time = newtime + } + , newmodel + , msg + ) + + +executeEvents : (msg -> model -> ( model, Cmd msg )) -> List (Event msg) -> model -> ( model, Cmd msg ) +executeEvents update events model = + List.foldl + (\event ( premodel, precmd ) -> + case event of + Empty message -> + ( premodel, precmd ) + + Soon time data -> + update data.msg premodel + ) + ( model, Cmd.none ) + events + + +occursIn : Time -> Time -> Event msg -> Bool +occursIn start end event = + case event of + Empty message -> + False + + Soon time data -> + (start <= data.occursAt) && (data.occursAt < end) diff --git a/src/old/StoryExample.elm b/src/old/StoryExample.elm new file mode 100644 index 0000000..3a1f4e6 --- /dev/null +++ b/src/old/StoryExample.elm @@ -0,0 +1,170 @@ +module StoryExample exposing (..) + +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) +import Story exposing (Story) +import SubTitles +import Task +import Animation +import AnimationFrame + + +story1 : Story Msg + + +story1x = + Story.andThen (ShowMessage "Die Animationen werden dadurch nicht schneller.") <| + Story.andInS 1 (ShowMessage "Die Geschwindigkeit beeinflusst nur die Story.") <| + Story.andInS 2 (ShowMessage "Sie können die Story pausieren und wieder starten.") <| + Story.andInS 2 (ShowMessage "Unten können Sie neue Stories starten.") <| + Story.andThen (ShowMessage "Mit dem Player werden die Events abgespielt.") <| + Story.andInS 1 (ShowMessage "Die Story besteht aus Events.") <| + Story.andInS 1 (ShowMessage "Story") <| + Story.andThen (ShowMessage "Dieses Beispiel demonstriert die Fähigkeiten von") <| + Story.empty NoOp + + +story1 = + [ Wait 5 * Time.second + , ShowMessage "Hallo" + , ShowMessage "Welt" + , Wait 1 * Time.second + , ShowMessage "Welt" + ] + + + +-- story2 : Story Msg +-- story2 = +-- { events = +-- [ { occursIn = Time.second * 0, msg = (ShowMessage "Story 2") } +-- ] +-- } + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +type alias Model = + { story : Story Msg + , storySpeed : Float + , paused : Bool + , player : Story.Player Msg + , subtitles : SubTitles.Model + } + + +type Msg + = NoOp + | Animate Time + | ShowMessage String + | StartStory (Story Msg) + | SetStorySpeedFromString String + | SetStorySpeed Float + | Pause + | Continue + + +init : ( Model, Cmd Msg ) +init = + ( { story = story1 + , storySpeed = 1.0 + , paused = False + , player = Story.start story1 + , subtitles = SubTitles.default + } + , Cmd.none + ) + + +startStory : Story Msg -> Model -> ( Model, Cmd Msg ) +startStory newstory model = + ( { model + | story = newstory + , player = Story.setPaused model.paused <| Story.setSpeed model.storySpeed <| Story.start newstory + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + Animate time -> + animate time model + + ShowMessage message -> + { model | subtitles = SubTitles.addMessage message model.subtitles } ! [] + + StartStory story -> + startStory story model + + SetStorySpeedFromString speedString -> + update (SetStorySpeed (0.05 * (Result.withDefault 0 (String.toFloat speedString)))) model + + SetStorySpeed speed -> + { model | storySpeed = speed, player = Story.setSpeed speed model.player } ! [] + + Pause -> + { model | paused = True, player = Story.setPaused True model.player } ! [] + + Continue -> + { model | paused = False, player = Story.setPaused False model.player } ! [] + + +animate : Time -> Model -> ( Model, Cmd Msg ) +animate time model = + let + ( newplayer, newmodel, msg ) = + Story.tick time update model.player model + in + { newmodel + | player = newplayer + , subtitles = SubTitles.animate time newmodel.subtitles + } + ! [ msg ] + + +view : Model -> Html Msg +view model = + Html.div [] + [ SubTitles.view model.subtitles + , Html.div [] + [ Html.button [ HE.onClick (StartStory story1) ] [ Html.text "Story 1" ] + --, Html.button [ HE.onClick (StartStory story2) ] [ Html.text "Story 2" ] + ] + , Html.div [] + [ Html.button [ HE.onClick Pause ] [ Html.text "Pause" ] + , Html.button [ HE.onClick Continue ] [ Html.text "Continue" ] + ] + , Html.div [] + [ Html.text "Story-Geschwindigkeit:" + , Html.input + [ HA.type_ "range" + , HA.value (toString (model.player.speed / 0.05)) + , HE.onInput SetStorySpeedFromString + ] + [] + , Html.text <| toString model.player.speed + ] + ] + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ AnimationFrame.diffs Animate + ] diff --git a/src/old/SubTitles.elm b/src/old/SubTitles.elm new file mode 100644 index 0000000..6619b95 --- /dev/null +++ b/src/old/SubTitles.elm @@ -0,0 +1,96 @@ +module SubTitles exposing (..) + +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) + + +type alias Model = + { fontsize : Int + , defaultTimeToDestroy : Time + , messages : List Message + } + + +type alias Message = + { timeToDestroy : Time + , title : String + } + + +default : Model +default = + init 22 (2 * Time.second) + + +init : Int -> Time -> Model +init fontsize defaultTimeToDestroy = + { fontsize = fontsize + , defaultTimeToDestroy = defaultTimeToDestroy + , messages = [] + } + + +animate : Time -> Model -> Model +animate time model = + { model + | messages = List.filter isMessageAlive <| List.map (animateMessage time) model.messages + } + + +animateMessage : Time -> Message -> Message +animateMessage time message = + { message + | timeToDestroy = message.timeToDestroy - time + } + + +isMessageAlive : Message -> Bool +isMessageAlive message = + message.timeToDestroy > 0 + + +view : Model -> Html msg +view model = + Html.div + [ HA.style + [ ( "min-height", "100px" ) + , ( "max-height", "100px" ) + , ( "border", "1px solid #000000" ) + , ( "margin", "2px" ) + ] + ] + [ Html.div [] (List.map (viewMessage model) model.messages) + ] + + +viewMessage : Model -> Message -> Html msg +viewMessage model message = + let + fontsize = + (toFloat model.fontsize) * (min 1.0 (message.timeToDestroy / 1000)) + in + Html.div + [ HA.style [ ( "font-size", (toString fontsize) ++ "px" ) ] + ] + [ Html.text <| message.title + ] + + +addMessage : String -> Model -> Model +addMessage title model = + addMessageWithTimeToDestroy model.defaultTimeToDestroy title model + + +addMessageWithTimeToDestroy : Float -> String -> Model -> Model +addMessageWithTimeToDestroy timeToDestroy title model = + { model + | messages = + model.messages + ++ [ { timeToDestroy = timeToDestroy + , title = title + } + ] + } diff --git a/src/old/SubTitlesExample.elm b/src/old/SubTitlesExample.elm new file mode 100644 index 0000000..8e21748 --- /dev/null +++ b/src/old/SubTitlesExample.elm @@ -0,0 +1,76 @@ +module SubTitlesExample exposing (..) + +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Task +import Time exposing (Time) +import SubTitles +import Animation +import AnimationFrame + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +type alias Model = + { subtitles : SubTitles.Model + } + + +type Msg + = NoOp + | Animate Time + | ShowMessage String + + +init : ( Model, Cmd Msg ) +init = + ( { subtitles = + SubTitles.addMessageWithTimeToDestroy (Time.second * 6) "SubTitles" <| + SubTitles.addMessage "Dieses Beispiel zeigt die Möglichkeiten von" <| + SubTitles.default + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + Animate time -> + { model + | subtitles = SubTitles.animate time model.subtitles + } + ! [] + + ShowMessage message -> + { model | subtitles = SubTitles.addMessage message model.subtitles } ! [] + + +view : Model -> Html Msg +view model = + Html.div [] + [ SubTitles.view model.subtitles + , Html.div [] + [ Html.button [ HE.onClick (ShowMessage "Neuer SubTitle") ] [ Html.text "Sub-Titel erstellen" ] + ] + ] + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ AnimationFrame.diffs Animate + ] diff --git a/src/old/VisualizationHtml.elm b/src/old/VisualizationHtml.elm new file mode 100644 index 0000000..00efd02 --- /dev/null +++ b/src/old/VisualizationHtml.elm @@ -0,0 +1,44 @@ +module VisualizationHtml exposing (..) + +import VirtualDom as VD +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (..) + + +viewDevice : Device -> Html.Html msg +viewDevice device = + Html.div + [] + [ Html.text + (case device of + Machine machine -> + "machine " ++ (toString machine.id) ++ " with speed " ++ (toString machine.speed) ++ " produced " ++ (toString machine.produced) + + TemperatureSensor sensor -> + "temperatur sensor " + ++ (toString sensor.id) + ++ " for " + ++ (toString sensor.machineId) + ++ " with value " + ++ (toString sensor.temperature) + ++ " " + ++ sensor.error + + Switch switch -> + "switch " ++ (toString switch.id) + + _ -> + "a device with unknown type" + ) + ] + + +view : Simulation -> Html.Html msg +view simulation = + Html.div [] + (Simulation.mapDevices viewDevice simulation) diff --git a/src/old/VisualizationHtmlExample.elm b/src/old/VisualizationHtmlExample.elm new file mode 100644 index 0000000..d0ebe6d --- /dev/null +++ b/src/old/VisualizationHtmlExample.elm @@ -0,0 +1,66 @@ +module VisualizationHtmlExample exposing (..) + +import VirtualDom as VD +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (Simulation) +import SimulationExample +import VisualizationHtml as VH +import AnimationFrame + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +type alias Model = + { simulation : Simulation + } + + +type Msg + = NoOp + | Animate Time + + +init : ( Model, Cmd Msg ) +init = + ( { simulation = SimulationExample.simulation1 + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + Animate time -> + { model | simulation = Simulation.simulate time model.simulation } ! [] + + +view : Model -> Html Msg +view model = + Html.div [] + [ Html.text "SimulationExample" + , VH.view model.simulation + ] + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ AnimationFrame.diffs Animate + ] diff --git a/src/old/VisualizationSvg.elm b/src/old/VisualizationSvg.elm new file mode 100644 index 0000000..8378d53 --- /dev/null +++ b/src/old/VisualizationSvg.elm @@ -0,0 +1,320 @@ +module VisualizationSvg exposing (..) + +import VirtualDom as VD +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Dict +import List +import Time exposing (Time) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (Simulation) +import VisualizationHtml as VH +import AnimationFrame +import Svg exposing (..) +import Svg.Events as SE exposing (..) +import Svg.Attributes exposing (..) +import Simulation exposing (..) + + +type Msg + = OnMachineClick Simulation.Id + + +update : Msg -> Simulation -> ( Simulation, Cmd Msg ) +update msg simulation = + case msg of + OnMachineClick id -> + (Debug.log ("macli" ++ (toString id)) simulation) ! [] + + +translation : Vec2 -> String +translation pos = + "translate(" ++ (toString <| Vec2.getX pos) ++ "," ++ (toString <| Vec2.getY pos) ++ ")" + + +vec2xky : Vec2 -> String +vec2xky pos = + (toString <| Vec2.getX pos) ++ "," ++ (toString <| Vec2.getY pos) + + +viewMachinePackage : Float -> Svg.Svg Msg +viewMachinePackage production = + let + pf = + ((production) - toFloat (round (production))) + + o = + toString (1.0 * (0.5 - (1.2 * pf))) + in + rect + [ height "39.96" + , width "39.96" + , x (toString (150.0 - 300.0 * pf)) + , y "233.112" + , fill "#00A99D" + , fillOpacity o + , stroke "#000000" + , strokeOpacity o + , strokeWidth "15" + , strokeMiterlimit "4" + , strokeLinejoin "round" + ] + [] + + +viewMachine : Simulation.MachineData -> Svg.Svg Msg +viewMachine machine = + let + production = + machine.produced * 0.002 + in + g + [ transform (translation machine.position) + ] + [ g + [ transform ("scale( 0.1)") ] + [ g [ x "9000", onClick (OnMachineClick machine.id) ] + [ viewMachinePackage (production + 0.0) + , viewMachinePackage (production + 0.25) + , viewMachinePackage (production + 0.5) + , viewMachinePackage (production + 0.75) + , rect + [ height "288.484", fill "#F7931E", width "213.969", x "287.832", y "40.123" ] + [] + , polygon [ points "501.801,328.596 244.781,328.596 287.83,377.314 468.368,377.314 ", fill "#00A99D" ] [] + , rect [ height "94.567", fill "#F7931E", width "180.536", x "287.832", y "377.309" ] [] + , rect [ height "169.072", fill "#B3B3B3", width "81.196", x "324.131", y "76.417" ] [] + , rect [ height "39.165", fill "#F7931E", width "33.028", x "348.211", y "131.824" ] [] + , Svg.path [ d "M37.962,328.596H287.83V273.07H37.962c-15.333,0.001-27.763,12.431-27.763,27.764l0,0 C10.199,316.167,22.629,328.596,37.962,328.596z", fill "#B3B3B3" ] [] + , Svg.path [ d "m 512,40.118 c 0,-5.632 -4.567,-10.199 -10.199,-10.199 l -213.971,0 c -5.632,0 -10.199,4.567 -10.199,10.199 l 0,222.754 C 117.78441,262.50092 119.0417,262.873 37.962,262.873 17.03,262.872 0,279.902 0,300.834 c 0,20.932 17.03,37.962 37.962,37.962 l 202.221,0 37.448,42.378 0,90.708 c 0,5.632 4.567,10.199 10.199,10.199 l 180.537,0 c 5.632,0 10.199,-4.567 10.199,-10.199 l 0,-91.405 31.643,-46.109 c 0.005,-0.007 0.008,-0.014 0.012,-0.021 0.24,-0.35 0.452,-0.718 0.647,-1.097 0.042,-0.082 0.08,-0.164 0.118,-0.247 0.153,-0.317 0.289,-0.643 0.408,-0.977 0.027,-0.074 0.057,-0.148 0.082,-0.222 0.133,-0.399 0.244,-0.807 0.326,-1.225 0.009,-0.048 0.013,-0.096 0.021,-0.144 0.064,-0.351 0.108,-0.709 0.136,-1.072 0.01,-0.13 0.014,-0.258 0.019,-0.388 0.005,-0.126 0.019,-0.25 0.019,-0.377 l 0,-288.48 z m -213.971,10.199 193.573,0 0,268.081 -193.573,0 z M 37.962,318.398 c -9.685,0 -17.564,-7.88 -17.564,-17.564 0,-9.684 7.879,-17.564 17.564,-17.564 l 239.668,0 0,7.306 -176.713,0 c -5.633,0 -10.199,4.567 -10.199,10.199 0,5.632 4.566,10.199 10.199,10.199 l 176.713,0 0,7.423 -239.668,0 z m 420.207,143.284 -160.14,0 0,-74.17 160.14,0 z m 24.263,-122.885 -19.435,28.318 -170.57,0 -25.023,-28.318 z" ] [] + , Svg.path [ d "M338.012,210.149c0,5.632,4.567,10.199,10.199,10.199h33.029c5.632,0,10.199-4.567,10.199-10.199V131.82 c0-5.632-4.567-10.199-10.199-10.199h-33.029c-5.632,0-10.199,4.567-10.199,10.199V210.149z M358.41,142.019h12.631v18.766H358.41 V142.019z M371.041,199.95H358.41v-18.766h12.631V199.95z" ] + [] + , Svg.path [ d "M324.129,255.69h81.194c5.632,0,10.199-4.567,10.199-10.199V76.417c0-5.632-4.567-10.199-10.199-10.199h-81.194 c-5.632,0-10.199,4.567-10.199,10.199v169.074C313.929,251.124,318.496,255.69,324.129,255.69z M334.328,86.616h60.795v148.676 h-60.795V86.616z" ] [] + , Svg.path [ d "M69.675,290.576h-6.943c-5.633,0-10.199,4.567-10.199,10.199c0,5.632,4.566,10.199,10.199,10.199h6.943 c5.633,0,10.199-4.567,10.199-10.199C79.874,295.143,75.308,290.576,69.675,290.576z" ] [] + ] + ] + ] + + +viewPackage : Package -> Svg.Svg msg +viewPackage package = + Svg.circle + [ cx (toString <| Vec2.getX package.position) + , cy (toString <| Vec2.getY package.position) + , r "3" + , fill package.color + , stroke package.color + , strokeWidth "2" + , strokeOpacity (toString package.glow) + ] + [] + + +packPos : Vec2 -> Vec2 -> Float -> Vec2 +packPos start dir time = + let + t = + if time > 1.0 then + time - 1.0 + else + time + in + Vec2.add start <| Vec2.scale t dir + + +viewTemperatureSensor : TemperatureSensorData -> Svg.Svg msg +viewTemperatureSensor sensor = + let + pos = + sensor.position + + temperature = + sensor.temperature + + c = + temperatureColor temperature + + h = + 99.0 * ((temperature - 20.0) / 50.0) + in + g [] + [ g [ transform (translation (Vec2.add pos <| vec2 20 -50)) ] + [ g [ transform ("scale( 0.1)") ] + [ Svg.path [ d "m 366.62698,608.15939 c -9.64247,-1.62509 -18.33214,-8.15321 -22.82744,-17.14911 -6.31057,-12.62856 -3.22155,-28.25528 7.44058,-37.64047 2.63962,-2.32348 6.97834,-4.99844 9.6416,-5.94435 10.12734,-3.30195 10.1672,-2.98265 22.18471,-0.11274 22.22994,8.72935 27.56276,36.78101 10.03733,52.79826 -7.39597,6.75951 -16.92938,9.65747 -26.47678,8.04841 z", fill c ] [] + , Svg.path [ d "m 355.32624,624.83474 c -11.80993,-4.02485 -21.47242,-12.17944 -28.02955,-23.65535 -3.94215,-6.89932 -5.74215,-14.42262 -5.74215,-24 0,-16.81121 6.29226,-29.86245 19.38596,-40.20984 l 5.11404,-4.0414 0.5,-45.12438 c 0.48605,-43.8657 0.56032,-45.23595 2.66237,-49.12438 4.81444,-8.90585 12.35439,-13.5 22.15629,-13.5 10.67981,0 17.88762,4.04468 24.76004,13.72522 1.5667,34.23928 1.11856,34.38418 1.21887,49.44055 l 0.29756,44.66576 5.31472,4.01266 c 11.76923,8.88585 19.53293,24.73358 19.57537,39.9584 0.062,22.22882 -15.90931,43.09733 -37.35361,48.80728 -8.21329,2.18695 -21.92851,1.74852 -29.85991,-0.95452 z m 26.94606,-11.16417 c 17.96613,-5.33537 30.56658,-24.68236 27.36277,-42.01335 -2.31706,-12.53415 -9.50334,-22.84108 -19.6059,-28.11977 l -5.46988,-2.85806 -0.006,-47 c -0.006,-44.84915 -0.0956,-47.14651 -1.95827,-50.20145 -5.57426,-9.1421 -18.32283,-7.78154 -22.66936,2.41933 -1.0949,2.56961 -1.37112,12.47225 -1.37112,49.15454 l 0,45.93666 -5.25097,2.96347 c -6.74331,3.80568 -13.22295,10.86374 -16.5729,18.0523 -3.67942,7.89557 -3.81968,21.01484 -0.31192,29.17515 7.7939,18.13144 27.68326,27.88717 45.85355,22.49118 z", fill "#000000" ] [] + , rect [ height (toString h), fill c, width "14.596", x "364.131", y (toString (546.417 - h)) ] [] + ] + ] + -- , (viewPort sensor.port_) + ] + + +viewPort : PortData -> Svg.Svg msg +viewPort port_ = + rect + [ height "5.0" + , width "5.0" + , x (toString ((Vec2.getX port_.position) - 2.5)) + , y (toString ((Vec2.getY port_.position) - 2.5)) + , fill "#dddddd" + , stroke "#999999" + , strokeWidth "2" + , strokeMiterlimit "6" + , strokeLinejoin "round" + ] + [] + + +viewSwitch : SwitchData -> Svg.Svg msg +viewSwitch switch = + g [] + ([ rect + [ height "10.0" + , width "10.0" + , x (toString ((Vec2.getX switch.position) - 5.0)) + , y (toString ((Vec2.getY switch.position) - 5.0)) + , fill "#999999" + , stroke "#000000" + , strokeWidth "2" + , strokeMiterlimit "6" + , strokeLinejoin "round" + ] + [] + ] + -- ++ (List.map viewPort switch.ports) + ) + + +viewRouter : RouterData -> Svg.Svg msg +viewRouter router = + g [] + ([ rect + [ height "12.0" + , width "32.0" + , x (toString ((Vec2.getX router.position) - 16.0)) + , y (toString ((Vec2.getY router.position) - 6.0)) + , fill "#999999" + , stroke "#000000" + , strokeWidth "2" + , strokeMiterlimit "6" + , strokeLinejoin "round" + ] + [] + , rect + [ height "10.0" + , width (toString (Basics.min 30.0 (toFloat (List.length router.packageQueue)))) + , x (toString ((Vec2.getX router.position) - 15.0)) + , y (toString ((Vec2.getY router.position) - 5.0)) + , fill "#ff0000" + ] + [] + ] + ) + + + +-- +-- viewCableWithSomePackages : Vec2 -> Vec2 -> Float -> Svg.Svg msg +-- viewCableWithSomePackages start end time = +-- let +-- dir = +-- Vec2.sub end start +-- in +-- g +-- [] +-- [ Svg.path [ d ("m " ++ (vec2xky start) ++ " " ++ (vec2xky dir)), stroke "#000000", strokeWidth "7.2" ] [] +-- , viewPackage (packPos start dir (time + 0.0)) time "#ff0000" +-- , viewPackage (packPos start dir (time + 0.2)) time "#00ff00" +-- , viewPackage (packPos start dir (time + 0.4)) time "#0000ff" +-- , viewPackage (packPos start dir (time + 0.6)) time "#ffc600" +-- , viewPackage (packPos start dir (time + 0.8)) time "#ff0000" +-- , viewPackage (packPos start dir (time + 0.8875)) time "#00ff00" +-- , viewPackage (packPos start dir (time + 0.9)) time "#ff0000" +-- ] + + +viewCable : Simulation -> CableData -> Svg.Svg Msg +viewCable simulation cable = + let + port0 = + getPort cable.port0 simulation + + port1 = + getPort cable.port1 simulation + + dir = + Vec2.sub port1.position port0.position + in + g [] + ([ Svg.path [ d ("m " ++ (vec2xky port0.position) ++ " " ++ (vec2xky dir)), stroke "#000000", strokeWidth "2.2" ] [] + ] + ++ (List.map viewPackage cable.packages) + ) + + +viewFloatsVisualizer : FloatsVisualizerData -> Svg.Svg Msg +viewFloatsVisualizer v = + let + thetext = + Dict.foldl (\id val t -> t ++ (toString id) ++ "=" ++ (toString val) ++ " | ") "" v.values + in + g [] + [ rect + [ height "12.0" + , width "32.0" + , x (toString ((Vec2.getX v.position) - 16.0)) + , y (toString ((Vec2.getY v.position) - 6.0)) + , fill "#999999" + , stroke "#000000" + , strokeWidth "2" + , strokeMiterlimit "6" + , strokeLinejoin "round" + ] + [] + , text_ + [ x (toString ((Vec2.getX v.position) - 20.5)) + , y (toString ((Vec2.getY v.position) - 20.5)) + --, text "hallo" + ] + [ Svg.text thetext ] + ] + + +viewDevice : Simulation -> Simulation.Device -> Svg.Svg Msg +viewDevice simulation device = + case device of + Simulation.Machine machine -> + viewMachine machine + + Simulation.TemperatureSensor sensor -> + viewTemperatureSensor sensor + + Switch switch -> + viewSwitch switch + + Router router -> + viewRouter router + + Port port_ -> + viewPort port_ + + Cable cable -> + viewCable simulation cable + + FloatsVisualizer v -> + viewFloatsVisualizer v + + +viewSimulation : Simulation -> Html Msg +viewSimulation simulation = + Html.div [] + [ svg + [ version "1.1" + , x "0" + , y "0" + , viewBox "0 0 1323.141 1322.95" + ] + (Simulation.mapDevices (\device -> viewDevice simulation device) simulation) + ] diff --git a/src/old/VisualizationSvgExample.elm b/src/old/VisualizationSvgExample.elm new file mode 100644 index 0000000..94fbd6d --- /dev/null +++ b/src/old/VisualizationSvgExample.elm @@ -0,0 +1,92 @@ +module VisualizationSvgExample exposing (..) + +import VirtualDom as VD +import Html exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import String +import Time exposing (Time) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (Simulation) +import VisualizationHtml as VH +import AnimationFrame +import Svg exposing (..) +import Svg.Attributes exposing (..) +import Simulation exposing (Simulation) +import SimulationExample +import VisualizationSvg exposing (..) + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +type alias Model = + { simulation : Simulation + , time : Time + } + + +type Msg + = NoOp + | Animate Time + | SimulationMsg Simulation.Msg + | VisualizationSvgMsg VisualizationSvg.Msg + + +init : ( Model, Cmd Msg ) +init = + ( { simulation = SimulationExample.simulation1 + , time = 0 + } + , Cmd.none + ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + Animate time -> + let + ( new_simulation, simulation_msg ) = + Simulation.simulate time model.simulation + in + { model | time = model.time + time, simulation = new_simulation } ! [ Cmd.map SimulationMsg simulation_msg ] + + SimulationMsg simulation_msg -> + let + ( newsim, new_simulation_cmd ) = + Simulation.update simulation_msg model.simulation + in + { model | simulation = newsim } ! [ Cmd.map SimulationMsg new_simulation_cmd ] + + VisualizationSvgMsg svgmsg -> + let + ( newsim, newsvgcmd ) = + VisualizationSvg.update svgmsg model.simulation + in + { model | simulation = newsim } ! [ Cmd.map VisualizationSvgMsg newsvgcmd ] + + +view : Model -> Html Msg +view model = + Html.div [] + [ Html.text "VisualizationSvgExample" + , Html.map VisualizationSvgMsg (viewSimulation model.simulation) + ] + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ AnimationFrame.diffs Animate + ] diff --git a/tests/MachineTest.elm b/tests/MachineTest.elm new file mode 100644 index 0000000..774b5b0 --- /dev/null +++ b/tests/MachineTest.elm @@ -0,0 +1,48 @@ +module MachineTest exposing (..) + +import Test exposing (..) +import Time exposing (..) +import Expect +import Fuzz exposing (list, int, tuple, string) +import String +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import SimulationTypes exposing (..) +import Simulation exposing (..) +import Machine exposing (..) + + +machine0 = + Machine.create (vec2 0 0) + + + +-- ( machine1, cmds1 ) = +-- Machine.update (Machine.SetSpeed 1.0) machine0 + + +machine1 = + Machine.setSpeed 1.0 machine0 + + +( machine2, cmds2 ) = + Machine.tick (second * 1.0) Simulation.empty machine1 +( machine3, cmds3 ) = + Machine.tick (second * 1.0) Simulation.empty machine2 + + +all : Test +all = + describe "Machine Test" + [ test "initial speed" <| + \() -> Expect.equal machine0.speed 0.0 + , test "set speed" <| + \() -> Expect.equal machine1.speed 1.0 + , test "produced" <| + \() -> Expect.equal machine2.produced 0.5 + , test "temperature changed" <| + \() -> Expect.equal machine2.temperature 27.0 + , test "produced 2" <| + \() -> Expect.equal machine3.produced 1.0 + , test "temperature changed 2" <| + \() -> Expect.equal machine3.temperature 33.3 + ] diff --git a/tests/Main.elm b/tests/Main.elm index b08644d..832ee3d 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -4,6 +4,8 @@ import Test exposing (..) import Test.Runner.Node exposing (run, TestProgram) import Json.Encode exposing (Value) import StoryTest +import MachineTest +import SimulationTest main : TestProgram @@ -12,6 +14,8 @@ main = describe "VST - Story Test Suite" [ --Tests.all, StoryTest.all + , MachineTest.all + , SimulationTest.all ] diff --git a/tests/SimulationTest.elm b/tests/SimulationTest.elm new file mode 100644 index 0000000..ed2f72d --- /dev/null +++ b/tests/SimulationTest.elm @@ -0,0 +1,111 @@ +module SimulationTest exposing (..) + +import Test exposing (..) +import Time exposing (..) +import Expect +import Dict +import Fuzz exposing (list, int, tuple, string) +import String +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Simulation exposing (..) +import SimulationTypes exposing (..) +import SimulationUpdate exposing (..) +import Machine exposing (..) +import Sensor exposing (..) + + +sim0 = + empty + + +sim1 = + addDevice + 1000 + (MachineType (Machine.create (vec2 0 0))) + sim0 + + +( sim2, msgs2 ) = + update (SetMachineSpeed 1000 1.0) sim1 + + + +--MachineMsg 1000 (Machine.SetSpeed 1.0)) sim1 + + +sim3 = + addDevice + 1001 + (SensorType + (Sensor.create + (\simulation -> + case findDevice 1000 simulation of + Just device -> + case device.type_ of + MachineType machine -> + machine.temperature + + _ -> + Debug.crash "device not a machine" + + Nothing -> + Debug.crash "machine not found" + ) + 1002 + 9000 + ) + ) + sim2 + + + +-- +-- machine0 = +-- Machine.create (vec2 0 0) +-- +-- +-- ( machine1, cmds1 ) = +-- Machine.update (Machine.SetSpeed 1.0) machine0 +-- ( machine2, cmds2 ) = +-- Machine.update (Machine.Animate (second * 1.0)) machine1 +-- ( machine3, cmds3 ) = +-- Machine.update (Machine.Animate (second * 1.0)) machine2 + + +all : Test +all = + describe "Simulation Test" + [ test "initial simulation" <| + \() -> Expect.equal (Dict.size sim0.devices) 0 + , test "no errors 0" <| + \() -> Expect.equal sim0.errors [] + , test "no errors 1" <| + \() -> Expect.equal sim1.errors [] + , test "device added" <| + \() -> Expect.equal (Dict.size sim1.devices) 1 + , test "no errors 2" <| + \() -> Expect.equal sim2.errors [] + , test "machine speed changed" <| + \() -> + Expect.equal + (case (getDevice 1000 sim2).type_ of + MachineType machine -> + machine.speed + + _ -> + -1.0 + ) + 1.0 + , test "no errors 3" <| + \() -> Expect.equal sim3.errors [] + -- , test "set speed" <| + -- \() -> Expect.equal machine1.speed 1.0 + -- , test "produced" <| + -- \() -> Expect.equal machine2.produced 0.5 + -- , test "temperature changed" <| + -- \() -> Expect.equal machine2.temperature 27.0 + -- , test "produced 2" <| + -- \() -> Expect.equal machine3.produced 1.0 + -- , test "temperature changed 2" <| + -- \() -> Expect.equal machine3.temperature 33.3 + ] diff --git a/tests/elm-package.json b/tests/elm-package.json index ea659db..71370bd 100644 --- a/tests/elm-package.json +++ b/tests/elm-package.json @@ -9,6 +9,7 @@ ], "exposed-modules": [], "dependencies": { + "elm-community/linear-algebra": "1.0.0 <= v < 2.0.0", "elm-community/json-extra": "2.0.0 <= v < 3.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", "mgold/elm-random-pcg": "4.0.2 <= v < 5.0.0",