Merge pull request #200 from rkoyama1623/add-color-option-for-draw-star

Add color option for draw star

Author: k-okada

doc/jlatex/jgraphics.tex

@@ -296,11 +296,11 @@ \subsection{Viewer}
 ことによりviewsurfaceの大きさを変える。}
 \methoddesc{:draw-line-ndc}{ p1 p2 \&optional (do-clip t)}{
 NDCの中に定義される2つの端点{\em p1,p2}を結ぶ線を描く。}
-\methoddesc{:draw-polyline-ndc}{polylines}{
+\methoddesc{:draw-polyline-ndc}{polylines \&optional color}{
 NDCの中に定義される端点を結ぶ多角形を描く。}
-\methoddesc{:draw-star-ndc}{center \&optional (size 0.01)}{
+\methoddesc{:draw-star-ndc}{center \&optional (size 0.01) color}{
 NDCの中に十字マークを描く。}
-\methoddesc{:draw-box-ndc}{low-left up-right}{
+\methoddesc{:draw-box-ndc}{low-left up-right \&optional color}{
 NDCの中に四角形を描く。}
 \methoddesc{:draw-arc-ndc}{point width height angle1 angle2 \&optional color}{
 NDCの中に円弧を描く。
@@ -315,8 +315,10 @@ \subsection{Viewer}
 \metdesc{:draw-fill-rectangle-ndc}{point width height \&optional color}
 \methoddesc{:draw-line}{p1 p2 \&optional (do-clip t)}{
 ワールド座標系に定義される2つの端点{\em p1,p2}を結ぶ線を描く。}
-\methoddesc{:draw-star}{position \&optional (size 0.01)}{
+\methoddesc{:draw-star}{position \&optional (size 0.01) color}{
 ワールド座標系の{\em position}位置に十字マークを描く。}
+\methoddesc{:draw-polyline}{vlist \&optional color}{
+ワールド座標系の{\em vlist}端点を結ぶ多角形を描く。}
 \methoddesc{:draw-box}{center \&optional (size 0.01)}{
 ワールド座標系の{\em center}に四角形を描く。}
 \methoddesc{:draw-arrow}{p1 p2}{

doc/latex/graphics.tex

@@ -314,11 +314,11 @@ \subsection{Viewer}
 and :size message to viewport.}
 \methoddesc{:draw-line-ndc}{ p1 p2 \&optional (do-clip t)}{
 draws a line whose two end points {\em p1, p2} are defined in NDC.}
-\methoddesc{:draw-polyline-ndc}{polylines}{
+\methoddesc{:draw-polyline-ndc}{polylines \&optional color}{
 draws polylines whose end points are defined in NDC.}
-\methoddesc{:draw-star-ndc}{center \&optional (size 0.01)}{
+\methoddesc{:draw-star-ndc}{center \&optional (size 0.01) color}{
 draws a cross mark in NDC.}
-\methoddesc{:draw-box-ndc}{low-left up-right}{
+\methoddesc{:draw-box-ndc}{low-left up-right \&optional color}{
 draws a rectangle in NDC.}
 \methoddesc{:draw-arc-ndc}{point width height angle1 angle2 [color]}{
 draws an arc in NDC.
@@ -333,8 +333,10 @@ \subsection{Viewer}
 \methoddesc{:draw-line}{p1 p2 \&optional (do-clip t)}{
 draws a line whose two end points {\em p1, p2} are defined in the world
 coordinates.}
-\methoddesc{:draw-star}{position \&optional (size 0.01)}{
+\methoddesc{:draw-star}{position \&optional (size 0.01) color}{
 draws a cross at {\em position} located in the world.}
+\methoddesc{:draw-polyline}{vlist \&optional color}{
+draws polylines whose end points {\em vlist} are defined in the world.}
 \methoddesc{:draw-box}{center \&optional (size 0.01)}{
 draws a rectangular at {\em center}in the world.}
 \methoddesc{:draw-arrow}{p1 p2}{

doc/methods

@@ -721,7 +721,7 @@ viewer
 	:draw-axis           (coords &optional size)
 	:draw-body           (bod &optional (normal-clip t))
 	:draw-box            (v &optional (size (/ (send surface :width) 300.0)))
-	:draw-box-ndc        (lower-left upper-right)
+	:draw-box-ndc        (lower-left upper-right color)
 	:draw-edge           (e &optional color)
 	:draw-edge-image     (ei &optional (dashed-invisibles nil) (color (send ei :color)))
 	:draw-faces          (flist &optional (normal-clip nil) color)
@@ -733,11 +733,11 @@ viewer
 	:draw-line-ndc       (p1 p2 &optional (do-clip t) (color nil))
 	:draw-one            (thing info)
 	:draw-point-ndc      (p &optional color)
-	:draw-polyline       (vlist)
-	:draw-polyline-ndc   (polyline)
+	:draw-polyline       (vlist &optional color)
+	:draw-polyline-ndc   (polyline &optional color)
 	:draw-rectangle-ndc  (point width height &optional color)
-	:draw-star           (v &optional size)
-	:draw-star-ndc       (point &optional (size 0.02))
+	:draw-star           (v &optional size color)
+	:draw-star-ndc       (point &optional (size 0.02) color)
 	:draw-string-ndc     (point string &optional color)
 	:erase               (thing)
 	:flush               

lisp/geo/viewport.l

@@ -197,13 +197,13 @@
     (setq width (send port :ndc-width-to-screen width))
     (setq height (send port :ndc-height-to-screen height))
     (send surface :draw-fill-arc point width height angle1 angle2))
-  (:draw-polyline-NDC (polyline)
+  (:draw-polyline-NDC (polyline &optional color)
     (let ((p1 (pop polyline)) p2)
       (while polyline
 	 (setq p2 (pop polyline))
-	 (send self :draw-line-NDC p1 p2 t)
+	 (send self :draw-line-NDC p1 p2 t color)
 	 (setq p1 p2))))
-  (:draw-box-NDC (lower-left upper-right)
+  (:draw-box-NDC (lower-left upper-right &optional color)
     (declare (float-vector lower-left upper-right))
     (let ((x1 (aref lower-left 0))   (y1 (aref lower-left 1))
 	  (x2 (aref upper-right 0)) (y2 (aref upper-right 1)))
@@ -212,13 +212,13 @@
 		   (float-vector x1 y1 0) (float-vector x2 y1 0)
 		   (float-vector x2 y2 0) (float-vector x1 y2 0)
 		   (float-vector x1 y1 0)))))
-  (:draw-star-NDC (point &optional (size 0.02))
+  (:draw-star-NDC (point &optional (size 0.02) (color nil))
     (send self :draw-line-NDC
 	(float-vector (- (aref point 0) size) (aref point 1) 0)
-	(float-vector (+ (aref point 0) size) (aref point 1) 0))
+	(float-vector (+ (aref point 0) size) (aref point 1) 0) t color)
     (send self :draw-line-NDC
 	(float-vector (aref point 0) (- (aref point 1) size) 0)
-	(float-vector (aref point 0) (+ (aref point 1) size) 0))) )
+	(float-vector (aref point 0) (+ (aref point 1) size) 0) t color)) )
 
 ;; drawing primitives which work in world coordinates
 ;; First, viewing and projective transformations are applied,
@@ -234,9 +234,9 @@
     (setq size (float-vector size size 0.0))
     (setq v (homo2normal (send eye :view v)))
     (send self :draw-box-NDC (v- v size) (v+ v size)))
-  (:draw-polyline (vlist)
+  (:draw-polyline (vlist &optional color)
     (send self :draw-polyline-ndc
-		(mapcar #'(lambda (x) (send eye :view x)) vlist)))
+		(mapcar #'(lambda (x) (send eye :view x)) vlist) color))
   (:draw-arc (point width height
 		&optional (angle1 0) (angle2 2pi) color
 		&aux v)
@@ -275,9 +275,9 @@
        (sys:reclaim p1) (sys:reclaim p2)
        (sys:reclaim pn) (sys:reclaim pa) (sys:reclaim pb)))
   (:pane () (send self :draw-box-NDC #f(-1 -1 0) #f(1 1 0)))
-  (:draw-star (v &optional size)
+  (:draw-star (v &optional size color)
       (if (null size) (setq size 0.02))
-      (send self :draw-star-NDC (homo2normal (send eye :view v)) size))
+      (send self :draw-star-NDC (homo2normal (send eye :view v)) size color))
   (:draw-2dlnseg   (l)
      (send self :draw-line (send l :spos) (send l :epos))) )