| ;(cond ((definedp 'init_window)) |
|
| ; (t (code-load "window.o" "-lX11"))) |
|
| ; ライブラリをexfileする |
|
| ;(cond ((definedp 'kanjilib)) |
|
| ; (t (exfile 'lib.l))) |
|
| ; |
|
| ;(cond ((definedp 'unpackprim)) |
|
| ; (t (exfile 'pack.l))) |
|
| ; bez |
|
| ; Bezier曲線を直線群で近似する |
|
| ; |
|
| (defun bez (x0 y0 x1 y1 x2 y2 x3 y3 (dlist)) |
|
| (lets ((maxx (max x0 x1 x2 x3)) |
|
| (maxy (max y0 y1 y2 y3)) |
|
| (minx (min x0 x1 x2 x3)) |
|
| (miny (min y0 y1 y2 y3))) |
|
| (cond |
|
| ((or (lessp (difference maxx minx) 2) |
|
| (lessp (difference maxy miny) 2)) |
|
| `((,(fix x3) . ,(fix y3)).,dlist)) |
|
| (t |
|
| (lets ((tempx (times 0.125 (plus x0 (times 3 x1)(times 3 x2) x3))) |
|
| (tempy (times 0.125 (plus y0 (times 3 y1)(times 3 y2) y3)))) |
|
| (bez tempx tempy |
|
| (times (plus x3 x2 x2 x1) 0.25) |
|
| (times (plus y3 y2 y2 y1) 0.25) |
|
| (times (plus x3 x2) 0.5) |
|
| (times (plus y3 y2) 0.5) |
|
| x3 y3 |
|
| (bez x0 y0 |
|
| (times (plus x0 x1) 0.5) |
|
| (times (plus y0 y1) 0.5) |
|
| (times (plus x0 x1 x1 x2) 0.25) |
|
| (times (plus y0 y1 y1 y2) 0.25) |
|
| tempx tempy dlist))))))) |
|
| ; |
|
| ; アウトラインから折れ線への変換を行なう |
|
| ; |
|
| |
|
| (defun setpart1 (l) |
|
| (and l |
|
| (lets ((last (car l)) |
|
| (curx (cadr last)) |
|
| (cury (caddr last)) |
|
| (x0)(y0)(x1)(y1)(x2)(y2) |
|
| (ret `((,(fix curx).,(fix cury))))) |
|
| (do ((ll (cdr l) (cdr ll))) |
|
| ((atom ll)ret) |
|
| (match ll |
|
| ((('angle x0 y0).next) |
|
| (setq ret `((,(fix x0).,(fix y0)).,ret)) |
|
| (setq curx x0 cury y0)) |
|
| ((('bezier x0 y0)('bezier x1 y1)) |
|
| (exit (bez curx cury x0 y0 x1 y1 (cadr last)(caddr last) ret))) |
|
| ((('bezier x0 y0)('bezier x1 y1)('angle x2 y2).next) |
|
| (setq ret (bez curx cury x0 y0 x1 y1 x2 y2 ret)) |
|
| (setq curx x2 cury y2) |
|
| (setq ll (cddr ll))) |
|
| (any (break) ; 想定しない入力 |
|
| )))))) |
|
| ; |
; |
| ; スケルトンからアウトラインへの変換を行なう |
; スケルトンからアウトラインへの変換を行なう |
| ; |
; |
| ; |
; |
| ; |
; |
| (defun skeleton2list (l tag) |
(defun skeleton2list (l tag) |
| |
; 仮想的なエレメント xlimit, ylimitを取り除く |
| (setq l (rm-limit l)) |
(setq l (rm-limit l)) |
| |
; 書体固有のスケルトン変形関数が定義されている場合は呼び出す |
| (let ((func (get-def 'typehook tag))) |
(let ((func (get-def 'typehook tag))) |
| (and func (setq l (funcall func l)))) |
(and func (setq l (funcall func l)))) |
| (let ((linkpoints nil) |
(let ((linkpoints nil) |
| (tmpline nil)(type3 nil) |
(tmpline nil)(type3 nil) |
| (type1 nil)(type2 nil)(cross nil)(kazari nil)(part3 nil) |
(type1 nil)(type2 nil)(cross nil)(kazari nil)(part3 nil) |
| (lines (cadr l))) |
(lines (cadr l))) |
| |
; 配列linkpointsの初期化 |
| (do ((ll points (cdr ll)) |
(do ((ll points (cdr ll)) |
| (linkcount 0 (1+ linkcount))) |
(linkcount 0 (1+ linkcount))) |
| ((atom ll)) |
((atom ll)) |
| ((atom lll)) |
((atom lll)) |
| ; (push (point-n (car lll) points) partpoint) |
; (push (point-n (car lll) points) partpoint) |
| (push (nth (car lll) points) partpoint)) |
(push (nth (car lll) points) partpoint)) |
| |
(setq partpoint (nreverse partpoint)) |
| |
|
| ;; tag に対するプロパティが未定義のときのため(石井) |
;; tag に対するプロパティが未定義のときのため(石井) |
| ;; if を使わないように直す(田中) |
;; if を使わないように直す(田中) |
| (lets ((funcname (get-def type tag)) |
(lets ((funcname (get-def type tag)) |
| (result (cond (funcname |
(result (cond (funcname |
| (funcall funcname |
(funcall funcname |
| (nreverse partpoint)(cddr part))) |
partpoint(cddr part))) |
| (t |
(t |
| (print (list 'undefined tag)) |
(print (list 'undefined tag)) |
| (funcall (get type 'mincho) |
(funcall (get type 'mincho) |
| (nreverse partpoint)(cddr part)))))) |
partpoint(cddr part)))))) |
| `(lines ,result))) |
`(lines ,result))) |
| |
|
| (push tmpline linelist) |
(push tmpline linelist) |
Diff of /renderer/apply.l
Parent Directory
| 
Revision Log