;;; Avoid a conflict with the package :GL of SBCL's CLX that was introduced
;;; with the GLX extensions support of SBCL CLX version 0.6.1.
(delete-package 'gl)
(require :cube-modeller)

#+nil
(declaim (optimize (compilation-speed 0)
                   (debug 1)
                   (safety 1)
                   (space 3)
                   (speed 3)))
         
(in-package "SB-ALIEN")

(let ((function (symbol-function 'try-reopen-shared-object)))
  (setf (symbol-function 'try-reopen-shared-object)
	#'(lambda (obj)
	    (declare (type shared-object obj))

	    ;; (format  *trace-output* "~&>>> 1) desired shared-object: ~d" (shared-object-file obj))
            (setf (shared-object-file obj)
                  (file-namestring (shared-object-file obj)))
	    ;; (format  *trace-output* "~&>>> 2) now searching instead: ~d" (shared-object-file obj))
            
            (funcall function obj))))

(in-package :cl-user)

(defun configure-freetype ()
  (setf mcclim-freetype:*freetype-font-path*
        (merge-pathnames (make-pathname :directory '(:relative "fonts"))
                         (make-pathname :directory (pathname-directory sb-ext:*core-pathname*))))
  
  (flet ((set-font (family face filename)
           (setf (cdr (assoc (list family face) mcclim-freetype::*families/faces*
                             :test #'equal))
                 filename)))
    (set-font :fix :roman "Andale_Mono.ttf")
    (set-font :fix :bold "Andale_Mono.ttf")))

(defun position-of-command-line-option (parameter-name)
  (position parameter-name sb-ext:*posix-argv* :test #'string-equal))

(defun get-command-line-argument (argument-name)
  (let ((position (position-of-command-line-option argument-name)))
    (when (and position
               (<= (+ 2 position) ;; there is an argument after its name
                   (length sb-ext:*posix-argv*)))
      (nth (1+ position) sb-ext:*posix-argv*))))
  
(setf *invoke-debugger-hook* nil) ;; Use SBCL's built-in debugger while loading the foreign objects.

(sb-ext:save-lisp-and-die "cube-modeller"
                          :executable t
			  :toplevel (lambda ()
                                      (setf *invoke-debugger-hook* #'clim-debugger:debugger)

                                      (format t "~&~%=============== LED Cube Modeller ===============~&~%")

                                      (when (position-of-command-line-option "--help")
                                        (format t 
"Usage: cube-modeller [--help] [--host <host-name or ip>] [-port <port>]
                              [--cube-tty <device>] [--frame-duration <delay>]
                              [--print-running-averager-info]
                              [--print-frame-duration-statistics]

  --help            show this screen

  --print-fps       print frames per second rate

  --host            host-name or ip of the cubeserver
  --host-name
  --hostname
  --ip

  --port            port of the cubeserver

  --cube-tty        path to the serial device of the cube
  --cubetty

  --frame-duration  set duration between the starts of two consecutive frames
                    (in milliseconds)

  --print-running-averager-info
                    print debug information of the running averager

  --print-frame-duration-statistics
                    calculate and print statistics on the frame display duration

")
                                        (sb-ext:quit))

                                      ;; *animation-pathname*
                                      (setf cube-modeller::*animation-pathname*
                                            (merge-pathnames (make-pathname :directory '(:relative "data"))
                                                             (make-pathname :directory (pathname-directory sb-ext:*core-pathname*))))

                                      ;; freetype
                                      (configure-freetype)

                                      ;; --print-fps
                                      (when (position-of-command-line-option "--print-fps")
                                        (setf cube-modeller::*print-frames-per-second-p* t))

                                      ;; --host and --port
                                      (let ((name-or-ip (or (get-command-line-argument "--host")
                                                            (get-command-line-argument "--hostname")
                                                            (get-command-line-argument "--host-name")
                                                            (get-command-line-argument "--ip"))))
                                        (when name-or-ip
                                          (cube:set-server-address name-or-ip
                                                                   (ignore-errors
                                                                     (parse-integer (get-command-line-argument "--port")
                                                                                    :junk-allowed t)))))

                                      ;; --cube-tty
				      (setf cube::*device-file*
                                            (or (get-command-line-argument "--cubetty")
                                                (get-command-line-argument "--cube-tty")))
                                      (when cube::*device-file*
					(format t "~&Writing cube data to device file \"~d\".~&~%" cube::*device-file*))

                                      ;; --frame-duration
                                      (let ((frame-duration (or (get-command-line-argument "--frame-duration")
                                                                (get-command-line-argument "--frameduration"))))
                                        (setf frame-duration (ignore-errors (/ (coerce (parse-integer frame-duration :junk-allowed t)
                                                                                       'float)
                                                                               1000)))
                                        (when frame-duration
                                          (format t "~&Setting frame delay to ~a.~&~%" frame-duration)
                                          (setf LED-cube:*default-frame-duration* frame-duration
                                                LED-cube:*frame-duration* frame-duration)))

                                      ;; --print-running-averager-info
                                      (when (position-of-command-line-option "--print-running-averager-info")
                                        (setf cube-modeller::*print-running-averager-info-p* t))
                                      
                                      ;; --print-frame-duration-statistics
                                      (when (position-of-command-line-option "--print-frame-duration-statistics")
                                        (setf cube-modeller::*print-frame-duration-statistics-p* t))

				      (cube-modeller:start)
				      (sb-ext:quit)))