parent
789756eb60
commit
0cfbbb9bdf
|
@ -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 |
|
@ -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)]
|
||||
|
|
|
@ -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)])
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user