[racket] designing animated text-box with universe

From: grant centauri (gcentauri at lincolnix.net)
Date: Sun Aug 11 18:38:36 EDT 2013

hello all, i am trying to design a classic role playing game dialog box
that would animate the printing of text one character at a time.  Little by
little, I have been able to develop this working example, but it doesn't
seem to work very well.  I am sure part of the problem is that I am
calculating local variables over and over again... but that is a symptom of
a larger design problem.  I have some experience with the HtDP design
recipe which I am trying to use intelligently, but sometimes I overdo it
and have unnecessary structs within structs, and other times I don't have
enough.  Some of the data I'm keeping in structs might be better off in a
separate global variable.  I don't really know the proper way to design
something like this.  Ideally, this code would end up being able to be used
as a module so that one could could use the text-box code with their own
dimensions, font, and background.  It seems fairly simple, and the metaphor
I was trying to use as a model was that of a printer with a print head that
moves, and paper to print on.  The basic function worked fine, but when
trying to add in functionality to do word wrapping, things got a bit
messy.  I've rewritten a number of times, and was just hoping for some
design advice before I start banging my head against the wall.  Here's the
code:

#lang racket
(require 2htdp/universe 2htdp/image)

;; current word is a list of chars, string-to-print is a list of strings
(struct buffer (current-word string-to-print))

;; defining a font structure, this is to use with the text/font function
(struct font (size color face family style weight underline?))

(define terminus-16 (font 16 'white "Terminus" 'system 'normal 'bold #f))

;; input is a buffer, paper is an image, font is a font, cursor-x and -y
are positive integers
(struct text-box (input paper font cursor-x cursor-y))

(define my-text "Now THIS is the string I'd like to print!  Oh my!, it
appears to be working.  However, there are some errors in my code (such as
calling first on an empty list now and then) and it seems to slow down
quite a bit.")

(define my-textbox (text-box (buffer empty (string-split my-text))
                 (rectangle 400 300 'solid 'blue)
                 terminus-16
                 10 10))

;; game-print: string font -> image
;; draws string s with the font f
(define (game-print s f)
  (text/font s (font-size f) (font-color f) (font-face f) (font-family f)
           (font-style f) (font-weight f) (font-underline? f)))

(define (tick tb)
   (next-char tb))

;; updates the "paper" so that the next character is placed on it, and
updates the current-word
(define (next-char tb)
  (define s (buffer-string-to-print (text-box-input tb)))
  (define word (buffer-current-word (text-box-input tb)))
  (define char-width (image-width (game-print " " (text-box-font tb))))
  (if (empty? word) (next-char (next-word tb))
      (text-box (buffer (rest word) s)
        (place-image (game-print (string (first word)) (text-box-font tb))
                 (text-box-cursor-x tb) (text-box-cursor-y tb)
                 (text-box-paper tb))
        (text-box-font tb)
        (+ char-width (text-box-cursor-x tb))
        (text-box-cursor-y tb))))

;; places the next word from the text-box-input's string-to-print into
current-word
(define (next-word tb)
  (define x (text-box-cursor-x tb))
  (define y (text-box-cursor-y tb))
  (define s (buffer-string-to-print (text-box-input tb)))
  (define word (first s))
  (define word-width (image-width (game-print word (text-box-font tb))))
  (define char-width (image-width (game-print " " (text-box-font tb))))
  (define line-height (+ 5 (image-height (game-print " " (text-box-font
tb)))))
  (define paper-width (image-width (text-box-paper tb)))
  (cond [(empty? s) tb]
    ;; this clause determines if we need to start a new line.
    [(> (+ x word-width) paper-width) (text-box (buffer (string->list word)
(rest s))
                            (text-box-paper tb)
                            (text-box-font tb)
                            10
                            (+ line-height (text-box-cursor-y tb)))]
    [else   (text-box (buffer (string->list word) (rest s))
              (text-box-paper tb)
              (text-box-font tb)
              (+ char-width (text-box-cursor-x tb))
              (text-box-cursor-y tb))]))

(define (render tb)
   (overlay
    (text-box-paper tb)
    (empty-scene 500 450 'black)))

(define (start)
   (big-bang my-textbox
         (on-tick next-char)
         (to-draw render)))

(start)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20130811/8d01a05b/attachment.html>

Posted on the users mailing list.