geom-space.stanza

defpackage geom/space :
  import core
  import collections
  import geom/vec
  import geom/mat
  import geom/box
  import geom/geom
  import geom/bounded
  import geom/poseable
  import geom/assembly
  import geom/shape

public defmulti spacer<?T> (g:?T&Poseable, dims:Vec3) -> T

;; public defn space-x (gdim:Double, shape:AnyShape) : mag1(gdim / x(dims(bounds(shape))), shape)
;; public defn space-y (gdim:Double, shape:AnyShape) : mag1(gdim / y(dims(bounds(shape))), shape)
;; public defn space-z (gdim:Double, shape:AnyShape) : mag1(gdim / z(dims(bounds(shape))), shape)

public defn spacer-x<?T> (gdim:Double, g:?T&Poseable) : spacer(g, Vec3(gdim, 0.0, 0.0))
public defn spacer-y<?T> (gdim:Double, g:?T&Poseable) : spacer(g, Vec3(0.0, gdim, 0.0))
public defn spacer-z<?T> (gdim:Double, g:?T&Poseable) : spacer(g, Vec3(0.0, 0.0, gdim))

public defn resize-idx<?T> (gdim:Double, idx:Int, shape:?T&AnyShape) -> T :
  mag1(gdim / dims(bounds(shape))[idx], shape)

public defn resize<?T> (gdims:Vec3, shape:?T&AnyShape) -> T :
  mag1(min(gdims / dims(bounds(shape))), shape)

public defn resize<?T> (gdims:Vec2, shape:?T&AnyShape) -> T :
  mag1(min(gdims / xy(dims(bounds(shape)))), shape)

public defn resize-x<?T> (gdim:Double, shape:?T&AnyShape) -> T : resize-idx(gdim, 0, shape)
public defn resize-y<?T> (gdim:Double, shape:?T&AnyShape) -> T : resize-idx(gdim, 1, shape)
public defn resize-z<?T> (gdim:Double, shape:?T&AnyShape) -> T : resize-idx(gdim, 2, shape)

public defn resize (gdims:Vec2) : resize{gdims, _}
public defn resize (gdims:Vec3) : resize{gdims, _}
public defn resize-x (gdim:Double) : resize-x{gdim, _}
public defn resize-y (gdim:Double) : resize-y{gdim, _}
public defn resize-z (gdim:Double) : resize-z{gdim, _}

public defn remove-spacers (p:Poseable) -> Poseable :
  match(p) :
    (a:Assembly) : Assembly(mat(a), name(a), color(a),
                            seq(remove-spacers, filter({ area*(dims(bounds(_))) > 0.0 }, children(a))))
    (s) : s

public defn stack-idx-using<?T> (ishapes:Seqable<?T&Poseable>, iboundz:Seqable<Box3>, idx:Int, dir:Double) -> Seq<T> :
  val [shapes, boundz] = [to-tuple(ishapes), to-tuple(iboundz)]
  val tot = sum $ for bounds in boundz seq : dims(bounds)[idx]
  ;; println("TOT %_" % [tot])
  var tot-fac:Double = 0.0
  val res =
    generate<T&Poseable> :
      for (child in shapes, bounds in boundz) do :
        val now-fac = dims(bounds)[idx] / tot
        val ctr     = center(bounds)[idx]
        val amount  = dir * (tot / 2.0 - (tot-fac + now-fac / 2.0) * tot) - ctr
        val del     = amount * Vec3-unit(idx)
        ;; println("STACKING %_ DEL %_ TOT %_ BOUNDS %_ DIMS %_ VOLUME %_" % [child del tot bounds dims(bounds) volume(dims(bounds))])
        yield(mov(del, child))
        tot-fac = tot-fac + now-fac
  ;; for r in res do :
  ;;   println("STACKED %_ BOUNDS %_ DIMS %_ VOLUME %_" % [r bounds(r) dims(bounds(r)) volume(dims(bounds(r)))])
  ;; val bdz = to-tuple $ seq({ volume(dims(bounds(_))) }, res)
  ;; val rres = to-tuple $ filter({ volume(dims(bounds(_))) > 0.0 }, res)
  ;; println("STACKING RRES %_" % [rres])
  ;; TODO: NEED TO FIGURE OUT WHETHER THIS IS NEEDED
  ;; filter({ area*(dims(bounds(_))) > 0.0 }, res)
  res

