aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2024-12-10 07:11:02 -0800
committercolin <colin@cicadas.surf>2024-12-10 07:11:02 -0800
commit03cdbb6a15e130a012377ab8d54074b6864e3480 (patch)
treead8c5cfbd7262a5bf9555729e9b57b26457de027
parent2cbb8e4114c860e1774efd40d18661aee8ab2a72 (diff)
cleanup, examples use def
-rw-r--r--examples/02-image-transforms-and-events.lisp17
-rw-r--r--examples/03-font-render.lisp35
-rw-r--r--examples/12-canvas-drawing-language.lisp2
-rw-r--r--src/canvas-language.lisp5
-rw-r--r--src/grid-geometry.lisp4
-rw-r--r--wheelwork-examples.asd2
6 files changed, 34 insertions, 31 deletions
diff --git a/examples/02-image-transforms-and-events.lisp b/examples/02-image-transforms-and-events.lisp
index 9e4710f..b81f788 100644
--- a/examples/02-image-transforms-and-events.lisp
+++ b/examples/02-image-transforms-and-events.lisp
@@ -131,14 +131,15 @@
(defun start ()
- (ww::start (make-instance 'image-transforms-etc
- :scale 2.0
- :fps 60
- :width 800
- :height 600
- :asset-root (merge-pathnames
- "examples/"
- (asdf:system-source-directory :wheelwork)))))
+ (ww::start
+ (make-instance 'image-transforms-etc
+ :scale 2.0
+ :fps 60
+ :width 800
+ :height 600
+ :asset-root (merge-pathnames
+ "examples/"
+ (asdf:system-source-directory :wheelwork)))))
diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp
index de3c487..66d097d 100644
--- a/examples/03-font-render.lisp
+++ b/examples/03-font-render.lisp
@@ -49,16 +49,13 @@
(defmethod ww::boot ((app font-display))
(let ((hello
- (make-instance
- 'ww::text
- ;:content "Hell! Oh World ..."
- :content (format nil "Hell!~%Oh World...")
- :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2))))
+ (make-instance 'ww::text
+ :content (format nil "Hell!~%Oh World...")
+ :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2))))
(instructions
- (make-instance
- 'ww::text
- :content "Click to spin. Press any key to change color."
- :font (ww::get-asset "Ticketing.ttf"))))
+ (make-instance 'ww::text
+ :content "Click to spin. Press any key to change color."
+ :font (ww::get-asset "Ticketing.ttf"))))
(ww::scale-by hello 3.0)
(setf
@@ -77,16 +74,16 @@
(defun start ()
- (ww::start (make-instance
- 'font-display
- :fps 60
- :refocus-on-mousedown-p nil
- :width 800
- :height 600
- :title "Wheelwork Example: Font display"
- :asset-root (merge-pathnames
- "examples/"
- (asdf:system-source-directory :wheelwork)))))
+ (ww::start
+ (make-instance 'font-display
+ :fps 60
+ :refocus-on-mousedown-p nil
+ :width 800
+ :height 600
+ :title "Wheelwork Example: Font display"
+ :asset-root (merge-pathnames
+ "examples/"
+ (asdf:system-source-directory :wheelwork)))))
diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp
index a727f7b..7c71dea 100644
--- a/examples/12-canvas-drawing-language.lisp
+++ b/examples/12-canvas-drawing-language.lisp
@@ -1,4 +1,4 @@
-;;;; examples/13-canvas-drawing-language.lisp
+;;;; examples/12-canvas-drawing-language.lisp
(defpackage #:ww.examples/12
(:use #:cl)
diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp
index b90e22d..1a8b12e 100644
--- a/src/canvas-language.lisp
+++ b/src/canvas-language.lisp
@@ -216,6 +216,11 @@ last points in PATH)."
(apply-pen-at x y)))
(setf *current-pen-position* (list left bottom)))
+(defun fill-region (region)
+ (with-slots (left bottom right top) region
+ (fill-rect left bottom right top)))
+
+
(defun fill-rel-rect (dx dy)
"Fills in a rectangle relative to current position."
(destructuring-bind (sx sy) *current-pen-position*
diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp
index 3597e75..f66a41f 100644
--- a/src/grid-geometry.lisp
+++ b/src/grid-geometry.lisp
@@ -86,8 +86,8 @@ top right corners of the bounding box for POLY "
,interior-clause))))))
(defmacro with-grid-rect ((x y) (left bottom right top) &body body)
- `(loop for ,x from ,left to ,right do
- (loop for ,y from ,bottom to ,top do ,@body )))
+ `(loop for ,x from (floor ,left) to (floor ,right) do
+ (loop for ,y from (floor ,bottom) to (floor ,top) do ,@body )))
(defmacro with-grid-circle
((x y) (cx cy radius &key interiorp) &body body)
diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd
index 3243831..2834c20 100644
--- a/wheelwork-examples.asd
+++ b/wheelwork-examples.asd
@@ -4,7 +4,7 @@
:license "GPL-3.0"
:version "0.0.1"
:serial t
- :depends-on (#:wheelwork #:wheelwork-gui)
+ :depends-on (#:wheelwork #:wheelwork-gui #:def)
:pathname "examples/"
:components ((:file "01-click-and-drag-image")
(:file "02-image-transforms-and-events")