PasteRack.org | ||
Paste # 58746 | ||
2020-05-22 12:13:06 | ||
Fork as a new paste. | ||
Paste viewed 473 times. | ||
Tweet | ||
Embed: | ||
#lang racket/gui ;;--------------------------------------------------------------------------------------------------- (define eyes-canvas% (class canvas% (init-field (eye-diameter 100)) (inherit refresh client->screen screen->client get-top-level-window) (define pupil-diameter (/ eye-diameter 3)) (define pupil-r (* 1/2 pupil-diameter)) (define r (/ eye-diameter 2)) (define eye-x r) (define eye-y r) (define/override (on-paint) (define dc (send this get-dc)) (define pen (send dc get-pen)) (define brush (send dc get-brush)) (define f (get-top-level-window)) ;; now draw the eye (send dc set-pen "black" 1 'solid) (send dc set-brush "white" 'solid) (send dc draw-ellipse 0 0 eye-diameter eye-diameter) (define-values (csx csy) (send this client->screen 0 0)) (define-values (fsx fsy) (send f client->screen 0 0)) (define osx (- csx fsx)) (define osy (- csy fsy)) ;(define values (a b) (screen->client x y)) (begin ; just for indentation ;; get canvas offsets ;(define-values (x-o y-o) (send dc get-origin)) (displayln (~a "osy" this )) ;; get mouse position (define-values (ms l) (get-current-mouse-state)) (define mouse-sx (round (send ms get-x))) ; screen coords (define mouse-sy (round (send ms get-y))) (define-values (mcx mcy) (send this screen->client mouse-sx mouse-sy)); client coords ;; (define-values (screen-eye-x screen-eye-y) (client->screen eye-x eye-y)) (define Δx (- screen-eye-x mouse-sx )) (define Δy (- screen-eye-y mouse-sy )) (define mag (magnitude (make-rectangular Δx Δy))) ;(displayln (~a "magnitude " mag)) (if (< mag (- r pupil-r)) (begin (send dc set-brush "black" 'solid) (send dc draw-ellipse (- mcx pupil-r) (- mcy pupil-r) pupil-diameter pupil-diameter) (send dc set-brush "red" 'solid) (send dc draw-ellipse mcx mcy 5 5)) (let ((direction (atan Δy Δx))) (define pupilΔx (- (round (* (cos direction) (* r 2/3))))) (define pupilΔy (- (round (* (sin direction) (* r 2/3))))) (define (tocentre n) (- (+ r n) pupil-r)) (define px (tocentre pupilΔx)) ; (- (+ r pupilΔx) pupil-r)) (define py (tocentre pupilΔy)) (send dc set-brush "black" 'solid) (send dc draw-ellipse px py pupil-diameter pupil-diameter)))) (send dc set-pen pen) (send dc set-brush brush)) (super-new [style (list 'transparent)]))) (module+ main (define frame (new frame% [label "Eyes"] [width 200] [height 246])) (define c (new eyes-canvas% [parent frame](eye-diameter 200))) (send frame show #t) (send c client->screen 0 0) (send frame client->screen 0 0) (define t (new timer% [notify-callback (λ () (send c refresh))] [interval 1000] [just-once? #f])))