Lightmap packing

lmpack.fsx

type LM = LM of int * int

let lmgs =
    [
        [
            LM (128, 512)
            LM (512, 512)
            LM (128, 512)
            LM (256, 256)
            LM (64, 64)
            LM (256, 256)
            LM (128, 128)
            LM (64, 64)
            LM (64, 64)
            LM (64, 256)
            LM (256, 256)
        ]
        [
            LM (256, 256)
            LM (128, 128)
            LM (64, 128)
            LM (256, 256)
            LM (64, 64)
            LM (256, 256)
            LM (128, 512)
            LM (256, 256)
            LM (256, 256)
        ]
        [
            LM (512, 512)
            LM (128, 128)
            LM (256, 256)
            LM (256, 256)
            LM (512, 512)
            LM (256, 256)
        ]
        [
            LM (512, 512)
            LM (512, 512)
            LM (256, 256)
            LM (256, 256)
            LM (512, 512)
        ]
        [
            LM (512, 512)
            LM (256, 256)
            LM (128, 128)
            LM (256, 256)
            LM (64, 64)
            LM (128, 128)
            LM (256, 256)
        ]
        [
            LM (512, 512)
            LM (256, 256)
            LM (256, 256)
            LM (256, 256)
            LM (256, 256)
            LM (128, 256)
            LM (256, 256)
        ]
        [
            LM (256, 256)
            LM (512, 512)
            LM (64, 512)
            LM (128, 256)
        ]
        [
            LM (512, 512)
            LM (64, 64)
            LM (256, 256)
        ]
        [
            LM (512, 512)
            LM (256, 256)
            LM (256, 256)
            LM (64, 64)
            LM (128, 128)
            LM (64, 64)
            LM (128, 256)
            LM (256, 256)
        ]
    ]

let rec packLMHelper x y ny acc lms =
    let width = 1024
    let height = 1024

    match lms with
    | [] -> [acc]
    | (LM (lw, lh) as l) :: rest ->
        if lw > width || lh > height then failwithf "Lightmap dimensions too big: %dx%d" lw lh

        if y + lh > height then
            acc :: packLMHelper 0 0 0 [] lms
        else if x + lw > width then
            packLMHelper 0 ny ny acc lms
        else
            packLMHelper (x + lw) y (max ny (y + lh)) (l :: acc) rest

let packLM lms =
    lms
    |> List.sortBy (function LM (w, h) -> (-h, -w))
    |> packLMHelper 0 0 0 []
    |> List.filter (List.isEmpty >> not)

lmgs |> List.collect id |> List.sumBy (function LM (x, y) -> x * y) |> printfn "%d"
lmgs |> List.length |> printfn "Mihai's code: %d"
lmgs |> List.collect id |> packLM |> List.length |> printfn "My code: %d"
lmgs |> List.collect id |> packLM |> List.map List.length |> List.max |> printfn "My code: %d"