suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

working on the gui

Browse Source
This commit is contained in:
Danny Yoo 2012-05-02 23:08:08 -04:00
parent 88e8ada3e1
commit f7728d74fc
1 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
whalesong-gui.rkt
View File

@ -2,6 +2,9 @@
(require racket/gui/base (require racket/gui/base
racket/class racket/class
racket/path
"parameters.rkt"
"whalesong-helpers.rkt"
framework/gui-utils) framework/gui-utils)
;; A minimal GUI just so that people aren't forced to deal with the command line. ;; A minimal GUI just so that people aren't forced to deal with the command line.
@ -19,26 +22,32 @@
[parent command-panel] [parent command-panel]
[label "Build a package"] [label "Build a package"]
[callback (lambda (button event) [callback (lambda (button event)
(build-dialog))])) (build-dialog))])
(void))
(define NO-FILE-SELECTED "No file selected") (define NO-FILE-SELECTED "No file selected")
(define (build-dialog) (define (build-dialog)
(define dialog (new dialog% [label "Build a package"]))
(define source-path #f) (define source-path #f)
(define dialog (new dialog% [label "Build a Whalesong package"]))
(define file-button (new button% (define file-button (new button%
[parent dialog] [parent dialog]
[label "Choose file to build"] [label "Choose file to build"]
[callback (lambda (button event) [callback (lambda (button event)
(set! source-path (get-file)) (set! source-path (get-file))
(cond (cond
[source-path [source-path
(current-output-dir (path-only source-path))
(send source-path-message set-label (send source-path-message set-label
(gui-utils:quote-literal-label (gui-utils:quote-literal-label
(format "~s selected" (path->string source-path)))) (format "~s selected. Output will be written to ~s."
(send build-button enabled #t)] (path->string source-path)
(path->string (current-output-dir)))))
(send build-button enable #t)]
[else [else
(send source-path-message set-label (send source-path-message set-label
(format NO-FILE-SELECTED source-path)) (format NO-FILE-SELECTED source-path))
@ -47,26 +56,35 @@
[label NO-FILE-SELECTED] [label NO-FILE-SELECTED]
[auto-resize #t])) [auto-resize #t]))
(define build-button (new button% (define build-button (new button%
[parent dialog] [parent dialog]
[label "Build!"] [label "Build!"]
[enabled #f] [enabled #f]
[callback (lambda (button event) [callback (lambda (button event)
(do-the-build! #:source-file source-path))])) (do-the-build source-path))]))
(send dialog show #t)) (define options-panel (new group-box-panel%
[parent dialog]
[label "Options"]))
(define (do-the-build! #:source-file source-file) (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 dialog show #t)
(void)) (void))
(define (do-the-build source-path)
(build-html-and-javascript source-path)
(message-box "Whalesong" "Build complete."))
#;(main)
(build-dialog)
(main)