Generate Pyramid Scheme code
Common Lisp - 2524 1890 bytes
(defun f(i)(let((s(loop as r in i collect(g r)))(n())(output""))(loop until n do(setf n T)(loop as r in s do(if(cdr r)(progn(setf output(c output(e r))(cdr r)(cdr(cdr r)))(setf n()))(setf output(c output(b(car r))))))(setf output(c output(format()"~%"))))output))(defun g(r)(if(stringp r)(d(m(length r))r)(if(<(length r)2)(d(m(length(car r)))(car r))(if(=(length(e r))1)(let((h(g(car(e r))))(p(d(m(length(car r)))(car r))))(let((o(+ 1(position #\^(e h))))(parent_length(car p)))(if(<(-(car h)o)parent_length)(l(cons(+ o parent_length)())(loop as n in(butlast(cdr p))collect(c(b o)n))(cons(c(subseq(e h)0 o)(car(last p)))())(loop as n in(cdr(cdr h))collect(c n(b (- parent_length(-(car h)o))))))(let((i(-(- o 1)parent_length)))(l(cons(car h)())(loop as n in(butlast(cdr p))collect(c(b o)n(b i)))(cons(c(subseq(nth 1 h)0 o)(car(last p))(b i))())(cddr h))))))(let((l-h(g(car(e r))))(r-h(g(e(e r)))))(let((ll(position #\^(e l-h)))(rl(position #\^(e r-h))))(let((lr(-(car l-h)ll 1))(rr(-(car r-h)rl 1)))(let((p(d(max(m(length(car r)))(ceiling(+ lr rl)2))(car r))))(let((m-pad(if(>(car p)(+ lr rl))(-(car p)lr rl)0)))(l(cons(+ ll 1(car p)1 rr)())(loop as n in(butlast(cdr p))collect(c(b(+ 1 ll))n(b(+ 1 rr))))(cons(c(subseq(e l-h)0(+ 1 ll))(car(last p))(subseq(e r-h)rl))())(loop as y in(append(cddr l-h)(make-list(length l-h):initial-element(b(car l-h))))as z in(append(cdr(cdr r-h))(make-list(length r-h):initial-element(b(car r-h))))collect(c y(b m-pad)z))))))))))))(defun d(r n)(cons(+(* 2 r)1)(l(cons(c(b r)"^"(b r))())(loop as i from 1 to r collect(c(b(- r i))"/"(subseq(c n(b(expt i 2)))(expt(- i 1)2)(expt i 2))"\\"(b(- r i))))(cons(make-string(+ 1(* 2 r)):initial-element #\-)()))))(defun m(l)(+ 1(floor(sqrt l))))(defun b(n)(make-string n :initial-element #\space))(defun c(&rest a)(apply 'concatenate 'string a))(defun l(&rest a)(apply 'concatenate 'list a))(defun e(tree)(nth 1 tree))
Thanks to @coredump for a number of golfing tricks. Sample output from the question:
> (f '(("out" (("chr" ("72")) ("chr" ("101")))) ("out" (("chr" ("108")))) ("out" (("chr" ("108")))) ("out" (("chr" ("111"))))))
^ ^ ^ ^
/o\ /o\ /o\ /o\
/ut \ /ut \ /ut \ /ut \
/ \ ^----- ^----- ^-----
/ \ /c\ /c\ /c\
^---------^ /hr \ /hr \ /hr \
/c\ /c\ ^----- ^----- ^-----
/hr \ /hr \ /1\ /1\ /1\
^----- ^-----/08 \ /08 \ /11 \
/7\ /1\ ----- ----- -----
/2 \ /01 \
----- -----
> (f '( ("+" ( ("asdfghjkl") ("do" ( "1" )) )) ))
^
/+\
/ \
/ \
/ \
/ \
^-----------^
/a\ /d\
/sdf\ /o \
/ghjkl\ ^-----
/ \ /1\
--------- / \
-----
> (f '(("+" ("9123" "3")) "3"))
^ ^
/+\ /3\
/ \ / \
/ \ -----
^-------^
/9\ /3\
/123\ / \
/ \ -----
-------
Here is the original, (mostly) ungolfed version:
(defun f (input)
(let ((trees (loop for tree in input collect (g tree)))
(done nil)
(output ""))
(loop while (not done)
do (setf done T)
(loop for tree in trees
do (if (cdr tree)
(progn
(setf output (conStr output (car (cdr tree))))
(setf (cdr tree) (cdr (cdr tree)))
(setf done nil))
(setf output (conStr output (blank (car tree))))))
(setf output (conStr output (format nil "~%"))))
output))
;creates a single tree
;output is a list, first element is the length of each line, the rest are the lines of text
(defun g (tree)
(if (stringp tree)
;strings should be drawn as just the pyramid for the name
(draw-body (min-rows (length tree)) tree)
(if (< (length tree) 2)
;lists with no arguments should be drawn as just the pyramid for the name
(draw-body (min-rows (length (car tree))) (car tree))
(if (= (length (car (cdr tree))) 1)
;single child
(let ((child (g (car (car (cdr tree))))) (parent (draw-body (min-rows (length (car tree))) (car tree))))
(let ((parent_offset (+ 1 (position #\^ (first-line child)))) (parent_length (car parent)))
(if (< (- (car child) parent_offset) parent_length)
(let ((child-fill (- parent_length (- (car child) parent_offset))))
(concatenate 'list
(cons (+ parent_offset parent_length) nil)
(loop for line in (butlast (cdr parent))
collect (conStr (blank parent_offset) line))
(cons (conStr (subseq (nth 1 child) 0 parent_offset) (car (last parent))) nil)
(loop for line in (cdr (cdr child))
collect (conStr line (blank child-fill)))))
(let ((parent-fill (- (- parent_offset 1) parent_length)))
(concatenate 'list
(cons (car child) nil)
(loop for line in (butlast (cdr parent))
collect (conStr (blank parent_offset) line (blank parent-fill)))
(cons (conStr (subseq (nth 1 child) 0 parent_offset) (car (last parent)) (blank parent-fill)) nil)
(cdr (cdr child)))))))
;two children
(let ((l-child (g (car (car (cdr tree))))) (r-child (g (car (cdr (car (cdr tree)))))))
(let ((lc-l-width (position #\^ (first-line l-child))) (rc-l-width (position #\^ (first-line r-child))))
(let ((lc-r-width (- (car l-child) lc-l-width 1)) (rc-r-width (- (car r-child) rc-l-width 1)))
(let ((parent (draw-body (max (min-rows (length (car tree))) (ceiling (+ lc-r-width rc-l-width) 2)) (car tree))))
(let ((m-pad (if (> (car parent) (+ lc-r-width rc-l-width))
(- (car parent) lc-r-width rc-l-width)
0)))
(concatenate 'list
(cons (+ lc-l-width 1 (car parent) 1 rc-r-width) nil)
(loop for line in (butlast (cdr parent))
collect (conStr (blank (+ 1 lc-l-width)) line (blank (+ 1 rc-r-width))))
(cons (conStr (subseq (first-line l-child) 0 (+ 1 lc-l-width)) (car (last parent)) (subseq (first-line r-child) rc-l-width)) nil)
(loop for left in (append (cdr (cdr l-child)) (make-list (length l-child) :initial-element (blank (car l-child))))
for right in (append (cdr (cdr r-child)) (make-list (length r-child) :initial-element (blank (car r-child))))
collect (conStr left (blank m-pad) right))))))))))))
;create a single pyramid
; output is a list, first element is the length of each line, the rest are the lines of text
(defun draw-body (rows name)
(print rows)
(print name)
(cons (+ (* 2 rows) 1)
(concatenate 'list (cons (conStr (blank rows) "^" (blank rows)) nil)
(loop for i from 1 to rows
collect (conStr (blank (- rows i)) "/" (subseq (conStr name (blank (expt i 2))) (expt (- i 1) 2) (expt i 2)) "\\" (blank (- rows i))))
(cons (make-string (+ 1 (* 2 rows)) :initial-element #\-) nil))))
(defun min-rows (l)
(+ 1 (floor (sqrt l))))
(defun blank (n)
(make-string n :initial-element #\space))
(defun conStr (&rest args)
(apply 'concatenate 'string args))
(defun first-line (tree)
(car (cdr tree)))
Try it Online!
Python 3, ~41.3KB + tests and examples
So, I didn't realise this was a challenge, and I wrote a whole language which compiles into Pyramid scheme... It's called psll, and you can find it here. It has a bunch of bells and whistles, syntactic sugar constructs: functions (kinda) and strings, compiler optimisation etc.
This is not exactly a competing answer, but I feel it's heavily relevant so I should post it here.