#lang scheme/base

(require "dynamic-rep.ss"
         scheme/runtime-path
         (for-syntax scheme/base "static-rep.ss"))

(provide (for-syntax posn-interface
                     image-interface
                     event-interface
                     world-interface
                     bigbang-interface)

         posn-module
         image-module
         event-module
         bigbang-module)

(define-runtime-path world-path "world.ss")

(define (W name)
  (dynamic-require world-path name))

(define-for-syntax posn-interface
  (make-interface/static
   #'iposn
   (list (make-sig/static #'make-posn (list #'x #'y))
         (make-sig/static #'posn-x (list #'p))
         (make-sig/static #'posn-y (list #'p))
         (make-sig/static #'posn? (list #'v))
         (make-sig/static #'weak-posn? (list #'v)))))

(define-for-syntax image-interface
  (make-interface/static
   #'iimage
   (list

    ;; Type predicates:
    (make-sig/static #'image? (list #'v))
    (make-sig/static #'mode? (list #'v))
    (make-sig/static #'image-color? (list #'v))
    (make-sig/static #'color? (list #'v))
    (make-sig/static #'font-size? (list #'v))
    (make-sig/static #'bytep (list #'v))

    ;; Color structure:
    (make-sig/static #'make-color (list #'r #'g #'b))
    (make-sig/static #'color-red (list #'c))
    (make-sig/static #'color-green (list #'c))
    (make-sig/static #'color-blue (list #'c))

    ;; Shape constructors:
    (make-sig/static #'rectangle (list #'w #'h #'m #'c))
    (make-sig/static #'circle (list #'r #'m #'c))
    (make-sig/static #'triangle (list #'s #'m #'c))
    (make-sig/static #'star (list #'n #'o #'i #'m #'c))

    ;; Other image constructors:
    (make-sig/static #'text (list #'s #'f #'c))
    (make-sig/static #'line (list #'x #'y #'c))
    (make-sig/static #'empty-scene (list #'w #'h))
    (make-sig/static #'add-line (list #'x1 #'y1 #'x2 #'y2 #'c))
    (make-sig/static #'overlay (list #'a #'b))
    (make-sig/static #'overlay/xy (list #'a #'x #'y #'b))
    (make-sig/static #'place-image (list #'i #'x #'y #'s))

    ;; Image accessors / operators:
    (make-sig/static #'image-width (list #'i))
    (make-sig/static #'image-height (list #'i))
    (make-sig/static #'put-pinhole (list #'i #'x #'y))
    (make-sig/static #'move-pinhole (list #'i #'x #'y))
    (make-sig/static #'pinhole-x (list #'i))
    (make-sig/static #'pinhole-y (list #'i))
    (make-sig/static #'image-inside? (list #'a #'b))
    (make-sig/static #'find-image (list #'a #'b))
    (make-sig/static #'image->color-list (list #'i))
    (make-sig/static #'color-list->image (list #'l #'w #'h #'x #'y))

    )))

(define-for-syntax event-interface
  (make-interface/static
   #'ievent
   (list (make-sig/static #'key-eventp (list #'v))
         (make-sig/static #'mouse-eventp (list #'v)))))

(define-for-syntax world-interface
  (make-interface/static
   #'iworld
   (list (make-sig/static #'handle-tick (list #'w))
         (make-sig/static #'handle-key (list #'w #'k))
         (make-sig/static #'handle-mouse (list #'w #'x #'y #'m))
         (make-sig/static #'render (list #'w))
         (make-sig/static #'done (list #'w))
         (make-sig/static #'tick-rate (list))
         (make-sig/static #'render-width (list))
         (make-sig/static #'render-height (list))
         (make-sig/static #'initial-world (list)))))

(define-for-syntax bigbang-interface
  (make-interface/static
   #'ibigbang
   (list (make-sig/static #'big-bang (list)))))

(define posn-module
  (make-module/dynamic
   (lambda (imports)
     (define exports (empty-interface/dynamic))
     (interface/dynamic-put-function! exports 'make-posn (W 'make-posn))
     (interface/dynamic-put-function! exports 'posn-x (W 'posn-x))
     (interface/dynamic-put-function! exports 'posn-y (W 'posn-y))
     (interface/dynamic-put-function! exports 'posn? (W 'posn?))
     (interface/dynamic-put-function! exports 'weak-posn? (W 'weak-posn?))
     (interface/dynamic-join exports imports))))

(define image-module
  (make-module/dynamic
   (lambda (imports)
     (define exports (empty-interface/dynamic))

     ;; Type predicates:
     (interface/dynamic-put-function! exports 'image? (W 'image?))
     (interface/dynamic-put-function! exports 'mode? (W 'mode?))
     (interface/dynamic-put-function! exports 'image-color? (W 'image-color?))
     (interface/dynamic-put-function! exports 'color? (W 'color?))
     (interface/dynamic-put-function! exports 'font-size? (W 'font-size?))
     (interface/dynamic-put-function! exports 'bytep (W 'bytep))

     ;; Color structure:
     (interface/dynamic-put-function! exports 'make-color (W 'make-color))
     (interface/dynamic-put-function! exports 'color-red (W 'color-red))
     (interface/dynamic-put-function! exports 'color-green (W 'color-green))
     (interface/dynamic-put-function! exports 'color-blue (W 'color-blue))

     ;; Shape constructors:
     (interface/dynamic-put-function! exports 'rectangle (W 'rectangle))
     (interface/dynamic-put-function! exports 'circle (W 'circle))
     (interface/dynamic-put-function! exports 'triangle (W 'triangle))
     (interface/dynamic-put-function! exports 'star (W 'star))

     ;; Other image constructors:
     (interface/dynamic-put-function! exports 'text (W 'text))
     (interface/dynamic-put-function! exports 'line (W 'line))
     (interface/dynamic-put-function! exports 'empty-scene (W 'empty-scene))
     (interface/dynamic-put-function! exports 'add-line (W 'add-line))
     (interface/dynamic-put-function! exports 'overlay (W 'overlay))
     (interface/dynamic-put-function! exports 'overlay/xy (W 'overlay/xy))
     (interface/dynamic-put-function! exports 'place-image (W 'place-image))

     ;; Image accessors / operators:
     (interface/dynamic-put-function! exports 'image-width (W 'image-width))
     (interface/dynamic-put-function! exports 'image-height (W 'image-height))
     (interface/dynamic-put-function! exports 'put-pinhole (W 'put-pinhole))
     (interface/dynamic-put-function! exports 'move-pinhole (W 'move-pinhole))
     (interface/dynamic-put-function! exports 'pinhole-x (W 'pinhole-x))
     (interface/dynamic-put-function! exports 'pinhole-y (W 'pinhole-y))
     (interface/dynamic-put-function! exports 'image-inside? (W 'image-inside?))
     (interface/dynamic-put-function! exports 'find-image (W 'find-image))
     (interface/dynamic-put-function! exports 'image->color-list (W 'image->color-list))
     (interface/dynamic-put-function! exports 'color-list->image (W 'color-list->image))

     (interface/dynamic-join exports imports))))

(define event-module
  (make-module/dynamic
   (lambda (imports)
     (define exports (empty-interface/dynamic))
     (interface/dynamic-put-function! exports 'key-eventp (W 'key-eventp))
     (interface/dynamic-put-function! exports 'mouse-eventp (W 'mouse-eventp))
     (interface/dynamic-join exports imports))))

(define bigbang-module
  (make-module/dynamic
   (lambda (imports)
     (define exports (empty-interface/dynamic))
     (define handle-tick (interface/dynamic-get-function imports 'handle-tick))
     (define handle-key (interface/dynamic-get-function imports 'handle-key))
     (define handle-mouse (interface/dynamic-get-function imports 'handle-mouse))
     (define render (interface/dynamic-get-function imports 'render))
     (define done (interface/dynamic-get-function imports 'done))
     (define tick-rate (interface/dynamic-get-function imports 'tick-rate))
     (define render-width (interface/dynamic-get-function imports 'render-width))
     (define render-height (interface/dynamic-get-function imports 'render-height))
     (define initial-world (interface/dynamic-get-function imports 'initial-world))
     (define (big-bang)
       ((W 'big-bang) (render-width) (render-height) (tick-rate) (initial-world))
       ((W 'on-tick-event) handle-tick)
       ((W 'on-key-event) handle-key)
       ((W 'on-mouse-event) handle-mouse)
       ((W 'on-redraw) render)
       ((W 'stop-when) done)
       't)
     (interface/dynamic-put-function! exports 'big-bang big-bang)
     (interface/dynamic-join exports imports))))