diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index 312a0e5..8fb6896 100644 --- a/js-assembler/package.rkt +++ b/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))) diff --git a/resource/main.rkt b/resource/main.rkt index 8c5c54f..e97d9c9 100644 --- a/resource/main.rkt +++ b/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")) diff --git a/resource/racket-impl.rkt b/resource/racket-impl.rkt new file mode 100644 index 0000000..51a5d51 --- /dev/null +++ b/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))) diff --git a/resource/runtime.rkt b/resource/runtime.rkt new file mode 100644 index 0000000..d2ab8c3 --- /dev/null +++ b/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)) + diff --git a/whalesong.rkt b/whalesong.rkt index ef19026..68ef8b8 100755 --- a/whalesong.rkt +++ b/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"))]) - (call-with-output-file* output-filename - (lambda (op) - (package-standalone-xhtml - (make-ModuleSource (build-path f)) - op)) - #:exists 'replace)))) + (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))))) @@ -135,7 +147,5 @@ (current-output-port))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (at-toplevel)