#lang racket/base (require racket/gui/base racket/class racket/path "parameters.rkt" "whalesong-helpers.rkt" framework/gui-utils) ;; A minimal GUI just so that people aren't forced to deal with the command line. ;; (define (main) (define frame (new frame% [label "Whalesong"])) (send frame show #t) (define command-panel (new horizontal-panel% [parent frame] [alignment '(center center)])) (new button% [parent command-panel] [label "Build a package"] [callback (lambda (button event) (build-frame))]) (void)) (define NO-FILE-SELECTED "No file selected") (define (build-frame) (define source-path #f) (define frame (new frame% [label "Build a Whalesong package"])) (define file-button (new button% [parent frame] [label "Choose .rkt file to build"] [callback (lambda (button event) (set! source-path (get-file)) (cond [source-path (current-output-dir (build-path (path-only source-path) (let-values ([(_1 name _2) (split-path source-path)]) (regexp-replace #px"\\.\\w+$" (path->string name) "")))) (send source-path-message set-label (gui-utils:quote-literal-label (format "~s selected." (path->string source-path)))) (send dest-dir-message set-label (gui-utils:quote-literal-label (format "Output will be written to directory ~s." (path->string (current-output-dir))))) (send build-button enable #t)] [else (send source-path-message set-label NO-FILE-SELECTED) (send build-button enabled #f)]))])) (define source-path-message (new message% [parent frame] [label NO-FILE-SELECTED] [auto-resize #t])) (define dest-dir-message (new message% [parent frame] [label ""] [auto-resize #t])) (define build-button (new button% [parent frame] [label "Build!"] [enabled #f] [callback (lambda (button event) (do-the-build source-path))])) (define options-panel (new group-box-panel% [parent frame] [label "Options"])) (new check-box% [parent options-panel] [label "Compress JavaScript?"] [value (current-compress-javascript?)] [callback (lambda (c e) (current-compress-javascript? (send c get-value)))]) (send frame show #t) (void)) (define (do-the-build source-path) (define f (new frame% [label "Building..."])) (define t (new text% [auto-wrap #f])) (define c (new editor-canvas% [parent f] [editor t])) (send f show #t) (thread (lambda () (parameterize ([current-report-port (open-output-text-editor t)]) (build-html-and-javascript source-path) (fprintf (current-report-port) "Done.\n"))))) #;(main) (build-frame)