working on resource loading

js-assembler/package.rkt

@@ -30,7 +30,8 @@
          get-standalone-code
          write-standalone-code
          get-runtime
-         write-runtime)
+         write-runtime
+         current-on-resource)
 
 
 
@@ -41,6 +42,13 @@
 
 
 
+(define current-on-resource
+  (make-parameter (lambda (r)
+                    (log-debug "Resource ~s should be written"
+                               (resource-path r))
+                    (void))))
+
+
 
 
 (define-struct js-impl (name ;; symbol
@@ -57,13 +65,11 @@
 
 (define (package-anonymous source-code
                            #:should-follow-children? should-follow?
-                           #:output-port op
-                           #:on-resource (on-resource (lambda (r) (void))))
+                           #:output-port op)
   (fprintf op "(function() {\n")
   (package source-code
            #:should-follow-children? should-follow?
-           #:output-port op
-           #:on-resource on-resource)
+           #:output-port op)
   (fprintf op " return invoke; })\n"))
 
 
@@ -210,13 +216,7 @@ MACHINE.modules[~s] =
 ;; load in modules.
 (define (package source-code
                  #:should-follow-children? should-follow?
-                 #:output-port op
-                 #:on-resource (on-resource 
-                                (lambda (r)
-                                  (log-debug "Resource ~s found" 
-                                             (resource-path r))
-                                  (void))))
-  
+                 #:output-port op)
   (define resources (set))
   
   
@@ -283,7 +283,7 @@ MACHINE.modules[~s] =
   (fprintf op "});\n")
   
   (for ([r resources])
-    (on-resource r)))
+    ((current-on-resource) r)))
 
 
 

resource/main.rkt

@@ -1,4 +1,6 @@
 #lang s-exp "../lang/kernel.rkt"
 
-(require "compile-time.rkt")
-(provide (all-from-out "compile-time.rkt"))
+(require "compile-time.rkt"
+         "runtime.rkt")
+(provide (all-from-out "compile-time.rkt"
+                       "runtime.rkt"))

resource/racket-impl.rkt

@@ -0,0 +1,10 @@
+#lang racket/base
+(provide resource->url)
+
+(require "structs.rkt"
+         net/url)
+
+
+
+(define (resource->url r)
+  (path->url (resource-path r)))

resource/runtime.rkt

@@ -0,0 +1,9 @@
+#lang s-exp "../lang/js/js.rkt"
+
+(require "structs.rkt")
+
+(declare-implementation
+ #:racket "racket-impl.rkt"
+ #:javascript ("js-impl.js")
+ #:provided-values (resource->url))
+

whalesong.rkt

@@ -4,8 +4,10 @@
 (require racket/list
          racket/string
          racket/match
+         racket/file
          "make/make-structs.rkt"
          "js-assembler/package.rkt"
+         "resource/structs.rkt"
          "private/command.rkt"
          "logger.rkt"
          "parameters.rkt"
@@ -31,6 +33,9 @@
 
 
 (define current-verbose? (make-parameter #f))
+(define current-resource-dir (make-parameter
+                              (build-path (current-directory) "res")))
+(define current-write-resources? (make-parameter #t))
 
 
 (define (at-toplevel)
@@ -111,12 +116,19 @@
             (regexp-replace #rx"[.](rkt|ss)$"
                             (path->string filename)
                             ".xhtml"))])
+      (parameterize ([current-on-resource
+                      (lambda (r)
+                        (make-directory* (current-resource-dir))
+                        (log-info (format "Writing resource ~s" (resource-path r)))
+                        (copy-file (resource-path r) 
+                                   (build-path (current-resource-dir)
+                                               (resource-key r))))])
         (call-with-output-file* output-filename
                                 (lambda (op)
                                   (package-standalone-xhtml
                                    (make-ModuleSource (build-path f))
                                    op))
-                              #:exists 'replace))))
+                                #:exists 'replace)))))
 
 
 
@@ -135,7 +147,5 @@
            (current-output-port)))
 
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (at-toplevel)