circle tweaker

circle-tweaker.lisp

;; For https://old.reddit.com/r/lisp/comments/v7xdky/simple_mechanism_for_clos_slot_dependencies/

(defpackage #:circle-tweaker
  (:use #:clim-lisp #:clim #:cells)
  (:export #:run))

(in-package #:circle-tweaker)

(defmodel circle-shape ()
  ((diameter
    :initarg :diameter
    :accessor diameter)
   (num-points
    :initarg :num-points
    :accessor num-points)
   (points
    :initform (c? (loop with n = (^num-points)
                        with radius = (/ (^diameter) 2.0)
                        with angle-delta = (/ (* 2 pi) n)
                        for i below n
                        for angle = (* i angle-delta)
                        collect (make-point (* (sin angle) radius)
                                            (* (cos angle) radius))))
    :accessor points))
  (:default-initargs :num-points (c-in 64) :diameter (c-in 2.0)))

(define-application-frame circle-tweaker ()
  ((circle :initform (make-instance 'circle-shape)
           :accessor circle))
  (:panes
   (main :application
         :display-function 'display-main)
   (int :interactor))
  (:layouts
   (default
    (vertically ()
      (7/8 main)
      (+fill+ int)))))

(defun display-main (frame pane)
  (let ((circle (circle frame)))
    (with-output-as-gadget (pane)
      (vertically ()
        ;; For some reason mcclim sliders don't show their labels...
        (labelling (:label "Diameter")
          (make-pane :slider
                     :orientation :horizontal
                     :min-value 1.0
                     :max-value 5.0
                     ;; One could also have a drag callback, I guess.
                     :value-changed-callback
                     (lambda (slider new-value)
                       (declare (ignore slider))
                       (setf (diameter circle) new-value))
                     :value (diameter circle)
                     :show-value-p t
                     :number-of-quanta 11
                     :decimal-places 2))
        (labelling (:label "Num Points")
          (make-pane :slider
                     :orientation :horizontal
                     :min-value 3
                     :max-value 64
                     :value-changed-callback
                     (lambda (slider new-value)
                       (declare (ignore slider))
                       (setf (num-points circle) new-value))
                     :value (num-points circle)
                     :show-value-p t))))
    (with-translation (pane 500 500)
      (with-scaling (pane 100 100)
        (draw-polygon pane (points circle) :filled nil :ink +blue+)))))

;; Whenever the points change, redisplay the frame's panes.
(defobserver points ()
  (redisplay-frame-panes *application-frame*))    

(defun run ()
  (run-frame-top-level
   (make-application-frame 'circle-tweaker)))