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. 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? Is it an
;; acceptable idiom. Does the idea of an idiom make sense in such a
;; plastic language as lisp, anyway? Is there any naming convention
;; for functions/macros of this type an experienced lisp programmer
;; would use?
(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))))
(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 ;-)
))))
;; symbol replacement macros
;; -----------------------------------------------------------------------------------------------------
;; we often want to evaluate the same form concurrently for red blue
;; and green, so we have some macros to automate this for us
;;
;; suffix test
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun string-has-suffix-p (original-suffix replacement-sufix string)
"Tests to see if string ends in original-suffix. If it doesn't,
return NIL, else return the string with the suffix replaced"
(let* ((suffix-char (aref original-suffix 0))
(suffix-char-pos (position suffix-char string :from-end t)))
(if (numberp suffix-char-pos)
(concatenate 'string
(subseq *my-string* 0
(position *suffix-char* *my-string* :from-end t))
replacement-suffix)
nil))))
(defun replace-suffix (original-suffix replacement-suffix symbol)
"Given a symbol, if it has a original suffix, return a symbol wiith
the suffix replaced, otherwise just echo the symbol, unchanged."
(if (symbolp symbol)
(let ((changed-string
(string-has-suffix-p
(symbol-name-symbol)
original-suffix replacement-suffix)))
(if changed-string
(intern changed-string)
symbol))
symbol))
;; recursively apply a function to a tree
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun map-tree (fn tree)
"Apply fn to every member of tree and produce a new tree."
(cond
((null tree)
nil)
((null (car tree))
(map-tree fn (cdr tree)))
((listp (car tree))
(cons (map-tree fn (car tree)) (map-tree fn (cdr tree))))
(t
(cons (funcall fn (car tree)) (map-tree fn (cdr tree)))))))
;; replace one suffixed symbol with another, recursively
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun replace-suffixed-symbol
(original-suffix replacement-suffix body-list)
"(replace suffix-symbol original-suffix replacement-suffix list)
Replace all symbols in body-list that have the original-suffix with a symbol with the replacement-suffix."
(map-tree
#'(lambda (x) (replace-suffix original-suffix replacement-suffix x))
body-list)))
;; Given a form containing a suffixed symbol, return multiple values
;; of the form, each containing the suffix replaced with one of the
;; replacements from the list
;; eg. (with-symbol-suffix-multiplier-values
;; ("-pixel"
;; '("-red" "-green" "-blue")
;; '(setf pixel-pixel 0)))
;; => (values (setf pixel-red 0) (setf pixel-green 0) (setf pixel-blue 0))
(defmacro with-symbol-suffix-multiplier-values
(original-prefix replacement-prefixes-list body)
(append '(values)
(loop
for replacements in replacement-prefixes-list
collect
(replace-suffixed-symbol original-prefix replacement-prefixes-list body))))
;; Similar to above, only it produces a list
(defmacro with-symbol-suffix-multiplier-list
(original-prefix replacement-prefixes-list body)
(append '(list)
(loop
for replacements in replacement-prefixes-list
collect
(replace-suffixed-symbol original-prefixe replacement-prefixes-list body))))
John Connors 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. 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? Is it an
> ;; acceptable idiom. Does the idea of an idiom make sense in such a
> ;; plastic language as lisp, anyway? Is there any naming convention
> ;; for functions/macros of this type an experienced lisp programmer
> ;; would use?
>
> (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)))
I have not thought this all out -- ok, I have not stared at yyour
example long enough to fully understand it <g> -- but it looks like a
"pix" is an RGBA value, you have starting and ending colors, and you
want to move smoothly from one color to another over an arbitrary 2-d
distance.
Why not just have RGBA-step pixes, one x and one y? Hmm, no, if you ar
emoving in a straight line you just need one delta RGBA.
You would write a function to subtract two RGBA pixes to yield a third
RGBA difference, hiding there-in the separate subtractions for R, G, B,
and A.
Likewise you would have an RGBA division function, though in this case
you want to divide each element by the same number, the number of pixels
in the distance to be covered.
Hmm, is it faster to have x and y steps than to do all that pythagorean
stuff?
Anyway, i think the key is to chunk the RGB and A together in a single
structure and create functions that know about RGBAs.
kt
Kenny Tilton wrote:
> John Connors 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. 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? Is it an
>> ;; acceptable idiom. Does the idea of an idiom make sense in such a
>> ;; plastic language as lisp, anyway? Is there any naming convention
>> ;; for functions/macros of this type an experienced lisp programmer
>> ;; would use?
>>
>> (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)))
>
>
> I have not thought this all out -- ok, I have not stared at yyour
> example long enough to fully understand it <g> -- but it looks like a
> "pix" is an RGBA value, you have starting and ending colors, and you
> want to move smoothly from one color to another over an arbitrary 2-d
> distance.
>
> Why not just have RGBA-step pixes, one x and one y? Hmm, no, if you ar
> emoving in a straight line you just need one delta RGBA.
>
> You would write a function to subtract two RGBA pixes to yield a third
> RGBA difference, hiding there-in the separate subtractions for R, G, B,
> and A.
>
> Likewise you would have an RGBA division function, though in this case
> you want to divide each element by the same number, the number of pixels
> in the distance to be covered.
>
> Hmm, is it faster to have x and y steps than to do all that pythagorean
> stuff?
>
> Anyway, i think the key is to chunk the RGB and A together in a single
> structure and create functions that know about RGBAs.
>
> kt
Therein lies the problem: a pix is display dependent and lacks the precision
required for accurate interpolation - so I'd have to have a set of interpolation functions,
then convert the interpolatable RGBA value to a pix at pixel set time. Hmm. So what I need
is something geared to be an RGBA temp register that can convert quickly into pixels, and
each component can be step-interpolated by varying amounts..
Hmm. Food for thought. ta.
John Fred.
Sorry for responding so late. Hope it's not moot by now.
On 2006-01-13, John Connors <·····@yagc.ndo.co.uk> 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 shit 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
Larry Clapp wrote:
> Sorry for responding so late. Hope it's not moot by now.
>
> On 2006-01-13, John Connors <·····@yagc.ndo.co.uk> 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 shit 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 | ·····@yagc.ndo.co.uk|
|http://badbyteblues.blogspot.com -----------------------|
+--------------------------------------------------------+