Annotation of /primdata/prim-test.lAnnotation of /primdata/prim-test.l
Parent Directory
| 
Revision Log
Revision: 1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | (setq mu '(((91 49) |
| 2 : | (138 62) | ||
| 3 : | (138 75) | ||
| 4 : | (135 248) | ||
| 5 : | (113 272) | ||
| 6 : | (67 275) | ||
| 7 : | (56 235) | ||
| 8 : | (113 178) | ||
| 9 : | (138 234) | ||
| 10 : | (135 327) | ||
| 11 : | (333 316) | ||
| 12 : | (327 282) | ||
| 13 : | (321 230) | ||
| 14 : | (25 122) | ||
| 15 : | (81 140) | ||
| 16 : | (210 123) | ||
| 17 : | (229 123) | ||
| 18 : | (280 80) | ||
| 19 : | (314 103) | ||
| 20 : | (337 140) | ||
| 21 : | (342 149)) | ||
| 22 : | ((hira-long | ||
| 23 : | (0 1 2 3 4 5 6 7 8 9 10 11 12) | ||
| 24 : | (hirawidth 3 23 17 18 16 18 12 8 18 23 23 8 3)) | ||
| 25 : | (hira-long (13 14 15 16) (hirawidth 5 19 25 14)) | ||
| 26 : | (hira-long (17 18 19 20) (hirawidth 5 13 18 12))))) | ||
| 27 : | (macro diff (x) `(difference .,x)) | ||
| 28 : | (defelement mincho hira-long | ||
| 29 : | (lets ((npoints (length points)) | ||
| 30 : | (array (vector (* npoints npoints) 0.0)) | ||
| 31 : | (ti | ||
| 32 : | (vector (1- npoints) | ||
| 33 : | (do ((l points (cdr l)) | ||
| 34 : | (ret)) | ||
| 35 : | ((atom (cdr l))(nreverse ret)) | ||
| 36 : | (push (exp (times 0.6666 | ||
| 37 : | (log (metric2 (car l)(cadr l))))) ret)))) | ||
| 38 : | (titi (vector (1- npoints))) | ||
| 39 : | (pi | ||
| 40 : | (vector npoints | ||
| 41 : | (do ((l points (cdr l)) | ||
| 42 : | (ret)) | ||
| 43 : | ((atom l)(nreverse ret)) | ||
| 44 : | (push (car l) ret)))) | ||
| 45 : | (bix (vector (1- (* npoints 2))))(biy (vector (1- (* npoints 2)))) | ||
| 46 : | (dpi (vector (1- (* npoints 2)))) | ||
| 47 : | (ddpi (vector (1- (* npoints 2)))) | ||
| 48 : | (dpir (vector (1- (* npoints 2)))) | ||
| 49 : | (ddpir (vector (1- (* npoints 2)))) | ||
| 50 : | (dpix (vector (1- (* npoints 2))))(dpiy (vector (1- (* npoints 2)))) | ||
| 51 : | (bi (vector (1- (* npoints 2)))) | ||
| 52 : | (hwlist (assq 'hirawidth alist)) | ||
| 53 : | (wi (cond (hwlist | ||
| 54 : | (vector npoints | ||
| 55 : | (do ((l (cdr hwlist)(cdr l)) | ||
| 56 : | (ret)) | ||
| 57 : | ((atom l)(nreverse ret)) | ||
| 58 : | (push (times (car l) hirawidth) ret)))) | ||
| 59 : | (t | ||
| 60 : | (vector npoints *default-hirawidth*)))) | ||
| 61 : | (bwi (vector (1- (* npoints 2)))) | ||
| 62 : | (dwi (vector (1- (* npoints 2)))) | ||
| 63 : | (dxi1 (vector (1- (* npoints 2)))) | ||
| 64 : | (dxi2 (vector (1- (* npoints 2)))) | ||
| 65 : | (dlen (vector (1- (* npoints 2)))) | ||
| 66 : | (dlen2 (vector (1- (* npoints 2)))) | ||
| 67 : | (s0)(s00)(s01)(s1)(s10)(s11) | ||
| 68 : | ) | ||
| 69 : | (do ((i 0 (1+ i)))((>= i (1- npoints))) | ||
| 70 : | (vset titi i (times (vref ti i)(vref ti i)))) | ||
| 71 : | (vset array 0 (quotient 2.0 (vref ti 0))) | ||
| 72 : | (vset array 1 (quotient 1.0 (vref ti 0))) | ||
| 73 : | (vset bi 0 (times2 (quotient 3.0 (vref titi 0)) | ||
| 74 : | (diff2 (vref pi 1)(vref pi 0)))) | ||
| 75 : | (vset bwi 0 (times (quotient 3.0 (vref titi 0)) | ||
| 76 : | (difference (vref wi 1)(vref wi 0)))) | ||
| 77 : | (do ((i 0 (1+ i)) | ||
| 78 : | (j npoints (+ j npoints))) | ||
| 79 : | ((>= i (- npoints 2))) | ||
| 80 : | (vset array (+ j i) (quotient 1.0 (vref ti i))) | ||
| 81 : | (vset array (+ j i 1)(plus (quotient 2.0 (vref ti i)) | ||
| 82 : | (quotient 2.0 (vref ti (1+ i))))) | ||
| 83 : | (vset array (+ j i 2) (quotient 1.0 (vref ti (1+ i)))) | ||
| 84 : | (vset bi (1+ i ) | ||
| 85 : | (plus2 | ||
| 86 : | (times2 (quotient -3.0 (vref titi i))(vref pi i)) | ||
| 87 : | (times2 (difference (quotient 3.0 (vref titi i)) | ||
| 88 : | (quotient 3.0 (vref titi (1+ i))))(vref pi (1+ i))) | ||
| 89 : | (times2 (quotient 3.0 (vref titi (1+ i)))(vref pi (+ i 2))))) | ||
| 90 : | (vset bwi (1+ i) | ||
| 91 : | (plus (times (quotient -3.0 (vref titi i))(vref wi i)) | ||
| 92 : | (times (difference (quotient 3.0 (vref titi i)) | ||
| 93 : | (quotient 3.0 (vref titi (1+ i)))) | ||
| 94 : | (vref wi (1+ i))) | ||
| 95 : | (times (quotient 3.0 (vref titi (1+ i))) | ||
| 96 : | (vref wi (+ i 2)))))) | ||
| 97 : | (vset array (- (* npoints npoints) 2) | ||
| 98 : | (quotient 1.0 (vref ti (- npoints 2)))) | ||
| 99 : | (vset array (1- (* npoints npoints)) | ||
| 100 : | (quotient 2.0 (vref ti (- npoints 2)))) | ||
| 101 : | (vset bi (1- npoints) | ||
| 102 : | (times2 (quotient 3.0 (vref titi (- npoints 2))) | ||
| 103 : | (diff2 (vref pi (1- npoints))(vref pi (- npoints 2))))) | ||
| 104 : | (vset bwi (1- npoints) | ||
| 105 : | (times (quotient 3.0 (vref titi (- npoints 2))) | ||
| 106 : | (difference (vref wi (1- npoints))(vref wi (- npoints 2))))) | ||
| 107 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 108 : | (vset bix i (car (vref bi i))) | ||
| 109 : | (vset biy i (cadr (vref bi i))) | ||
| 110 : | (vset dpix i 0.0) | ||
| 111 : | (vset dpiy i 0.0) | ||
| 112 : | (vset dwi i 0.0) | ||
| 113 : | ) | ||
| 114 : | (gs npoints array dpix bix) | ||
| 115 : | (gs npoints array dpiy biy) | ||
| 116 : | (gs npoints array dwi bwi) | ||
| 117 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 118 : | (vset dpi i `(,(vref dpix i) ,(vref dpiy i)))) | ||
| 119 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 120 : | (vset dwi i (times 0.2 (vref dwi i)))) | ||
| 121 : | ; (print dwi) | ||
| 122 : | ; (vset ddpi 0 '(0.0 0.0)) | ||
| 123 : | |||
| 124 : | (do ((i 0 (1+ i))) | ||
| 125 : | ((>= i (1- npoints))) | ||
| 126 : | (setq len (metric2 (vref pi i)(vref pi (1+ i)))) | ||
| 127 : | (setq n (fix (quotient (plus len 10) 20))) | ||
| 128 : | (setq p1 (vref pi i) dp1 (vref dpi i) w1 (vref wi i) dw1 (vref dwi i)) | ||
| 129 : | (setq p2 (vref pi (1+ i)) dp2 (vref dpi (1+ i)) | ||
| 130 : | w2 (vref wi (1+ i)) dw2 (vref dwi (1+ i))) | ||
| 131 : | (setq t1 (vref ti i)) | ||
| 132 : | (setq t2 (times t1 t1) t3 (times t1 t1 t1)) | ||
| 133 : | (do ((j 0 (1+ j))) | ||
| 134 : | ((> j n)) | ||
| 135 : | (setq tt (times j (quotient (vref ti i) n))) | ||
| 136 : | (setq tt1 tt) | ||
| 137 : | (setq tt2 (times tt tt) tt3 (times tt tt tt)) | ||
| 138 : | (setq p | ||
| 139 : | (plus2 | ||
| 140 : | (times2 (quotient (times 2 tt3) t3) | ||
| 141 : | (diff2 p1 p2)) | ||
| 142 : | (times2 (quotient tt3 t2) | ||
| 143 : | (plus2 dp1 dp2)) | ||
| 144 : | (times2 (quotient (times 3 tt2) t2) | ||
| 145 : | (diff2 p2 p1)) | ||
| 146 : | (times2 (times -1.0 (quotient tt2 t1)) | ||
| 147 : | (plus2 dp1 dp1 dp2)) | ||
| 148 : | (times2 tt1 dp1) | ||
| 149 : | p1)) | ||
| 150 : | (setq dp | ||
| 151 : | (plus2 | ||
| 152 : | (times2 (quotient (times 6 tt2) t3) | ||
| 153 : | (diff2 p1 p2)) | ||
| 154 : | (times2 (quotient (times 3 tt2) t2) | ||
| 155 : | (plus2 dp1 dp2)) | ||
| 156 : | (times2 (quotient (times 6 tt1) t2) | ||
| 157 : | (diff2 p2 p1)) | ||
| 158 : | (times2 (times -2.0 (quotient tt1 t1)) | ||
| 159 : | (plus2 dp1 dp1 dp2)) | ||
| 160 : | dp1)) | ||
| 161 : | (setq w | ||
| 162 : | (plus | ||
| 163 : | (times (quotient (times 2 tt3) t3) | ||
| 164 : | (diff w1 w2)) | ||
| 165 : | (times (quotient tt3 t2) | ||
| 166 : | (plus dw1 dw2)) | ||
| 167 : | (times (quotient (times 3 tt2) t2) | ||
| 168 : | (diff w2 w1)) | ||
| 169 : | (times (times -1.0 (quotient tt2 t1)) | ||
| 170 : | (plus dw1 dw1 dw2)) | ||
| 171 : | (times tt1 dw1) | ||
| 172 : | w1)) | ||
| 173 : | (setq dw | ||
| 174 : | (plus | ||
| 175 : | (times (quotient (times 6 tt2) t3) | ||
| 176 : | (diff w1 w2)) | ||
| 177 : | (times (quotient (times 3 tt2) t2) | ||
| 178 : | (plus dw1 dw2)) | ||
| 179 : | (times (quotient (times 6 tt1) t2) | ||
| 180 : | (diff w1 w2)) | ||
| 181 : | (times (times -2.0 (quotient tt1 t1)) | ||
| 182 : | (plus dw1 dw1 dw2)) | ||
| 183 : | dw1)) | ||
| 184 : | (format "/c /c /c /c daen/n" (fix (car p))(- 400 (fix (cadr p))) | ||
| 185 : | (fix (times 360 (quotient (theta dp '(1.0 0.0)) 6.2832))) (fix w)))) | ||
| 186 : | (setq p (vref pi (1- npoints)) dp (vref dpi (1- npoints)) | ||
| 187 : | w (vref wi (1- npoints))) | ||
| 188 : | (format "/c /c /c /c daen/n" (fix (car p))(- 400 (fix (cadr p))) | ||
| 189 : | (fix (times 360 (quotient (theta dp '(1.0 0.0)) 6.2832))) (fix w)) | ||
| 190 : | |||
| 191 : | (vset ddpi (1- npoints) '(0.0 0.0)) | ||
| 192 : | (do ((i 0 (1+ i))) | ||
| 193 : | ((>= i (1- npoints))) | ||
| 194 : | (vset ddpi i | ||
| 195 : | (plus2 | ||
| 196 : | (times2 | ||
| 197 : | (quotient 6.0 (vref titi i)) | ||
| 198 : | (diff2 (vref pi (1+ i))(vref pi i))) | ||
| 199 : | (times2 | ||
| 200 : | (quotient -4.0 (vref ti i)) | ||
| 201 : | (vref dpi i)) | ||
| 202 : | (times2 | ||
| 203 : | (quotient -2.0 (vref ti i)) | ||
| 204 : | (vref dpi (1+ i))) | ||
| 205 : | ))) | ||
| 206 : | (do ((i 0 (1+ i))(tmp))((>= i npoints)) | ||
| 207 : | (vset dlen i (setq tmp (quotient 1.0 (length2 (vref dpi i))))) | ||
| 208 : | (vset dlen2 i (times tmp tmp))) | ||
| 209 : | (do ((i 0 (1+ i))(x)(y))((>= i npoints)) | ||
| 210 : | (setq x (times (vref dlen i)(car (vref dpi i))) | ||
| 211 : | y (times (vref dlen i)(cadr (vref dpi i)))) | ||
| 212 : | (vset dpir i | ||
| 213 : | (vector 6 `(,x ,y ,y ,(minus x) 0 0))) | ||
| 214 : | (setq x (times (vref dlen i)(car (vref ddpi i))) | ||
| 215 : | y (times (vref dlen i)(cadr (vref ddpi i)))) | ||
| 216 : | (vset ddpir i | ||
| 217 : | (vector 6 `(,x ,y ,y ,(minus x) 0 0)))) | ||
| 218 : | ; (break) | ||
| 219 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 220 : | (vset dxi1 i | ||
| 221 : | (plus2 (vref dpi i) | ||
| 222 : | (affine `(0 ,(minus (vref dwi i)))(vref dpir i)) | ||
| 223 : | (affine `(0 ,(minus (vref wi i)))(vref ddpir i)) | ||
| 224 : | (times2 (times -1.0 (mul2 (vref dpi i)(vref ddpi i)) | ||
| 225 : | (vref dlen2 i)) | ||
| 226 : | (affine `(0 ,(minus (vref wi i)))(vref dpir i))) | ||
| 227 : | )) | ||
| 228 : | (vset dxi2 i | ||
| 229 : | (plus2 (vref dpi i) | ||
| 230 : | (affine `(0 ,(vref dwi i)) | ||
| 231 : | (vref dpir i)) | ||
| 232 : | (affine `(0 ,(vref wi i))(vref ddpir i)) | ||
| 233 : | (times2 (times -1.0 (mul2 (vref dpi i)(vref ddpi i)) | ||
| 234 : | (vref dlen2 i)) | ||
| 235 : | (affine `(0 ,(vref wi i)) | ||
| 236 : | (vref dpir i))) | ||
| 237 : | ) | ||
| 238 : | )) | ||
| 239 : | ; (break) | ||
| 240 : | (setq d0 (normlen2 (times -0.8 (vref wi 0))(vref dpi 0))) | ||
| 241 : | (setq l0 (length2 d0)) | ||
| 242 : | (setq l0 (times l0 l0)) | ||
| 243 : | (setq s0 (plus2 (vref pi 0) d0)) | ||
| 244 : | (cond | ||
| 245 : | ((plusp (vref wi 0)) | ||
| 246 : | (setq p00 (plus2 (vref pi 0) | ||
| 247 : | (affine `(0 ,(minus (vref wi 0)))(vref dpir 0)))) | ||
| 248 : | (setq p01 (plus2 (vref pi 0)(affine `(0 ,(vref wi 0))(vref dpir 0)))) | ||
| 249 : | (setq s00 (plus2 p00 (times2 (quotient l0 | ||
| 250 : | (mul2 (vref dxi1 0) d0)) | ||
| 251 : | (vref dxi1 0)))) | ||
| 252 : | (setq s01 (plus2 p01 (times2 (quotient l0 | ||
| 253 : | (mul2 (vref dxi2 0)d0)) | ||
| 254 : | (vref dxi2 0)))))) | ||
| 255 : | (setq d1 (normlen2 (times 0.8 (vref wi (1- npoints))) | ||
| 256 : | (vref dpi (1- npoints)))) | ||
| 257 : | (setq l1 (length2 d1)) | ||
| 258 : | (setq l1 (times l1 l1)) | ||
| 259 : | (setq s1 (plus2 (vref pi (1- npoints)) d1)) | ||
| 260 : | (cond | ||
| 261 : | ((plusp (vref wi (1- npoints))) | ||
| 262 : | (setq p10 (plus2 (vref pi (1- npoints)) | ||
| 263 : | (affine `(0 ,(minus (vref wi (1- npoints)))) | ||
| 264 : | (vref dpir (1- npoints))))) | ||
| 265 : | (setq p11 (plus2 (vref pi (1- npoints)) | ||
| 266 : | (affine `(0 ,(vref wi (1- npoints))) | ||
| 267 : | (vref dpir (1- npoints))))) | ||
| 268 : | (setq s10 (plus2 p10 (times2 (quotient l1 | ||
| 269 : | (mul2 (vref dxi1 (1- npoints)) | ||
| 270 : | d1)) | ||
| 271 : | (vref dxi1 (1- npoints))))) | ||
| 272 : | (setq s11 (plus2 p11 (times2 (quotient l1 | ||
| 273 : | (mul2 (vref dxi2 (1- npoints)) | ||
| 274 : | d1)) | ||
| 275 : | (vref dxi2 (1- npoints))))))) | ||
| 276 : | (setq test 'bezier) | ||
| 277 : | (do ((i 0 (1+ i)) | ||
| 278 : | (ret1 (and (plusp (vref wi 0)) | ||
| 279 : | `((,test .,(inter2 p00 s00 circle-ratio)) | ||
| 280 : | (,test .,(inter2 s0 s00 circle-ratio)) | ||
| 281 : | (angle .,s0)))) | ||
| 282 : | (ret2 (and (plusp (vref wi 0)) | ||
| 283 : | `((,test .,(inter2 p01 s01 circle-ratio)) | ||
| 284 : | (,test .,(inter2 s0 s01 circle-ratio)) | ||
| 285 : | (angle .,s0)))) | ||
| 286 : | (p0)(p1)) | ||
| 287 : | ((>= i (1- npoints)) | ||
| 288 : | (cond ((plusp (vref wi (1- npoints))) | ||
| 289 : | (push `(angle .,p10) ret1) | ||
| 290 : | (push `(,test .,(inter2 p10 s10 circle-ratio)) ret1) | ||
| 291 : | (push `(,test .,(inter2 s1 s10 circle-ratio)) ret1))) | ||
| 292 : | (push `(angle .,s1) ret1) | ||
| 293 : | (cond ((plusp (vref wi (1- npoints))) | ||
| 294 : | (push `(angle .,p11) ret2) | ||
| 295 : | (push `(,test .,(inter2 p11 s11 circle-ratio)) ret2) | ||
| 296 : | (push `(,test .,(inter2 s1 s11 circle-ratio)) ret2))) | ||
| 297 : | (push `(angle .,s1) ret2) | ||
| 298 : | `(,(reverse ret1) ,(reverse ret2))) | ||
| 299 : | (setq p1 (plus2 (vref pi i)(affine `(0 ,(vref wi i))(vref dpir i)))) | ||
| 300 : | (setq p2 (plus2 (vref pi (1+ i)) | ||
| 301 : | (affine `(0 ,(vref wi (1+ i)))(vref dpir (1+ i))))) | ||
| 302 : | (push `(angle .,p1) ret2) | ||
| 303 : | (push `(,test .,(plus2 p1 | ||
| 304 : | (times2 (quotient (vref ti i) 3.0) | ||
| 305 : | (vref dxi2 i)))) ret2) | ||
| 306 : | (push `(,test .,(diff2 p2 | ||
| 307 : | (times2 (quotient (vref ti i) 3.0) | ||
| 308 : | (vref dxi2 (1+ i))))) ret2) | ||
| 309 : | (setq p1 (plus2 (vref pi i)(affine `(0 ,(minus (vref wi i))) | ||
| 310 : | (vref dpir i)))) | ||
| 311 : | (setq p2 (plus2 (vref pi (1+ i)) | ||
| 312 : | (affine `(0 ,(minus (vref wi (1+ i)))) | ||
| 313 : | (vref dpir (1+ i))))) | ||
| 314 : | (push `(angle .,p1) ret1) | ||
| 315 : | (push `(,test .,(plus2 p1 | ||
| 316 : | (times2 (quotient (vref ti i) 3.0) | ||
| 317 : | (vref dxi1 i)))) ret1) | ||
| 318 : | (push `(,test .,(diff2 p2 | ||
| 319 : | (times2 (quotient (vref ti i) 3.0) | ||
| 320 : | (vref dxi1 (1+ i))))) ret1)))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |