From 276c7728829436874260eb73033dad85b998a8c7 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Wed, 20 Jul 2022 13:56:14 -0500
Subject: [doc] docstrings to canvas language [add] stroke/fill steps
---
src/canvas-language.lisp | 61 +++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 60 insertions(+), 1 deletion(-)
diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp
index 83e510f..fb3b679 100644
--- a/src/canvas-language.lisp
+++ b/src/canvas-language.lisp
@@ -89,7 +89,10 @@ saved by WITH-PEN-STATE"
(mapcar #'colfix newpen)))))
(defun canvas-pen-width (n)
- (setf *current-pen-width* (round n)))
+ "Set the cavnas pen width. This is approximately how many pixels
+wide a line drawn with the pen will be. If N is not a positive
+integer."
+ (setf *current-pen-width* n))
(defun can-fill-canvas-at-p (x y)
(with-slots (pixel-width pixel-height) *current-canvas*
@@ -101,13 +104,17 @@ saved by WITH-PEN-STATE"
(loop for (x y) in path collect (list (+ cx x) (+ cy y)))))
(defun move-to (x y)
+ "Sets the pen's position without drawing. "
(setf *current-pen-position* (list x y)))
(defun move-rel (dx dy)
+ "Moves the current pen by dx dy."
(setf *current-pen-position*
(mapcar #'+ *current-pen-position* (list dx dy))))
(defun apply-pen-at (x y)
+ "Draws the pen onto the canvas at the location X Y. If the pen width
+is 1 the just one pixel is drawn. If 2 then 4 are drawn, and so on. "
(let ((w
(max 0 (1- *current-pen-width*))))
(destructuring-bind
@@ -122,34 +129,73 @@ saved by WITH-PEN-STATE"
(setf r cr g cg b cb a ca)))))))
(defun stroke-to (ex ey)
+ "Draw a line from the current pen position to EX EY."
(destructuring-bind (sx sy) *current-pen-position*
(with-grid-line (x y) (sx sy) (ex ey)
(apply-pen-at x y)))
(setf *current-pen-position* (list ex ey)))
(defun stroke-rel (dx dy)
+ "Draw a line from the current pen position to a distance DX DY away."
(apply #'stroke-to (mapcar #'+ *current-pen-position* (list dx dy))))
(defun stroke-path (path)
+ "Draw a path. PATH is a list of (X Y) points. The pen is moved to
+the first point and then each point is connnected. At last, the pen's
+position is set to the last point. "
(with-grid-path (x y) (path) (apply-pen-at x y))
(setf *current-pen-position* (copy-list (first (last path)))))
(defun stroke-rel-path (path)
+ "Draw a path starting at the current point. PATH is a list of DX DY
+values, each of which is relative to the current position of the PEN.
+
+If you are looking for a function where each subsequent point moves
+the pen relative to its antecedent, look at STROKE-STEPS"
(stroke-path
(cons *current-pen-position*
(rel-to-current-pos path))))
+(defun steps-to-concrete-points (steps)
+ (loop
+ with (cx cy) = *current-pen-position*
+ for (dx dy) in steps
+ do (incf cx dx)
+ (incf cy dy)
+ collect (list cx cy)))
+
+(defun stroke-steps (steps)
+ "STEPS is a list of (dx dy) steps. The pen starts at the current
+positoin and draws a path, each step on the path moves the pen dx dy
+from its then current location."
+ (stroke-path
+ (cons *current-pen-position*
+ (steps-to-concrete-points steps))))
+
+
+
(defun fill-path (path)
+ "Draws path as a closed polygon (implicitly connecting the first and
+last points in PATH)."
(let ((*current-pen-width* 1))
(with-grid-path (x y) (path :interiorp t)
(apply-pen-at x y))))
+(defun fill-steps (steps)
+ "Like STROKE-STEPS but implicitly connects the first and last points
+ to be drawn and fills the resulting polygon in with the current pen."
+ (fill-path
+ (cons *current-pen-position*
+ (steps-to-concrete-points steps))))
+
(defun fill-rel-path (path)
+ "See STROKE-REL-PATH."
(fill-path
(cons *current-pen-position*
(rel-to-current-pos path))))
(defun stroke-rect (left bottom right top)
+ "Draws a rectangle."
(stroke-path (list (list left bottom)
(list left top)
(list right top)
@@ -157,6 +203,7 @@ saved by WITH-PEN-STATE"
(list left bottom))))
(defun stroke-rel-rect (dx dy)
+ "Draws a rectangle relative to the current position."
(destructuring-bind (sx sy) *current-pen-position*
(let ((left
(if (plusp dx) sx (+ sx dx)))
@@ -169,12 +216,14 @@ saved by WITH-PEN-STATE"
(stroke-rect left bottom right top))))
(defun fill-rect (left bottom right top)
+ "Fills in a rectangle."
(let ((*current-pen-width* 1))
(with-grid-rect (x y) (left bottom right top)
(apply-pen-at x y)))
(setf *current-pen-position* (list left bottom)))
(defun fill-rel-rect (dx dy)
+ "Fills in a rectangle relative to current position."
(destructuring-bind (sx sy) *current-pen-position*
(let ((left
(if (plusp dx) sx (+ sx dx)))
@@ -187,23 +236,33 @@ saved by WITH-PEN-STATE"
(fill-rect left bottom right top))))
(defun stroke-bezier (control-pts &optional (curve-samples 10))
+ "Draws a bezier curve with control points CONTROL-PTS. CURVE-SAMPLES
+is the number of points on the 'real bezier curve' that will be
+connected by straight lines to form an approximate curve. Use a higher
+value for smoother looking curves."
(let (path)
(with-grid-bezier (x y) (control-pts :count curve-samples)
(push (list x y) path))
(stroke-path (reverse path))))
(defun stroke-rel-bezier (rel-control-points &optional (curve-samples 10))
+ "Like STROKE-BEZIER but REL-CONTROL-POINTS are (DX DY) that
+represent the position of control points relative to the current pen
+position."
(stroke-bezier (cons *current-pen-position*
(rel-to-current-pos rel-control-points))
curve-samples))
(defun fill-bezier (control-pts &optional (curve-samples 10))
+ "Like STROKE-BEZIER but will implicitly connect the first and last
+curve sample points and fill in the resulting polygon."
(let (path)
(with-grid-bezier (x y) (control-pts :count curve-samples)
(push (list x y) path))
(fill-path (reverse path))))
(defun fill-rel-bezier (rel-control-points &optional (curve-samples 10))
+ "Like STROKE-REL-BEZIER and FILL-BEZIER."
(fill-bezier (cons *current-pen-position*
(rel-to-current-pos rel-control-points))
curve-samples))
--
cgit v1.2.3