#lang s-exp "lang.ss"

;; Hardcoded modules known by Moby.

;; FIXME: these bindings should not be hardcoded here; a module should be self-describing
;; in terms of what bindings it provides.


(require "env.ss")
(require "../runtime/permission.ss")

(define-struct module-binding (name source bindings))




(define world-effects-module 
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))
          
          (define module-path 
            "moby/world-effects")]
    (make-module-binding 'world-effects
                         module-path
                         (list (bf 'make-effect:none module-path 0
                                   false 
                                   "make_dash_effect_colon_none")
                               (bf 'make-effect:beep module-path 0
                                   false 
                                   "make_dash_effect_colon_beep")
                               (bf 'make-effect:play-dtmf-tone module-path 2
                                   false 
                                   "make_dash_effect_colon_play_dash_dtmf_dash_tone")
                               (make-binding:function 
                                'make-effect:send-sms module-path 2 false 
                                "make_dash_effect_colon_send_dash_sms"
                                (list PERMISSION:SEND-SMS)
                                false)                               
                               (make-binding:function
                                'make-effect:play-sound
                                module-path
                                1
                                false 
                                "make_dash_effect_colon_play_dash_sound"
                                (list PERMISSION:INTERNET)
                                false)
                               (bf 'make-effect:stop-sound module-path 1
                                   false 
                                   "make_dash_effect_colon_stop_dash_sound")
                               (bf 'make-effect:pause-sound module-path 1
                                   false
                                   "make_dash_effect_colon_pause_dash_sound")
                               (bf 'make-effect:set-sound-volume module-path 1
                                   false 
                                   "make_dash_effect_colon_set_dash_sound_dash_volume")
                               (bf 'make-effect:raise-sound-volume module-path 0
                                   false
                                   "make_dash_effect_colon_raise_dash_sound_dash_volume")
                               (bf 'make-effect:lower-sound-volume module-path 0
                                   false 
                                   "make_dash_effect_colon_lower_dash_sound_dash_volume")
                               
                               (make-binding:function 'make-effect:set-wake-lock module-path 1
                                   false "make_dash_effect_colon_set_dash_wake_dash_lock" 
                                   (list PERMISSION:WAKE-LOCK) 
                                   false)
                               (make-binding:function
                                'make-effect:release-wake-lock
                                module-path
                                0
                                false "make_dash_effect_colon_release_dash_wake_dash_lock"
                                (list PERMISSION:WAKE-LOCK)
                                false)
                               (bf 'make-effect:pick-playlist module-path 1 false
                                   "make_dash_effect_colon_pick_dash_playlist")
                               (bf 'make-effect:pick-random module-path 2 false
                                   "make_dash_effect_colon_pick_dash_random")
                               ))))


