;;; PLT Scheme Science Collection
;;; Copyright (c) 2004 M. Douglas Williams
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; Lesser General Public License for more details.
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;; -------------------------------------------------------------------
;;; This module adds discrete plots to the plot collection included
;;; with PLT Scheme.
;;; Version  Date      Description
;;; 1.0.0    09/30/04  Marked as ready for Release 1.0.  (Doug
;;;                    Williams)

(module plot-discrete mzscheme
  (require (lib "")
           (lib "" "plot"))
  ;; Draw a bar if height y and the specified width centered at the
  ;; given x coordinate.
  (define (draw-bar x width y view)
    (let* ((width/2 (/ width 2.0))
           (x1 (- x width/2))
           (x2 (+ x width/2)))
      (send view fill
            `(,x1 ,x1 ,x2 ,x2)
            `(0 ,y ,y 0))))
  ;; Draw binned discrete data.  [n1, n2] is the bin range.
  (define (draw-discrete bins n1 n2 width view)
    (let ((n (vector-length bins)))
      (do ((i 0 (+ i 1)))
          ((= i n) (void))
        (let ((x (+ n1 i)))
          (draw-bar x width (vector-ref bins i) view)))))
  ;; Draw a discrete function.
  (define (draw-discrete-function f x-min x-max width view)
    (let ((n1 (inexact->exact (ceiling x-min)))
          (n2 (inexact->exact (floor x-max))))
      (do ((i n1 (+ i 1)))
          ((> i n2) (void))
        (draw-bar i width (f i) view))))
  ;; Discrete plot extender.
  (define-plot-type discrete
     data 2dview (x-min x-max) ((width .5) (color 'black))
       (send 2dview set-line-color color)
       (cond ((and (list? data)
                   (= (length data) 3)
                   (integer? (car data))
                   (integer? (cadr data))
                   (vector? (caddr data)))
              ;; Binned discrete data: (n1 n1 bins)
              (draw-discrete (caddr data) (car data) (cadr data) width 2dview))
             ((procedure? data)
              ;; Discrete function
              (draw-discrete-function data x-min x-max width 2dview))
              (error 'discrete
                     "data format unknown")))))