An abandoned render engine with poor man's flexbox

main.elm

module Main exposing (main)

import List.Extra exposing (scanl)
import Style exposing (CustomColor(..), getColor)
import Svg exposing (Svg, circle, rect, svg, text, text_)
import Svg.Attributes exposing (..)


type alias Position =
    { x : Float
    , y : Float
    }


type alias Node =
    { color : CustomColor
    , content : String
    }


type alias Shape =
    { width : Float
    , height : Float
    }


type Block
    = NodeBlock Node Shape
    | Group (List BlockView) Shape


getBlockShape : Block -> Shape
getBlockShape block =
    case block of
        NodeBlock _ shape ->
            shape

        Group _ shape ->
            shape


type BlockView
    = NodeView Node BlockProperty
    | GroupView (List BlockView) BlockProperty


getViewPosition : BlockView -> Position
getViewPosition blk =
    case blk of
        NodeView _ blockProp ->
            blockProp.position

        GroupView _ blockProp ->
            blockProp.position


type alias BlockProperty =
    { shape : Shape
    , position : Position
    }


type alias NodeStyle =
    { rx : Float, ry : Float }


updatePosition : Position -> BlockView -> BlockView
updatePosition parentPos blkView =
    let
        getAbsPosition : Position -> Position
        getAbsPosition relativePos =
            { x = relativePos.x + parentPos.x
            , y = relativePos.y + parentPos.y
            }

        updateBlockProp blkP =
            { blkP | position = getAbsPosition blkP.position }
    in
    case blkView of
        NodeView node blockProp ->
            NodeView node (updateBlockProp blockProp)

        GroupView blockViewList blockProp ->
            GroupView (List.map (updatePosition parentPos) blockViewList)
                (updateBlockProp blockProp)


renderBlock : Position -> Block -> BlockView
renderBlock position block =
    case block of
        NodeBlock node shape ->
            NodeView node { shape = shape, position = position }

        Group blockViewList shape ->
            GroupView (List.map (updatePosition position) blockViewList)
                { shape = shape, position = position }


viewBlock : NodeStyle -> BlockView -> Svg msg
viewBlock style blockv =
    case blockv of
        NodeView node blockProperty ->
            let
                shape =
                    blockProperty.shape

                x =
                    blockProperty.position.x

                y =
                    blockProperty.position.y

                xCenter =
                    x + shape.width / 2

                yCenter =
                    y + shape.height / 2

                toStr =
                    String.fromFloat
            in
            Svg.g []
                [ rect
                    [ Svg.Attributes.x <| toStr x
                    , Svg.Attributes.y <| toStr y
                    , width <| toStr shape.width
                    , height <| toStr shape.height
                    , fill <| getColor node.color
                    , rx <| toStr style.rx
                    , ry <| toStr style.ry
                    ]
                    []
                , text_
                    [ Svg.Attributes.x <| toStr xCenter
                    , Svg.Attributes.y <| toStr yCenter
                    , fill <| getColor White
                    , textAnchor "middle"
                    , alignmentBaseline "middle"
                    ]
                    [ text node.content ]
                ]

        GroupView blockViewList blockProperty ->
            Svg.g [] <| List.map (viewBlock style) blockViewList


somePos : Position
somePos =
    { x = 20, y = 20 }


someNode : Node
someNode =
    { color = CItem
    , content = "Item"
    }


userNode : Node
userNode =
    { color = CUser
    , content = "User"
    }


someSize : Shape
someSize =
    { width = 200
    , height = 50
    }


smooth : NodeStyle
smooth =
    { rx = 10
    , ry = 10
    }


type FlexDirection
    = LeftToRight
    | TopToBottom


type Offset
    = OffsetAt Position
    | NoOffset


flexBox : FlexDirection -> Float -> Offset -> List Block -> Block
flexBox renderDirection space offsetM blocks =
    let
        pos0 =
            case offsetM of
                NoOffset ->
                    { x = 0, y = 0 }

                OffsetAt offset ->
                    offset

        append : Position -> Shape -> Position
        append pos blockShape =
            case renderDirection of
                LeftToRight ->
                    { pos | x = pos.x + blockShape.width + space }

                TopToBottom ->
                    { pos | y = pos.y + blockShape.height + space }

        putNext : Block -> Position -> Position
        putNext block pos =
            append pos (getBlockShape block)

        posList =
            scanl
                putNext
                pos0
                blocks

        addToWidth : Block -> Float -> Float
        addToWidth block blockWidth =
            blockWidth + (getBlockShape block).width

        width =
            List.foldl addToWidth 0 blocks

        heightM =
            blocks |> List.map (getBlockShape >> .height) |> List.maximum

        height =
            case heightM of
                Nothing ->
                    0

                Just h ->
                    h

        shape =
            { height = height, width = width }
    in
    Group
        (List.map2
            renderBlock
            posList
            blocks
        )
        shape


main =
    svg
        [ width "1000"
        , height "1000"
        , viewBox "0 0 1000 1000"
        ]
        [ circle
            [ cx "50"
            , cy "50"
            , r "50"
            ]
            []
        , viewBlock smooth <|
            renderBlock { x = 50, y = 100 } <|
                flexBox LeftToRight
                    5
                    (OffsetAt { x = 40, y = 10 })
                    [ NodeBlock someNode someSize
                    , NodeBlock someNode someSize
                    , flexBox TopToBottom
                        50
                        (OffsetAt { x = 0, y = 0 })
                        [ NodeBlock userNode someSize
                        , NodeBlock userNode someSize
                        ]
                    ]
        ]

Style.elm

module Style exposing (..)
type CustomColor
    = CItem
    | CItemHidden
    | CUser
    | CUserHidden
    | Grey
    | White


getColor : CustomColor -> String
getColor customColor =
    case customColor of
        CItem ->
            "#124E78"

        CItemHidden ->
            "#7EA8BE"

        CUser ->
            "#DB9D47"

        CUserHidden ->
            "#F9DD90"

        Grey ->
            "#595959"

        White ->
            "#F2F6D0"