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

fixed PR 8770, made stick man a little bit shorter

Browse Source 
svn: r6793
This commit is contained in:
Robby Findler 2007-07-02 03:50:04 +00:00
parent c0999f05ee
commit 541752ca35
3 changed files with 32 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/drscheme/private/stick-figures.ss
View File

@ -12,6 +12,22 @@
(define line-size 2)
(define waiting-points
'((head 47 -4)
(neck 40 14)
(shoulders 38 29)
(left-elbow 6 65)
(right-elbow 63 66)
(left-hand 59 73)
(right-hand 58 18)
(waist 35 77)
(left-knee 16 116)
(right-knee 55 113)
(left-ankle 16 155)
(right-ankle 61 154)
(left-toe -3 152)
(right-toe 80 145))
#;
'((head 47 -4)
(neck 40 14)
(shoulders 38 29)
@ -205,7 +221,7 @@
(define orig-x 0)
(define orig-y 0)
(define/override (on-paint)
(draw-callback (get-dc) 1 #t points 0 0))
(draw-callback (get-dc) 1 #t points 0 0 line-size))
(define/override (on-event evt)
(cond
[(send evt button-down? 'left)
@ -256,10 +272,10 @@
(new canvas%
[parent cp]
[paint-callback (λ (c dc)
(draw-callback dc small-factor #f running-points 0 0)
(draw-callback dc small-factor #f waiting-points 30 0)
(draw-callback dc small-factor #f points 30 50)
(draw-callback dc small-factor #f points 0 50))]))
(draw-callback dc small-factor #f running-points 0 0 line-size)
(draw-callback dc small-factor #f waiting-points 30 0 line-size)
(draw-callback dc small-factor #f points 30 50 line-size)
(draw-callback dc small-factor #f points 0 50 line-size))]))
(define bp (new horizontal-panel% [parent f] [stretchable-height #f]))
(new button%
[parent bp]

10
collects/drscheme/private/unit.ss
View File

@ -282,6 +282,7 @@ module browser threading seems wrong.
(define make-execute-bitmap
(bitmap-label-maker (string-constant execute-button-label)
#;(get-running-bitmap)
(build-path (collection-path "icons") "run.png")))
(define make-save-bitmap
(bitmap-label-maker (string-constant save-button-label)
@ -1464,7 +1465,7 @@ module browser threading seems wrong.
(if (equal? f1 f2)
(loop (cdr p1) (cdr p2) (+ i 1))
i))])))]
[exp (reverse (explode-path (normalize-path fn)))]
[exp (reverse (explode-path (normalize-path/exists fn)))]
[other-exps
(filter
(λ (x) (and x
@ -1472,7 +1473,7 @@ module browser threading seems wrong.
(map (λ (other-tab)
(let ([fn (send (send other-tab get-defs) get-filename)])
(and fn
(reverse (explode-path (normalize-path fn))))))
(reverse (explode-path (normalize-path/exists fn))))))
tabs))]
[size
(let loop ([other-exps other-exps]
@ -1484,6 +1485,11 @@ module browser threading seems wrong.
(max new-size size)))]))])
(path->string (apply build-path (reverse (take-n size exp))))))
(define/private (normalize-path/exists fn)
(if (file-exists? fn)
(normalize-path fn)
fn))
(define/private (add-modified-flag text string)
(if (send text is-modified?)
(let ([prefix (get-save-diamond-prefix)])

4
collects/framework/private/editor.ss
View File

@ -426,7 +426,9 @@
(define/public (update-frame-filename)
(let* ([filename (get-filename)]
[name (if filename
(path->string (file-name-from-path (normalize-path filename)))
(path->string
(file-name-from-path
filename))
(get-filename/untitled-name))])
(for-each (λ (canvas)
(let ([tlw (send canvas get-top-level-window)])