[plt-scheme] help for DFS illustration

From: Grant Rettke (grettke at acm.org)
Date: Sat May 2 08:20:58 EDT 2009

On Fri, May 1, 2009 at 1:08 PM, Mustafa Can Buken
<mustafacanb89 at gmail.com> wrote:
> Wanting a code is a bad habbit I know, so I want to take advice about
> how to do this illustration, which things that we should do. Thanks to
> everybody for helps.

#lang scheme/gui

;; string->color% : (string? arg) -> (is-a? result color%)
;; To find a color% by name.
;; Delegates work to the the-color-database, of type color-database<%>.
;; (string->color% "Tomato") -> color%
;; (string->color% "Violet") -> color%
;; (string->color% "Sienna") -> color%
;; (string->color% "Chocolate") -> color%
;; See the color-database<%> documentation for a list of color names.
(define (string->color% name)
  (send the-color-database find-color name))

;; bitmap%->image-snip% :
;; (is-a? arg bitmap%) -> (is-a? result image-snip%)
;; To create a snip configurd to display the contents of the bitmap%.
;; image-snip%s can be displayed in the definitions windows (REPL).
(define (bitmap%->image-snip% bitmap)
  (let ((snip (make-object image-snip%)))
    (begin
      (send snip set-bitmap bitmap)
      snip)))

(define (make-sample-bitmap% width height)
  (let ((bitmap (make-object bitmap% width height))
        (dc (new bitmap-dc%))
        (white (string->color% "White"))
        (black (string->color% "Black")))
    (begin
      ;; connect the bitmap to the dc
      (send dc set-bitmap bitmap)
      ;; enable anti-aliasing
      (send dc set-smoothing 'aligned)
      ;; configure the drawing pen and brush for the background
      (send dc set-pen
            (make-object pen% white 1 'solid))
      (send dc set-brush
            (make-object brush% white 'solid))
      ;; draw the solid background color
      (send dc draw-rectangle 0 0 width height)
      ;; configure the drawing pen and brush for the foreground
      (send dc set-pen black 1 'solid)
      (send dc set-brush
            (make-object brush% black 'solid))
      ;; draw a shape
      (let ((x (/ width 2))
            (y (/ height 2)))
        (send dc draw-ellipse x y x y))
      ;; disconnect the bitmap from the dc
      (send dc set-bitmap #f)
      bitmap)))

(define a-bitmap (make-sample-bitmap% 100 100))

(bitmap%->image-snip% a-bitmap)


Posted on the users mailing list.