clt

Configurable Leathercraft Templates

  1. 1
  2. 2
  3. 3
  4. 4
  5. 5
  6. 6
  7. 7
  8. 8
  9. 9
  10. 10
  11. 11
  12. 12
  13. 13
  14. 14
  15. 15
  16. 16
  17. 17
  18. 18
  19. 19
  20. 20
  21. 21
  22. 22
  23. 23
  24. 24
  25. 25
  26. 26
  27. 27
  28. 28
  29. 29
  30. 30
  31. 31
  32. 32
  33. 33
  34. 34
  35. 35
  36. 36
  37. 37
  38. 38
  39. 39
  40. 40
  41. 41
  42. 42
  43. 43
  44. 44
  45. 45
  46. 46
  47. 47
  48. 48
  49. 49
  50. 50
  51. 51
  52. 52
  53. 53
  54. 54
  55. 55
  56. 56
  57. 57
  58. 58
  59. 59
  60. 60
  61. 61
  62. 62
  63. 63
  64. 64
  65. 65
  66. 66
  67. 67
  68. 68
  69. 69
  70. 70
  71. 71
  72. 72
  73. 73
  74. 74
  75. 75
  76. 76
  77. 77
  78. 78
  79. 79
  80. 80
  81. 81
  82. 82
  83. 83
  84. 84
  85. 85
  86. 86
  87. 87
  88. 88
  89. 89
  90. 90
  91. 91
  92. 92
  93. 93
  94. 94
  95. 95
  96. 96
  97. 97
  98. 98
  99. 99
  100. 100
  101. 101
  102. 102
  103. 103
  104. 104
  105. 105
  106. 106
  107. 107
  108. 108
  109. 109
  110. 110
  111. 111
  112. 112
  113. 113
  114. 114
  115. 115
  116. 116
  117. 117
  118. 118
  119. 119
  120. 120
  121. 121
  122. 122
  123. 123
  124. 124
  125. 125
  126. 126
  127. 127
  128. 128
  129. 129
  130. 130
  131. 131
  132. 132
  133. 133
  134. 134
  135. 135
  136. 136
  137. 137
  138. 138
  139. 139
  140. 140
  141. 141
  142. 142
  143. 143
  144. 144
  145. 145
  146. 146
  147. 147
  148. 148
  149. 149
  150. 150
  151. 151
  152. 152
  153. 153
  154. 154
  155. 155
  156. 156
  157. 157
  158. 158
  159. 159
  160. 160
  161. 161
  162. 162
  163. 163
  164. 164
-- Copyright 2026 Shota FUJI
--
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.
--
-- SPDX-License-Identifier: MPL-2.0


module Template.Layout.Packer exposing (pack)

import List
import Svg exposing (..)
import Svg.Attributes as Attrs
import Template.Layout.Coordinate exposing (..)
import Template.Layout.Item exposing (Item)


{-| Packs multiple items into specified sized containers.

This function packs given `items` using stupid bin packing algorithm so they won't
overlap or overflow. As we're dealing with printable leather template, we can
afford multiple containers to be packed.

Items larger than the container will be placed as-is, and won't change container's
size. Caller is responsible for pre-splitting items prior to passing them to this
function if a piece is expected to be larger than the container.

This function treats each item's `AtLeast` size request as `Exactly`.

-}
pack : SizeRequest -> Float -> List (Item msg) -> List (Item msg)
pack container gap items =
    case items of
        [] ->
            []

        _ ->
            items
                -- Clip items larger than the container, otherwise `packPages` goes into
                -- infinite recursion.
                |> List.map
                    (\item -> { item | size = clip item.size container })
                |> List.sortBy
                    (\item ->
                        let
                            { width, height } =
                                minSizeOf item.size
                        in
                        -(max width height)
                    )
                |> packPages container gap


packPages : SizeRequest -> Float -> List (Item msg) -> List (Item msg)
packPages size gap items =
    case items of
        [] ->
            []

        _ ->
            let
                ( children, rest ) =
                    tryPackInto { x = 0, y = 0 } (minSizeOf size) gap items
            in
            { size = size
            , element =
                \p s ->
                    children
                        |> List.map (\item -> item.element p s)
                        |> g []
            }
                :: packPages size gap rest


{-| Tries to pack items into a rectangular, and returns packed items and items not fit
into the rectangular.
-}
tryPackInto : Point2D -> Size -> Float -> List (Item msg) -> ( List (Item msg), List (Item msg) )
tryPackInto p size gap items =
    case items of
        [] ->
            ( [], [] )

        item :: xs ->
            let
                itemSize =
                    minSizeOf item.size
            in
            if contains size itemSize then
                let
                    ( topItems, rest ) =
                        tryPackInto
                            { x = p.x + itemSize.width + gap, y = p.y }
                            { width = size.width - itemSize.width - gap, height = itemSize.height }
                            gap
                            xs
                            |> Tuple.mapFirst
                                ((::)
                                    { size = item.size
                                    , element =
                                        \q _ ->
                                            item.element { x = p.x + q.x, y = p.y + q.y } itemSize
                                    }
                                )
                in
                tryPackInto
                    { x = p.x, y = p.y + itemSize.height + gap }
                    { width = size.width, height = size.height - itemSize.height - gap }
                    gap
                    rest
                    |> Tuple.mapFirst
                        ((++) topItems)

            else if contains { width = size.height, height = size.width } itemSize then
                let
                    ( topItems, rest ) =
                        tryPackInto
                            { x = p.x + itemSize.height + gap, y = p.y }
                            { width = size.width - itemSize.height - gap, height = itemSize.width }
                            gap
                            xs
                            |> Tuple.mapFirst
                                ((::)
                                    { size = item.size
                                    , element =
                                        \q _ ->
                                            let
                                                ox =
                                                    p.x + q.x

                                                oy =
                                                    p.y + q.y
                                            in
                                            g
                                                [ Attrs.transform
                                                    ((if itemSize.height > itemSize.width then
                                                        [ "rotate(-90 " ++ String.fromFloat ox ++ " " ++ String.fromFloat oy ++ ")"
                                                        , "translate(" ++ String.fromFloat -itemSize.width ++ " 0)"
                                                        ]

                                                      else
                                                        [ "rotate(90 " ++ String.fromFloat ox ++ " " ++ String.fromFloat (oy + itemSize.height) ++ ")"
                                                        , "translate(" ++ String.fromFloat -itemSize.height ++ " 0)"
                                                        ]
                                                     )
                                                        |> String.join " "
                                                    )
                                                ]
                                                [ item.element { x = ox, y = oy } itemSize ]
                                    }
                                )
                in
                tryPackInto
                    { x = p.x, y = p.y + itemSize.width + gap }
                    { width = size.width, height = size.height - itemSize.width - gap }
                    gap
                    rest
                    |> Tuple.mapFirst
                        ((++) topItems)

            else
                tryPackInto p size gap xs
                    |> Tuple.mapSecond ((::) item)