View of /lisp/tools/primdisp.l

Parent Directory

Revision Log

*** empty log message ***

;;
;; primdisp.l
;; $Revision: 1.3 $
;;

(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)))))