;; RadioEntry is a structure that describes a choice in a 
;; radio button box.  A RadioEntry has a label, which is a
;; string and a function that takes a RadioEntry as an input 
;; parameter and has no return value (the return value is 
;; disregarded.  A data storage field is provided to hold any 
;; data needed by the function (note that the data could be a 
;; function as well.
;; (make-RadioEntry string (RadioEntry --> null) any)
(define-struct RadioEntry (label func data))

;; makeFrame: string number number --> frame
;; makeFrame is a factory that creates a visible frame of the
;; given width and height.   The label is shown on the
;; frame's title bar.  A frame object is returned.
;; The the DrScheme Help Desk for more information on 
;; directly manipulating frame objects.
(define (makeFrame aLabel aWidth aHeight)
  (local [(define f (instantiate frame% () (label aLabel) (width aWidth) (height aHeight) ))]
    (begin
      (send f show true)
      f)))

;;makeRefresh: component --> (-->void)
;;A factory for a function that will refresh (repaint) the supplied 
;; window component.   The function returned takes no 
;; argument and returns nothing -- it only has the side-effect
;; of refreshing the component.
(define (makeRefresh component)
  (lambda ()
    (send component refresh)))

;;makeRefreshTimer: component number --> timer
;; returns a running timer that refreshes the supplied component
;; at an interval of the supplied number of milliseconds.
(define (makeRefreshTimer component repaint-interval)
  (instantiate timer% () 
    (notify-callback (makeRefresh component))  
    (interval repaint-interval) )) 


;; addRadioBox: string window-container vector-of-RadioEntry --> radiobox
;; adds a labelled radio box component to the supplied 
;; parent window-container (frame, panel, pane, or dialog).
;; The radio buttons shown will correspond to the RadioEntries in the supplied vector of 
;; RadioEntries.  The RadioEntry structures supply the label that is shown as well as the 
;; function that is called when the corresponding radio button is clicked.  The function is 
;; called with its own RadioEntry structure as its input, enabling access to the radio button's 
;; label and any associated data.  
;; In addition, when addRadioBox is run, the function of the first radio button in the vector is 
;; called.  This ensures that the system is is the state indicated by the buttons.
(define (addRadioBox aLabel aParent reVec)
  (local [(define default-selection 0)
          (define rb (instantiate radio-box% () 
                       (label aLabel) 
                       (choices (map (lambda (re)
                                       (RadioEntry-label re))
                                     (Vector->list reVec))) 
                       (parent aParent) 
                       (callback (lambda (radiobox controlevent)
                                   (local [(define i (send radiobox get-selection))]
                                     ((RadioEntry-func (vector-ref reVec i)) (vector-ref reVec i)))))))]
    (begin
      (send rb set-selection default-selection)
      ((RadioEntry-func (vector-ref reVec default-selection)) (vector-ref reVec default-selection))
      rb)))

;; addButton: string window-container (--> void) --> button
;; Adds a labelled button to the supplied parent window-container.   When the button
;; is clicked the suppled function is called.
(define (addButton aLabel aParent aCallback) 
  (instantiate button% () (label aLabel) (parent aParent) (callback (lambda (button controlEvent)
                                                                      (aCallback)))))

;; addCanvas: window-container (drawing-context --> void) --> canvas
;; adds a canvas to the supplied parent window-container.   The supplied
;; painting function is called whenever the component is a refreshed.  The 
;; painting function is called with a drawing context, which supplies drawing
;; behaviors for the canvas.
(define (addCanvas a-parent painter)
  (instantiate canvas% () 
    (parent a-parent) 
    (paint-callback painter)))


;; make-draw-solid-line:  canvas --> (posn posn --> void)
;; Takes a canvas and returns a function that will draw a solid
;; straight line from posn 1 to posn 2 on the canvas.
(define (make-draw-solid-line a-canvas)
  (local [(define a-dc (send a-canvas get-dc))]
  (lambda (p1 p2)
    (send a-dc draw-line (posn-x p1) (posn-y p1) (posn-x p2) (posn-y p2)))))