Skip to content

Instantly share code, notes, and snippets.

@thomcc
Created Dec 12, 2011
Embed
What would you like to do?
donut
(define *theta-spacing* 0.07)
(define *phi-spacing* 0.02)
(define *screen-width* 300)
(define *screen-height* 240)
(define R1 1)
(define R2 2)
(define K2 5)
(define K1 (/ (* 3 K2 *screen-width*) (* 8 (+ R1 R2))))
(define (clip n min max) (if (< n min) min (if (> n max) max n)))
(define donutcvs
(class canvas%
(super-new)
(inherit get-dc refresh)
(define A 0.0)
(define B 0.0)
(define tick? #f)
(define/public (run)
(set! tick? #t)
(refresh))
(define (canvas-frame)
(define dc (get-dc))
(send dc set-brush "black" 'solid)
(send dc set-alpha 1)
(send dc draw-rectangle 0 0 *screen-width* *screen-height*)
(send dc set-pen "white" 1 'solid)
(define-values (ca sa cb sb)
(values (cos A) (sin A) (cos B) (sin B)))
(for ([j (in-range 0.0 6.28 0.3)])
(let ((ct (cos j)) (st (sin j)))
(for ([i (in-range 0.0 6.28 0.1)])
(let ([sp (sin i)] [cp (cos i)]
[ox (+ R2 (* R1 ct))] [oy (+ R1 st)])
(let ([x (- (* ox (+ (* cb cp) (* sa sb sp))) (* oy ca sb))]
[y (+ (* ox (- (* sb cp) (* sa cb sp))) (* oy ca cb))]
[ooz (/ 1 (+ K2 (* ca ox sp) (* sa oy)))])
(let ([xp (+ (/ *screen-width* 2) (* K1 ooz x))]
[yp (- (/ *screen-height* 2) (* K1 ooz y))])
(let ([l (clip (* 0.7 (+ (* cp ct sb) (- (* sa ct sp)) (- (* sa st))
(* cb (- (* ca st) (* ct sa sp)))))
0.0 1.0)])
(send dc set-alpha l)
(send dc draw-point xp yp)))))))))
(define/override (on-paint)
(when tick?
(set! tick? #f)
(canvas-frame)
(set! A (+ A *theta-spacing*))
(set! B (+ B *phi-spacing*))
(queue-callback (λ _ (send this run)) #f)))))
(define sema (make-semaphore 0))
(define frame (make-object (class frame% (define/augment (on-close)
(semaphore-post sema)
(inner (void) on-close))
(super-new)) "mmm... donut..."))
(define cvs (make-object donutcvs frame))
(send cvs min-width *screen-width*)
(send cvs min-height *screen-height*)
(send cvs run)
(send frame show #t)
(void (yield sema))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment