;;;
;;; Demo code for reading standard image file formats
;;;
;;; Margaret M. Fleck and Daniel E. Stevenson
;;; Copyright 1997
;;;

;;; This file contains the coprocessor-functions
;;;   for foreign-image-reader.scm.

;;; Transfer sheets in correct order for MIT format, 
;;;     which also works for PGM (grayscale) format.
;;; Offset is added to each output value during the transfer.
(bulk-define mit-transfer-bytes
	      ((integer-grid 1 1) (manifold 2 1) integer)
	      unspecified
  (lambda (input output offset)
    (let* ((input-ptr (sheet-min-sample input))
	   (height (point-coordinate (sample-offset
				      (sheet-max-sample output)
				      (sheet-min-sample output))
				     1))
	   (start (shift-sample (sheet-min-sample output)
				-1 (+ height 1))))
      ;; start is just above and to the left of the upper left 
      ;; corner of the 2D output image.  input-ptr is at the start
      ;; of the 1D block of input values.
      (scan (row start #f scan-down)
	    (scan (output-ptr row #f scan-right)
		  (sample-set! output-ptr (+ offset (sample-ref input-ptr)))
		  (set! input-ptr (shift-sample input-ptr 1)))))))


;;; Read PPM's interleaved color format.
;;; Offset is 0, 1, or 2 depending on which plane you want to transfer.
(bulk-define ppm-transfer-bytes
	      ((integer-grid 1 1) (manifold 2 1) integer)
	      unspecified
  (lambda (input output offset)
    (expect (and (>= offset 0) (<= offset 2)))
    (let* ((input-ptr (sheet-min-sample input))
	   (height (point-coordinate (sample-offset
				      (sheet-max-sample output)
				      (sheet-min-sample output))
				     1))
	   (start (shift-sample (sheet-min-sample output)
				-1 (+ height 1))))
      ;; start is just above and to the left of the upper left 
      ;; corner of the 2D output image.  input-ptr is at the start
      ;; of the 1D block of input values.
      (scan (row start #f scan-down)
	    (scan (output-ptr row #f scan-right)
		  (sample-set! output-ptr 
			       (sample-ref 
				(shift-sample input-ptr offset)))
		  (set! input-ptr (shift-sample input-ptr 3)))))))