#lang slideshow
(require scheme/class
scheme/gui/base)
(provide castle
window-path)
(define-values (castle window-path)
(let ([p (new dc-path%)]
[p2 (new dc-path%)]
[p3 (new dc-path%)]
[window (new dc-path%)]
[flag (new dc-path%)])
(send p move-to 0 20)
(send p line-to 0 -40)
(send p line-to -5 -40)
(send p line-to 15 -60)
(send p line-to 35 -40)
(send p line-to 30 -40)
(send p line-to 30 -35)
(send p line-to 40 -35)
(send p line-to 40 -75)
(send p line-to 35 -75)
(send p line-to 75 -115)
(send p line-to 115 -75)
(send p line-to 110 -75)
(send p line-to 110 -35)
(send p line-to 120 -35)
(send p line-to 120 -40)
(send p line-to 115 -40)
(send p line-to 135 -60)
(send p line-to 155 -40)
(send p line-to 150 -40)
(send p line-to 150 20)
(send p line-to 100 20)
(send p curve-to 100 -30 80 -30 75 -30)
(send p curve-to 70 -30 50 -30 50 20)
(send p close)
(send window move-to 100 20)
(send window curve-to 100 -30 80 -30 75 -30)
(send window curve-to 70 -30 50 -30 50 20)
(send window close)
(send window translate 45 154)
(send p2 move-to -20 40)
(send p2 line-to -20 -60)
(send p2 line-to -25 -60)
(send p2 line-to -25 -75)
(send p2 line-to -20 -75)
(send p2 line-to -20 -70)
(send p2 line-to -15 -70)
(send p2 line-to -15 -75)
(send p2 line-to -10 -75)
(send p2 line-to -10 -70)
(send p2 line-to -5 -70)
(send p2 line-to -5 -75)
(send p2 line-to 0 -75)
(send p2 line-to 0 -70)
(send p2 line-to 5 -70)
(send p2 line-to 5 -75)
(send p2 line-to 10 -75)
(send p2 line-to 10 -70)
(send p2 line-to 15 -70)
(send p2 line-to 15 -75)
(send p2 line-to 20 -75)
(send p2 line-to 20 -60)
(send p2 line-to 15 -60)
(send p2 line-to 15 40)
(send p2 close)
(send p2 scale 1.5 1.5)
(send p3 move-to 5 -20)
(send p3 line-to 5 -100)
(send p3 line-to 0 -100)
(send p3 line-to 75 -175)
(send p3 line-to 150 -100)
(send p3 line-to 145 -100)
(send p3 line-to 145 -20)
(send p3 close)
(send p3 scale 1.0 1.75)
(send flag move-to 0 0)
(send flag curve-to 10 0 0 10 10 10)
(send flag curve-to 20 10 10 20 20 20)
(send flag curve-to 19 20 20 30 10 30)
(send flag curve-to 1 30 10 20 1 20)
(send flag line-to 1 40)
(send flag line-to 0 40)
(send flag close)
(send flag scale 3.0 1.0)
(values
(dc (lambda (dc x y)
(let ([op (send dc get-pen)]
[ob (send dc get-brush)]
[x (+ x 45)]
[y (+ y 344)])
(send dc set-pen "black" 2 'solid)
(send dc set-brush "pink" 'solid)
(send dc draw-path flag (+ x 74) (- y 340))
(send dc set-brush "darkorchid" 'solid)
(send dc draw-path p3 x y)
(send dc set-brush "blue" 'solid)
(send dc draw-path p2 (+ x -5) (- y 40))
(send dc draw-path p2 (+ x 160) (- y 40))
(send dc set-brush "purple" 'solid)
(send dc draw-path p x y)
(send dc set-brush "white" 'solid)
(send dc draw-path window (- x 45) (- y 344))
(send dc set-pen op)
(send dc set-brush ob)))
236 366)
window)))