Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 60 lines (52 sloc) 2.147 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
#lang racket
(require "button-with-alternatives.rkt"
         racket/gui/base)

;; Defines the Whalesong tool user interface. We add a button
;; with choices to either run the program in the browser, or
;; build a package.


(define (whalesong-tool-ui parent-widget
                           #:label (label "Run Whalesong")
                           #:on-browser (on-browser
                                         (lambda ()
                                           (void)))
                           #:on-build-package (on-build-package
                                               (lambda ()
                                                 (void))))
  (define container (new horizontal-pane%
                         [parent parent-widget]))
  
  (define b
    (new button%
         [label label]
         [callback (lambda (b ce)
                     (define selection
                       (send alternatives get-selection))
                     (cond
                       [(string=? selection "Run in browser")
                        (on-browser)]
                       [(string=? selection "Build smartphone package")
                        (on-build-package)]
                       [else
                        (void)]))]
         [parent container]))
  
  (define alternatives
    (new button-with-alternatives%
         [parent container]
         [choices-thunk (lambda () (list "Run in browser"
                                         "Build smartphone package"))]))
    #;(define ch (new choice%
                  [label ""]
                  [choices (list "Run in browser"
                                 "Build smartphone package")]
                  [style '(horizontal-label)]
                  [parent container]))
  container)


(define (test)
  (define f (new frame% [label "test frame"]))
  (whalesong-tool-ui f
                     #:on-browser
                     (lambda ()
                       (printf "on-browser\n"))
                     
                     #:on-build-package
                     (lambda ()
                       (printf "on-build-package\n")))
  (send f show #t))
Something went wrong with that request. Please try again.