suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

svn: r13986

Browse Source
This commit is contained in:
Robby Findler 2009-03-06 19:37:04 +00:00
parent 060bb38ebb
commit cab47712fb
3 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/drscheme/private/drscheme-normal.ss
View File

@ -233,9 +233,10 @@
(cond
[(or prince-kuhio-day? kamehameha-day?)
(set-splash-progress-bar? #f)
(vector (dynamic-require 'drscheme/private/honu-logo 'draw-honu)
280
280)]
(let ([size ((dynamic-require 'drscheme/private/palaka 'palaka-pattern-size) 4)])
(vector (dynamic-require 'drscheme/private/honu-logo 'draw-honu)
size
size))]
[texas-independence-day?
(build-path (collection-path "icons") "texas-plt-bw.gif")]
[(and halloween? high-color?)

2
collects/drscheme/private/honu-logo.ss
View File

@ -417,7 +417,6 @@
(define black-honu-bitmap 'not-yet-the-bitmap)
(define black-honu-bdc (make-object bitmap-dc%))
(send black-honu-bdc set-smoothing 'aligned)
(define (do-draw dc left-body-color right-body-color)
(send dc draw-bitmap black-honu-bitmap 0 0)
@ -437,6 +436,7 @@
(define (recalc-bitmap)
(send black-honu-bdc set-bitmap black-honu-bitmap)
(send black-honu-bdc set-smoothing 'aligned)
(draw-palaka black-honu-bdc (send black-honu-bitmap get-width) (send black-honu-bitmap get-height))
(draw black-honu-bdc
"black" "black" "black" "black" "black" "black"

15
collects/drscheme/private/palaka.ss
View File

@ -1,16 +1,19 @@
#lang scheme/base
(require scheme/class scheme/gui/base)
(provide draw-palaka palaka-pattern-size)
(define scale 1)
(define palaka-color (send the-color-database find-color "lightsteelblue"))
(define stripe-width (* scale 6))
(define stripe-gap (* scale 2))
(define blank-space-between-stripe-sets (* stripe-width 5))
(define ε 0)
(define vert-stripe-percent (- 1/2 ε))
(define horiz-stripe-percent (+ 1/4 ε))
(define quadrant-size (* 2 (+ (* stripe-width 4)
(* stripe-gap 3))))
(define quadrant-size (+ (* stripe-width 4)
(* stripe-gap 3)
blank-space-between-stripe-sets))
(define-syntax-rule
(four-times i e1 e ...)
(let loop ([i 0])
@ -50,18 +53,18 @@
quadrant-size
stripe-width)))
(define (palaka-pattern-size i) (+ (* quadrant-size i) blank-space-between-stripe-sets))
#;
(begin
(define f (new frame% [label "Palaka"]))
(define c (new canvas%
[parent f]
[min-width 200]
[min-height 200]
[min-width (palaka-pattern-size 4)]
[min-height (palaka-pattern-size 4)]
[paint-callback
(λ (c dc)
(let-values ([(cw ch) (send c get-client-size)])
(send dc set-smoothing 'aligned)
(draw-palaka dc cw ch)))]))
(send f show #t))
(provide draw-palaka)