| (do ((l (oblist) (cdr l))) |
(do ((l (oblist) (cdr l))) |
| ((atom l)) |
((atom l)) |
| (remprop (car l) 'prim))) |
(remprop (car l) 'prim))) |
| |
; |
| |
; pointを結ぶtension 1のスプラインを求める |
| |
; |
| |
(declare (alpha beta gamma sqrt2 sqrt5 d16 sqrt51 sqrt35)special) |
| |
(setq alpha 1.0 beta 1.0 gamma 0.0) |
| |
(defun reduce_points(points) |
| |
(do ((l points (cdr l)) |
| |
(ret nil) |
| |
(old '(10000.0 10000.0))) |
| |
((atom l)(nreverse ret)) |
| |
(cond ((>$ 1.0 (metric2 old (car l)))) |
| |
(t (push (car l) ret) |
| |
(setq old (car l)))))) |
| |
(defun spline (points) |
| |
(let ((fais nil) |
| |
(points (reduce_points points)) |
| |
(thetas nil) |
| |
(lengthes nil) |
| |
(npoints 2) |
| |
(psis nil) |
| |
(array nil) |
| |
(x nil) |
| |
(ret nil) |
| |
(b nil)) |
| |
(do ((l points (cdr l)) |
| |
(p0 nil) |
| |
(p1 nil) |
| |
(p2 nil) |
| |
(d0 nil) |
| |
(d1 nil) |
| |
(theta nil) |
| |
(costheta nil) |
| |
(sintheta nil)) |
| |
((atom (cddr l)) |
| |
(push (metric2 (car l)(cadr l)) lengthes) |
| |
(setq lengthes (nreverse lengthes)) |
| |
(push 0.0 psis) |
| |
(setq psis (nreverse psis))) |
| |
(setq p0 (car l) p1 (cadr l) p2 (caddr l)) |
| |
(setq d1 (diff2 p2 p1) d0 (diff2 p1 p0)) |
| |
(setq theta (theta d1 d0)) |
| |
(setq npoints (1+ npoints)) |
| |
(push (metric2 (car l)(cadr l)) lengthes) |
| |
; (print (list costheta sintheta theta lengthes)) |
| |
(push theta psis)) |
| |
(setq array (vector (* npoints npoints) 0.0)) |
| |
(setq x (vector npoints 0.0) b (vector npoints 0.0)) |
| |
(vset array 0 (-$ (//$ (*$ alpha alpha) beta) |
| |
(*$ 3.0 (*$ alpha alpha)) |
| |
(//$ (*$ gamma beta beta) alpha))) |
| |
(vset array 1 (-$ (//$ (*$ gamma beta beta) alpha) |
| |
(*$ 3.0 (*$ beta beta gamma)) |
| |
(//$ (*$ alpha alpha) beta))) |
| |
(vset b 0 (*$ (-$ (car psis))(vref array 1))) |
| |
(do ((i 1 (1+ i)) |
| |
(tmppsi psis (cdr tmppsi)) |
| |
(lk nil) |
| |
(lk1 nil) |
| |
(psi nil) |
| |
(psi1 nil) |
| |
(tmplen lengthes (cdr tmplen)) |
| |
(offset (+ npoints 1) (+ offset npoints 1))) |
| |
((>= i (1- npoints))) |
| |
(setq lk (car tmplen) lk1 (cadr tmplen)) |
| |
(setq psi (car tmppsi) psi1 (cadr tmppsi)) |
| |
(vset array (1- offset) (//$ (*$ beta beta) lk alpha)) |
| |
(vset array offset (+$ (*$ beta beta (//$ 1.0 lk) |
| |
(-$ 3.0 (//$ 1.0 alpha))) |
| |
(*$ alpha alpha (//$ 1.0 lk1) |
| |
(-$ 3.0 (//$ 1.0 beta))))) |
| |
(vset array (1+ offset) (//$ (*$ alpha alpha) lk1 beta)) |
| |
(vset b i (-$ (*$ psi beta beta (//$ 1.0 lk) |
| |
(-$ (//$ 1.0 alpha) 3.0)) |
| |
(//$ (*$ psi1 alpha alpha) lk1 beta)))) |
| |
(vset array (- (* npoints npoints) 2) |
| |
(-$ (//$ (*$ gamma alpha alpha) beta) |
| |
(*$ 3.0 gamma alpha alpha) |
| |
(//$ (*$ beta beta) alpha))) |
| |
(vset array (- (* npoints npoints) 1) |
| |
(-$ (//$ (*$ beta beta) alpha) |
| |
(*$ gamma alpha alpha) |
| |
(*$ 3.0 beta beta))) |
| |
; (print "psis") |
| |
; (print psis) |
| |
; (print "lengthes") |
| |
; (print lengthes) |
| |
; (print "array") |
| |
(do ((i 0 (1+ i))) |
| |
((>= i npoints)) |
| |
(do ((j 0 (1+ j)) |
| |
(ret nil)) |
| |
((>= j npoints)(nreverse ret)) |
| |
(push (vref array (+ (* npoints i) j)) ret))) |
| |
; (print "b") |
| |
(do ((i 0 (1+ i)) |
| |
(ret nil)) |
| |
((>= i npoints)(nreverse ret)) |
| |
(push (vref b i) ret)) |
| |
; (print "gs") |
| |
(gs npoints array x b) |
| |
(do ((i 0 (1+ i)) |
| |
(ret nil)) |
| |
((>= i npoints)(setq thetas (nreverse ret))) |
| |
(push (vref x i) ret)) |
| |
; (print "thetas")(print thetas) |
| |
(setq ret `((angle .,(car points)))) |
| |
(do ((l points (cdr l)) |
| |
(tmptheta thetas (cdr tmptheta)) |
| |
(tmppsi psis (cdr tmppsi)) |
| |
(diff nil)(p0 nil)(p1 nil)(fai nil)(f nil)(r nil) |
| |
(rotdiff nil)(sintheta nil)(costheta nil)(sinfai nil)(cosfai nil)) |
| |
((atom (cdr l))(nreverse ret)) |
| |
(setq p0 (car l) p1 (cadr l)) |
| |
(setq diff (diff2 p1 p0)) |
| |
(setq rotdiff (rot90 diff)) |
| |
(setq sintheta (sin (car tmptheta)) costheta (cos (car tmptheta))) |
| |
(setq fai (-$ 0.0 (car tmppsi)(cadr tmptheta))) |
| |
; (print (list (car tmppsi)(cadr tmptheta)fai)) |
| |
(setq sinfai (sin fai) cosfai (-$ (cos fai))) |
| |
(setq f (_f (car tmptheta) fai)) |
| |
(setq r (//$ f alpha)) |
| |
(push `(bezier .,(plus2 p0 (times2 (*$ r costheta) diff) |
| |
(times2 (*$ r sintheta) rotdiff))) ret) |
| |
(setq f (_f fai (car tmptheta))) |
| |
(setq r (//$ f beta)) |
| |
(push `(bezier .,(plus2 p1 (times2 (*$ r cosfai) diff) |
| |
(times2 (*$ r sinfai) rotdiff))) ret) |
| |
(push `(angle .,p1) ret)))) |
| |
|
| |
(setq sqrt2 (sqrt 2.0) sqrt5 (sqrt 5.0) d16 (//$ 1.0 16.0)) |
| |
(setq sqrt51 (-$ sqrt5 1.0) sqrt35 (-$ 3.0 sqrt5)) |
| |
(defun _f (theta fai) |
| |
(let ((sinfai (sin fai)) |
| |
(cosfai (cos fai)) |
| |
(sintheta (sin theta)) |
| |
(costheta (cos theta))) |
| |
(//$ (+$ 2.0 (*$ sqrt2 |
| |
(-$ sintheta (*$ d16 sinfai)) |
| |
(-$ sinfai (*$ d16 sintheta)) |
| |
(-$ costheta cosfai))) |
| |
(*$ 3.0 (+$ 1.0 |
| |
(*$ 0.5 sqrt51 costheta) |
| |
(*$ 0.5 sqrt35 cosfai)))))) |
| |
|
| |
(defun gs (n array x b) |
| |
(do ((i 0 (1+ i))) |
| |
((> i 10)) |
| |
(vset x 0 (//$ (-$ (vref b 0) |
| |
(*$ (vref array 1)(vref x 1)) |
| |
(*$ (vref array (1- n))(vref x (1- n))) |
| |
) |
| |
(vref array 0))) |
| |
(do ((j 1 (1+ j)) |
| |
(offset (+ n 1) (+ offset n 1))) |
| |
((>= j (1- n))) |
| |
(vset x j |
| |
(//$ (-$ (vref b j) |
| |
(+$ (*$ (vref array (1- offset))(vref x (1- j))) |
| |
(*$ (vref array (1+ offset))(vref x (1+ j))))) |
| |
(vref array offset)))) |
| |
(vset x (1- n) (//$ (-$ (vref b (1- n)) |
| |
(*$ (vref array (* (1- n) n))(vref x 0)) |
| |
(*$ (vref array (- (* n n) 2))(vref x (- n 2)))) |
| |
(vref array (1- (* n n))))) |
| |
(do ((j 0 (1+ j)) |
| |
(ret nil)) |
| |
((>= j n)(nreverse ret)) |
| |
(push (vref x j)ret)))) |
Diff of /renderer/apply.l
Parent Directory
| 
Revision Log