Annotation of /renderer/hiranew.lAnnotation of /renderer/hiranew.l
Parent Directory
| 
Revision Log
Revision: 1.3 - (view) (download)
| 1 : | ktanaka | 1.1 | ; |
| 2 : | ; please compile this file by iwasaki version compiler | ||
| 3 : | ; | ||
| 4 : | (declare (hirawidth *default-hirawidth* circle-ratio gothicwidth smallhira-affine smallhira-width) special) | ||
| 5 : | |||
| 6 : | (defelement mincho hira-long | ||
| 7 : | (cond | ||
| 8 : | ((equal 2 (length points)) | ||
| 9 : | (lets ((p0 (car points)) | ||
| 10 : | (p1 (cadr points)) | ||
| 11 : | (hwlist (assq 'hirawidth alist)) | ||
| 12 : | (w0 (cond (hwlist (cadr hwlist))(t *default-hirawidth*))) | ||
| 13 : | (w1 (cond (hwlist (caddr hwlist))(t *default-hirawidth*))) | ||
| 14 : | (l0 (rot270 (diff2 p1 p0))) | ||
| 15 : | (a00 (plus2 p0 (normlen2 w0 l0))) | ||
| 16 : | (a01 (diff2 p0 (normlen2 w0 l0))) | ||
| 17 : | (a10 (plus2 p1 (normlen2 w1 l0))) | ||
| 18 : | (a11 (diff2 p1 (normlen2 w1 l0)))) | ||
| 19 : | `(((angle .,a00)(angle .,a10)) | ||
| 20 : | ((angle .,a01)(angle .,a11))))) | ||
| 21 : | (t | ||
| 22 : | (lets ((npoints (length points)) | ||
| 23 : | ; (ms (times 0.5 meshsize)) | ||
| 24 : | (ms 0) | ||
| 25 : | (array (vector (* npoints npoints) 0.0)) | ||
| 26 : | (func #'(lambda (x) (exp (times 0.66666 (log x))))) | ||
| 27 : | (ti | ||
| 28 : | (vector (1- npoints) | ||
| 29 : | (do ((l points (cdr l)) | ||
| 30 : | (ret)) | ||
| 31 : | ((atom (cdr l))(nreverse ret)) | ||
| 32 : | (push (funcall func (metric2 (car l)(cadr l))) ret)))) | ||
| 33 : | (titi (vector (1- npoints))) | ||
| 34 : | (hwlist (assq 'hirawidth alist)) | ||
| 35 : | (bwi (vector (1- (* npoints 2)))) | ||
| 36 : | (dwi (vector (1- (* npoints 2)))) | ||
| 37 : | (wi (cond (hwlist | ||
| 38 : | (vector npoints | ||
| 39 : | (do ((l (cdr hwlist)(cdr l)) | ||
| 40 : | (ret)) | ||
| 41 : | ((atom l)(nreverse ret)) | ||
| 42 : | (push (max ms (times (car l) hirawidth)) ret)))) | ||
| 43 : | (t | ||
| 44 : | (vector npoints *default-hirawidth*)))) | ||
| 45 : | (center (tenhokan points func)) | ||
| 46 : | ) | ||
| 47 : | (do ((i 0 (1+ i)))((>= i (1- npoints))) | ||
| 48 : | (vset titi i (times (vref ti i)(vref ti i)))) | ||
| 49 : | (vset array 0 (quotient 2.0 (vref ti 0))) | ||
| 50 : | (vset array 1 (quotient 1.0 (vref ti 0))) | ||
| 51 : | (vset bwi 0 (times (quotient 3.0 (vref titi 0)) | ||
| 52 : | (difference (vref wi 1)(vref wi 0)))) | ||
| 53 : | (do ((i 0 (1+ i)) | ||
| 54 : | (j npoints (+ j npoints))) | ||
| 55 : | ((>= i (- npoints 2))) | ||
| 56 : | (vset array (+ j i) (quotient 1.0 (vref ti i))) | ||
| 57 : | (vset array (+ j i 1)(plus (quotient 2.0 (vref ti i)) | ||
| 58 : | (quotient 2.0 (vref ti (1+ i))))) | ||
| 59 : | (vset array (+ j i 2) (quotient 1.0 (vref ti (1+ i)))) | ||
| 60 : | (vset bwi (1+ i) | ||
| 61 : | (plus (times (quotient -3.0 (vref titi i))(vref wi i)) | ||
| 62 : | (times (difference (quotient 3.0 (vref titi i)) | ||
| 63 : | (quotient 3.0 (vref titi (1+ i)))) | ||
| 64 : | (vref wi (1+ i))) | ||
| 65 : | (times (quotient 3.0 (vref titi (1+ i))) | ||
| 66 : | (vref wi (+ i 2)))))) | ||
| 67 : | (vset array (- (* npoints npoints) 2) | ||
| 68 : | (quotient 1.0 (vref ti (- npoints 2)))) | ||
| 69 : | (vset array (1- (* npoints npoints)) | ||
| 70 : | (quotient 2.0 (vref ti (- npoints 2)))) | ||
| 71 : | (vset bwi (1- npoints) | ||
| 72 : | (times (quotient 3.0 (vref titi (- npoints 2))) | ||
| 73 : | (difference (vref wi (1- npoints))(vref wi (- npoints 2))))) | ||
| 74 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 75 : | (vset dwi i 0.0) | ||
| 76 : | ) | ||
| 77 : | (gs npoints array dwi bwi) | ||
| 78 : | (do ((i 0 (1+ i)))((>= i npoints)) | ||
| 79 : | (vset dwi i (times 0.2 (vref dwi i)))) | ||
| 80 : | (do ((l (reverse center)) | ||
| 81 : | (ret '(nil nil)) | ||
| 82 : | (i (1- npoints) (1- i))) | ||
| 83 : | ((atom l) ret) | ||
| 84 : | (match l | ||
| 85 : | (((angle . p3)(bezier . p2)(beizer . p1)(angle . p0) . rest) | ||
| 86 : | (setq ret (curve1 p0 p1 p2 p3 | ||
| 87 : | (vref wi (1- i)) | ||
| 88 : | (plus (vref wi (1- i)) | ||
| 89 : | (times 0.3333 (vref ti (1- i)) | ||
| 90 : | (vref dwi (1- i)))) | ||
| 91 : | (plus (vref wi i) | ||
| 92 : | (times -0.3333 (vref ti (1- i)) | ||
| 93 : | (vref dwi i))) | ||
| 94 : | (vref wi i) | ||
| 95 : | ret)) | ||
| 96 : | (setq l (cdddr l))) | ||
| 97 : | (any (setq l (cdr l))))))))) | ||
| 98 : | |||
| 99 : | (defelement gothic hira-long | ||
| 100 : | (cond | ||
| 101 : | ((equal 2 (length points)) | ||
| 102 : | (lets ((p0 (car points)) | ||
| 103 : | (p1 (cadr points)) | ||
| 104 : | (hwlist (assq 'hirawidth alist)) | ||
| 105 : | (w0 (cond (hwlist (cadr hwlist))(t *default-hirawidth*))) | ||
| 106 : | (w1 (cond (hwlist (caddr hwlist))(t *default-hirawidth*))) | ||
| 107 : | (l0 (rot270 (diff2 p1 p0))) | ||
| 108 : | (a00 (plus2 p0 (normlen2 w0 l0))) | ||
| 109 : | (a01 (diff2 p0 (normlen2 w0 l0))) | ||
| 110 : | (a10 (plus2 p1 (normlen2 w1 l0))) | ||
| 111 : | (a11 (diff2 p1 (normlen2 w1 l0)))) | ||
| 112 : | `(((angle .,a00)(angle .,a10)) | ||
| 113 : | ((angle .,a01)(angle .,a11))))) | ||
| 114 : | (t | ||
| 115 : | (lets ((npoints (length points)) | ||
| 116 : | (array (vector (* npoints npoints) 0.0)) | ||
| 117 : | (func #'(lambda (x) (exp (times 0.66666 (log x))))) | ||
| 118 : | (center (tenhokan points func)) | ||
| 119 : | (w gothicwidth) | ||
| 120 : | ) | ||
| 121 : | (do ((l (reverse center)) | ||
| 122 : | (ret '(nil nil))) | ||
| 123 : | ((atom l) ret) | ||
| 124 : | (match l | ||
| 125 : | (((angle . p3)(bezier . p2)(beizer . p1)(angle . p0) . rest) | ||
| 126 : | (setq ret (curve1 p0 p1 p2 p3 w w w w ret)) | ||
| 127 : | (setq l (cdddr l))) | ||
| 128 : | (any (setq l (cdr l))))))))) | ||
| 129 : | |||
| 130 : | (setq circle-ratio (quotient (times 4.0 (difference (sqrt 2) 1)) 3.0)) | ||
| 131 : | (setq smallhira-affine (movexy 200 230 (scalexy 0.8 0.8 (movexy -200 -200)))) | ||
| 132 : | (setq smallhira-width 0.85) | ||
| 133 : | |||
| 134 : | (defun smallkana (type list) | ||
| 135 : | (lets ((prim (applykanji (car list) type)) | ||
| 136 : | (points (car prim)) | ||
| 137 : | (elements (cadr prim)) | ||
| 138 : | (newpoints) | ||
| 139 : | (newelements)) | ||
| 140 : | (do ((l points (cdr l))) | ||
| 141 : | ((atom l)) | ||
| 142 : | (push (affine (car l) smallhira-affine) newpoints)) | ||
| 143 : | (do ((l elements (cdr l))(element)(alist)(hirawidth)) | ||
| 144 : | ((atom l)) | ||
| 145 : | (setq element (car l)) | ||
| 146 : | (setq alist (cddr element)) | ||
| 147 : | (setq hirawidth (assq 'hirawidth alist)) | ||
| 148 : | (cond (hirawidth | ||
| 149 : | (do ((ll (cdr hirawidth)(cdr ll)) | ||
| 150 : | (newhirawidth)) | ||
| 151 : | ((atom ll) | ||
| 152 : | (push `(,(car element),(cadr element) | ||
| 153 : | (hirawidth .,(nreverse newhirawidth)) | ||
| 154 : | .,(remq hirawidth alist)) | ||
| 155 : | newelements)) | ||
| 156 : | (push (fix (times smallhira-width (car ll))) newhirawidth))) | ||
| 157 : | (t | ||
| 158 : | (push element newelements)))) | ||
| 159 : | `(,(nreverse newpoints),(nreverse newelements) | ||
| 160 : | (xlimit 15 385)(ylimit 15 385).,(cddr prim)))) | ||
| 161 : | ; | ||
| 162 : | (defun kana-joint (fonttype list) | ||
| 163 : | (lets ((affines (cadr (car list))) | ||
| 164 : | (prims (cadr (cadr list)))) | ||
| 165 : | (do ((outlines (affinepart (applykanji (car prims)fonttype)(car affines))) | ||
| 166 : | (a (cdr affines)(cdr a)) | ||
| 167 : | (p (cdr prims)(cdr p))) | ||
| 168 : | ((atom p)`(,(car outlines),(cadr outlines) | ||
| 169 : | (xlimit 15 385)(ylimit 15 385).,a)) | ||
| 170 : | (setq outlines | ||
| 171 : | (appendpart outlines | ||
| 172 : | (affinepart (applykanji (car p) fonttype)(car a))))))) | ||
| 173 : | (defkazari mincho ((hira-short hira-long) 2 (hira-short hira-long) 0) | ||
| 174 : | (progn | ||
| 175 : | ; (print (list (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3))) | ||
| 176 : | `((angle .,(vref cross 2)) | ||
| 177 : | (angle .,(vref cross 1))))) | ||
| 178 : | (defkazari gothic (hira-long 2 hira-long 0) | ||
| 179 : | (lets ((p0 (vref cross 0)) | ||
| 180 : | (p1 (vref cross 1)) | ||
| 181 : | (p2 (vref cross 2)) | ||
| 182 : | (p3 (vref cross 3)) | ||
| 183 : | (l0 (diff2 p2 p0)) | ||
| 184 : | (l1 (diff2 p1 p0)) | ||
| 185 : | (rightp (plusp (mul2 l1 (rot90 l0)))) | ||
| 186 : | (costheta (costheta l0 l1))) | ||
| 187 : | (cond ((and rightp (lessp 0.2 costheta)) | ||
| 188 : | `((angle .,p1) | ||
| 189 : | (angle .,p2))) | ||
| 190 : | (t `((angle .,p0)))))) | ||
| 191 : | (defkazari gothic (hira-long 3 hira-long 1) | ||
| 192 : | (lets ((p0 (vref cross 0)) | ||
| 193 : | (p1 (vref cross 1)) | ||
| 194 : | (p2 (vref cross 2)) | ||
| 195 : | (p3 (vref cross 3)) | ||
| 196 : | (l0 (diff2 p2 p0)) | ||
| 197 : | (l1 (diff2 p1 p0)) | ||
| 198 : | (rightp (plusp (mul2 l1 (rot90 l0)))) | ||
| 199 : | (costheta (costheta l0 l1))) | ||
| 200 : | (cond ((and (not rightp) (lessp 0.2 costheta)) | ||
| 201 : | `((angle .,p2) | ||
| 202 : | (angle .,p1))) | ||
| 203 : | (t `((angle .,p3)))))) | ||
| 204 : | |||
| 205 : | ; | ||
| 206 : | ; circle | ||
| 207 : | ; | ||
| 208 : | (defun circle0 (x y rx ry) | ||
| 209 : | (lets ((rx1 (times rx circle-ratio)) | ||
| 210 : | (ry1 (times ry circle-ratio)) | ||
| 211 : | (p0 `(,x ,(difference y ry ))) | ||
| 212 : | ) | ||
| 213 : | `((angle .,p0) | ||
| 214 : | (bezier ,(plus x rx1) ,(difference y ry )) | ||
| 215 : | (bezier ,(plus x rx) ,(difference y ry1)) | ||
| 216 : | (angle ,(plus x rx) ,y) | ||
| 217 : | (bezier ,(plus x rx) ,(plus y ry1)) | ||
| 218 : | (bezier ,(plus x rx1) ,(plus y ry )) | ||
| 219 : | (angle ,x ,(plus y ry)) | ||
| 220 : | (bezier ,(difference x rx1) ,(plus y ry )) | ||
| 221 : | (bezier ,(difference x rx) ,(plus y ry1)) | ||
| 222 : | (angle ,(difference x rx) ,y) | ||
| 223 : | (bezier ,(difference x rx) ,(difference y ry1)) | ||
| 224 : | (bezier ,(difference x rx1) ,(difference y ry )) | ||
| 225 : | (angle .,p0)))) | ||
| 226 : | ; | ||
| 227 : | (defun hira-circle (points (alist)) | ||
| 228 : | (lets ((p0 (first points)) | ||
| 229 : | (p1 (second points)) | ||
| 230 : | (w (times *default-hirawidth* hirawidth)) | ||
| 231 : | (ix (difference (abs (difference (car p1)(car p0))) w)) | ||
| 232 : | (iy (difference (abs (difference (cadr p1)(cadr p0))) w)) | ||
| 233 : | (ox (plus (abs (difference (car p1)(car p0))) w)) | ||
| 234 : | (oy (plus (abs (difference (cadr p1)(cadr p0))) w)) | ||
| 235 : | (ic (circle0 (car p0)(cadr p0) ix iy)) | ||
| 236 : | (oc (circle0 (car p0)(cadr p0) ox oy))) | ||
| 237 : | `(,ic ,oc))) | ||
| 238 : | ; | ||
| 239 : | |||
| 240 : | (defelement mincho hira-circle (hira-circle points alist)) | ||
| 241 : | (defelement naal hira-circle (hira-circle points alist)) | ||
| 242 : | |||
| 243 : | (defkazari mincho (hira-long 0 hira-long 1) | ||
| 244 : | (kanastart (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3))) | ||
| 245 : | (defkazari mincho (hira-long 2 hira-long 3) | ||
| 246 : | (reverse | ||
| 247 : | (kanastart (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2)))) | ||
| 248 : | (defun kanastart (p0 p1 p2 p3) | ||
| 249 : | (lets ((pp0 (inter2 p2 p0 1.8)) | ||
| 250 : | (pp1 (inter2 p3 p1 1.8)) | ||
| 251 : | (pp2 (inter2 pp0 pp1 0.5))) | ||
| 252 : | `((angle .,p0) | ||
| 253 : | (bezier .,(inter2 p0 pp0 circle-ratio)) | ||
| 254 : | (bezier .,(inter2 pp2 pp0 circle-ratio)) | ||
| 255 : | (angle .,pp2) | ||
| 256 : | (bezier .,(inter2 pp2 pp1 circle-ratio)) | ||
| 257 : | (bezier .,(inter2 p1 pp1 circle-ratio)) | ||
| 258 : | (angle .,p1)))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |