Re: Huge hairy clauses and macro sytnax abstraction.

Larry Clapp wrote:
Sorry for responding so late. Hope it's not moot by now.

On 2006-01-13, John Connors <johnc@xxxxxxxxxxxxxx> wrote:

Finally, I may have found out how to move lisp from Emacs to Thunderbird
without major formatting accidents.

;; I'm looking for some stylistic and practical advice on my software
;; renderer code; I always end up writing huge clauses like the one
;; below, with repeated s-expressions for each color component the
;; renderer deals with.


Ick. Abstraction, abstraction, abstraction.


;; I'm trying to deal with this by writing a
;; macro that takes an s-experession, and duplicates it n times, and
;; then does a substitution m times like the macro below the
;; example. My question is - is this a common technique?


I don't know for sure, but I doubt it.


;; Is it an
;; acceptable idiom.


I wouldn't want to see it in anything *I* had to maintain, even if *I*
wrote it.


;; Does the idea of an idiom make sense in such a
;; plastic language as lisp, anyway?


Yes. :)

One can condense many idioms into functions or macros, but not all.


;; Is there any naming convention
;; for functions/macros of this type an experienced lisp programmer
;; would use?


I don't think an experienced Lisp programmer would do this, so, no. :)

(... But I welcome correction from those more experienced than I. :)


(defun ptc-draw-color-y-sorted-triangle (top-x top-y top-pix
mid-x mid-y mid-pix
bottom-x bottom-y bottom-pix)
(declare (type dimension top-x top-y mid-x mid-y bottom-x bottom-y)
(pixel top-pix mid-pix bottom-pix))
(c-type-assert (and (< top-y mid-y)
(< mid-y bottom-y)
(< top-y bottom-y)))
(if (< mid-x top-x)
;; midx is on left
(let ((right-x-step
(/ (- bottom-x top-x) (- bottom-y top-y)))
(right-red-step
(/ (- (get-red bottom-pix) (get-red top-pix))
(- bottom-y top-y)))
(right-green-step
(/ (- (get-green bottom-pix) (get-green top-pix))
(- bottom-y top-y)))
(right-blue-step
(/ (- (get-blue bottom-pix) (get-blue top-pix))
(- bottom-y top-y)))
(right-alpha-step
(/ (- (get-alpha bottom-pix) (get-alpha top-pix))
(- bottom-y top-y)))
(top-left-x-step
(/ (- mid-x top-x) (- mid-y top-y)))
(top-left-red-step
(/ (- (get-red mid-pix) (get-red top-pix))
(- mid-y top-y)))
(top-left-green-step
(/ (- (get-green mid-pix) (get-green top-pix))
(- mid-y top-y)))
(top-left-blue-step
(/ (- (get-blue mid-pix) (get-blue top-pix))
(- mid-y top-y)))
(top-left-alpha-step
(/ (- (get-alpha mid-pix) (get-alpha top-pix))
(- mid-y top-y)))
(bottom-left-x-step
(/ (- bottom-x mid-x)
(- bottom-y mid-y)))
(bottom-left-red-step
(/ (- (get-red bottom-pix) (get-red mid-pix))
(- bottom-y mid-y)))
(bottom-left-green-step
(/ (- (get-green bottom-pix) (get-green mid-pix))
(- bottom-y mid-y)))
(bottom-left-blue-step
(/ (- (get-blue bottom-pix) (get-blue mid-pix))
(- bottom-y mid-y)))
(bottom-left-alpha-step
(/ (- (get-alpha bottom-pix) (get-alpha mid-pix))
(- bottom-y mid-y))))


I think this part cries out for a little more lazyness (or "refactoring",
if you like).

You have lots of calculations of the form

(/ (- a b) (- c d))

and

(/ (- (get-<something> a) (get-<something> b))
(- c d))

We can see that the first is actually a more specific version of the
second, with the "get-<something>" replaced with #'identity.

So then you have (wide code follows)

(flet ((get-step (func a b c d)
(/ (- (funcall func a) (funcall func b))
(- c d))))
(let ((right-x-step (get-step #'identity bottom-x top-x bottom-y top-y))
(right-red-step (get-step #'get-red bottom-pix top-pix bottom-y top-y))
(right-green-step (get-step #'get-green bottom-pix top-pix bottom-y top-y))
(right-blue-step (get-step #'get-blue bottom-pix top-pix bottom-y top-y))
(right-alpha-step (get-step #'get-alpha bottom-pix top-pix bottom-y top-y))

(top-left-x-step (get-step #'identity mid-x top-x mid-y top-y))
(top-left-red-step (get-step #'get-red mid-pix top-pix mid-y top-y))
(top-left-green-step (get-step #'get-green mid-pix top-pix mid-y top-y))
(top-left-blue-step (get-step #'get-blue mid-pix top-pix mid-y top-y))
(top-left-alpha-step (get-step #'get-alpha mid-pix top-pix mid-y top-y))

(bottom-left-x-step (get-step #'identity bottom-x mid-x bottom-y mid-y))
(bottom-left-red-step (get-step #'get-red bottom-pix mid-pix bottom-y mid-y))
(bottom-left-green-step (get-step #'get-green bottom-pix mid-pix bottom-y mid-y))
(bottom-left-blue-step (get-step #'get-blue bottom-pix mid-pix bottom-y mid-y))
(bottom-left-alpha-step (get-step #'get-alpha bottom-pix mid-pix bottom-y mid-y))
)
; ...
))

Do you see another pattern yet?

(labels ((get-step #|as before|#)
(get-all-steps (x1 x2 y1 y2 p1 p2)
(values
(get-step #'identity x1 x2 y1 y2)
(get-step #'get-red p1 p2 y1 y2)
(get-step #'get-green p1 p2 y1 y2)
(get-step #'get-blue p1 p2 y1 y2)
(get-step #'get-alpha p1 p2 y1 y2))))
(multiple-value-bind
(right-x-step right-red-step right-green-step right-blue-step right-alpha-step)
(get-all-steps bottom-x top-x bottom-y top-y bottom-pix top-pix)
(multiple-value-bind
(top-left-x-step top-left-red-step top-left-green-step top-left-blue-step top-left-alpha-step)
(get-all-steps mid-x top-x mid-y top-y mid-pix top-pix)
(multiple-value-bind
(bottom-left-x-step #|blah blah blah|#)
(#|blah blah blah|#))
; ...
)))

And yet a third pattern ...

(defstruct step
x r g b a)

(flet ((get-all-steps (x1 x2 y1 y2 p1 p2)
(let ((diff (- y1 y2))) ; a slight optimization; probably pre-mature :)
(flet ((get-step (func a b)
(/ (- (funcall func a) (funcall func b)) diff)))
(make-step ; this part may be wrong too
:x (get-step #'identity x1 x2)
:r (get-step #'get-red p1 p2)
:g (get-step #'get-green p1 p2)
:b (get-step #'get-blue p1 p2)
:a (get-step #'get-alpha p1 p2))))))
(let ((right (get-all-steps bottom-x top-x bottom-y top-y bottom-pix top-pix))
(top-left (get-all-steps #|blah|#))
(bottom-left (get-all-steps #|blah|#)))
; ...
))

And then you could put the constructor with the structure, rather than the
function that uses it:

(defstruct step
x r g b a)

;; Define your own "boa constructor" *laugh*
;; (I *** you not; see http://www.lispworks.com/documentation/HyperSpec/Body/m_defstr.htm)
(make-step-boa (x1 x2 y1 y2 p1 p2)
(#| get-all-steps from above |#))

(let ((right (make-step-boa bottom-x top-x bottom-y top-y bottom-pix top-pix))
(top-left (make-step-boa #|blah|#))
(bottom-left (make-step-boa #|blah|#)))
; ...
)


(multiple-value-bind
(mid-right-x
mid-right-red mid-right-green mid-right-blue
mid-right-alpha
mid-left-x
mid-left-red mid-left-green mid-left-blue
mid-left-alpha)
(with-steps ((y top-y mid-y)
(right-x top-x right-x-step)
(right-red (get-red top-pix) right-red-step)
(right-green (get-green top-pix) right-blue-step)
(right-blue (get-blue top-pix) right-green-step)
(right-alpha (get-alpha top-pix) right-alpha-step)
(left-x top-x top-left-x-step)
(left-red (get-red top-pix) top-left-red-step)
(left-green (get-green top-pix) top-left-green-step)
(left-blue (get-blue top-pix) top-left-blue-step)
(left-alpha (get-alpha top-pix) top-left-alpha-step))
(ptc-draw-colour-hline
(floor left-x)
y
(floor (- right-x left-x))
(make-pixel
(floor left-red) (floor left-green) (floor left-blue)
(floor left-alpha))
(make-pixel
(floor right-red) (floor right-green) (floor right-blue)
(floor right-alpha))))
;; draw bottom part
;; and so on ......(insert missing code here ;-)
))))


I didn't look closely at this part, but I bet you could do something
similar here.

-- Larry


Actually, thats incredibly useful, ta but it has set me to wondering what the best way to manipulate small microstructures with no invariants (eg vertices = 3 floats, uv's = 2 floats) are: there are so many options. A list seems needless for a fixed size struct, a simple-array seems to be a possibility, as are structs, but multiple values are tempting - especially if the implementation can pass them around on registers/stack. A CLOS vertex class seems like extreme overkill.


--
+--------------------------------------------------------+
|Cyborg Animation Programmer | johnc@xxxxxxxxxxxxxx|
|http://badbyteblues.blogspot.com -----------------------|
+--------------------------------------------------------+
.