public defn stack-idx<?T> (ishapes:Seqable<?T&Poseable>, idx:Int, dir:Double) -> Seq<T> :
  val shapes = to-tuple $ ishapes
  stack-idx-using(shapes, seq(bounds, shapes), idx, dir)

public defn stack-x<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-idx(shapes, 0,  -1.0)

public defn stack-y<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-idx(shapes, 1,  -1.0)

public defn stack-z<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-idx(shapes, 2,  -1.0)

public defn stack-meld-idx<?T> (t:Double, ishapes:Seqable<?T&Poseable>, idx:Int, dir:Double) -> Seq<T> :
  val shapes = to-tuple $ ishapes
  defn offset (b:Box3) :
    val a = -0.5 * t * Vec3-unit(idx)
    val res = fatten(b, a)
    ;; println("B %_ T %_ A %_ -> %_" % [b, t, a, res])
    res 
  stack-idx-using(shapes, seq({ offset(bounds(_)) }, shapes), idx, dir)

public defn stack-meld-x<?T> (t:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-meld-idx(t, shapes, 0,  -1.0)

public defn stack-meld-y<?T> (t:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-meld-idx(t, shapes, 1,  -1.0)

public defn stack-meld-z<?T> (t:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-meld-idx(t, shapes, 2,  -1.0)

public defn stack-meld-x (t:Double) : stack-meld-x{t, _}
public defn stack-meld-y (t:Double) : stack-meld-y{t, _}
public defn stack-meld-z (t:Double) : stack-meld-z{t, _}

public deftype AnyGlue <: Poseable
public defmulti amount (g:AnyGlue) -> Double

public defn glue-amount<?T> (shape:?T&Poseable) -> Double :
  match(shape) :
    (g:AnyGlue) : amount(g)
    (s)         : 0.0

public deftype AssemblyGlue <: AnyGlue & Assembly
public deftype ShapeGlue <: AnyGlue & AnyShape
defmulti glue (g:AssemblyGlue) -> ShapeGlue

public defn AssemblyGlue (glue:ShapeGlue) :
  new AssemblyGlue :
    defmethod glue (this) : glue
    defmethod color (this): BLACK
    defmethod bounds (this) : bounds(glue)
    defmethod amount (this) : amount(glue)

public defmulti glue-of<?T> (s:?T&Poseable, a:Double) -> T

public defn glue-when<?T> (first?:True|False, last?:True|False, ends:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  generate<T> :
    var last-shape:T&Poseable
    for (shape in shapes, i in 0 to false) do :
      if i > 0 :
        yield(glue-of(shape, 1.0))
      else if first? :
        yield(glue-of(shape, ends))
      yield(shape)
      last-shape = shape
    yield(glue-of(last-shape, ends)) when last? 

public defn glue-even<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  glue-when(true, false, 1.0, shapes)

public defn glue-odd<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  glue-when(false, false, 1.0, shapes)

public defn glue-all<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  glue-when(true, true, 1.0, shapes)

public defn glue-evenly<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  glue-when(true, true, 0.5, shapes)

public defn glue<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  glue-odd(shapes)

public defn assign-glue-idx<?T> (ishapes:Seqable<?T&Poseable>, target:Double, idx:Int) -> Seq<T> :
  val shapes = to-tuple(ishapes)
  val tot = sum $ for shape in shapes seq : dims(bounds(shape))[idx]
  val glue-tot = sum $ for shape in shapes seq : glue-amount(shape)
  val gap-tot = (target - tot)
  for shape in shapes seq :
    match(shape) :
      (g:AnyGlue&T) :
        val s = (amount(g) / glue-tot) * gap-tot * Vec3-unit(idx)
        spacer(shape, s)
      (s)           : s

;; public defn interleave<?T> (a:Seqable<?T&Poseable>, b:Seqable<?T&Poseable>) -> Seq<T> :
;;   generate<T> :
;;     val [sa, sb] = [to-seq(a), to-seq(b)]
;;     let loop (a?:True|False = true) :
;;       if not empty?(sa) and not empty?(sa):
;;         yield(next(sa) when a? else next(sb))
;;         loop(not a?)

public defn stack-idx<?T> (d:Double, idx:Int, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-idx(assign-glue-idx(shapes, d, idx), idx, 1.0)

public defn stack-x<?T> (w:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-x(assign-glue-idx(shapes, w, 0))
public defn stack-y<?T> (h:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-y(assign-glue-idx(shapes, h, 1))
public defn stack-z<?T> (d:Double, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  stack-z(assign-glue-idx(shapes, d, 2))
public defn stack-x (w:Double) : stack-x{w, _}
public defn stack-y (h:Double) : stack-y{h, _}
public defn stack-z (d:Double) : stack-z{d, _}

public defn space-idx<?T> (iseps:Seqable<Double>, idx:Int, ishapes:Seqable<?T&Poseable>) -> Seq<T> :
  val shapes = to-tuple $ ishapes
  val seps = to-tuple $ for (sep in iseps, i in 0 to (length(shapes) - 1)) seq : sep
  val tot = sum $ seps
  val start = -0.5 * tot
  val offs = to-tuple $ generate<Double> :
    let loop (off = start, i = 0) :
      yield(off)
      if i < length(seps) : loop(off + seps[i], i + 1)
  ;; println("SHAPES %_ SEPS %_ TOT %_ START %_ OFFS %_ DIMZ %_" %
  ;;         [shapes, seps, tot, start, offs, to-tuple $ seq({ dims(bounds(_)) }, shapes)])
  for (shape in shapes, off in offs) seq :
    mov(off * Vec3-unit(idx), shape)

public defn space-x<?T> (seps:Seqable<Double>, shapes:Seqable<?T&Poseable>) : space-idx(seps, 0, shapes)
public defn space-y<?T> (seps:Seqable<Double>, shapes:Seqable<?T&Poseable>) : space-idx(seps, 1, shapes)
public defn space-z<?T> (seps:Seqable<Double>, shapes:Seqable<?T&Poseable>) : space-idx(seps, 2, shapes)

public defn space-idx<?T> (sep:Double, idx:Int, shapes:Seqable<?T&Poseable>) -> Seq<T> :
  space-idx(repeatedly({ sep }), idx, shapes)

public defn space-x<?T> (sep:Double, shapes:Seqable<?T&Poseable>) : space-idx(sep, 0, shapes)
public defn space-y<?T> (sep:Double, shapes:Seqable<?T&Poseable>) : space-idx(sep, 1, shapes)
public defn space-z<?T> (sep:Double, shapes:Seqable<?T&Poseable>) : space-idx(sep, 2, shapes)

public defn space-idx (sep:Double, idx:Int) : space-idx{repeatedly({ sep }), idx, _}

public defn space-x (sep:Double) : space-idx(sep, 0)
public defn space-y (sep:Double) : space-idx(sep, 1)
public defn space-z (sep:Double) : space-idx(sep, 2)

defn align-it<?T> (ishapes:Seqable<?T&Poseable>, value:(Box3) -> Double, mov:(Double, T) -> T) -> Seq<T> :
  val shapes = to-tuple(ishapes)
  val target = reduce(union, seq(bounds, shapes))
  ;; val target = bounds(shapes[0])
  for (child in shapes) seq :
    mov(value(target) - value(bounds(child)), child)

val id-pose = id-mat4()

public defn attach<?T> (src:?T&Poseable, spos:Mat4, dst:?T&Poseable, dpos:Mat4) -> Seqable<T> :
  [xyz(inverse(spos) * dpos, src), dst]

public defn attach<?T> (src:?T&Poseable, si:Symbol, dst:?T&Poseable, di:Symbol) -> Seqable<T> :
  attach(src, lookup?(poses(src),si,id-pose), dst, lookup?(poses(dst),di, id-pose))

public defn align-min-x<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { x(lo(_)) }, mov-x)

public defn align-max-x<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { x(hi(_)) }, mov-x)

public defn align-min-y<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { y(lo(_)) }, mov-y)

public defn align-max-y<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { y(hi(_)) }, mov-y)

public defn align-min-z<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { z(lo(_)) }, mov-z)

public defn align-max-z<?T> (shapes:Seqable<?T&Poseable>) -> Seq<T> :
  align-it(shapes, { z(hi(_)) }, mov-z)

public defn axis-aligned-smash<?T> (s:?T&Poseable) -> T :
  val bb    = bounds(s)
  val dims  = dims(bb)
  val idx   = min-idx(dims)
  val ctr   = center(bb)
  defn rot (s) : if idx == 0 : reflect-xz(s) else if idx == 1 : reflect-yz(s) else : s
  val res = rot(mov((- ctr), s))
  ;; println("SMASH %_ (%_ %_) -> %_" % [s bb ctr res])
  res

defn segment<?T> (shapes:Seqable<?T>, width:T -> Double, max-width:Double, space:Double) -> Seqable<Tuple<T>> :
  val row = Vector<T>()
  generate<Tuple<T>> :
    for pc in shapes do :
      val off = sum $ join(seq(width, cat(row, [pc])), space)
      if off > max-width :
        yield(to-tuple $ row)
        ;; println("OFF %_ > %_" % [off max-width])
        clear(row)
      ;; println("ADD ROW")
      add(row, pc)
    if length(row) > 0 : yield(to-tuple $ row)

public defn nest (pcs:Seqable<Poseable>, size:Vec2, spacer:Vec3 -> Poseable, space:Double) -> Seqable<Assembly> :
  val apcs  = to-tuple $ pcs
  ;; println("NEST A %_" % [apcs])
  val rpcs  = to-tuple $ seq(fn (pc): reflect-xy(pc) when max-idx(dims(bounds(pc))) != max-idx(size) else pc, apcs)
  ;; println("NEST R %_" % [rpcs])
  val spcs  = to-tuple $ lazy-qsort({ y(dims(bounds(_))) }, rpcs)
  ;; println("NEST S %_" % [spcs])
  val rows  = to-tuple $ segment(spcs, { x(dims(bounds(_))) }, x(size), space)
  ;; println("NEST ROWS %_" % [rows])
  ;; val pages = segment(rows, { y(dims(bounds(union(shapes $ Assembly $ _)))) }, y(size), space)
  val pages = to-tuple $ segment(rows, { y(dims(bounds(Assembly $ _))) }, y(size), space)
  ;; println("PAGES %_" % [pages])
  val res = to-tuple $ for page in pages seq :
    val rrows = for row in page seq:
      ;; println("ROW %_" % [row])
      Assembly(stack-x(join(row, spacer(x3(space)))))
    Assembly(stack-y(join(rrows, Assembly([ spacer(y3(space)) ]))))
  ;; println("NEST RES %_" % [res])
  res

;;; SHAPE

;; public deftype Shape <: AnyShape
;; 
;; public defn shapes (any-shapes:Seqable<AnyShape>) -> Seqable<Shape> :
;;   generate<Shape> : for e in any-shapes do : yield(e as Shape) when e is Shape
;; 
;; public defn shapes (p:Poseable) : shapes(any-shapes(p))

;;;; AGGREGATE GEOMS