;;; PLT Scheme Science Collection
;;; plot-histogram-2d.ss
;;; 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
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; 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 implements 2d histogram in the PLoT Scheme package.
;;;
;;; Version  Date      Description
;;; 1.0.0    09/28/04  Marked as ready for Release 1.0.  (Doug
;;;                    Williams)

(module plot-histogram-2d mzscheme
  
  (require (lib "class.ss")
           (lib "plot-extend.ss" "plot"))
  
  (provide
   histogram-2d)
  
  ;; Draw a column given the widths (x and y)
  (define (draw-column-given-widths
           x x-width y y-width width-factor z view)
    (let* ((half-x-whitespace (/ (* x-width (- 1.0 width-factor)) 2.0))
           (x1 (+ x half-x-whitespace))
           (x2 (- (+ x x-width) half-x-whitespace))
           (half-y-whitespace (/ (* y-width (- 1.0 width-factor)) 2.0))
           (y1 (+ y half-y-whitespace))
           (y2 (- (+ y y-width) half-y-whitespace)))
      ;; Draw bottom
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1 ,y2 ,y2 ,y1)
            '(0 0 0 0 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 1
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1, y1 ,y1 ,y1)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 2
      (send view plot-polygon
            `(,x2 ,x2 ,x2 ,x2 ,x2)
            `(,y1 ,y2 ,y2 ,y1 ,y1)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 3
      (send view plot-polygon
            `(,x2 ,x1 ,x1 ,x2 ,x2)
            `(,y2 ,y2 ,y2 ,y2 ,y2)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 4
      (send view plot-polygon
            `(,x1 ,x1 ,x1 ,x1 ,x1)
            `(,y2 ,y1 ,y1 ,y2 ,y2)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw top
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1 ,y2 ,y2 ,y1)
            `(,z ,z ,z ,z ,z)
            '(1 1 1 1 1)
            1)))
  
  ;; Draw a column
  (define (draw-column x1 x2 y1 y2 width-factor z view)
    (let* ((half-x-whitespace (/ (* (- x2 x1) (- 1.0 width-factor)) 2.0))
           (half-y-whitespace (/ (* (- y2 y1) (- 1.0 width-factor)) 2.0)))
      (set! x1 (+ x1 half-x-whitespace))
      (set! x2 (- x2 half-x-whitespace))
      (set! y1 (+ y1 half-y-whitespace))
      (set! y2 (- y2 half-y-whitespace))
      ;; Draw bottom
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1 ,y2 ,y2 ,y1)
            '(0 0 0 0 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 1
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1, y1 ,y1 ,y1)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 2
      (send view plot-polygon
            `(,x2 ,x2 ,x2 ,x2 ,x2)
            `(,y1 ,y2 ,y2 ,y1 ,y1)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 3
      (send view plot-polygon
            `(,x2 ,x1 ,x1 ,x2 ,x2)
            `(,y2 ,y2 ,y2 ,y2 ,y2)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw face 4
      (send view plot-polygon
            `(,x1 ,x1 ,x1 ,x1 ,x1)
            `(,y2 ,y1 ,y1 ,y2 ,y2)
            `(0 0 ,z ,z 0)
            '(1 1 1 1 1)
            1)
      ;; Draw top
      (send view plot-polygon
            `(,x1 ,x2 ,x2 ,x1 ,x1)
            `(,y1 ,y1 ,y2 ,y2 ,y1)
            `(,z ,z ,z ,z ,z)
            '(1 1 1 1 1)
            1)))
  
  ;; Draw a histogram-2d with specified ranges (x and y)
  (define (draw-histogram-2d 
           bins x-ranges y-ranges width-factor view)
    (let ((nx (- (vector-length x-ranges) 1))
          (ny (- (vector-length y-ranges) 1)))
      (do ((i 0 (+ i 1)))
          ((= i nx) (void))
        (do ((j 0 (+ j 1)))
            ((= j ny) (void))
          (let ((bin (+ (* i ny) j)))
            (draw-column (vector-ref x-ranges i)
                         (vector-ref x-ranges (+ i 1))
                         (vector-ref y-ranges j)
                         (vector-ref y-ranges (+ j 1))
                         width-factor
                         (vector-ref bins bin)
                         view))))))
  
  ;; Define histogram-2d plot type
  (define-plot-type histogram-2d
    data 3dview (x-min x-max y-min y-max) ((color 'black) (width 1.0))
    (begin
      (send 3dview set-line-color color)
      (set! width (max width 0.0))
      (set! width (min width 1.0))
      (draw-histogram-2d (car data)
                         (cadr data)
                         (caddr data)
                         width
                         3dview)))
  
)