#! /usr/local/bin/guile \
-e main -s
!#
;;; Parquet.scm - Maurizio Tomasi 2003
;;;
;;; This Scheme program will generate file "parquet.inc", a POV-Ray
;;; include file which contains the definition of a set of bricks in
;;; an herringbone pattern.  The overall object extends in the x,z
;;; direction.
;;;
;;; The set of bricks is designed to be rotated by 45 degrees along
;;; the y axis.  Since it would have been difficult to "cut" the
;;; bricks which partially go outside the bounds, this program
;;; implements a very simple clipping algorithm: a brick is *not*
;;; written in the output file only if the program is absolutely sure
;;; the brick will be "outside" the floor (if it is not sure, it will
;;; keep the brick).  This means that you should always do a CSG
;;; intersection with a box before using the parquet.
;;;
;;; You must implement two macros named CreateParquetText1 and
;;; CreateParquetText2 before including "parquet.inc".  These macros
;;; must define a texture which extends along the z axis and the x
;;; axis respectively, and will be used for the bricks.  Mote that
;;; these are macros, not variables; this gives you a certain amount
;;; of flexibility (see "walls.inc" for an implementation).

;;; Output port
(define output-file #f)

;;; These two variables roughly fix the overall size of the floor.
;;; Divide by three to get the number of bricks along both the
;;; diagonal directions.
(define l1-limit 120)
(define l2-limit 14)

(define sqrt-2 (sqrt 2))

;;; Return #t if MIN-X <= X <= MAX-X, #f otherwise
(define between?
  (lambda (x min-x max-x)
    (and (>= x min-x) (<= x max-x))))

;;; Create a new parquet brick.  If the specified (U,V) position is
;;; outside the parquet, return #f.
(define create-brick
  (lambda (u v up?)
    (if (< (+ u v) (/ (+ l1-limit l2-limit) sqrt-2))
	(begin
	  (format output-file 
		  "box { <~a, ~a, ~a>, <~a, ~a, ~a> ~a ()}\n"
		  (+ 0.01 u) 0 (+ 0.01 v)
		  (+ -0.01 (+ u (if up? 1 3))) 1 (+ -0.01 (+ v (if up? 3 1)))
		  ;; Distinguish between "up" and "right" bricks
		  (if up? "CreateParquetText1" "CreateParquetText2"))
	  #t)
	#f)))

;;; Create a diagonal of bricks, either vertical or horizontal
;;; (according to the UP? parameter, which is #f if the row goes along
;;; the x axis, #t if along the z axis).
(define create-brick-diagonal
  (lambda (u-start v-start up?)
    (letrec ((place-next-brick
	      (lambda (u v)
		(if (create-brick u v up?)
		    (place-next-brick (+ u 1) (+ v 1))))))
      (place-next-brick u-start v-start))))

(define main
  (lambda (args)
    ;; Open the file
    (set! output-file (open-output-file "parquet.inc"))
    
    (letrec ((create-horizontal-diagonals ; Implemented recursively
	      (lambda (u v count)
		(create-brick-diagonal u v #f)
		(if (< v (/ l2-limit sqrt-2))
		    (create-horizontal-diagonals (- u 3) 
						 (+ v 2) 
						 (+ count 1)))))

	     (create-vertical-diagonals ; Ditto
	      (lambda (u v count)
		(create-brick-diagonal u v #t)
		(if (< v (/ l2-limit sqrt-2))
		    (create-vertical-diagonals (- u 3)
					       (+ v 2)
					       (+ count 1))))))

      (create-horizontal-diagonals 0 0 0)
      (create-vertical-diagonals -1 0 0))

    ;; Close the file
    (close-output-port output-file)
))
