Better debugger icon bomb

(cherry picked from commit 5736695bae)
This commit is contained in:
Neil Toronto 2012-01-10 15:21:49 -07:00 committed by Ryan Culpepper
parent 789756eb60
commit 0cfbbb9bdf
5 changed files with 46 additions and 13 deletions

View File

@ -386,12 +386,11 @@ module browser threading seems wrong.
frame
program-filename)))])))
(define disk-color (make-object color% 255 233 112))
(define execute-bitmap (icons:play-icon icons:run-icon-color (icons:toolbar-icon-height)))
(define break-bitmap (icons:stop-icon icons:halt-icon-color (icons:toolbar-icon-height)))
(define small-save-bitmap (icons:small-save-icon icons:syntax-icon-color disk-color
(define small-save-bitmap (icons:small-save-icon icons:syntax-icon-color "gold"
(icons:toolbar-icon-height)))
(define save-bitmap (icons:save-icon icons:syntax-icon-color disk-color
(define save-bitmap (icons:save-icon icons:syntax-icon-color "gold"
(icons:toolbar-icon-height)))
(define-values (get-program-editor-mixin add-to-program-editor-mixin)

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.3 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

View File

@ -115,7 +115,7 @@
[height color material]
(define scale (/ height 32))
(let* ([indent-fm (fm* 0.5 (x-flomap "black" (* 22 scale)))]
[indent-dfm (deep-flomap-raise (flomap->deep-flomap indent-fm) (* -2 scale))]
[indent-dfm (deep-flomap-raise (flomap->deep-flomap indent-fm) (* -1 scale))]
[fm (regular-polygon-flomap 8 (/ (* 2 pi) 16) color height)]
[dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-cc-superimpose 'add dfm indent-dfm)]
@ -218,16 +218,20 @@
(define scale (/ height 32))
(define fuse-fm
(let* ([fm (draw-icon-flomap
16 16 (λ (dc)
(send dc set-pen "black" 1/2 'solid)
10 25 (λ (dc)
(send dc set-pen "darkred" 1 'solid)
(send dc set-brush "gold" 'solid)
(draw-path-commands
dc 0 0
'((m 0.5 5.5)
(c -1.5 -2 -0.5 -5 2 -5.5
3 0.5 5 2.5 6 5
0.5 2.5 -1.5 4.5 -4 4
-1 -2 -1.5 -3.5 -4 -3.5))))
'((m 3.5 0)
(c -5 0 -3.29080284 10.4205 -3 11.5
1.1137011 4.1343 2 6.5 0 8.5
-0.5711131 2.0524 1.5 4 3.5 3.5
2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5
-2 -7 -2 -9 -1.5 -9
0 1 -0.5 2 1 3.5
2 0.5 4 -1.5 3.5 -3.5
-2 -2 -2 -5 -5.5 -5))))
scale)]
[dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-icon-style dfm)]

View File

@ -10,7 +10,7 @@
(provide (all-defined-out))
(define debugger-bomb-color (make-object color% 128 64 64))
(define debugger-bomb-color (make-object color% 128 32 32))
(define macro-stepper-hash-color (make-object color% 30 96 30))
(define (check-syntax-flomap [height (toolbar-icon-height)] [material (default-icon-material)])

View File

@ -10,7 +10,6 @@
(define (get-num-callbacks) num-callbacks)
(define (register-gc-callback proc)
(printf "registering~n")
(register-finalizer (malloc 4) (λ (val)
(set! num-callbacks (+ 1 num-callbacks))
(printf "here~n")
@ -143,6 +142,37 @@
(scale-path-commands cmds sx sy))]
[(list) (list)]))
(define (relativize-path-commands cmds)
(let loop ([x 0] [y 0] [cmds cmds])
(cond
[(empty? cmds) empty]
[else
(define cmd (first cmds))
(match cmd
;; absolute commands
[`(M) (loop x y (rest cmds))]
[`(L) (loop x y (rest cmds))]
[`(C) (loop x y (rest cmds))]
[`(M ,ax ,ay ,as ...) (cons `(m ,(- ax x) ,(- ay y))
(loop ax ay (cons `(M ,@as) (rest cmds))))]
[`(L ,ax ,ay ,as ...) (cons `(l ,(- ax x) ,(- ay y))
(loop ax ay (cons '(L ,@as) (rest cmds))))]
[`(C ,ax1 ,ay1 ,ax2 ,ay2 ,ax ,ay ,as ...)
(cons `(c ,(- ax1 x) ,(- ay1 y) ,(- ax2 x) ,(- ay2 y) ,(- ax x) ,(- ay y))
(loop ax ay (cons `(C ,@as) (rest cmds))))]
;; relative commands
[`(m) (loop x y (rest cmds))]
[`(l) (loop x y (rest cmds))]
[`(c) (loop x y (rest cmds))]
[`(m ,dx ,dy ,ds ...) (cons `(m ,dx ,dy) (loop (+ x dx) (+ y dy)
(cons `(m ,@ds) (rest cmds))))]
[`(l ,dx ,dy ,ds ...) (cons `(l ,dx ,dy) (loop (+ x dx) (+ y dy)
(cons `(l ,@ds) (rest cmds))))]
[`(c ,dx1 ,dy1 ,dx2 ,dy2 ,dx ,dy ,ds ...)
(cons `(c ,dx1 ,dy1 ,dx2 ,dy2 ,dx ,dy)
(loop (+ x dx) (+ y dy) (cons `(c ,@ds) (rest cmds))))]
[_ (error 'apply-path-commands "unknown path command ~e" cmd)])])))
(define (get-text-size str font)
(define bm (make-bitmap 1 1))
(define dc (make-object bitmap-dc% bm))