Commit 651999e0 authored by Thorsten Wißmann's avatar Thorsten Wißmann 🐧
Browse files

Cache rendering results as much as possible

parent 1d7cab43
......@@ -15,6 +15,7 @@ import String
import TrackA
import TrackA exposing (TrackA)
import Either
import Svg.Lazy as Svg
type Direction = Upwards | Downwards
......@@ -199,7 +200,7 @@ renderCarriageAt flags attributes (a1,p1) (a2,p2) =
, SvgAttr.ry (toString carConfig.roundness_y)
]
carConfig.carLen carConfig.carWidth car_center car_angle
, SvgUtils.svgCenteredText [ SvgAttr.class "carLabel" ] flags.label car_center car_angle
, SvgUtils.svgCenteredText [ SvgAttr.class "carLabel" ] (Debug.log "Rendering car" flags.label) car_center car_angle
-- , SvgUtils.svgAngledPoint <| { angle = a1, p = p1 }
-- , SvgUtils.svgAngledPoint <| { angle = a2, p = p2 }
-- , SvgUtils.svgAngledPoint <| { angle = car_angle, p = car_center }
......@@ -227,8 +228,7 @@ renderCarriageOnPath offset path attributes car =
)
|> Maybe.withDefault (0, {x=0, y=0})
in
[ renderCarriageAt
car.flags attributes
[ renderCarriageAt car.flags attributes
(offset2point axis1)
(offset2point axis2)
]
......
......@@ -34,6 +34,7 @@ import Html.App
import Svg.Attributes as SvgAttr
import Svg
import Svg.Events
import Svg.Lazy as Svg
import SvgUtils
import AnimationFrame
import TrackA
......@@ -46,7 +47,7 @@ import Char
import P2D
-- MODEL
type alias Model =
type alias RawModel render_cache =
{ rt : RT.LayoutedRailTree (Has RT.Path ()) ()
, cars : Array C.Carriage
, initial_car_positions : Array RT.Path
......@@ -60,12 +61,21 @@ type alias Model =
, time_requested : List (Time -> Msg)
-- wether to show the cars in the desired order
, show_train_preview : Bool
, train_preview : (SvgUtils.BoundedSvg TrainPreview.EmptyType)
, show_shunt_labels : Bool
, shunt_labels : List (Svg.Svg TrainPreview.EmptyType)
, history : History
, render_cache : render_cache
}
type alias RenderingCache =
{ train_preview : (SvgUtils.BoundedSvg TrainPreview.EmptyType)
, shunt_labels : List (Svg.Svg TrainPreview.EmptyType)
, rendered_rail_tree : List (Svg.Svg Msg)
, bbox_rail_tree : SvgUtils.BoundingRect
}
type alias Model = RawModel RenderingCache
-- UPDATE
type Msg =
RailClicked RT.Path
......@@ -107,16 +117,12 @@ init car_positions rail_net =
, time_requested = []
, show_train_preview = True
, query = query
, train_preview = TrainPreview.render cars query
, show_shunt_labels = False
, shunt_labels =
Shunt.shunts rail_net
|> List.filter (not << List.isEmpty)
|> List.indexedMap (Shunt.view layouted_rail_net Shunt.showTrackIdx)
, history = RPHistory.init
, render_cache = ()
}
in
model
fillRenderCache model
getQuery : Model -> List Int
......@@ -192,8 +198,8 @@ runCommandNoHistory cmd model =
RPCmd.SetQuery query ->
{ model
| query = query
, train_preview = TrainPreview.render model.cars query
}
|> fillRenderCache
RPCmd.Batch cmds ->
List.foldl runCommand model cmds
......@@ -367,7 +373,40 @@ isSolved model =
|> Maybe.map correct_order
|> Maybe.withDefault False
-- VIEW
fillRenderCache : RawModel a -> Model
fillRenderCache model =
let
singleton x = [x]
-- the bumper at the root
root_bumper =
RT.Junction (Has.unit RT.AutoAngles) [] -- take a simple bumper
-- layout it at the root but with the reversed angle
|> RT.layoutRailTreeAt (P2D.Angled -180 (P2D.P2D 0.0 0.0))
root_bumper_svg : List (Svg.Svg Msg)
root_bumper_svg =
RT.renderRailTree TrainPreview.exfalso root_bumper
in
{ model | render_cache =
{ train_preview = TrainPreview.render model.cars model.query
, shunt_labels =
Shunt.shunts model.rt
|> List.filter (not << List.isEmpty)
|> List.indexedMap (Shunt.view model.rt Shunt.showTrackIdx)
, rendered_rail_tree =
RT.renderRailTree
(singleton << Svg.Events.onMouseUp << RailClicked << Has.witness)
model.rt
++ root_bumper_svg
, bbox_rail_tree =
RT.boundingBox model.rt `SvgUtils.bboxUnion` RT.boundingBox root_bumper
}}
view : Model -> Html Msg
view model =
let
......@@ -384,17 +423,6 @@ view model =
|> Array.indexedMap (\i c -> C.renderCarriage model.rt (car_attributes i c) c)
|> Array.toList
|> List.concat
singleton a = [a]
bbox =
let rect = RT.boundingBox model.rt
in
Svg.rect
[ SvgAttr.width <| toString (rect.max.x - rect.min.x)
, SvgAttr.height <| toString(rect.max.y - rect.min.y)
, SvgAttr.x <| toString(rect.min.x)
, SvgAttr.y <| toString(rect.min.y)
, SvgAttr.class "boundingbox"
] []
-- For Debugging: show the points for bbox computation
-- bpoints =
......@@ -408,35 +436,19 @@ view model =
-- ]
-- [])
rendered_rail_tree =
RT.renderRailTree
(singleton << Svg.Events.onMouseUp << RailClicked << Has.witness)
model.rt
bbox_rail_tree = RT.boundingBox model.rt
mapSnd f (a,b) = (a,f b)
train_preview : (SvgUtils.BoundedSvg a)
train_preview =
model.train_preview
model.render_cache.train_preview
|> mapSnd (Html.App.map TrainPreview.exfalso)
shunt_labels : List (Svg.Svg any)
shunt_labels =
if model.show_shunt_labels
then List.map (Html.App.map TrainPreview.exfalso) model.shunt_labels
then List.map (Html.App.map TrainPreview.exfalso) model.render_cache.shunt_labels
else []
root_bumper : SvgUtils.BoundedSvg any
root_bumper =
RT.Junction (Has.unit RT.AutoAngles) [] -- take a simple bumper
-- layout it at the root but with the reversed angle
|> RT.layoutRailTreeAt (P2D.Angled -180 (P2D.P2D 0.0 0.0))
|> (\lrt ->
( RT.boundingBox lrt
, Svg.g [] <| RT.renderRailTree TrainPreview.exfalso lrt
))
in
SvgUtils.boundedSvg
[ SvgAttr.class <|
......@@ -447,7 +459,11 @@ view model =
<| (if model.show_train_preview
then (SvgUtils.aboveOf SvgUtils.Center 20.0 train_preview)
else identity)
<| SvgUtils.union root_bumper
<| (bbox_rail_tree, Svg.g [] (shunt_labels ++ rendered_rail_tree ++ cars))
<| ( model.render_cache.bbox_rail_tree
, Svg.g []
(shunt_labels
++ [Svg.lazy (always <| Svg.g [] model.render_cache.rendered_rail_tree) ()]
++ cars)
)
-- vim: ft=elm et ts=2 sw=2
Supports Markdown
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