[racket] Problem scrolling contents of text% in editor-snip%

Thanks for the info Matthew.

My misunderstanding of how the editor-snip% and text% classes work led me
to believe that it should be possible to scroll a message string displayed
within an editor-snip% and text% combination.

Eventually I gave up trying to make those work the way I wanted. After
reviewing the documentation, I changed my approach to the problem I had, to
wit, display and move (scroll) some text message within some area on a
pasteboard%. I post here the code from my working solution, along with a
little demonstration of its use, in case it might be useful for others.

If anyone knows of other solutions, or has suggestions to improve or
otherwise make my solution more idiomatic, please do let me know.

Cheers,

Kieron.

 ****

(module moving-text-snip racket/gui

  ; Define a sub-class of editor-snip% that has a pasteboard%,
  ;   which displays a string-snip% encapsulating the required text.
  ; start-moving-text creates a thread that moves the string-snip% across
the pasteboard%,
  ;   moving (scrolling) the text message through the area displayed by the
class.
  ; stop-moving-text kills the thread.
  ;
  ; To do:
  ; Deal with resizing the display area.
  ; Add ability to change message or sleep time or amount to move per tick.
  ; Add ability to scroll left to right.
  ; Add ability to scroll up and down.

  (provide moving-text-snip%)
  (define moving-text-snip%
    (class editor-snip%
      (init [message-text #f])

      (init-field [sleep-time 0.03] [pixels-per-tick 1])

      (define display-pasteboard (new pasteboard%))

      (super-new [editor display-pasteboard])

      (define message-string-snip (make-object string-snip% message-text))
      (send display-pasteboard insert message-string-snip)

      (inherit get-min-width get-max-width get-min-height get-max-height
get-inset)

      (define text-mover-thread #f)

      (define/public (start-text-moving)
        (printf "start-text-moving: thread:~a~n" text-mover-thread)
        (when (equal? text-mover-thread #f)
          ; get the size of the area displaying the moving text
          (printf "  container: dimensions: min:(~a ~a) max:(~a ~a)~n"
            (get-min-width) (get-min-height)
            (get-max-width) (get-max-height))

          (define scroll-start-pos (get-max-width))

          ; get the size of the string-snip%
          (define x1 (box 0))
          (define y1 (box 0))
          (define x2 (box 0))
          (define y2 (box 0))
          (send display-pasteboard get-snip-location message-string-snip x1
y1 #f)
          (send display-pasteboard get-snip-location message-string-snip x2
y2 #t)
          (define message-snip-width (- (unbox x2) (unbox x1)))
          (define message-snip-height (- (unbox y2) (unbox y1)))
          (printf "  snip: dimensions:(~a ~a)->(~a ~a) size:(~a ~a)~n"
                 (unbox x1) (unbox y1)
                 (unbox x2) (unbox y2)
                 message-snip-width message-snip-height)

          (define scroll-end-pos (- message-snip-width))

          ; move the string-snip% across the pasteboard% some number of
pixels per tick, with some delay between ticks
          (define current-pos scroll-start-pos)
          (define (do-scroll-text)
            (send display-pasteboard move-to message-string-snip
current-pos 0)
            (sleep sleep-time)
            (set! current-pos (if (<= current-pos scroll-end-pos)
scroll-start-pos (- current-pos pixels-per-tick)))
            (do-scroll-text)
            )
          (set! text-mover-thread (thread do-scroll-text))
          ))

      (define/public (stop-text-moving)
        (printf "stop-text-moving: thread:~a~n" text-mover-thread)
        (when (not (equal? text-mover-thread #f))
          (kill-thread text-mover-thread)
          (set! text-mover-thread #f)
          ))
      )))

****

#lang racket/gui

(require "moving-text-snip.rkt")

(define f (instantiate frame% ("Moving-Text-Module Test" #f 600 400)))
(define c (instantiate editor-canvas% (f)))
(define p (instantiate pasteboard% ()))
(send c set-editor p)
(send f show #t)

(define s
  (new moving-text-snip%
    [message-text "hello world .... one two three ... goodbye world ...
alpha bravo charlie delta ...   "]))

(send s set-min-width 250)
(send s set-max-width 250)

(send s set-min-height 50)
(send s set-max-height 50)

(send p insert s)

(define x (box 0))
(define y (box 0))
(define w (box 0))
(define h (box 0))

(send (send p get-admin) get-view x y w h #f)
(printf "canvas: position:(~a ~a) dimensions:(~a ~a)~n"
        (unbox x) (unbox y)
        (unbox w) (unbox h))

(printf "start text moving~n")
(send s start-text-moving)

(thread
  (thunk
    (sleep 5)
    (printf "try to start text moving that's already moving~n")
    (send s start-text-moving)
    (sleep 5)
    (printf "stop text moving~n")
    (send s stop-text-moving)
    ))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20120516/1d29f5de/attachment-0001.html>