Skip to content

Instantly share code, notes, and snippets.

@maufdez
Created July 14, 2019 22:39
Show Gist options
  • Save maufdez/5a420948a1fdcfb7b6cf33bdead61ccc to your computer and use it in GitHub Desktop.
Save maufdez/5a420948a1fdcfb7b6cf33bdead61ccc to your computer and use it in GitHub Desktop.
Epicycles demo using ParenScript
(defvar *canvas-name* "myCanvas")
(defvar *canvas-style* "border:1px solid #000000;")
(defvar *canvas-width* 400)
(defvar *canvas-height* 400)
(defun create-canvas ()
((@ document write)
(ps-html ((:canvas :id *canvas-name*
:width *canvas-width*
:height *canvas-height*
:style *canvas-style*))))
(chain document (get-element-by-id *canvas-name*)))
(defvar *canvas* (create-canvas))
(defvar *ctx* (chain *canvas* (get-context "2d")))
(defmacro on-canvas (&body body)
(flet ((convert (sexp)
(if (eq 'setprop (car sexp))
`(setf (@ *ctx* ,(cadr sexp)) ,(caddr sexp))
`(chain *ctx* ,sexp))))
`(progn ,@(mapcar #'convert body))))
(defvar *t* 0)
(defun update ()
(incf *t* (/ (* 2 pi) 180))
(when (>= *t* (* 2 pi)) (setf *t* (- *t* (* 2 pi))))
t)
(defvar *precoord* '())
(defvar *maxpoints* 180)
(defun add-shift-left (array object)
(let ((len (length array)))
(dotimes (i (1- len))
(setf (elt array i) (elt array (1+ i))))
(setf (elt array (1- len)) object)
t))
(defun draw ()
(let* ((r1 185)
(r2 15)
(w1 1)
(w2 -4)
(x1 (+ 200 (* r1 (cos (* w1 *t*)))))
(y1 (- 200 (* r1 (sin (* w1 *t*)))))
(x2 (+ x1 (* r2 (cos (* w2 *t*)))))
(y2 (- y1 (* r2 (sin (* w2 *t*))))))
(if (< (length *precoord*) *maxpoints*)
(setf *precoord* (append *precoord* (create x x2 :y y2)))
(add-shift-left *precoord* (create x x2 :y y2)))
(on-canvas
(clear-rect 0 0 400 400)
(fill-text *t* 10 10)
(setprop line-width 1)
(setprop stroke-style "black")
(begin-path)
(move-to 200 200)
(line-to x1 y1)
(move-to x1 y1)
(line-to x2 y2)
(stroke)
(setprop stroke-style "red")
(begin-path)
(arc 200 200 r1 0 (* 2 pi))
(stroke)
(setprop stroke-style "green")
(begin-path)
(arc x1 y1 r2 0 (* 2 pi))
(stroke)
(setprop fill-style "red")
(begin-path)
(arc x1 y1 5 0 (* 2 pi))
(fill)
(setprop fill-style "green")
(begin-path)
(arc x2 y2 5 0 (* 2 pi))
(fill))
(when (> (length *precoord*) 1)
(let ((startcoord (elt *precoord* 0)))
(on-canvas
(setprop line-width 2)
(begin-path)
(move-to (@ startcoord x) (@ startcoord y)))
(dolist (coord *precoord*)
(on-canvas
(line-to (@ coord x) (@ coord y))))
(on-canvas (stroke))))
t))
;;; Set a loop
(defvar *fps* 30)
(set-interval
(lambda ()
(update)
(draw)
t)
(/ 1000 *fps*))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment