Created
August 29, 2015 00:25
-
-
Save apg/c539f8d9790ded349986 to your computer and use it in GitHub Desktop.
banana scanimation, assuming you have the banana files.
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
#lang racket/base | |
(require racket/draw | |
racket/gui) | |
(define files (for/list [(i (in-range 7))] | |
(format "/tmp/banana/banana~a.png" i))) | |
(define bitmaps (map (lambda (x) (read-bitmap x)) files)) | |
(define dcs (map (lambda (x) (new bitmap-dc% [bitmap x])) bitmaps)) | |
(define-values [width height] (send (car dcs) get-size)) | |
(define bitmap (make-bitmap 365 360)) | |
(define dc (new bitmap-dc% [bitmap bitmap])) | |
(define maskbitmap (make-bitmap (* 3 365) 360)) | |
(define mdc (new bitmap-dc% [bitmap maskbitmap])) | |
(define vdcs (apply vector dcs)) | |
(define buffer (make-bytes (* 360 4))) | |
(for ([i (in-range 365)]) | |
(let* ([tmp-dc (vector-ref vdcs (remainder i (vector-length vdcs)))]) | |
(send tmp-dc get-argb-pixels i 0 1 360 buffer) | |
(send dc set-argb-pixels i 0 1 360 buffer))) | |
(for ([i (in-range (* 3 365))]) | |
(when (= 0 (remainder i (vector-length vdcs))) | |
(send mdc set-brush "black" 'solid) | |
(send mdc set-pen "black" 0 'solid) | |
(send mdc draw-rectangle i 0 (sub1 (vector-length vdcs)) 360))) | |
(define frame (new frame% | |
[label "Example"] | |
[width (inexact->exact width)] | |
[height (inexact->exact height)])) | |
(define mouse-x 0) | |
(define scana-canvas% | |
(class canvas% | |
(define/override (on-event event) | |
(display mouse-x) (newline) | |
(set! mouse-x (send event get-x))) | |
(super-new))) | |
(define scana | |
(new scana-canvas% [parent frame] | |
[paint-callback | |
(lambda (canvas d) | |
(send d draw-bitmap bitmap 0 0) | |
(send d draw-bitmap maskbitmap mouse-x 0))])) | |
(send frame show #t) | |
(define timer | |
(new timer% | |
(interval 10) ;; update every 100 ms | |
(notify-callback | |
(lambda () | |
(send scana refresh))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment