diff options
| -rw-r--r-- | src/canvas-language.lisp | 61 |
1 files changed, 60 insertions, 1 deletions
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)) |