Let's write β

プログラミング中にできたことか、思ったこととか

スピログラフ

スピログラフという正式名称があるのを知ったのは高校の時だが
綺麗な文様が書ける定規という存在はごくごく子供の頃に知っていた。
あの綺麗な文様を自分のプログラムで出力できたらさぞたのしかろう

(ql:quickload :lispbuilder-sdl)
(ql:quickload :lispbuilder-sdl-gfx)

(defun inner-cycloid (rc rm theta)
  (let ((x (+ (* (- rc rm) (cos theta))
              (* rm (cos (* (/ (- rc rm) rm) theta)))))
        (y (- (* (- rc rm) (sin theta))
              (* rm (sin (* (/ (- rc rm) rm) theta))))))
    (values x y)))
 
(defun inner-cycloid-viewer (rc rm)
  (let ((win-size (* rc 2.5))
        (points '())
        (rad 0))
  (sdl:with-init ()
    (sdl:window (round (* rc 2.5)) 
                (round (* rc 2.5)) :title-caption "inner-cycloid")
    (sdl:with-events ()
      (:quit-event () t)
      (:idle ()
       (sdl:clear-display sdl:*black*)
       (multiple-value-bind (x y) (inner-cycloid rc rm rad)
         (pushnew (cons x y) points)
         (loop for point in points
               for px = (car point)
               for py = (cdr point)
               do
               (sdl:draw-pixel-* (round (+ px (/ win-size 2)))
                                 (round (+ py (/ win-size 2)))
                                 :color sdl:*cyan*))
         (sdl:draw-circle-* 
           (round (+ x (/ win-size 2)))
           (round (+ y (/ win-size 2))) 5 :color sdl:*cyan*)
         (incf rad 0.1)
         (sdl:update-display)))))))

(defun hypotrochoid (rc rm rd theta)
  (let ((x (+ (* (- rc rm) (cos theta))
              (* rd (cos (* (/ (- rc rm) rm) theta)))))
        (y (- (* (- rc rm) (sin theta))
              (* rd (sin (* (/ (- rc rm) rm) theta))))))
    (values x y)))

(defun hypotrochoid-viewer (rc rm rd)
  (let ((win-size (* (max rc rm rd) 2.5))
        (points '())
        (rad 0))
  (sdl:with-init ()
    (sdl:window win-size win-size :title-caption "inner-cycloid")
    (sdl:with-events ()
      (:quit-event () t)
      (:idle ()
       (sdl:clear-display sdl:*black*)
       (multiple-value-bind (x y) (hypotrochoid rc rm rd rad)
         (pushnew (cons x y) points)
         (loop for point in points
               for px = (car point)
               for py = (cdr point)
               do
               (sdl:draw-pixel-* (round (+ px (/ win-size 2)))
                                 (round (+ py (/ win-size 2)))
                                 :color sdl:*cyan*))
         (sdl:draw-circle-* 
           (round (+ x (/ win-size 2)))
           (round (+ y (/ win-size 2))) 5 :color sdl:*cyan*)
         (incf rad 0.1)
         (sdl:update-display)))))))

f:id:Pocket7878_dev:20130209182444p:plain
f:id:Pocket7878_dev:20130209182333p:plain