;-*- Mode: Lisp; Package: ccl -*-
;*********************************************************************
;*                                                                   *
;*             F R A M E W O R K S                                   *
;*                                                                   *
;*********************************************************************
   ;* Author    : Alexander Repenning (alexander@agentsheets.com)    *
   ;*             http://www.agentsheets.com                         *
   ;* Copyright : (c) 1996-2003, AgentSheets Inc.                    *
   ;* Filename  : frameworks.lisp                                    *
   ;* Updated   : 01/22/04                                           *
   ;* Versions  :                                                    *
   ;*    1.0.0  11/26/02                                             *
   ;*    1.1    11/03/03 Use Frameworks.lisp                         *
   ;*    1.2    12/22/03 empty-all-framework-caches                  *
   ;*    1.2.1  01/22/04 hardcode $kCFAllocatorDefault as (%null-ptr)*
   ;* HW/SW     : PowerPC G4, MCL 5, OS X 10.3.1                     *
   ;* Requires  : gameDevices.framework                              *
   ;* Abstract  : Minimal functions to access GamePads, JoySticks    *
   ;*                                                                *
   ;******************************************************************

;; Apple Doc: http://developer.apple.com/documentation/MacOSX/Conceptual/BPFrameworks/

(in-package :ccl)

(export '(add-to-framework-paths framework-function unload-bundle-executable empty-all-framework-caches))

(defvar *Framework-Paths*
  '("/System/Library/Frameworks/")
  "list of Posix paths to frame works. These paths will be searched if no complete path is provided.")


(defun ADD-TO-FRAMEWORK-PATHS (Path) "
  in: string Path.
  Add a new path to the list of paths searched by find-framework-bundle."
  (pushnew Path *Framework-Paths* :test #'string=))

;_________________________________________
;  Bundle Loader                          |
;_________________________________________

(defun FIND-FRAMEWORK-BUNDLE (Name &optional Path) "
  in:  string Name, &optional posixPath Path.
  out: Bundle Bundle.
  Find framework <Name> at <Path>.
  If no <Path> is provided use *Framework-Paths*.
  If framework is not found return nil."
  (dolist (Path (if Path (list Path) *Framework-Paths*))
    (with-cfstrs ((URLstring (concatenate 'string Path Name)))
      (let ((bundleURL (#_CFURLCreateWithFileSystemPath
                        (%null-ptr)
                        URLstring
                        #$kCFURLPOSIXPathStyle
                        t)))
        (let ((Bundle (#_CFBundleCreate (%null-ptr) bundleURL)))
          (#_CFRelease bundleURL)
          (unless (%null-ptr-p Bundle) (return Bundle)))))))
      

(defun LOAD-BUNDLE-EXECUTABLE (Bundle)  "
  in: Bundle Bundle.
  Loads a bundle's main executable code into memory and dynamically links it into the running application."
  (#_CFBundleLoadExecutable Bundle))


(defun UNLOAD-BUNDLE-EXECUTABLE (Bundle) "
  in: Bundle Bundle.
  Unloads the main executable for the specified bundle."
  (#_CFBundleUnloadExecutable Bundle))


(defun MACPTR-TO-EQUIVALENT-FIXNUM (addr)
  ;; Do the Garry Byers
  (rlet ((buf :long))
    (setf (%get-ptr buf) addr)
    (ash (%get-signed-long buf) -2)))

;__________________________________________
; Caching                                  |
;__________________________________________

;; Strategy: do not load framework and function pointer before using function
;;           This simplifies save-application

(defvar *Frameworks-Loaded* (make-hash-table :test #'equal) "All the frameworks currrently loaded")

(defvar *Framework-Function-Pointers* (make-hash-table) "Function pointers")

(defvar *Framework-Function-Description* (make-hash-table) "Function Decription property lists including :name, :path, and :framework")


(defun GET-FRAMEWORK-FUNCTION-POINTER (Name)
  (let ((Function-Pointer (gethash Name *Framework-Function-Pointers*)))
    ;; SIMPLE CASE: function is already cached!
    (when Function-Pointer (return-from GET-FRAMEWORK-FUNCTION-POINTER Function-Pointer))
    ;; COMPLEX CASE: need to look it up
    ;; make sure framework is loaded
    (let ((Framework-Name (getf (gethash Name *Framework-Function-Description*) :framework)))
      (unless Framework-Name (error "no framework name defined for ~A" Name))
      (let ((Framework (gethash Framework-Name *Frameworks-Loaded*)))
        (unless Framework
          (setf Framework 
                (find-framework-bundle 
                 Framework-Name 
                 (getf (gethash Name *Framework-Function-Description*) :path)))
          (unless Framework (error "cannot find framework: ~A" Framework-Name))
          ;; try to load the framework
          (unless (load-bundle-executable Framework) (error "cannot load bundle of framework: ~A" Framework-Name))
          (setf (gethash Framework-Name *Frameworks-Loaded*) Framework))
        ;; find function pointer
        (setf Function-Pointer
              (with-cfstrs ((FunctionName (getf (gethash Name *Framework-Function-Description*) :name)))
                (#_CFBundleGetFunctionPointerForName Framework FunctionName)))
        (when (%null-ptr-p Function-Pointer)
          (error "cannot find function: ~A in framework: ~A"
                 (getf (gethash Name *Framework-Function-Description*) :name)
                 Framework-Name))
        ;; adjust function pointer, cache and return
        (setq Function-Pointer (macptr-to-equivalent-fixnum Function-Pointer))
        (setf (gethash Name *Framework-Function-Pointers*) Function-Pointer)
        Function-Pointer))))


(defmacro FRAMEWORK-FUNCTION (Name (&rest Parameters) &rest Keywords)
  `(progn
     ;; Add Description
     (setf (gethash ',Name *Framework-Function-Description*) 
           '(:input ,Parameters ,@Keywords))
     ;; create function
     (defun ,Name ,(mapcar #'first Parameters)
       ,(or (getf Keywords :documentation) "write me")
       (ppc-ff-call
        (get-framework-function-pointer ',Name)
        ,@(mapcan #'reverse Parameters)
        ,(or (getf Keywords :output) :void)))
     ;; Export
     (export ',Name)
     ',Name))


(defun EMPTY-ALL-FRAMEWORK-CACHES () "
  Empty all the framework caches."
  ;; current implementation for development only: framework is not unloaded
  (setf *Frameworks-Loaded* (make-hash-table :test #'equal))
  (setf *Framework-Function-Pointers* (make-hash-table)))
   
  


#| Examples:


(framework-function FIND-INPUT-DEVICE ((Usage :signed-fullword))
  :documentation "If device is found return 1 and use it for further queries."
  :output :signed-fullword
  :name "findInputDevice"
  :framework "gameDevices.framework")


|#