[plt-scheme] examples of code using graph.ss?

Hi,

Here is a simple example;

let me know how you go

Cheers,

Stephen



;;
(module graph-demo mzscheme
  (require
   (lib "mred.ss" "mred")
   (lib "graph.ss" "mrlib")
   (lib "class.ss")
   )

  (define the-frame
    (new frame% ;
         (label "graph-demo")
         (width 600)
         (height 600)))

  ;; add the matching descriptions list box
  (define the-editor-canvas (instantiate editor-canvas% (the-frame)))
  (define draw-lines-pasteboard% (class (graph-pasteboard-mixin pasteboard%)
;
                                   (super-new)
                                   (define/public (add-issue issue)
                                     (let* ((issue-snip (make-object
my-graph-snip% issue))
                                            )
                                       (send this insert issue-snip)
                                       issue-snip))))

  (define the-graph-pasteboard (instantiate draw-lines-pasteboard% ()))
  (send the-editor-canvas set-editor the-graph-pasteboard)

  (define my-graph-snip% (graph-snip-mixin string-snip%)) ;; use
string-snip%
  ; I'm playing with a decorated editor snip at the moment so I can edit the
text
  ; of a snip in-place, and have a cute little icon, all in a nice box.

  ;; does what it says on the can.
  (define (connect parent child)
    (define dark-pen (send the-pen-list find-or-create-pen "blue" 1 'solid))
    (define dark-brush (send the-brush-list find-or-create-brush "blue"
'solid))
    (define light-pen (send the-pen-list find-or-create-pen "light blue" 1
'solid))
    (define light-brush (send the-brush-list find-or-create-brush "light
blue" 'solid))
    (add-links parent child
               dark-pen light-pen
               dark-brush light-brush  "-->to-->" ))

  (define aaa (send the-graph-pasteboard add-issue "aaa"))
  (define bbb (send the-graph-pasteboard add-issue "bbb"))
  (define ccc (send the-graph-pasteboard add-issue "ccc"))
  (define ddd (send the-graph-pasteboard add-issue "ddd"))

  (connect aaa bbb)
  (connect ccc bbb)
  (connect ddd bbb)
  (connect aaa ddd)

  (send the-frame show #t)

  (define-values (width height) (send the-editor-canvas get-client-size))

  (printf "width:~a height:~a" width height)
  (define (random-position extent)
    (+ 30 (random (- extent 60)))
    )
  (send the-graph-pasteboard move-to aaa (random-position width)
(random-position height) )
  (send the-graph-pasteboard move-to bbb (random-position width)
(random-position height))
  (send the-graph-pasteboard move-to ccc (random-position width)
(random-position height))
  (send the-graph-pasteboard move-to ddd (random-position width)
(random-position height))


  )




-- 
Cheers,

Stephen



--
Stephen De Gabrielle
s.degabrielle at ucl.ac.uk
Telephone +44 (0)20 7679 5242 (x45242)
Mobile                  079 851 890 45
http://www.uclic.ucl.ac.uk/annb/MaSI.html
University College London Interaction Centre
Remax House - 31/32 Alfred Place
London - WC1E 7DP
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070923/18f605bc/attachment.html>