;;;; Copyright 2000 by Paul Emsley
;;;; Copyright 2004 by Paul Emsley, The University of York

;;;; This program 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.
 
;;;; This program 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 this program; if not, write to the Free Software
;;;; Foundation, Inc.,  59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

(use-modules (ice-9 popen))
(use-modules (goosh))

;;; Is this the right place for this?  Perhaps yes and the other stuff
;;; goes into coot-shell-utils, or something.
;;;
;;; trackball type a symbol: either 'flat or 'spherical-surface.
;;;
(define set-virtual-trackball-type
  (lambda (type)

    (cond 
     ((eq? type 'flat) (vt-surface 1))
     ((eq? type 'spherical-surface) (vt-surface 0))
     (else 
      ; usually not output anywhere
      (format #t "virtual trackball type ~s not understood~%")))))
    

(define list-of-strings?
  (lambda (ls)

    (if (not (list? ls))
	#f
	(let f ((ls ls))
	  (cond 
	   ((null? ls) #t)
	   ((string? (car ls))
	    (f (cdr ls)))
	   (else #f))))))
		    

(define string-append-with-spaces
  (lambda (ls)

    (if (null? ls) 
	""
	(string-append (car ls) " " (string-append-with-spaces (cdr ls))))))

(define rotation-centre
  (lambda ()

    (map rotation-centre-position (list 0 1 2))))

(define rotation-center rotation-centre) ; maybe there is a better
					 ; place for US spellings.

;;;
;;; Make list of integers, a to b: eg (2 3 4 5)
(define number-list
  (lambda (a b)

    (cond
     ((= a b) (list a))
     ((> a b) '())
     (else
      (cons a (number-list (+ a 1) b))))))


; from thi <ttn@mingle.glug.org>
;
(define (shell-command-to-string cmd)
  (with-output-to-string
    (lambda ()
      (let ((in-port (open-input-pipe cmd)))
	(let loop ((line (read-line in-port 'concat)))
	  (or (eof-object? line)
	      (begin
		(display line)
		(loop (read-line in-port 'concat)))))))))

; run cmd putting output to file-name and reading commands data from
; the list of strings data-list.
; 
(define shell-command-to-file-with-data 
  (lambda (cmd file-name data-list)

;    (call-with-output-file file-name
;	(lambda (port)

	  (let ((write-port (open-pipe cmd OPEN_WRITE)))
	    
	    (let f ((data-list data-list))
	      
	      (if (null? data-list)

		  (close-port write-port)
		  
		  (begin
		    (format #t "writing ~s~%" (car data-list))
		    (write (car data-list) write-port)
		    (newline write-port)
		    (f (cdr data-list))))))))

;; Return #t or #f:
(define command-in-path? 
  (lambda (cmd)

    ;; test for command (see goosh-command-with-file-input description)
    ;; 
    (if (string? cmd) 
	(let ((have-command? (run "which" cmd)))

	  (if (= have-command? 0) ; we *do* have the command
	      #t
	      #f)))))

      
; Where cmd is e.g. "refmac" 
;       args is (list "HKLIN" "thing.mtz")
;       log-file-name is "refmac.log"      
;       data-list is (list "HEAD" "END")
; 
; Return the exist status e.g. 0 or 1.
; 
(define goosh-command
  (lambda (cmd args data-list log-file-name screen-output-also?)
    
    (if (not (command-in-path? cmd))

	(format #t "command ~s not found~%" cmd)

	(let* ((cmd-ports (apply run-with-pipe (append (list "r+" cmd) args)))
	       (pid (car cmd-ports))
	       (output-port (car (cdr cmd-ports)))
	       (input-port  (cdr (cdr cmd-ports))))
	  
	  (let loop ((data-list data-list))
	    (if (null? data-list)
		(begin 
		  (close input-port))
		
		(begin
		  (format input-port "~a~%" (car data-list))
		  (loop (cdr data-list)))))
	  
	  (call-with-output-file log-file-name
	    (lambda (log-file-port)
	      
	      (let f ((obj (read-line output-port)))
		(if (eof-object? obj)
		    (begin 
		      (let* ((status-info (waitpid pid))
			     (status (status:exit-val (cdr status-info))))
			(format #t "exit status: ~s~%" status)
			status)) ; return status 
		    
		    (begin
		      (if (eq? screen-output-also? #t)
			  (format #t ":~a~%" obj))
		      (format log-file-port "~a~%" obj)
		      (f (read-line output-port)))))))))))
	     
; example usage:
;(goosh-command "mtzdump" (list "HKLIN" "a.mtz") (list "HEAD" "END") "test.log" #t)


(define goosh-command-with-file-input
  (lambda (cmd args input-file log-file-name)

    ;; we had a problem here (may 2004).  If command was not in path,
    ;; this function either hung or caused coot to immediately stop.
    ;; So now we test to see if cmd exists in the path first, by
    ;; running "which" on it.
    ;; 
    (if (string? cmd) 
	(let ((have-command? (run "which" cmd)))

	  (if (= have-command? 0) ; we *do* have the command

	      (with-output-to-file log-file-name
		(lambda ()
		  (with-input-from-file input-file
		    (lambda() 
		      (apply run (cons cmd args))))))
	      '()))
	'())))

;(define goosh-command-sans-log
;  (lambda (cmd args data-list)

;    (if (string? cmd) 
;	(let ((have-command? (run "which" cmd)))

;	  (if (= have-command? 0) ; we *do* have the command

;	      )))))

	      
(define string-append-with-string
  (lambda (str-ls tag-str)

    (string-concatenate

     (let f ((ls str-ls))
       (cond
	((null? ls) '())
	(else 
	 (cons (car ls)
	       (cons tag-str
		     (f (cdr ls))))))))))



(define string-concatenate 
  (lambda (ls)
    (apply string-append ls)))


(define multi-read-pdb 
  (lambda (glob-pattern dir)
    (map (lambda (file)
	   (format #t "Reading ~s in ~s~%" file dir)
	   (let ((full-path (append-dir-file dir file)))
	     (read-pdb full-path)))
	 (glob glob-pattern dir))))

(define read-pdb-all
  (lambda ()
    (let ((recentre-status (recentre-on-read-pdb)))
      (set-recentre-on-read-pdb 0)
      (map read-pdb (glob "*.pdb" "."))
      (set-recentre-on-read-pdb recentre-status))))

;; return a list if str is a string, else return '()
;; 
(define string->list-of-strings
  (lambda (str)

    (if (not (string? str))
	'()
	(let f ((chars (string->list str))
		(word-list '())
		(running-list '()))

	  (cond 
	   ((null? chars) (reverse 
			   (if (null? running-list)
			       word-list
			       (cons (list->string running-list) word-list))))
	   ((char=? (car chars) #\space) (f (cdr chars)
					    (if (null? running-list)
						word-list
						(cons (list->string 
						       (reverse running-list))
						      word-list))
					    '()))
	   (else 
	    (f (cdr chars)
	       word-list
	       (cons (car chars) running-list))))))))
	       


;;; These 2 functions from Chart and are copyrighted by Paul Emsley.

;;;  in a laughable attempt to minimise system dependence.
;;;
(define append-dir-file
  (lambda (dir-name file-name)

    (string-append (directory-as-file-name dir-name) "/" file-name)))

;;; similarly
(define append-dir-dir
  (lambda (dir-name sub-dir-name)

    (string-append (directory-as-file-name dir-name) "/" sub-dir-name)))

;; remove any trailing /s
;;
(define directory-as-file-name
  (lambda (dir)

    (if (= 0 (string-length dir))
	"."
	(let ((rchars (reverse (string->list dir))))
	  (let f ((rls rchars))
	    (cond 
	     ((eq? #\/ (car rls)) (f (cdr rls)))
	     (else
	      (list->string (reverse rls)))))))))
	  

;;; the following functions from PLEAC (guile version thereof of course).
;;; 
;; or define a utility function for this
(define (directory-files dir)
  (if (not (access? dir R_OK))
    '()
    (let ((p (opendir dir)))
      (do ((file (readdir p) (readdir p))
           (ls '()))
          ((eof-object? file) (closedir p) (reverse! ls))
        (set! ls (cons file ls))))))

(define (glob->regexp pat)
  (let ((len (string-length pat))
        (ls '("^"))
        (in-brace? #f))
    (do ((i 0 (1+ i)))
        ((= i len))
      (let ((char (string-ref pat i)))
        (case char
          ((#\*) (set! ls (cons "[^.]*" ls)))
          ((#\?) (set! ls (cons "[^.]" ls)))
          ((#\[) (set! ls (cons "[" ls)))
          ((#\]) (set! ls (cons "]" ls)))
          ((#\\)
           (set! i (1+ i))
           (set! ls (cons (make-string 1 (string-ref pat i)) ls))
           (set! ls (cons "\\" ls)))
          (else
           (set! ls (cons (regexp-quote (make-string 1 char)) ls))))))
    (string-concatenate (reverse (cons "$" ls)))))

(define (glob pat dir)
  (let ((rx (make-regexp (glob->regexp pat))))
    (filter (lambda (x) (regexp-exec rx x)) (directory-files dir))))


;;;
(define view-matrix
  (lambda ()

    (map (lambda (row-number)
	   (map (lambda (column-number)
		  (get-view-matrix-element row-number column-number))
		(list 0 1 2)))
	 (list 0 1 2))))

;;;
(define miguels-axes
  (lambda ()

    (apply set-axis-orientation-matrix (apply append (view-matrix)))
    (set-axis-orientation-matrix-usage 1)))

;;; Note: mol-cen could contain values less than -9999.  
;;;
(define molecule-centre 
  (lambda (imol) 

    (map (lambda(iaxis) 
	   (molecule-centre-internal imol iaxis))
	 (list 0 1 2))))
      
;;; 
(define move-molecule-to-screen-centre
  (lambda (imol)

    ;; We need to know what the current molecule centre for imol is.
    ;; That is not available for export at the moment, but it should
    ;; be.
    (let ((current-mol-centre (molecule-centre imol))
	  (rotate-centre (rotation-centre)))

      (translate-molecule-by imol 
			     (- (list-ref rotate-centre      0)
				(list-ref current-mol-centre 0))
			     (- (list-ref rotate-centre      1)
				(list-ref current-mol-centre 1))
			     (- (list-ref rotate-centre      2)
				(list-ref current-mol-centre 2))))))


(define move-molecule-to-screen-center move-molecule-to-screen-centre)

;; return a list of chain ids for given molecule number.
;; return empty list on error
(define chain-ids
  (lambda (imol)

    (let ((number-of-chains (n-chains imol)))

      (map (lambda (chain-no)
	     (chain-id imol chain-no))
	   (number-list 0 (- number-of-chains 1))))))


;; convert from interface name to schemish name
;;
(define is-solvent-chain? is-solvent-chain-p)
(define valid-model-molecule? is-valid-model-molecule)

(define residue-exists? 
  (lambda (imol chain-id resno ins-code)

    (= 1 (does-residue-exist-p imol chain-id resno ins-code))))



;; backups wrapper:
(define with-no-backups
  (lambda (imol thunk)

    (let ((backup-mode (backup-state imol)))

      (turn-off-backup imol)
      (lambda ()
	(thunk))
      (if (= backup-mode 1)
	  (turn-on-backup imol)))))