#!/usr/lib/scadalisp/bin/phlisp

(require "filesel")
(require "widgets")
(require "readwgt")
(require "imageproc")
(require "usage")

;;;
;;; Some configuration options
;;;

;;; The starting image directory.  I use /usr/images.  For demo purposes,
;;; use the current directory.
(setq BaseDir ".")

;;; Set the reduction.  0.5 is 50%.  Numbers over 1 are errors.
(setq Reduction 1)

;;; Remove borders on the window by setting this to t.
(setq NoBorders nil)

;;; Load Application Builder widget files instead of images.
(setq WidgetFiles nil)

;;; Set the goal width and height for the thumbnail mode.
(setq GoalWidth nil)
(setq GoalHeight nil)

;;;
;;; The usage message for when things go sadly wrong
;;;

(setq __USAGE "
#ifdef __USAGE
#%C	[-g width height] [-b] [-r reduction] [-w] [filename...]
#    -b            Do not draw borders or title on window
#    -g w h        Reduce to the specified size
#    -r reduction  Reduce by reduction ratio (e.g., .5=half)
#    -w            Load .wgtw files instead of images
#endif
")

;;;
;;; Parse the argument list.
;;;

(setq imagenames nil)

(do ((arg (cdr argv) (cdr arg))
     (i (car arg) (car arg)))
    ((not arg))
    (cond
     ((equal i "-b") (setq NoBorders t))
     ((equal i "-r") (setq Reduction (number (cadr arg)))
      (setq arg (cdr arg)))
     ((equal i "-w") (setq WidgetFiles t))
     ((equal i "-g")
      (setq GoalWidth (number (cadr arg)))
      (setq GoalHeight (number (caddr arg)))
      (setq arg (cddr arg)))
     ((equal (substr i 0 1) "-") (exit-program (Usage)))
     (t (setq imagenames (cons i imagenames)))
     )
    )
(setq imagenames (reverse imagenames))

;;;
;;; Initialize Photon
;;;

(PtInit nil)

;;;
;;; Close a window if we actually pressed the Close menu item.  Force the
;;; garbage collector to pick up any image memory that is lying around.
;;;

(defun maybe-close-window (win)
  (if imagenames
      (exit-program 0)
    (let ((winevent (@ event_data window_event)) retval)
      (switch (@ winevent event_f)
	      (Ph_WM_CLOSE (PtDestroyWidget win) (gc))
	      )
      )
    )
  )

;;;
;;; Display a window with an image in it
;;;

(defun image-window (image imname)
  (let (lab win)
    (if image
	(progn
	  (PtSetParentWidget nil)
	  (setq win (new PtWindow))
	  (-> win title (string imname))
	  (win SetArea 10 10 (@ (@ image size) w) (@ (@ image size) h))
	  (-> win notify_flags Ph_WM_CLOSE)
	  (-> win managed_flags (cons Ph_WM_CLOSE nil))
	  (PtAttachCallback win Pt_CB_WINDOW `(maybe-close-window ,win))
	  
	  (if NoBorders
	      (-> win render_flags `(,(bor Ph_WM_RENDER_BORDER
					   (bor Ph_WM_RENDER_TITLE
						Ph_WM_RENDER_RESIZE)) . nil))
	    )
	  
	  (setq lab (ImageToLabel image))
	  (PtRealizeWidget win)
	  (PtSetParentWidget nil)
	  )
      )
    win
    )
  )

;;;
;;; Load an image from disk, display it, and return the window
;;;

(defun load-image (imname)
  (let (lab win image)
    (if (not (equal (substr imname 0 1) "/"))
	(setq imname (string BaseDir "/" imname)))
    (setq image (PxLoadImage imname))
    (if image
	(progn
	  (if (!= Reduction 1)
	      (progn
		(setq image (PxReduceImage image Reduction Reduction))
		(gc)		; explicitly reclaim large image buffer
		)
	    (if (and GoalWidth GoalHeight)
		(setq image (ImageThumbNail image GoalWidth GoalHeight)))
	    )
	  (setq win (image-window image imname))
	  )
      )
    win
    )
  )

;;;
;;; Function to call when the user presses the OK button on the non-modal
;;; file selector.
;;;

(defun load-name (name)
  (if WidgetFiles
      (wload name)
    (load-image name)
    )
  )

;;;
;;; If there were no images named on the command line, pop up the
;;; file selector.
;;;

(if (not imagenames)
    (FileSelector BaseDir '(load-name filesel-Selection) '(exit-program 0)
		  "*.{gif,jpg,bmp}"))

;;;
;;; Just playing with the modal file selector.
;;;
;;;(if (not imagenames)
;;;    (let ((name (ModalFileSelector BaseDir)))
;;;      (if name (setq imagenames (cons name imagenames)))))

(setq loaded nil)

(for name in imagenames do
     (setq last (load-name name))
     (if last (setq loaded last)))

(if (or (not imagenames) loaded)
    (PtMainLoop))
