[wadalabfont-kit] / skeleton-edit / primdisp.l  

View of /skeleton-edit/primdisp.l

Parent Directory | Revision Log
Revision: 1.1 - (download) (annotate)
Fri Jun 27 00:52:12 2003 UTC (20 years, 10 months ago) by ktanaka
Branch: MAIN
CVS Tags: SNAP-20040518, SNAP-20030702, SNAP-20030630, HEAD
*** empty log message ***
;;
;; primdisp.l
;; $Revision: 1.1 $
;;

(defun clear-win! (win)
  (clear-area win :x 0 :y 0 :width (width-win win) :height (height-win win)))

(defun draw-nikuduked-skeleton (win prim mincho-gothic)
  (setq prim (shapeup-skeleton prim))
  (if (null (car prim))
      (beep win)
    (let ((outline (skeleton2list (applykanji prim) mincho-gothic))
	  (save (get-winprop win 'button-press-handler))
	  (loopend nil))
      (clear-win! win)
      (mapcar outline 
	      (function (lambda (x) (fill-polygon-win! win (setpart1 x)))))
      (display-force-output (window-display win)))))

(defun show-nikuduked-skeleton (win prim mincho-gothic)
  (setq prim (shapeup-skeleton prim))
  (if (null (car prim))
      (beep win)
    (let ((outline (skeleton2list (applykanji prim) mincho-gothic))
	  (save (get-winprop win 'button-press-handler))
	  (loopend nil))
      (clear-win! win)
      (mapcar outline 
	      (function (lambda (x) (show-polygon-win! win (setpart1 x)))))
      (display-force-output (window-display win)))))

(defun draw-nikuduked-skeleton-win! (win prim mincho-gothic)
  (setq prim (shapeup-skeleton prim))
  (if (null (car prim))
      (beep win)
    (let ((outline (skeleton2list (applykanji prim) mincho-gothic))
	  (save (get-winprop win 'button-press-handler))
	  (loopend nil))
      (mapcar outline 
	      (function (lambda (x) (fill-polygon-win! win (setpart1 x)))))
      (display-force-output (window-display win)))))
  

ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help