;; $Revision$ |
;; $Revision$ |
;; |
;; |
|
|
(defun toggle-skelton-link (win code x y prim) |
(defun toggle-skeleton-link (win code x y prim) |
(lets ((ret nil) |
(lets ((ret nil) |
(points (get-points prim)) |
(points (get-points prim)) |
(lines (get-lines prim)) |
(lines (get-lines prim)) |
(setq ret (cons points (cons lines aux-info))) |
(setq ret (cons points (cons lines aux-info))) |
(clear-win win) |
(clear-win win) |
(if grid (grid-win win)) |
(if grid (grid-win win)) |
(draw-skelton-win win ret) |
(draw-skeleton-win win ret) |
(redraw-win win) |
(redraw-win win) |
ret)) |
ret)) |
|
|
(print (list 'hatena s)) |
(print (list 'hatena s)) |
s))) |
s))) |
|
|
(defun shapeup-skelton (prim (leave nil)) |
(defun shapeup-skeleton (prim (leave nil)) |
(cond ((null prim) '(nil nil)) |
(cond ((null prim) '(nil nil)) |
((and (listp prim) (eq (car prim) 'joint)) |
((and (listp prim) (eq (car prim) 'joint)) |
(recursive-copy prim)) |
(recursive-copy prim)) |
(rem-info p 'link-ok)) |
(rem-info p 'link-ok)) |
p))) |
p))) |
|
|
;; make skelton link |
;; make skeleton link |
(setq |
(setq |
lines |
lines |
(mapcar lines |
(mapcar lines |