CL-Canvas

A canvas for graphics output and mouse and keyboard input with Lisp (currently only tested on LispWorks for Windows, but should work on Allegro Common Lisp for Windows, too). You need ASDF and these packages: hello-c.zip and cl-canvas.zip

Sample usage

Line drawing

(clc:show-canvas 300 300)
(setf clc:*current-color* #x00ffff)
(clc:fill-rect 50 50 250 250)
(setf clc:*current-color* 0)
(loop for i from 50 to 250 by 5 do (clc:draw-line (- 300 i) 50 50 i))
(clc:draw-line 250 250 250 50)
(clc:draw-line 250 250 50 250)
(clc:repaint)

Logo-like turtle interface

(defun kochcurve (level size)
  (if (= level 0)
      (clc:forward size)
    (let ((level (1- level))
          (size (/ size 3)))
      (kochcurve level size)
      (clc:left 60)
      (kochcurve level size)
      (clc:right 120)
      (kochcurve level size)
      (clc:left 60)
      (kochcurve level size))))

(defun snow (level size)
  (kochcurve level size)
  (clc:right 120)
  (kochcurve level size)
  (clc:right 120)
  (kochcurve level size)
  (clc:right 120)
  (kochcurve level size))

(clc:show-canvas 300 300)
(clc:snow 4 140)

Direct pixel setting

(defun mandelbrot (x0 y0 x1 y1)
  (declare (special clc:*width* clc:*height*))
  (loop for y from 0 below clc:*height* do
        (loop for x from 0 below clc:*width* do
              (loop with a = (complex
                              (float (+ (* (/ (- x1 x0) clc:*width*) x) x0))
                              (float (+ (* (/ (- y1 y0) clc:*height*) y) y0)))
                    for z = a then (+ (* z z) a)
                    while (< (abs z) 2)
                    for c from 60 above 0
                    finally (clc:set-pixel x y (logior (mod (* 13 c) 256)
                                                   (ash (mod (* 7 c) 256) 8)
                                                   (ash (mod (* 2 c) 256) 16))))))
  (clc:repaint))

(clc:show-canvas 300 300)
(mandelbrot 0.2 0.5 0.4 0.7)

Text output

(clc:test-hershey-font)

A drawing program (left mouse button: draw; space: clear screen)

(let ((mouse-pressed nil)
      (last-x 0)
      (last-y 0))
  (defun on-l-button-down (x y)
    (setf mouse-pressed t
          last-x x
          last-y y))
  (defun on-l-button-up (x y)
    (declare (ignore x y))
    (setf mouse-pressed nil))
  (defun on-mouse-move (x y)
    (when mouse-pressed 
      (clc:draw-line last-x last-y x y)
      (clc:repaint)
      (setf last-x x
            last-y y))))

(defun drawing-program ()
  (clc:show-canvas 400 400
                   :caption "Drawing program"
                   :on-mouse-move #'on-mouse-move
                   :on-l-button-down #'on-l-button-down
                   :on-l-button-up #'on-l-button-up
                   :on-key-down #'(lambda (code)
                                    (when (= code clc:VK_SPACE)
                                      (clc:clear-framebuffer)
                                      (clc:repaint)))))

(drawing-program)