;;;;
;;;; w w w - i m g . s t k	--  WWW for STk (images file reader)
;;;;
;;;; Copyright © 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works.  Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.  
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; This version uses some of the enhancements done by Harvey J. Stein:
;;;;         Copyright (c) 1995 Harvey J. Stein (hjstein@math.huji.ac.il)
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date:  6-Oct-1996 17:12
;;;; Last file update: 11-Apr-1998 11:50
;;;;

(require "image")
(select-module WWW)

;=============================================================================
;
; 			U t i l i t i e s
;
;=============================================================================
(define (copy-port-image in out)
  (do ((c (read-char in) (read-char in)) (count 0 (+ count 1)))
      ((or www:stop-loading (eof-object? c)))
    (write-char c out)
    (when (= count 100)  ; animate screen
      (set! count 0)
      (www:hook-formatting))))


(define (need pkg)
  (unless (provided? pkg) (try-load pkg)))


(define (load-default-image name)
  ;; Default images must have the following name
  ;;   file:@parentdir.xpm
  ;;   file:@dir.xpm
  ;;   file:@file.xpm
  ;; These names are generated by the directory viewer.
  (make-image (string-append "@" name "@.xpm")
	      :file (string-append *stk-library* "/Images/" name ".xpm")))

;=============================================================================
;
;		 I m a g e s   m a n a g e m e n t
;
;=============================================================================

(define (make-remote-image key url port)
  (let ((image (find-image key)))
    (unless image
      ; We don't have loaded this image yet
      (let* ((tmpname (temporary-file-name))
	     (file    (open-file tmpname "w")))
	(when file
	  (copy-port-image port file)
	  (close-output-port file)
	  (set! image (make-image key :file tmpname))
	  (remove-file tmpname))))
    image))

(define (insert-image txt image)
  (txt 'image 'create "end" :image image :pady 2 :padx 2)
  image)

;=============================================================================
;
; 			 I m a g e   v i e w e r 
;
;=============================================================================
(define (view-image txt fd url)
  (let* ((str-url (if (string? url) url (URL:unparse-url url)))
	 (image   (if (eq? (URL:service url) 'file)
		      ;; Image is in a file
		      (make-image (URL:filename url))
		      ;; Image is distant
		      (make-remote-image str-url url fd))))
    (and image (insert-image txt image))))

;=============================================================================

;;;; Add the txt viewer
(www:add-viewer (string->regexp "\\.gif$|\\.ppm$|\\.jpg$|\\.pbm$|\\.x[bp]m$")
		view-image)
(www:add-viewer 'img 
		view-image)

;;;; Initialize package
(need "pixmap")
(need "jpeg")

(when (provided? "pixmap")
  (load-default-image "parentdir")
  (load-default-image "file")
  (load-default-image "dir"))

(provide "www-img")