diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/easter-egg.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/easter-egg.rkt index a947656b76..ec647e4006 100644 --- a/pkgs/drracket-pkgs/drracket-test/tests/drracket/easter-egg.rkt +++ b/pkgs/drracket-pkgs/drracket-test/tests/drracket/easter-egg.rkt @@ -12,6 +12,7 @@ (start-up-on-day 10 29 "Matthias's birthday") (start-up-on-day 10 31 "Halloween") (start-up-on-day 11 1 "Matthew's birthday") + (start-up-on-day 12 10 "Ada Lovelace's birthday") (start-up-on-day 12 25 "Christmas") (define now (current-seconds)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/ada.png b/pkgs/drracket-pkgs/drracket/drracket/private/ada.png new file mode 100644 index 0000000000..d6c27628f8 Binary files /dev/null and b/pkgs/drracket-pkgs/drracket/drracket/private/ada.png differ diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/ada.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/ada.rkt new file mode 100644 index 0000000000..f3f3c3aad3 --- /dev/null +++ b/pkgs/drracket-pkgs/drracket/drracket/private/ada.rkt @@ -0,0 +1,166 @@ +#lang racket/base +(require pict + racket/gui/base + racket/class + racket/list + racket/runtime-path + (for-syntax racket/base)) +(provide ada-size draw-splash-ada) + +(module+ test (require rackunit)) + +(define-runtime-path ada.png (if (getenv "PLTDRBREAKIMAGES") + "ada-broken.png" + "ada.png")) + +#| +code for Bernoulli numbers taken from Wikipedia: + http://en.wikipedia.org/wiki/Bernoulli_number#Algorithmic_description +|# + +(define-syntax-rule + (for-from-by-to-do var start step end body ...) + (for ([var (in-range start (+ end step) step)]) + body ...)) + +(define-syntax-rule + (in-range/including-end start end step) + (in-range start (+ end step) step)) + +(define (bernoulli-number n) + (define A (make-vector (+ n 1))) + (for ([m (in-range/including-end 0 n 1)]) + (vector-set! A m (/ 1 (+ m 1))) + (for ([j (in-range/including-end m 1 -1)]) + (vector-set! A + (- j 1) + (* j (- (vector-ref A (- j 1)) + (vector-ref A j)))))) + (vector-ref A 0)) + +(module+ test + (check-equal? + (build-list 9 bernoulli-number) + '(1 1/2 1/6 0 -1/30 0 1/42 0 -1/30))) + +#| + +Code for making a pict out of the +bernoulli sequence + +|# + +(define (make-bernoulli-sequence-pict n) + (apply hc-append + (add-between + (for/list ([x (in-range n)]) + (number->pict (bernoulli-number x))) + (tt ", ")))) + +(define (tt str) + (text str 'roman 24)) + +(define (number->pict num) + (cond + [(integer? num) (tt (integer->string num))] + [else + (define n (tt (integer->string (abs (numerator num))))) + (define d (tt (integer->string (denominator num)))) + (define line (frame (blank (max (pict-width d) (pict-width n)) 0))) + (define abs-frac (vc-append 2 n line d)) + (cond + [(negative? num) + (hc-append (tt "-") abs-frac)] + [else + abs-frac])])) + +(define (integer->string n) + (define s (format "~a" n)) + (cond + [(<= (string-length s) 3) s] + [else + (reverse-string + (regexp-replace* #rx"[0-9][0-9][0-9]" + (reverse-string s) + "\\0,"))])) +(define (reverse-string s) (list->string (reverse (string->list s)))) +(module+ test + (check-equal? (integer->string 0) "0") + (check-equal? (integer->string 1) "1") + (check-equal? (integer->string 100) "100") + (check-equal? (integer->string 1000) "1,000") + (check-equal? (integer->string 1234) "1,234") + (check-equal? (integer->string 1000000) "1,000,000")) + +#| + +Code for sliding a wide pict by + +|# + +;; 0 <= n <= 1 +(define (sliding-sequence n width pict) + (define bw (pict-width pict)) + (define starting-x (* (- bw width) n)) + (inset/clip pict + (- starting-x) + 0 + (+ (- bw) starting-x width) + 0)) + +#| + +Put things together into a function +that actually does drawing in a window. + +|# + +(define ada-bmp (and (file-exists? ada.png) + (read-bitmap ada.png))) +(define ada-w (if ada-bmp (send ada-bmp get-width) 300)) +(define ada-h (if ada-bmp (send ada-bmp get-height) 300)) +(define ada-size (+ 32 (max ada-w ada-h))) + +(define (draw-ada dc point-in-time cw ch [sequence-on-top? #f]) + (define p (sliding-sequence + point-in-time + cw + bernoulli-sequence-pict)) + (draw-pict p dc 0 0) + (when ada-bmp + (send dc draw-bitmap + ada-bmp + (- (/ cw 2) (/ ada-w 2)) + (- (/ ch 2) (/ ada-h 2))))) + +(define bernoulli-sequence-pict (make-bernoulli-sequence-pict 50)) +(define (draw-splash-ada dc current max width height) + (send dc erase) + (draw-ada dc (/ current max) width height) #t) + +(module+ main + + (define bmp (read-bitmap ada.png)) + (define point-in-time 0) + (define δ #e0.0002) + + (define (draw c dc) + (define-values (cw ch) (send c get-client-size)) + (draw-ada dc point-in-time cw ch)) + + (void (new timer% + [notify-callback + (λ () + (set! point-in-time (+ point-in-time δ)) + (send c refresh))] + [interval 50])) + + + + (define f (new frame% [label ""])) + (define c (new canvas% + [parent f] + [paint-callback draw] + [min-width ada-size] + [min-height ada-size])) + (send f show #t)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt index e3d2d031b5..927d243b10 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt @@ -59,14 +59,17 @@ [(weekend-date? date) 'weekend] [else 'normal])) -(define-values (texas-independence-day? prince-kuhio-day? kamehameha-day? halloween?) +(define-values (texas-independence-day? + prince-kuhio-day? kamehameha-day? halloween? + ada-lovelace-bday?) (let* ([month (date-month startup-date)] [day (date-day startup-date)] [dow (date-week-day startup-date)]) (values (and (= 3 month) (= 2 day)) (and (= 3 month) (= 26 day)) (and (= 6 month) (= 11 day)) - (and (= 10 month) (= 31 day))))) + (and (= 10 month) (= 31 day)) + (and (= 12 month) (= 10 day))))) (define special-state #f) @@ -147,6 +150,12 @@ (vector (dynamic-require 'drracket/private/honu-logo 'draw-honu) size size))] + [ada-lovelace-bday? + (set-splash-progress-bar?! #f) + (let ([size (dynamic-require 'drracket/private/ada 'ada-size)]) + (vector (dynamic-require 'drracket/private/ada 'draw-splash-ada) + size + size))] [texas-independence-day? (collection-file-path texas-plt-bw.gif "icons")] [halloween?