Added :x0 :y0 :x1 :y1 to line initialize-instance. Added examples.

Pascal J. Bourguignon [2015-11-13 21:14]
Added :x0 :y0 :x1 :y1 to line initialize-instance. Added examples.
Filename
pgl/examples/ball.lisp
pgl/examples/checkerboard.lisp
pgl/examples/felt-board.lisp
pgl/examples/yarn-pattern.lisp
pgl/examples/yin-yaing.lisp
pgl/examples/yin-yang.lisp
pgl/pgl-ball.lisp
pgl/pgl-test.lisp
pgl/pgl.lisp
diff --git a/pgl/examples/ball.lisp b/pgl/examples/ball.lisp
new file mode 100644
index 0000000..04cc079
--- /dev/null
+++ b/pgl/examples/ball.lisp
@@ -0,0 +1,129 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               ball.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Test the pgl library with a bouncing ball.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.BALL"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.BALL")
+
+
+(defclass ball (compound)
+  ((vx :initarg :vx :accessor vx :initform (- (+ 10 (random 20.0d0)) 15))
+   (vy :initarg :vy :accessor vy :initform (- (+ 10 (random 30.0d0)) 15))
+   (gx :initarg :gx :accessor gx :initform 0                            )
+   (gy :initarg :gy :accessor gy :initform (random 10.0d0)              )))
+
+(defun make-ball (diameter)
+  (let* ((components (cons (make-instance 'oval :x 0 :y 0 :width diameter :height diameter
+                                                :color *red* :fill-color *red* :filled t)
+                           (loop :for alpha :from 0 :below 360 :by 30
+                                 :collect (make-instance 'arc
+                                                         :x 0 :y 0
+                                                         :width diameter :height diameter
+                                                         :start alpha :sweep 15
+                                                         :color *yellow* :fill-color *yellow* :filled t))))
+         (ball (make-instance 'ball :x 0 :y 0 :width diameter :height diameter
+                                    :components components
+                                    :vx (random 30.0d0) :vy 0
+                                    :gx 0 :gy (random 10.0d0))))
+    (dolist (component components) (send-to-front component))
+    ball))
+
+(defun update-position-velocity (x vx gx w)
+  (incf x vx)
+  (unless (<= 0 x w)
+    (setf x (- x vx vx)
+          vx (* 0.9 (- vx))))
+  (incf vx gx)
+  (values x vx gx))
+
+(defmethod update ((b ball) w h)
+  (let ((x (x b))
+        (y (y b))
+        (vx (vx b))
+        (vy (vy b))
+        (gx (gx b))
+        (gy (gy b))
+        (s (width b)))
+    (multiple-value-setq (x vx gx) (update-position-velocity x vx gx (- w s)))
+    (multiple-value-setq (y vy gy) (update-position-velocity y vy gy (- h s)))
+    (setf (vx b) vx
+          (vy b) vy
+          (gx b) gx
+          (gy b) gy)
+    (set-location b x y)))
+
+(defclass ball-window (window)
+  ((ball :initarg :ball :accessor ball)))
+
+(defun make-ball-window ()
+  (let* ((w 512)
+         (h 342)
+         (ball       (make-ball 80))
+         (background (make-instance 'compound
+                                    :x 0 :y 0 :width w :height h
+                                    :components (list (make-instance 'rect
+                                                                     :filled t :fill-color *blue* :color *blue*
+                                                                     :x 0 :y 0 :width w :height h)
+                                                      ball))))
+    (make-instance
+     'ball-window
+     :ball ball
+     :title "Beach Ball"
+     :color *blue*
+     :x 20 :y 40
+     :width w :height h
+     :components (list background))))
+
+(defmethod tick ((window ball-window))
+  (update (ball window) (width window) (height window)))
+
+(defun run ()
+  (let ((w  (make-ball-window))
+        (dt (make-instance 'timer :duration-ms 100)))
+    (start-timer dt)
+    (unwind-protect
+         (loop
+           :for e := (get-next-event (logior +timer-event+ +window-event+))
+           :do (case (event-type-keyword e)
+                 (:timer-ticked  (when (eql dt (event-timer e))
+                                   (tick w)))
+                 (:window-closed (when (eql w (event-window e))
+                                   (loop-finish)))))
+      (stop-timer dt)
+      (free dt)
+      (close-window w))))
+
+;;; THE END ;;;;
diff --git a/pgl/examples/checkerboard.lisp b/pgl/examples/checkerboard.lisp
new file mode 100644
index 0000000..d38b3c5
--- /dev/null
+++ b/pgl/examples/checkerboard.lisp
@@ -0,0 +1,60 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               checkerboard.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Example taken from https://cs.stanford.edu/people/eroberts/jtf/tutorial/UsingTheGraphicsPackage.html
+;;;;
+;;;;    This program draws a checkerboard.  The dimensions of the
+;;;;    checkerboard is specified by the constants NROWS and
+;;;;    NCOLUMNS, and the size of the squares is chosen so
+;;;;    that the checkerboard fills the available vertical space.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.CHECKERBOARD"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.CHECKERBOARD")
+
+
+(defun run (&optional (nrows 8) (ncolumns 8))
+  (let* ((width 512)
+         (height 342)
+         (win  (make-instance 'window :width width :height height
+                                      :title "Checkerboard"))
+         (sqsize (/ height nrows)))
+    (loop :for i :below nrows
+          :for y := (* i sqsize)
+          :do (loop :for j :below ncolumns
+                    :for x := (* j sqsize)
+                    :for sq := (make-instance 'rect :x x :y y :width sqsize :height sqsize)
+                    :do (set-filled sq (plusp (mod (+ i j) 2)))
+                        (compound-add win sq)))))
+
+;;;; THE END ;;;;
diff --git a/pgl/examples/felt-board.lisp b/pgl/examples/felt-board.lisp
new file mode 100644
index 0000000..5117a45
--- /dev/null
+++ b/pgl/examples/felt-board.lisp
@@ -0,0 +1,62 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               felt-board.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Example taken from https://cs.stanford.edu/people/eroberts/jtf/tutorial/UsingTheGraphicsPackage.html
+;;;;
+;;;;    This program offers a simple example of the acm.graphics package
+;;;;    that draws a red rectangle and a green oval.  The dimensions of
+;;;;    the rectangle are chosen so that its sides are in proportion to
+;;;;    the "golden ratio" thought by the Greeks to represent the most
+;;;;    aesthetically pleasing geometry.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.FELT-BOARD"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.FELT-BOARD")
+
+
+(defun run ()
+  (let* ((phi  1.618)
+         (win  (make-instance 'window :width 512 :height 342
+                              :title "Felt Board"))
+         (rect (make-instance 'rect :x 100 :y  50               :width 100 :height (/ 100 phi)))
+         (oval (make-instance 'oval :x 150 :y (+ 50 (/ 50 phi)) :width 100 :height (/ 100 phi))))
+    (set-filled rect t)
+    (set-color rect *orange*)
+    (set-fill-color rect *red*)
+    (compound-add win rect)
+    (set-filled oval t)
+    (set-color oval *blue*)
+    (set-fill-color oval *green*)
+    (compound-add win oval)))
+
+;;;; THE END ;;;;
diff --git a/pgl/examples/yarn-pattern.lisp b/pgl/examples/yarn-pattern.lisp
new file mode 100644
index 0000000..2d45cc4
--- /dev/null
+++ b/pgl/examples/yarn-pattern.lisp
@@ -0,0 +1,86 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               yarn-pattern.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Example taken from https://cs.stanford.edu/people/eroberts/jtf/tutorial/UsingTheGraphicsPackage.html
+;;;;
+;;;;    This program illustrates the use of the GLine class to simulate
+;;;;    winding a piece of colored yarn around a set of pegs equally
+;;;;    spaced along the edges of the canvas.  At each step, the yarn is
+;;;;    stretched from its current peg to the one DELTA pegs further on.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YARN-PATTERN"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YARN-PATTERN")
+
+(defvar *n-across* 50)
+(defvar *n-down*   30)
+(defvar *peg-sep*  10)
+(defvar *delta*    67)
+
+(defun create-peg-list (across down peg-sep)
+  (coerce (nconc (loop :for i :below across
+                       :collect (make-point :x (* i peg-sep)))
+                 (loop :for i :below down
+                       :collect (make-point :x (* across peg-sep) :y (* i peg-sep)))
+                 (loop :for i :from across :above 0
+                       :collect (make-point :x (* i peg-sep) :y (* down peg-sep)))
+                 (loop :for i :from down :above 0
+                       :collect (make-point  :y (* i peg-sep))))
+          'vector))
+
+(defun run ()
+  (let* ((width     521)
+         (height    342)
+         (win       (make-instance 'window :width 512 :height 342
+                                           :title "Yarn Pattern"))
+         ;; (cx        (/ width 2))
+         ;; (cy        (/ height 2))
+         (cx 0)
+         (cy 0)
+         (pegs      (create-peg-list *n-across* *n-down* *peg-sep*))
+         (pegs.size (length pegs))
+         (this-peg  0)
+         (next-peg  -1))
+    (loop :repeat pegs.size ; :while (or (plusp this-peg) (minusp next-peg))
+          :do (setf next-peg (mod (+ this-peg *delta*) pegs.size))
+              (let* ((p0   (aref pegs this-peg))
+                     (p1   (aref pegs next-peg))
+                     (line (make-instance 'line :x0 (+ cx (x p0))
+                                                :y0 (+ cy (y p0))
+                                                :x1 (+ cx (x p1))
+                                                :y1 (+ cy (y p1))
+                                                :color *magenta*)))
+                (compound-add win line))
+              (setf this-peg next-peg))))
+
+;;;; THE END ;;;;
diff --git a/pgl/examples/yin-yaing.lisp b/pgl/examples/yin-yaing.lisp
new file mode 100644
index 0000000..2d45cc4
--- /dev/null
+++ b/pgl/examples/yin-yaing.lisp
@@ -0,0 +1,86 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               yarn-pattern.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Example taken from https://cs.stanford.edu/people/eroberts/jtf/tutorial/UsingTheGraphicsPackage.html
+;;;;
+;;;;    This program illustrates the use of the GLine class to simulate
+;;;;    winding a piece of colored yarn around a set of pegs equally
+;;;;    spaced along the edges of the canvas.  At each step, the yarn is
+;;;;    stretched from its current peg to the one DELTA pegs further on.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YARN-PATTERN"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YARN-PATTERN")
+
+(defvar *n-across* 50)
+(defvar *n-down*   30)
+(defvar *peg-sep*  10)
+(defvar *delta*    67)
+
+(defun create-peg-list (across down peg-sep)
+  (coerce (nconc (loop :for i :below across
+                       :collect (make-point :x (* i peg-sep)))
+                 (loop :for i :below down
+                       :collect (make-point :x (* across peg-sep) :y (* i peg-sep)))
+                 (loop :for i :from across :above 0
+                       :collect (make-point :x (* i peg-sep) :y (* down peg-sep)))
+                 (loop :for i :from down :above 0
+                       :collect (make-point  :y (* i peg-sep))))
+          'vector))
+
+(defun run ()
+  (let* ((width     521)
+         (height    342)
+         (win       (make-instance 'window :width 512 :height 342
+                                           :title "Yarn Pattern"))
+         ;; (cx        (/ width 2))
+         ;; (cy        (/ height 2))
+         (cx 0)
+         (cy 0)
+         (pegs      (create-peg-list *n-across* *n-down* *peg-sep*))
+         (pegs.size (length pegs))
+         (this-peg  0)
+         (next-peg  -1))
+    (loop :repeat pegs.size ; :while (or (plusp this-peg) (minusp next-peg))
+          :do (setf next-peg (mod (+ this-peg *delta*) pegs.size))
+              (let* ((p0   (aref pegs this-peg))
+                     (p1   (aref pegs next-peg))
+                     (line (make-instance 'line :x0 (+ cx (x p0))
+                                                :y0 (+ cy (y p0))
+                                                :x1 (+ cx (x p1))
+                                                :y1 (+ cy (y p1))
+                                                :color *magenta*)))
+                (compound-add win line))
+              (setf this-peg next-peg))))
+
+;;;; THE END ;;;;
diff --git a/pgl/examples/yin-yang.lisp b/pgl/examples/yin-yang.lisp
new file mode 100644
index 0000000..d1f57ec
--- /dev/null
+++ b/pgl/examples/yin-yang.lisp
@@ -0,0 +1,74 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               yin-yang.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Example taken from https://cs.stanford.edu/people/eroberts/jtf/tutorial/UsingTheGraphicsPackage.html
+;;;;
+;;;;    This program draws the Taoist yin-yang symbol at the center of
+;;;;    the graphics window.  The height and width of the entire figure
+;;;;    are both specified by the constant FIGURE_SIZE.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2015-11-13 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YIN-YANG"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
+  (:export "RUN"))
+(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.EXAMPLE.YIN-YANG")
+
+(defun run (&optional (figure-size 150))
+  (let* ((width     521)
+         (height    342)
+         (win       (make-instance 'window :width 512 :height 342
+                                           :title "Yin-Yang"))
+         (x (/ width 2))
+         (y (/ height 2))
+         (r (/ figure-size 2))
+         (big-black     (make-instance 'arc :x (- x r) :y (- y r)
+                                            :width (* 2 r) :height (* 2 r)
+                                            :start -90 :sweep 180
+                                            :filled t))
+         (small-white   (make-instance 'arc :x (- x (/ r 2)) :y (- y  r)
+                                            :width r :height r
+                                            :start -90 :sweep 180
+                                            :filled t
+                                            :color *white*
+                                            :fill-color *white*))
+         (small-black   (make-instance 'arc :x (- x (/ r 2)) :y y
+                                            :width r :height r
+                                            :start 90 :sweep 180
+                                            :filled t))
+         (outer-circle  (make-instance 'arc :x (- x r) :y (- y  r)
+                                            :width (* 2 r) :height (* 2 r)
+                                            :start 0 :sweep 360)))
+    (compound-add win big-black)
+    (compound-add win small-white)
+    (compound-add win small-black)
+    (compound-add win outer-circle)))
+
+;;;; THE END ;;;;
diff --git a/pgl/pgl-ball.lisp b/pgl/pgl-ball.lisp
deleted file mode 100644
index 080277b..0000000
--- a/pgl/pgl-ball.lisp
+++ /dev/null
@@ -1,129 +0,0 @@
-;;;; -*- mode:lisp;coding:utf-8 -*-
-;;;;**************************************************************************
-;;;;FILE:               pgl-ball.lisp
-;;;;LANGUAGE:           Common-Lisp
-;;;;SYSTEM:             Common-Lisp
-;;;;USER-INTERFACE:     NONE
-;;;;DESCRIPTION
-;;;;
-;;;;    Test the pgl library with a bouncing ball.
-;;;;
-;;;;AUTHORS
-;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
-;;;;MODIFICATIONS
-;;;;    2015-11-13 <PJB> Created.
-;;;;BUGS
-;;;;LEGAL
-;;;;    AGPL3
-;;;;
-;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
-;;;;
-;;;;    This program is free software: you can redistribute it and/or modify
-;;;;    it under the terms of the GNU Affero General Public License as published by
-;;;;    the Free Software Foundation, either version 3 of the License, or
-;;;;    (at your option) any later version.
-;;;;
-;;;;    This program is distributed in the hope that it will be useful,
-;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;;    GNU Affero General Public License for more details.
-;;;;
-;;;;    You should have received a copy of the GNU Affero General Public License
-;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-;;;;**************************************************************************
-
-(defpackage "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.TEST.BALL"
-  (:use "COMMON-LISP"
-        "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY")
-  (:export "RUN"))
-(in-package "COM.INFORMATIMAGO.PORTABLE-GRAPHICS-LIBRARY.TEST.BALL")
-
-
-(defclass ball (compound)
-  ((vx :initarg :vx :accessor vx :initform (- (+ 10 (random 20.0d0)) 15))
-   (vy :initarg :vy :accessor vy :initform (- (+ 10 (random 30.0d0)) 15))
-   (gx :initarg :gx :accessor gx :initform 0                            )
-   (gy :initarg :gy :accessor gy :initform (random 10.0d0)              )))
-
-(defun make-ball (diameter)
-  (let* ((components (cons (make-instance 'oval :x 0 :y 0 :width diameter :height diameter
-                                                :color *red* :fill-color *red* :filled t)
-                           (loop :for alpha :from 0 :below 360 :by 30
-                                 :collect (make-instance 'arc
-                                                         :x 0 :y 0
-                                                         :width diameter :height diameter
-                                                         :start alpha :sweep 15
-                                                         :color *yellow* :fill-color *yellow* :filled t))))
-         (ball (make-instance 'ball :x 0 :y 0 :width diameter :height diameter
-                                    :components components
-                                    :vx (random 30.0d0) :vy 0
-                                    :gx 0 :gy (random 10.0d0))))
-    (dolist (component components) (send-to-front component))
-    ball))
-
-(defun update-position-velocity (x vx gx w)
-  (incf x vx)
-  (unless (<= 0 x w)
-    (setf x (- x vx vx)
-          vx (* 0.9 (- vx))))
-  (incf vx gx)
-  (values x vx gx))
-
-(defmethod update ((b ball) w h)
-  (let ((x (x b))
-        (y (y b))
-        (vx (vx b))
-        (vy (vy b))
-        (gx (gx b))
-        (gy (gy b))
-        (s (width b)))
-    (multiple-value-setq (x vx gx) (update-position-velocity x vx gx (- w s)))
-    (multiple-value-setq (y vy gy) (update-position-velocity y vy gy (- h s)))
-    (setf (vx b) vx
-          (vy b) vy
-          (gx b) gx
-          (gy b) gy)
-    (set-location b x y)))
-
-(defclass ball-window (window)
-  ((ball :initarg :ball :accessor ball)))
-
-(defun make-ball-window ()
-  (let* ((w 512)
-         (h 342)
-         (ball       (make-ball 80))
-         (background (make-instance 'compound
-                                    :x 0 :y 0 :width w :height h
-                                    :components (list (make-instance 'rect
-                                                                     :filled t :fill-color *blue* :color *blue*
-                                                                     :x 0 :y 0 :width w :height h)
-                                                      ball))))
-    (make-instance
-     'ball-window
-     :ball ball
-     :title "Beach Ball"
-     :color *blue*
-     :x 20 :y 40
-     :width w :height h
-     :components (list background))))
-
-(defmethod tick ((window ball-window))
-  (update (ball window) (width window) (height window)))
-
-(defun run ()
-  (let ((w  (make-ball-window))
-        (dt (make-instance 'timer :duration-ms 100)))
-    (start-timer dt)
-    (unwind-protect
-         (loop
-           :for e := (get-next-event (logior +timer-event+ +window-event+))
-           :do (case (event-type-keyword e)
-                 (:timer-ticked  (when (eql dt (event-timer e))
-                                   (tick w)))
-                 (:window-closed (when (eql w (event-window e))
-                                   (loop-finish)))))
-      (stop-timer dt)
-      (free dt)
-      (close-window w))))
-
-;;; THE END ;;;;
diff --git a/pgl/pgl-test.lisp b/pgl/pgl-test.lisp
index 044d4b9..df01bbb 100644
--- a/pgl/pgl-test.lisp
+++ b/pgl/pgl-test.lisp
@@ -165,10 +165,6 @@
   (object.contains *w* 11.0d0 61.0d0)


-
-
-
-
   )

 ;;;; THE END ;;;;
diff --git a/pgl/pgl.lisp b/pgl/pgl.lisp
index fa2d8a5..f890f02 100644
--- a/pgl/pgl.lisp
+++ b/pgl/pgl.lisp
@@ -230,18 +230,18 @@ Licensed under the AGPL3.
 (defstruct rectangle (x 0.0d0) (y 0.0d0) (width 0.0d0) (height 0.0d0))

 (defgeneric x (object)
-  (:method ((p point)) (x p))
-  (:method ((r rectangle)) (x r)))
+  (:method ((p point)) (point-x p))
+  (:method ((r rectangle)) (rectangle-x r)))
 (defgeneric y (object)
-  (:method ((p point)) (y p))
-  (:method ((r rectangle)) (y r)))
+  (:method ((p point)) (point-y p))
+  (:method ((r rectangle)) (rectangle-y r)))
 (defgeneric width (object)
   (:method ((p point)) 0)
-  (:method ((r rectangle)) (width r))
+  (:method ((r rectangle)) (rectangle-width r))
   (:method ((d dimension)) (dimension-width d)))
 (defgeneric height (object)
   (:method ((p point)) 0)
-  (:method ((r rectangle)) (height r))
+  (:method ((r rectangle)) (rectangle-height r))
   (:method ((d dimension)) (dimension-height d)))

 (defun rectangle-emptyp (r)
@@ -1353,11 +1353,15 @@ the various subclasses.
 (defclass line (object)
   ())

-(defmethod initialize-instance :after ((self line) &key &allow-other-keys)
-  (let* ((x0 (x self))
-         (y0 (y self))
-         (x1 (+ x0 (width  self)))
-         (y1 (+ y0 (height self))))
+(defmethod initialize-instance :after ((self line) &key (x0 0 x0p) (y0 0 y0p) (x1 0 x1p) (y1 0 y1p) &allow-other-keys)
+  (let* ((x0 (double (if x0p x0 (x self))))
+         (y0 (double (if y0p y0 (y self))))
+         (x1 (double (if x1p x1 (+ x0 (width  self)))))
+         (y1 (double (if y1p y1 (+ y0 (height self))))))
+    (when x0p (setf (slot-value self 'x) x0))
+    (when y0p (setf (slot-value self 'y) y0))
+    (when x1p (setf (slot-value self 'width) (- x1 x0)))
+    (when y1p (setf (slot-value self 'height) (- y1 y0)))
     (line.create self x0 y0 x1 y1)
     (%set-object-attributes self)))
ViewGit