#| -*-Scheme-*-

$Id: pic-read.scm,v 1.9 2003/03/08 02:48:36 cph Exp $

Copyright (c) 1991,1992,2001,2003 Massachusetts Institute of Technology

This file is part of MIT/GNU Scheme.

MIT/GNU Scheme is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

MIT/GNU Scheme 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
General Public License for more details.

You should have received a copy of the GNU General Public License
along with MIT/GNU Scheme; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.

|#

;;;; Procedures to read a file in raw pgm format into a picture

(declare (usual-integrations))

(define (pgm-file->picture filename)
  (call-with-input-file (standard-pathname filename "pgm")
    (lambda (port)
      (get-body port (get-header port)))))

(define (standard-pathname filename type)
  (let ((pathname (->pathname filename)))
    (if (or (pathname-type pathname)
	    (file-exists? pathname))
	pathname
	(pathname-new-type pathname type))))

(define (get-header port)
  (let* ((type (get-line port))
	 (dims (get-line port))
	 (no-of-greys (string->number (get-line port)))
	 (spc-index (string-find-next-char dims #\space)))
    (if (not (equal? type "P5"))  ; P5 is the magic number for raw PGM format
	(error "Unrecognized format (Convert to raw PGM)."))
    (vector type
	    (string->number (string-head dims spc-index))
	    (string->number (string-tail dims (+ spc-index 1)))
	    no-of-greys)))

(define get-line
  (let ((delimiters (char-set #\newline)))
    (lambda (port)
      (let loop ()
	(let ((line (read-string delimiters port)))
	  (if (eof-object? line)
	      (error "EOF encountered when parsing line."))
	  (read-char port)
	  ;; ignore comments
	  (if (and (not (string-null? line))
		   (char=? #\# (string-ref line 0)))
	      (loop)
	      line))))))

(define (get-body port attributes)
  (let* ((length (vector-ref attributes 1))
	 (width (vector-ref attributes 2))
	 (pic (make-picture length width))
	 (data
	  (make-initialized-vector
	   width
	   (lambda (index)
	     index			; ignored
	     (flo:make-vector length 0.))))) ;initialize to blank
    (side-effecting-iter
     width
     (lambda (n)
       (let ((nth-row (vector-ref data (- width n 1))))
	 (side-effecting-iter
	  length
	  (lambda (m)
	    (flo:vector-set!
	     nth-row
	     m
	     (exact->inexact (char->ascii (read-char port)))))))))
    (picture-set-data! pic data)
    pic))

;;; Procedure to read in a picture that was previously saved using
;;; picture-write.

(define (picture-read filename)
  (let ((pic-mimic (fasload (standard-pathname filename "pic"))))
    (if (not (record? pic-mimic))
	(error "Object loaded is not a record:" pic-mimic))
    (let ((mimic-type (record-type-descriptor pic-mimic)))
      (if (not (equal? (record-type-field-names mimic-type)
		       (record-type-field-names <picture>)))
	  (error "Object loaded is not a picture:" pic-mimic))
      (let ((new-pic
	     (make-picture ((record-accessor mimic-type 'width) pic-mimic)
			   ((record-accessor mimic-type 'height) pic-mimic))))
	(picture-set-data! new-pic
			   ((record-accessor mimic-type 'data) pic-mimic))
	(%picture-set-min! new-pic
			   ((record-accessor mimic-type 'min) pic-mimic))
	(%picture-set-max! new-pic
			   ((record-accessor mimic-type 'max) pic-mimic))
	new-pic))))