Skip to content
Snippets Groups Projects
Commit 1d7cab43 authored by Thorsten Wißmann's avatar Thorsten Wißmann :penguin:
Browse files

Show bumpers at the root

parent f795a7e6
Branches
No related tags found
No related merge requests found
......@@ -43,6 +43,7 @@ import RailPuzzle.History as RPHistory
import RailPuzzle.History exposing (History)
import Shunt
import Char
import P2D
-- MODEL
type alias Model =
......@@ -426,6 +427,16 @@ view model =
then List.map (Html.App.map TrainPreview.exfalso) model.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 <|
......@@ -436,6 +447,7 @@ 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))
-- vim: ft=elm et ts=2 sw=2
......@@ -67,6 +67,21 @@ type Alignment = Left | Right | Center
aboveOf' : Float -> (BoundedSvg m) -> (BoundedSvg m) -> (BoundedSvg m)
aboveOf' = aboveOf Center
bboxUnion : BoundingRect -> BoundingRect -> BoundingRect
bboxUnion b1 b2 =
{ min = { x = min b1.min.x b2.min.x, y = min b1.min.y b2.min.y }
, max = { x = max b1.max.x b2.max.x, y = max b1.max.y b2.max.y }
}
{-| Just take the union of two bounding boxes and don't shift anything
-}
union : (BoundedSvg m) -> (BoundedSvg m) -> BoundedSvg m
union (b1,s1) (b2,s2) =
( bboxUnion b1 b2
, Svg.g [] [s1,s2]
)
{-|
moves the first object on top of the second, the alignment of the upper
object is as in the specified Alignment
......
......@@ -9,6 +9,7 @@ import Has exposing (Has)
import Carriage as C
import RailTree as RT
import NonEmptyList as NEList
import P2D
-- we define our emptytype here, because we can't define
-- exfalso for Never.
......@@ -46,12 +47,24 @@ render cars query =
-- and put the i'th car on the i'th track
|> List.indexedMap (\i f -> C.newCarAt f <| List.repeat i RT.Further)
|> List.concatMap (C.renderCarriage rail_tree [])
root_bumper : (SvgUtils.BoundingRect, List (Svg.Svg 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
, RT.renderRailTree exfalso lrt
))
in
( RT.boundingBox rail_tree
( RT.boundingBox rail_tree `SvgUtils.bboxUnion` fst root_bumper
, Svg.g
[ SvgAttr.class "trainPreview" ]
(RT.renderRailTree (always []) rail_tree
++ rendered_cars
++ snd root_bumper
)
)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment