Created
July 14, 2019 22:39
-
-
Save maufdez/5a420948a1fdcfb7b6cf33bdead61ccc to your computer and use it in GitHub Desktop.
Epicycles demo using ParenScript
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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