(define world-handlers-module 
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))
          (define module-path 
            "moby/world-handlers")]
    (make-module-binding 'world-config
                         module-path
                         (list (bf 'on-tick module-path 2 false "plt.world.config.Kernel.onTick")
                               (bf 'on-tick! module-path 3 false "plt.world.config.Kernel.onTick_star_")
                               (bf 'on-mouse module-path 1 false "plt.world.config.Kernel.onMouse")
                               (bf 'on-mouse! module-path 2 false "plt.world.config.Kernel.onMouse_star_")
                               

			       (bf 'initial-effect module-path 1 false "plt.world.config.Kernel.initialEffect")

                               (bf 'on-key module-path 1 false "plt.world.config.Kernel.onKey")
                               (bf 'on-key! module-path 2 false "plt.world.config.Kernel.onKey_star_")

                               (bf 'on-announce module-path 1 false "plt.world.config.Kernel.onAnnounce")
                               (bf 'on-announce! module-path 2 false "plt.world.config.Kernel.onAnnounce_star_")

                               (make-binding:function
                                'on-location-change module-path 1 false
                                "plt.world.config.Kernel.onLocationChange"
                                (list PERMISSION:LOCATION)
                                false)
                               (make-binding:function
                                'on-location-change! module-path 2 false
                                "plt.world.config.Kernel.onLocationChange_star_"
                                (list PERMISSION:LOCATION)
                                false)
                               
                               (make-binding:function
                                'on-tilt module-path 1 false
                                "plt.world.config.Kernel.onTilt"
                                (list PERMISSION:TILT)
                                false)
                               (make-binding:function
                                'on-tilt! module-path 2 false
                                "plt.world.config.Kernel.onTilt_star_"
                                (list PERMISSION:TILT)
                                false)
                               
                               (make-binding:function
                                'on-acceleration module-path 1 false
                                "plt.world.config.Kernel.onAcceleration"
                                (list PERMISSION:TILT)
                                false)
                               
                               (make-binding:function
                                'on-acceleration! module-path 2 false
                                "plt.world.config.Kernel.onAcceleration_star_"
                                (list PERMISSION:TILT)
                                false)
                               
                               (make-binding:function
                                'on-shake module-path 1 false
                                "plt.world.config.Kernel.onShake"
                                (list PERMISSION:SHAKE)
                                false)
                               
                               (make-binding:function
                                'on-shake! module-path 2 false
                                "plt.world.config.Kernel.onShake_star_"
                                (list PERMISSION:SHAKE)
                                false)
                               
                               ;; old style
                               (bf 'on-redraw module-path 1 false "plt.world.config.Kernel.onRedraw")
                               
                               ;; Supports both draw and css
                               (bf 'on-draw module-path 2 false "plt.world.config.Kernel.onDraw")
                               
                               (bf 'stop-when module-path 1 false "plt.world.config.Kernel.stopWhen")))))





(define (make-world-module module-path)
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))]
    (make-module-binding 'world
                       module-path
                       (append (module-binding-bindings world-handlers-module)
                               (module-binding-bindings world-effects-module)
                               (list (bf 'big-bang module-path 3 true "plt.world.Kernel.bigBang")

				     ;; Images
				     (bf 'image? module-path 1 false "plt.world.Kernel.isImage")
				     (bf 'image=? module-path 2 false "plt.world.Kernel.image_equal__question__")

				     (bf 'make-color module-path 3 false "plt.world.Kernel.make_dash_color")

                                     (bf 'empty-scene module-path 2 false
                                         "plt.world.Kernel.emptyScene")
                                     (bf 'place-image module-path 4 false
                                         "plt.world.Kernel.placeImage")
                                     
                                     (bf 'put-pinhole module-path 3 false
                                         "plt.world.Kernel.put_dash_pinhole")

                                     (bf 'circle module-path 3 false
                                         "plt.world.Kernel.circle")
                                     
                                     (bf 'star module-path 5 false
                                         "plt.world.Kernel.star")

                                     (bf 'nw:rectangle module-path 4 false
                                         "plt.world.Kernel.nwRectangle")
                                     (bf 'rectangle module-path 4 false
                                         "plt.world.Kernel.rectangle")
                                     (bf 'triangle module-path 3 false
                                         "plt.world.Kernel.triangle")
                                     (bf 'ellipse module-path 4 false
                                         "plt.world.Kernel.ellipse")
                                     (bf 'line module-path 3 false
                                         "plt.world.Kernel.line")
                                     
				     (bf 'overlay module-path 2 true
					 "plt.world.Kernel.overlay")
				     (bf 'overlay/xy module-path 4 false
					 "plt.world.Kernel.overlay_slash_xy")

                                     (bf 'key=? module-path 2 false
                                         "plt.world.Kernel.isKeyEqual")
                                     (bf 'text module-path 3 false
                                         "plt.world.Kernel.text")
				     (bf 'open-image-url module-path 1 false
                                         "plt.world.Kernel.openImageUrl")
                                     (bf 'image-width module-path 1 false
                                         "plt.world.Kernel.imageWidth")
                                     (bf 'image-height module-path 1 false
                                         "plt.world.Kernel.imageHeight")
                                     (bf 'image-rotate module-path 2 false
                                         "plt.world.Kernel.imageRotate")
                                     
                                     )))))


;; world teachpack bindings
(define world-module 
  (local [(define module-path
            "moby/world")]
    (make-world-module module-path)))


;; Alternative world teachpack bindings
(define world-stub-module
  (local [(define module-path                       
            "moby/world")]
    (make-world-module module-path)))


;; Bootstrap bindings
(define bootstrap-teachpack
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))
          (define module-path
            "moby/bootstrap-teachpack")
          (define js-module-path
            "plt._MODULES['bootstrap-teachpack.js']")
          ]
    (make-module-binding 'world
                         module-path
                         (append 
                          (list 
                           (bf 'START module-path 14 false (string-append js-module-path ".EXPORTS['START']"))
                           (make-binding:constant 'test-frame 
                                                  (string-append js-module-path ".EXPORTS['test-frame']")
                                                  empty)
                           (bf 'sq module-path 1 false (string-append js-module-path ".EXPORTS['sq']"))
                           (bf 'sine module-path 1 false (string-append js-module-path ".EXPORTS['sine']"))
                           (bf 'cosine module-path 1 false (string-append js-module-path ".EXPORTS['cosine']"))
                           (bf 'tangent module-path 1 false (string-append js-module-path ".EXPORTS['tangent']")))
                           (module-binding-bindings world-stub-module)))))

;; Cage teachpack
(define cage-teachpack
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))
          (define module-path
            "moby/cage-teachpack")
          (define js-module-path
            "plt._MODULES['cage-teachpack.js']")
          ]
    (make-module-binding 'world
                         module-path
                         (append 
                          (list 
                           (bf 'start module-path 1 false (string-append js-module-path ".EXPORTS['start']")))))))

;; Function teachpack
(define function-teachpack
  (local [;; bf: symbol path number boolean string -> binding:function
          ;; Helper function.
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string empty false))
          (define module-path
            "moby/function-teachpack")
          (define js-module-path
            "plt._MODULES['function-teachpack.js']")
          ]
    (make-module-binding 'world
                         module-path
                         (append 
                          (list 
                           (bf 'start module-path 1 false (string-append js-module-path ".EXPORTS['start']")))))))





;; location library
(define location-module 
  (local [(define module-path
            "moby/geolocation")
          
          (define (bf name module-path arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string 
                                   (list PERMISSION:LOCATION)
                                   false))]
    (make-module-binding 'location
                         module-path
                         (list (bf 'get-latitude module-path 0 false 
                                   "plt.lib.Location.getLatitude")
                               (bf 'get-longitude module-path 0 false 
                                   "plt.lib.Location.getLongitude")
                               (bf 'get-altitude module-path 0 false 
                                   "plt.lib.Location.getAltitude")
                               (bf 'get-bearing module-path 0 false 
                                   "plt.lib.Location.getBearing")
                               (bf 'get-speed module-path 0 false 
                                   "plt.lib.Location.getSpeed")
                               (bf 'location-distance module-path 4 false
                                   "plt.lib.Location.getDistanceBetween")))))


;; accelerometer library
(define tilt-module 
  (local [(define module-path 
            "moby/tilt")
          
          (define (bf name arity vararity? java-string)
            (make-binding:function name module-path arity vararity? java-string
                                   (list PERMISSION:TILT)
                                   true))]
    (make-module-binding 'tilt
                         module-path
                         (list (bf 'get-x-acceleration 0 false 
                                   "plt.lib.Tilt.getXAcceleration")
                               (bf 'get-y-acceleration 0 false 
                                   "plt.lib.Tilt.getYAcceleration")
                               (bf 'get-z-acceleration 0 false 
                                   "plt.lib.Location.getZAcceleration")
                               
                               (bf 'get-azimuth 0 false 
                                   "plt.lib.Tilt.getAzimuth")
                               (bf 'get-pitch 0 false 
                                   "plt.lib.Tilt.getPitch")
                               (bf 'get-roll 0 false 
                                   "plt.lib.Tilt.getRoll")))))





(define telephony-module
  (local [(define module-path
            "moby/telephony")]

    (make-module-binding 'telephony
                         module-path
                         (list (make-binding:function 'get-signal-strengths
                                                      module-path 
                                                      0 
                                                      false 
                                                      "plt.lib.Telephony.getSignalStrengths"
                                                      (list PERMISSION:TELEPHONY)
                                                      false)))))





(define net-module
  (local [(define module-path
            "moby/net")]

    (make-module-binding 'net
                         module-path
                         (list (make-binding:function 'get-url
                                                      module-path 
                                                      1 
                                                      false 
                                                      "plt.lib.Net.getUrl"
                                                      (list PERMISSION:INTERNET)
                                                      false)))))

(define parser-module
  (local [(define module-path
            "moby/parser")]

    (make-module-binding 'parser
                         module-path
                         (list (make-binding:function 'xml->s-exp
                                                      module-path 
                                                      1 
                                                      false 
                                                      "plt.lib.Parser.parseXml"
                                                      empty
                                                      false)
                               #;(make-binding:function 'split-whitespace
	                                                      module-path
        	                                              1
                	                                      false
                        	                              "plt.lib.Parser.splitWhitespace"
                                	                      empty
                                        	              false)))))

(define jsworld-module
  (local [(define module-path
            "moby/jsworld")

          (define (bf name arity java-string)
            (make-binding:function name module-path arity true java-string empty false))]
    (make-module-binding 'jsworld
                         module-path
                         (list (make-binding:function 
                                'js-big-bang
                                module-path
                                1
                                true
                                "plt.world.MobyJsworld.bigBang"
                                empty
                                false)
                               (make-binding:function 'js-text 
                                                      module-path 
                                                      1 
                                                      false 
                                                      "plt.world.MobyJsworld.text"
                                                      empty
                                                      false)
                               
                               
                               ;; Each of these functions can take an optional
                               ;; (sexpof css-style) argument.

                               (bf 'js-div 0 "plt.world.MobyJsworld.div")
                               (bf 'js-p 0 "plt.world.MobyJsworld.p")
                               (bf 'js-button 1 "plt.world.MobyJsworld.button")
                               (bf 'js-button! 2 "plt.world.MobyJsworld.buttonStar")
                               (bf 'js-input 2 "plt.world.MobyJsworld.input")
			       (make-binding:function 'js-img module-path 1 true 
						      "plt.world.MobyJsworld.img"
						      (list PERMISSION:INTERNET) 
						      false)
                               (bf 'js-node 1 "plt.world.MobyJsworld.rawNode")
			       (bf 'js-select 2 "plt.world.MobyJsworld.select")))))
  


;; The default bindings for moby will include
;; stuff from regular world
;; stuff from jsworld
(define moby-module-binding
  (make-module-binding 'moby
                       "moby/moby"
                       (append 
                        (module-binding-bindings world-stub-module)
                        (module-binding-bindings jsworld-module)
                        (module-binding-bindings telephony-module)
                        (module-binding-bindings location-module)
			(module-binding-bindings net-module))))

                               
                               

;; extend-env/module-binding: env module-binding -> env
;; Extends an environment with the bindings associated to a module.
(define (extend-env/module-binding an-env a-module-binding)
  (local [(define (loop an-env contents)
            (cond
              [(empty? contents)
               an-env]
              [else
               (loop (env-extend an-env (first contents))
                     (rest contents))]))]
    (loop an-env (module-binding-bindings a-module-binding))))



(define known-modules (list world-module
                            world-stub-module
                            location-module
                            tilt-module
                            net-module
                            parser-module
                            bootstrap-teachpack
			    function-teachpack
			    cage-teachpack
                            telephony-module
                            moby-module-binding))



(provide/contract [struct module-binding ([name symbol?]
                                          [source string?]
                                          [bindings (listof binding?)])]
                  [extend-env/module-binding 
                   (env? module-binding? . -> . env?)]
                  [known-modules (listof module-binding?)]
                  [moby-module-binding module-binding?])