PolyHack.preload
Last Edited by: Spreitzer, June 18, 1985 5:33:24 pm PDT
(setq pi 3.141592653589793)
(setq i (complex 0 1))
(setq twopi (mult 2 pi))
(defun cbox
(c al fl pl ab fb pb ar fr pr at ft pt)
(list
(ClosedPoly c
(Liss 0 al fl pl 0 ab fb pb)
(Liss 0 ar fr pr 0 ab fb pb)
(Liss 0 ar fr pr 0 at ft pt)
(Liss 0 al fl pl 0 at ft pt)
)
)
)
(defun box
(al fl pl ab fb pb ar fr pr at ft pt)
(list
(ClosedPoly invert
(Liss 0 al fl pl 0 ab fb pb)
(Liss 0 ar fr pr 0 ab fb pb)
(Liss 0 ar fr pr 0 at ft pt)
(Liss 0 al fl pl 0 at ft pt)
)
)
)
(defun ChooseFreq (fMax)
(mult
(quot (plus 15 (mult (Choose 0 20) (Choose 1 fMax))) 20)
(minus (mult (Choose 0 1) 2) 1)
)
)
(defun randcbox (c fMax)
(cbox c
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
)
)
(defun randbox (fMax)
(box
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
1 (ChooseFreq fMax) (Choose 0 360)
)
)
(defun PowerSeries
(closed color nTerms radiusFactor freqFactor deltaPhase)
(letrec
(
(tail
(lambda
(n radius freq phase)
(if
(lt n 1)
nil
(cons
(Liss 0 radius freq (plus phase 90) 0 radius freq phase)
(tail
(minus n 1)
(mult radius radiusFactor)
(mult freq freqFactor)
(rem (plus phase deltaPhase) 360)
)
)
)
)
)
)
(list
(ListPoly closed color
(Series (cons (Constant 0 0) (tail nTerms 1 1 0)))
)
)
)
)
(defun mapints (f first last)
(if
(lt last first)
nil
(cons
(f first)
(mapints f (plus first 1) last))))
(defun MapBothInts (f first last)
(if
(lt last first)
nil
(cons
(f (minus 0 first))
(f first)
(MapBothInts f (plus first 1) last))))
(defun PtolSeries
(closed color nTerms syn typicalRadius)
(letrec
((Term (lambda (n)
(letrec
((An (syn n))
(r (abs An))
(t (mult 180 (div (arg An) pi))))
(Liss 0 r n (plus t 90) 0 r n t)))))
(list
(ListPoly closed color
(Series (cons (Term 0) (MapBothInts Term 1 nTerms)) typicalRadius)))))
(defun PtolAnalWork
(n pts)
(if
(lt (length pts) 2)
0
(let
(
(t1 (car (car pts)))
(z1 (car (cdr (car pts))))
(t2 (car (car (cdr pts))))
(z2 (car (cdr (car (cdr pts))))))
(plus
(if
(equal t1 t2)
0
(if
(equal n 0)
(div (mult (plus z1 z2) (minus t2 t1)) 2)
(plus
(mult
(div
(minus
(mult z1 t2)
(mult z2 t1))
(minus t2 t1))
(div
(minus
(exp (mult -1 i n t2))
(exp (mult -1 i n t1)))
(mult -1 i n)))
(mult
(div
(minus z2 z1)
(minus t2 t1))
(plus
(div
(minus
(mult t2 (exp (mult -1 i n t2)))
(mult t1 (exp (mult -1 i n t1))))
(mult -1 i n))
(div
(minus
(exp (mult -1 i n t2))
(exp (mult -1 i n t1)))
(mult n n)))))))
(PtolAnalWork n (cdr pts))))))
(defun PtolAnal
(pts)
(let
((last (nth (length pts) pts)))
(let
((closedpts (cons (list (minus (car last) twopi) (nth 2 last)) pts)))
(lambda (n) (div (PtolAnalWork n closedpts) twopi)))))
(defun TriangleFilter
(i r1 r2)
(cond
((le i r1) 1)
((ge i r2) 0)
(T (minus 1 (div (minus i r1 0.0) (minus r2 r1))))
)
)
(defun FilteredPowerSeries
(closed color nTerms radiusFactor freqFactor deltaPhase flat)
(prog
(defun tail (i radius freq phase)
(if
(gt i nTerms)
nil
(cons
(let
((fr (mult radius (TriangleFilter i (mult nTerms flat 1.0) (plus nTerms 1)))))
(Liss 0 fr freq (plus phase 90) 0 fr freq phase)
)
(tail
(plus i 1)
(mult radius radiusFactor)
(mult freq freqFactor)
(rem (plus phase deltaPhase) 360)
)
)
)
)
(list
(ListPoly closed color
(Series (cons (Constant 0 0) (tail 1 1 1 0)))
)
)
)
)
(defun FilteredSeries
(closed color parms oneWidth zeroWidth)
(prog
(defun Fixit
((freq xAmpl xPhase yAmpl yPhase))
(let
((scale (TriangleFilter (abs freq) oneWidth zeroWidth)))
(Liss 0 (mult scale xAmpl) freq xPhase 0 (mult scale yAmpl) freq yPhase)
)
)
(ListPoly closed color
(Series (cons (Constant 0 0) (mapcar Fixit parms)))
)
)
)
(defun Generate
(nTerms MakeIt)
(do
((i (plus nTerms 1) (minus i 1))
(ans
nil
(let
(((ax px ay py) (MakeIt i)))
(if
(and (equal ax 0) (equal ay 0))
ans
(cons (list i ax px ay py) ans)
)
)))
((gt i 0) ans)
ans
)
)
(defun circpts
(r n)
(mapints
(lambda (j)
(let
((tau (mult j (div twopi n))))
(list tau (mult r (exp (mult i tau))))))
1
n))
(defun lines (r n nTerms)
(PtolSeries false white nTerms (PtolAnal (circpts r n)) r))