v5.4.99.1, executable-yield-handler', and make-bitmap' etc.

collects/2htdp/private/image-more.rkt

@@ -617,11 +617,11 @@
        (rotated-rectangular-bounding-box w h (text-angle atomic-shape)))]
     [(flip? atomic-shape)
      (let* ([bitmap (flip-shape atomic-shape)]
-            [bb (bitmap-raw-bitmap bitmap)])
+            [bb (ibitmap-raw-bitmap bitmap)])
        (let-values ([(l t r b)
-                     (rotated-rectangular-bounding-box (* (send bb get-width) (bitmap-x-scale bitmap))
+                     (rotated-rectangular-bounding-box (* (send bb get-width) (ibitmap-x-scale bitmap))
-                                                       (* (send bb get-height) (bitmap-y-scale bitmap))
+                                                       (* (send bb get-height) (ibitmap-y-scale bitmap))
-                                                       (bitmap-angle bitmap))])
+                                                       (ibitmap-angle bitmap))])
          (values l t r b)))]
     [else
      (fprintf (current-error-port) "using bad bounding box for ~s\n" atomic-shape)
@@ -707,14 +707,14 @@
      (let ([bitmap (flip-shape atomic-shape)]
            [flipped? (flip-flipped? atomic-shape)])
        (make-flip flipped?
-                  (make-bitmap (bitmap-raw-bitmap bitmap)
+                  (make-bitmap (ibitmap-raw-bitmap bitmap)
-                               (bitmap-raw-mask bitmap)
+                               (ibitmap-raw-mask bitmap)
                                (bring-between (if flipped? 
-                                                  (+ (bitmap-angle bitmap) θ)
+                                                  (+ (ibitmap-angle bitmap) θ)
-                                                  (- (bitmap-angle bitmap) θ))
+                                                  (- (ibitmap-angle bitmap) θ))
                                               360)
-                               (bitmap-x-scale bitmap)
+                               (ibitmap-x-scale bitmap)
-                               (bitmap-y-scale bitmap)
+                               (ibitmap-y-scale bitmap)
                                (make-hash))))]))
 
 ;; rotate-point : point angle -> point

collects/frtime/frp-snip.rkt

@@ -15,7 +15,7 @@
                   any-nested-reactivity? raise-reactivity)
          
          ;; GRacket require
-         (except-in mred send-event))
+         mred)
 
 (define drs-eventspace #f)
 

collects/frtime/scribblings/frtime.scrbl

@@ -2,7 +2,7 @@
 @(require scribble/manual
   (for-label scheme
     scheme/class
-    (except-in scheme/gui/base send-event)
+    scheme/gui/base
     (only-in frtime 
              undefined undefined? behavior? event? signal? seconds milliseconds never-e
 	     new-cell set-cell! event-receiver send-event

collects/mred/mred-sig.rkt

@@ -118,11 +118,13 @@ label->plain-label
 labelled-menu-item<%>
 list-box%
 list-control<%>
+make-bitmap
 make-eventspace
+make-gl-bitmap
 make-gui-empty-namespace
 make-gui-namespace
+make-monochrome-bitmap
 make-screen-bitmap
-make-gl-bitmap
 map-command-as-meta-key
 menu%
 menu-bar%
@@ -156,6 +158,7 @@ put-file
 queue-callback
 radio-box%
 readable-snip<%>
+read-bitmap
 read-editor-global-footer
 read-editor-global-header
 read-editor-version

collects/mred/mred.rkt

@@ -102,6 +102,9 @@
 	     begin-busy-cursor
 	     bell
 	     bitmap%
+             make-bitmap
+             read-bitmap
+             make-monochrome-bitmap
 	     brush%
 	     brush-list%
 	     editor-data%

collects/mred/private/gdi.rkt

@@ -8,7 +8,8 @@
 	   "wx.ss"
            "te.rkt"
 	   "mrtop.ss"
-	   "mrcanvas.ss")
+	   "mrcanvas.ss"
+           "syntax.rkt")
 
   (provide register-collecting-blit
 	   unregister-collecting-blit

collects/mred/private/wx/cocoa/queue.rkt

@@ -54,9 +54,23 @@
 
 (tellv app finishLaunching)
 
+;; In case we were started in an executable without a bundle,
+;; explicitly register with the dock so the application can receive
+;; keyboard events.
+;; This technique is not sanctioned by Apple --- I found the code in SDL.
+(define-cstruct _CPSProcessSerNum ([lo _uint32] [hi _uint32]))
+(define-appserv CPSGetCurrentProcess (_fun _CPSProcessSerNum-pointer -> _int)
+  #:fail (lambda () (lambda args 1)))
+(define-appserv CPSEnableForegroundOperation (_fun _CPSProcessSerNum-pointer _int _int _int _int -> _int)
+  #:fail (lambda () #f))
+(let ([psn (make-CPSProcessSerNum 0 0)])
+  (when (zero? (CPSGetCurrentProcess psn))
+    (void (CPSEnableForegroundOperation psn #x03 #x3C #x2C #x1103))))
+
 (define app-delegate (tell (tell MyApplicationDelegate alloc) init))
 (tellv app setDelegate: app-delegate)
-(tellv app activateIgnoringOtherApps: #:type _BOOL #t)
+(unless (scheme_register_process_global "Racket-GUI-no-front" #f)
+  (tellv app activateIgnoringOtherApps: #:type _BOOL #t))
 
 ;; For some reason, nextEventMatchingMask:... gets stuck if the
 ;;  display changes, and it doesn't even send the 

collects/mred/private/wx/common/queue.rkt

@@ -498,3 +498,12 @@
          (send e set-wait-cursor-mode #f))))))
 
 (define (is-busy?) (positive? (eventspace-wait-cursor-count (current-eventspace))))
+
+;; ----------------------------------------
+
+;; Before exiting, wait until frames are closed, etc.:
+(executable-yield-handler
+ (let ([old-eyh (executable-yield-handler)])
+   (lambda (v)
+     (yield main-eventspace)
+     (old-eyh v))))

collects/mred/private/wxme/snip.rkt

@@ -1023,10 +1023,7 @@
               (send f jump-to end)))))))
   
   (def/public (load-file [(make-or-false path-string?) [name #f]]
-                         [(symbol-in unknown unknown/mask gif gif/mask
+                         [image-type? [kind 'unknown]]
-                                     jpeg png png/mask
-                                     xbm xpm bmp pict)
-                          [kind 'unknown]]
                          [bool? [rel-path? #f]]
                          [bool? [inline? #t]])
     (do-set-bitmap #f #f #f)

collects/mrlib/image-core.rkt

@@ -117,10 +117,10 @@ has been moved out).
 ;;  - flip
 
 ;; a bitmap is:
-;;  - (make-bitmap (is-a?/c bitmap%) angle positive-real 
+;;  - (make-ibitmap (is-a?/c bitmap%) angle positive-real 
-;;                 hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle]) -o> (cons (is-a?/c bitmap%) (is-a?/c bitmap%)])
+;;                  hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle]) -o> (cons (is-a?/c bitmap%) (is-a?/c bitmap%)])
 ;;    NOTE: bitmap copying needs to happen in 'write' and 'read' methods
-(define-struct/reg-mk bitmap (raw-bitmap raw-mask angle x-scale y-scale cache)
+(define-struct/reg-mk ibitmap #:reflect-id bitmap (raw-bitmap raw-mask angle x-scale y-scale cache)
   #:omit-define-syntaxes #:transparent
   #:property prop:custom-write (λ (x y z) (bitmap-write x y z)))
 
@@ -404,7 +404,7 @@ has been moved out).
   (or (polygon? shape)
       (line-segment? shape)
       (curve-segment? shape)
-      (bitmap? shape)
+      (ibitmap? shape)
       (np-atomic-shape? shape)))
 
 (define (np-atomic-shape? shape)
@@ -412,7 +412,7 @@ has been moved out).
       (text? shape)
       (and (flip? shape)
            (boolean? (flip-flipped? shape))
-           (bitmap? (flip-shape shape)))))
+           (ibitmap? (flip-shape shape)))))
 
 ;; normalize-shape : shape -> normalized-shape
 ;; normalizes 'shape', calling 'f' on each atomic shape in the normalized shape.
@@ -490,8 +490,8 @@ has been moved out).
          (if bottom
              (make-overlay bottom this-one)
              this-one))]
-      [(or (bitmap? shape) (np-atomic-shape? shape))
+      [(or (ibitmap? shape) (np-atomic-shape? shape))
-       (let ([shape (if (bitmap? shape) 
+       (let ([shape (if (ibitmap? shape) 
                         (make-flip #f shape)
                         shape)])
          (let ([this-one 
@@ -532,12 +532,12 @@ has been moved out).
        [else
         (let ([bitmap (flip-shape shape)])
           (make-flip (flip-flipped? shape)
-                     (make-bitmap (bitmap-raw-bitmap bitmap)
+                     (make-ibitmap (ibitmap-raw-bitmap bitmap)
-                                  (bitmap-raw-mask bitmap)
+                                   (ibitmap-raw-mask bitmap)
-                                  (bitmap-angle bitmap)
+                                   (ibitmap-angle bitmap)
-                                  (* x-scale (bitmap-x-scale bitmap))
+                                   (* x-scale (ibitmap-x-scale bitmap))
-                                  (* y-scale (bitmap-y-scale bitmap))
+                                   (* y-scale (ibitmap-y-scale bitmap))
-                                  (bitmap-cache bitmap))))])]))
+                                   (ibitmap-cache bitmap))))])]))
 
 (define (scale-color color x-scale y-scale)
   (cond
@@ -875,34 +875,34 @@ the mask bitmap and the original bitmap are all together in a single bytes!
 (define (get-rendered-bitmap flip-bitmap)
   (let ([key (get-bitmap-cache-key flip-bitmap)])
     (calc-rendered-bitmap flip-bitmap key)
-    (car (hash-ref (bitmap-cache (flip-shape flip-bitmap))
+    (car (hash-ref (ibitmap-cache (flip-shape flip-bitmap))
                    key))))
 
 (define (get-rendered-mask flip-bitmap)
   (let ([key (get-bitmap-cache-key flip-bitmap)])
     (calc-rendered-bitmap flip-bitmap key)
-    (cdr (hash-ref (bitmap-cache (flip-shape flip-bitmap))
+    (cdr (hash-ref (ibitmap-cache (flip-shape flip-bitmap))
                    key))))
 
 (define (get-bitmap-cache-key flip-bitmap)
   (let ([bm (flip-shape flip-bitmap)])
     (list (flip-flipped? flip-bitmap)
-          (bitmap-x-scale bm)
+          (ibitmap-x-scale bm)
-          (bitmap-y-scale bm)
+          (ibitmap-y-scale bm)
-          (bitmap-angle bm))))
+          (ibitmap-angle bm))))
 
 (define (calc-rendered-bitmap flip-bitmap key)
   (let ([bitmap (flip-shape flip-bitmap)])
     (cond
-      [(hash-ref (bitmap-cache bitmap) key #f) => (λ (x) x)]
+      [(hash-ref (ibitmap-cache bitmap) key #f) => (λ (x) x)]
       [else
        (let ([flipped? (flip-flipped? flip-bitmap)])
-         (define-values (orig-bitmap-obj orig-mask-obj) (values (bitmap-raw-bitmap bitmap)
+         (define-values (orig-bitmap-obj orig-mask-obj) (values (ibitmap-raw-bitmap bitmap)
-                                                                (bitmap-raw-mask bitmap)))
+                                                                (ibitmap-raw-mask bitmap)))
          (define-values (bitmap-obj mask-obj)
            (cond
-             [(<= (* (bitmap-x-scale bitmap) 
+             [(<= (* (ibitmap-x-scale bitmap) 
-                     (bitmap-y-scale bitmap))
+                     (ibitmap-y-scale bitmap))
                   1)
               ;; since we prefer to rotate big things, we rotate first
               (let-values ([(bitmap-obj mask-obj) (do-rotate bitmap orig-bitmap-obj orig-mask-obj flipped?)])
@@ -912,16 +912,16 @@ the mask bitmap and the original bitmap are all together in a single bytes!
               (let-values ([(bitmap-obj mask-obj) (do-scale bitmap orig-bitmap-obj orig-mask-obj)])
                 (do-rotate bitmap bitmap-obj mask-obj flipped?))]))
          (define pair (cons bitmap-obj mask-obj))
-         (hash-set! (bitmap-cache bitmap) key pair)
+         (hash-set! (ibitmap-cache bitmap) key pair)
          pair)])))
 
 (define (do-rotate bitmap bitmap-obj mask-obj flip?)
   (cond
-    [(and (not flip?) (zero? (bitmap-angle bitmap)))
+    [(and (not flip?) (zero? (ibitmap-angle bitmap)))
      ;; don't rotate anything in this case.
      (values bitmap-obj mask-obj)]
     [else
-     (let ([θ (degrees->radians (bitmap-angle bitmap))])
+     (let ([θ (degrees->radians (ibitmap-angle bitmap))])
        (let-values ([(bytes w h) (bitmap->bytes bitmap-obj mask-obj)])
          (let-values ([(rotated-bytes rotated-w rotated-h)
                        (rotate-bytes bytes w h θ)])
@@ -933,8 +933,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
              (values bm mask)))))]))
 
 (define (do-scale bitmap orig-bm orig-mask)
-  (let ([x-scale (bitmap-x-scale bitmap)]
+  (let ([x-scale (ibitmap-x-scale bitmap)]
-        [y-scale (bitmap-y-scale bitmap)])
+        [y-scale (ibitmap-y-scale bitmap)])
     (cond
       [(and (= 1 x-scale) (= 1 y-scale))
        ;; no need to scale in this case
@@ -1081,7 +1081,7 @@ the mask bitmap and the original bitmap are all together in a single bytes!
         [h (send bm get-height)])
     (make-image (make-translate (/ w 2)
                                 (/ h 2)
-                                (make-bitmap bm mask-bm 0 1 1 (make-hash)))
+                                (make-ibitmap bm mask-bm 0 1 1 (make-hash)))
                 (make-bb w h h)
                 #f)))
 
@@ -1125,8 +1125,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
          curve-segment-color
          make-pen pen? pen-color pen-width pen-style pen-cap pen-join pen
          
-         make-bitmap bitmap? bitmap-raw-bitmap bitmap-raw-mask bitmap-angle bitmap-x-scale bitmap-y-scale 
+         make-ibitmap ibitmap? ibitmap-raw-bitmap ibitmap-raw-mask ibitmap-angle ibitmap-x-scale ibitmap-y-scale 
-         bitmap-cache
+         ibitmap-cache
 
          make-flip flip? flip-flipped? flip-shape
          

collects/mrlib/private/regmk.rkt

@@ -10,14 +10,15 @@
 
 (define-syntax (define-struct/reg-mk stx)
   (syntax-case stx ()
-    [(_ id . rest)
+    [(_ id #:reflect-id reflect-id rest ...)
      (let ([build-name
-            (λ (fmt)
+            (λ (fmt id)
-              (datum->syntax #'id (string->symbol (format fmt (syntax->datum #'id)))))])
+              (datum->syntax id (string->symbol (format fmt (syntax->datum id)))))])
        #`(begin
-           (define-struct id . rest)
+           (define-struct id rest ... #:reflection-name 'reflect-id)
-           (add-id-constructor-pair '#,(build-name "struct:~a")
+           (add-id-constructor-pair '#,(build-name "struct:~a" #'reflect-id)
-                                    #,(build-name "make-~a"))))]))
+                                    #,(build-name "make-~a" #'id))))]
+    [(_ id . rest) #'(define-struct/reg-mk id #:reflect-id id . rest)]))
 
 (define (id->constructor id)
   (let ([line (assoc id id-constructor-pairs)])

collects/racket/draw.rkt

@@ -23,7 +23,6 @@
          pen% pen-list% the-pen-list
          brush% brush-list% the-brush-list
          region%
-         bitmap%
          dc-path%
          dc<%>
          bitmap-dc%
@@ -31,4 +30,9 @@
          ps-setup% current-ps-setup
          get-face-list
          gl-config%
-         gl-context<%>)
+         gl-context<%>
+
+         bitmap%
+         make-bitmap
+         read-bitmap
+         make-monochrome-bitmap)

collects/racket/draw/private/bitmap.rkt

@@ -15,7 +15,10 @@
          "color.rkt")
 
 (provide bitmap%
-         make-alternate-bitmap-kind)
+         make-bitmap
+         read-bitmap
+         make-monochrome-bitmap
+         (protect-out make-alternate-bitmap-kind))
 
 ;; FIXME: there must be some way to abstract over all many of the
 ;; ARGB/RGBA/BGRA iterations.
@@ -26,7 +29,7 @@
   get-alphas-as-mask
   set-alphas-as-mask)
 
-(define (kind-symbol? s)
+(define (bitmap-file-kind-symbol? s)
   (memq s '(unknown unknown/mask unknown/alpha
                     gif gif/mask gif/alpha 
                     jpeg jpeg/alpha
@@ -36,7 +39,7 @@
                     bmp bmp/alpha
                     pict)))
 
-(define (save-kind-symbol? s)
+(define (bitmap-save-kind-symbol? s)
   (memq s '(png jpeg gif xbm xpm bmp)))
 
 (define (quality-integer? i)
@@ -88,8 +91,8 @@
                 (alternate-bitmap-kind-width a)
                 (alternate-bitmap-kind-height a)
                 #f #t #f #f)]
-       [([exact-nonnegative-integer? w]
+       [([exact-positive-integer? w]
-         [exact-nonnegative-integer? h]
+         [exact-positive-integer? h]
          [any? [b&w? #f]]
          [any? [alpha? #f]])
         (values
@@ -113,7 +116,7 @@
            s)
          #f)]
        [([(make-alts path-string? input-port?) filename]
-         [kind-symbol? [kind 'unknown]]
+         [bitmap-file-kind-symbol? [kind 'unknown]]
          [(make-or-false color%) [bg-color #f]]
          [any? [complain-on-failure? #f]])
         (let-values ([(s b&w?) (do-load-bitmap filename kind bg-color complain-on-failure?)]
@@ -155,8 +158,8 @@
                         mask-bm)
                 (values #f 0 0 #f #f #f #f))))]
        [([bytes? bstr]
-         [exact-nonnegative-integer? w]
+         [exact-positive-integer? w]
-         [exact-nonnegative-integer? h])
+         [exact-positive-integer? h])
         (let ([bw (quotient (+ w 7) 8)])
           (unless ((bytes-length bstr) . >= . (* h bw))
             (error (init-name 'bitmap%)
@@ -218,7 +221,7 @@
     (define/public (adjust-lock delta) (set! locked (+ locked delta)))
 
     (def/public (load-bitmap [(make-alts path-string? input-port?) in]
-                             [kind-symbol? [kind 'unknown]]
+                             [bitmap-file-kind-symbol? [kind 'unknown]]
                              [(make-or-false color%) [bg #f]]
                              [any? [complain-on-failure? #f]])
       (check-alternate 'load-bitmap)
@@ -432,7 +435,7 @@
         (send bm release-bitmap-storage)))
 
     (def/public (save-file [(make-alts path-string? output-port?) out]
-                           [save-kind-symbol? [kind 'unknown]]
+                           [bitmap-save-kind-symbol? [kind 'unknown]]
                            [quality-integer? [quality 75]])
       (check-ok 'save-file)
       (if alt?
@@ -743,3 +746,19 @@
           (cairo_surface_mark_dirty s))))
 
     ))
+
+(define/top (make-bitmap [exact-positive-integer? w]
+                         [exact-positive-integer? h]
+                         [any? [alpha? #t]])
+  (make-object bitmap% w h #f alpha?))
+
+(define/top (read-bitmap [path-string? filename]
+                         [bitmap-file-kind-symbol? [kind 'unknown/alpha]])
+  (make-object bitmap% filename kind))
+
+(define/top (make-monochrome-bitmap [exact-positive-integer? w]
+                                    [exact-positive-integer? h]
+                                    [(make-or-false bytes?) [bits #f]])
+  (if bits
+      (make-object bitmap% bits w h)
+      (make-object bitmap% w h #t)))

collects/scribblings/gui/bitmap-class.scrbl

@@ -13,8 +13,8 @@ Sometimes, a bitmap object creation fails in a low-level manner. In
  bitmaps (otherwise, @|MismatchExn|).
 
 
-@defconstructor*/make[(([width (integer-in 1 10000)]
+@defconstructor*/make[(([width exact-positive-integer?]
-                        [height (integer-in 1 10000)]
+                        [height exact-positive-integer?]
                         [monochrome? any/c #f]
                         [alpha? any/c #f])
                        ([in (or/c path-string? input-port?)]
@@ -27,8 +27,13 @@ Sometimes, a bitmap object creation fails in a low-level manner. In
                               'unknown]
                         [bg-color (or/c (is-a?/c color%) false/c) #f])
                        ([bits bytes?]
-                        [width (integer-in 1 10000)]
+                        [width exact-positive-integer?]
-                        [height (integer-in 1 10000)]))]{
+                        [height exact-positive-integer?]))]{
+
+The @racket[make-bitmap], @racket[make-monchrome-bitmap], and
+ @racket[read-bitmap] functions are preferred over using
+ @racket[make-object] with @racket[bitmap%], because the functions are
+ less overloaded and provide more useful defaults.
 
 When @scheme[width] and @scheme[height] are provided: Creates a new
  bitmap. If @scheme[monochrome?] is true, the bitmap is monochrome; if
@@ -57,8 +62,8 @@ When a @scheme[bits] byte string is provided: Creates a monochrome
 
 @defmethod[(get-argb-pixels [x real?]
                             [y real?]
-                            [width (integer-in 1 10000)]
+                            [width exact-nonnegative-integer?]
-                            [height (integer-in 1 10000)]
+                            [height exact-nonnegative-integer?]
                             [pixels (and/c bytes? mutable?)]
                             [alpha? any/c #f])
            void?]{
@@ -87,7 +92,7 @@ Returns a copy of this bitmap's requested OpenGL configuration. See
 }
 
 @defmethod[(get-height)
-           (integer-in 1 10000)]{
+           exact-positive-integer?]{
 
 Gets the height of the bitmap in pixels.
 
@@ -130,7 +135,7 @@ Unlike an alpha channel, the mask bitmap is @italic{not} used
 }
 
 @defmethod[(get-width)
-           (integer-in 1 10000)]{
+           exact-positive-integer?]{
 
 Gets the width of the bitmap in pixels.
 

collects/scribblings/gui/bitmap-funcs.scrbl

@@ -0,0 +1,40 @@
+#lang scribble/doc
+@(require "common.ss")
+
+@title{Bitmaps}
+
+
+@defproc[(make-bitmap [width exact-positive-integer?]
+                      [height exact-positive-integer?]
+                      [alpha? any/c #t])
+         (is-a?/c bitmap%)]{
+
+Returns @racket[(make-object bitmap% width height #f alpha?)], but
+this procedure is preferred because it defaults @racket[alpha?] in a
+more useful way.}
+
+
+@defproc[(make-monochrome-bitmap [width exact-positive-integer?]
+                                 [height exact-positive-integer?]
+                                 [bits (or/c bytes? #f) #f])
+         (is-a?/c bitmap%)]{
+
+Returns @racket[(make-object bitmap% width height #t)] if
+@racket[bits] is @racket[#f], or @racket[(make-object bitmap% bits
+width height)] otherwise. This procedure is preferred to using
+@racket[make-object] on @racket[bitmap%] because it is less
+overloaded.}
+
+
+@defproc[(read-bitmap [in (or path-string? input-port?)]
+                      [kind (one-of/c 'unknown 'unknown/mask 'unknown/alpha
+                                      'gif 'gif/mask 'gif/alpha 
+                                      'jpeg 'jpeg/alpha
+                                      'png 'png/mask 'png/alpha
+                                      'xbm 'xbm/alpha 'xpm 'xpm/alpha
+                                      'bmp 'bmp/alpha)
+                            'unknown/alpha])
+         (is-a?/c bitmap%)]{
+
+Returns @racket[(make-object bitmap% in kind)], but this procedure is
+preferred because it defaults @racket[kind] in a more useful way.}

collects/scribblings/gui/draw-funcs.scrbl

@@ -8,4 +8,5 @@
 @include-section["global-draw-funcs.scrbl"]
 @include-section["post-script-funcs.scrbl"]
 @include-section["draw-list-funcs.scrbl"]
+@include-section["bitmap-funcs.scrbl"]
 @include-section["font-funcs.scrbl"]

collects/scribblings/gui/gui.scrbl

@@ -7,14 +7,9 @@
 
 @declare-exporting[racket/gui/base racket/gui #:use-sources (mred)]
 
-This reference manual describes the GUI toolbox that is part of Racket
- and whose core is implemented by the GRacket executable.
-
 @defmodule*/no-declare[(racket/gui/base)]{The
 @racketmodname[racket/gui/base] library provides all of the class,
-interface, and procedure bindings defined in this manual. At run time,
+interface, and procedure bindings defined in this manual.}
-this library needs primitive graphics support that the GRacket executable
-provides; this library cannot run inside the Racket executable.}
 
 @defmodulelang*/no-declare[(racket/gui)]{The
 @racketmodname[racket/gui] language combines all bindings of the

collects/scribblings/reference/exit.scrbl

@@ -21,3 +21,18 @@ argument is used as the OS-level exit code if it is an exact integer
 between @racket[1] and @racket[255] (which normally means
 ``failure''); otherwise, the exit code is @racket[0], (which normally
 means ``success'').}
+
+
+@defparam[executable-yield-handler proc ((integer-in 0 255) . -> . any)]{
+
+A parameter that determines a procedure to be called as the Racket
+process is about to exit normally. The procedure associated with this
+parameter is not call when @racket[exit] (or, more precisely, the
+defauly @tech{exit handler}) is used to exit early. The argument to
+the handler is the status code that is returned to the system on exit.
+The default executable-yield handler simply returns @|void-const|.
+
+The @racketmodname[scheme/gui/base] library sets this parameter to
+wait until all frames are closed, timers stopped, and queued events
+handled in the main eventspace. See @racketmodname[scheme/gui/base]
+for more information.}

collects/waterworld/waterworld.rkt

@@ -79,16 +79,16 @@
   (define *checking-message*
     "Considering your move ...")
 
-  (define (make-bitmap s)
+  (define (make-wbitmap s)
     (make-object bitmap% 
 		 (build-path 
 		  (collection-path "waterworld") s) 'gif))
   (define *jolly-bitmap* #f)
   (define *jolly-ce-bitmap* #f)
-  (define *jolly-large-bitmap* (make-bitmap "jolly-large.gif"))
+  (define *jolly-large-bitmap* (make-wbitmap "jolly-large.gif"))
-  (define *jolly-small-bitmap* (make-bitmap "jolly-small.gif"))
+  (define *jolly-small-bitmap* (make-wbitmap "jolly-small.gif"))
-  (define *jolly-large-ce-bitmap* (make-bitmap "jolly-large-ce.gif"))
+  (define *jolly-large-ce-bitmap* (make-wbitmap "jolly-large-ce.gif"))
-  (define *jolly-small-ce-bitmap* (make-bitmap "jolly-small-ce.gif"))
+  (define *jolly-small-ce-bitmap* (make-wbitmap "jolly-small-ce.gif"))
 
   (define *jolly-small-desc* (list *jolly-small-bitmap* *jolly-small-ce-bitmap* 16 16))
   (define *jolly-large-desc* (list *jolly-large-bitmap* *jolly-large-ce-bitmap* 23 27))

doc/release-notes/racket/Draw_and_GUI_5_5.txt

@@ -1,96 +1,130 @@
-Changes:
+GRacket, Racket, Drawing, and GUIs
+----------------------------------
 
- * The drawing portion of the old GUI toolbox is now available as a
+Version 5.5 includes two major changes to the Racket drawing and GUI
-   separate layer: `racket/draw'. This layer can be used from plain
+API:
-   Racket independent of the `racket/gui' library, although
-   `racket/gui' re-exports `racket/draw'.
 
-   The `racket/draw' library is built on top of the widely used Cairo
+ * The drawing portion of the GUI toolbox is now available as a
-   drawing library and Pango text-rendering library.
+   separate layer: `racket/draw'. This layer can be used independent
+   of the `racket/gui/base' library, although `racket/gui' re-exports
+   `racket/draw'.
 
- * Drawing to a bitmap may not produce the same results as drawing to
+   (The `racket/draw' library is built on top of the widely used Cairo
-   a canvas. Use the `make-screen-bitmap' function (from `racket/gui')
+   drawing library and Pango text-rendering library.)
-   or the `make-bitmap' method of `canvas%' to obtain a bitmap that
-   uses the same drawing algorithms as a canvas.
 
-   Drawing to a canvas always draws into a bitmap that is kept
+ * The GRacket executable is no longer strictly necessary for running
-   offscreen and periodically flushed onto the screen. The new
+   GUI programs; the `racket/gui/base' library can be used from
-   `suspend-flush' and `resume-flush' methods of `canvas%' provide
+   Racket.
-   some control over the timing of the flushes, which in many cases
-   avoids the need for (additional) double buffering of canvas
-   content.
 
- * A color bitmap can have an alpha channel, instead of just a mask
+   The GRacket executable still offers some additional GUI-specific
-   bitmap. When drawing a bitmap, alpha channels are used more
+   functiontality however. Most notably, GRacket is a GUI application
-   consistently and automatically than mask bitmaps. More
+   under Windows (as opposed to a console application, which is
-   significantly, drawing into a bitmap with an alpha channel
+   launched slightly differently by the OS), GRacket is a bundle under
-   preserves the drawn alphas; for example, drawing a line in the
+   Mac OS X (so the dock icon is the Racket logo, for example), and
-   middle of an empty bitmap produces an image with non-zero alpha
+   GRacket manages single-instance mode for Windows and X.
-   only at the drawn line.
 
-   Create a bitmap with an alpha channel by supplying #t as the new
+The drawing and GUI libraries have also changed in further small ways.
-   `alpha?' argument to the `bitmap%' constructor, or by loading an
-   image with a type like 'unknown/alpha insteda of 'unknown or
-   'unknown/mask.
 
-   A newly created `bitmap%' has an empty content (i.e., white with
-   zero alpha), insteda of unspecified content.
 
-   Images can be read into a `bitmap%' from from input ports, instead
+Bitmaps
-   of requiring a file path.
+-------
 
- * A `dc<%>' supports additional drawing transformations: a rotation
+Drawing to a bitmap may not produce the same results as drawing to a
-   (via `set-rotation') and a general transformation matrix (via
+canvas. Use the `make-screen-bitmap' function (from `racket/gui') or
-   `set-initial-matrix'). Scaling factors can be negative, which
+the `make-bitmap' method of `canvas%' to obtain a bitmap that uses the
-   corresponds to flipping the direction of drawing.
+same drawing algorithms as a canvas.
 
-   A transformation matrix has the form `(vector xx xy yx yy x0 y0)',
+A color bitmap can have an alpha channel, instead of just a mask
-   where a point (x1, y1) is transformed to a point (x2, y2) with x2 =
+bitmap. When drawing a bitmap, alpha channels are used more
-   xx*x1 + yx*y1 + x0 and y2 = xy*x1 + yy*y1 + y0, which is the usual
+consistently and automatically than mask bitmaps. More significantly,
-   convention.
+drawing into a bitmap with an alpha channel preserves the drawn
+alphas; for example, drawing a line in the middle of an empty bitmap
+produces an image with non-zero alpha only at the drawn line.
 
-   New methods `translate', `scale', `rotate', and `transform'
+Only bitmaps created with the new `make-gl-bitmap' function support
-   simplify adding a further translation, scaling, rotation, or
+OpenGL drawing.
-   arbitrary matrix transformation on top of the current
-   transformation. The new `get-translation' and `set-translation'
-   methods help to capture and restore transformation settings.
 
-   The old translation and scaling transformations apply after the
+Use the new `make-bitmap', `read-bitmap', `make-monochrome-bitmap',
-   initial matrix. The new rotation transformation applies after the
+`make-screen-bitmap', and `make-gl-bitmap' functions to create
-   other transformations. This layering is redundant, since all
+bitmaps, instead of using `make-object' with `bitmap%'. The new
-   transformations can be expressed in a single matrix, but it is
+constructors are less overloaded and provide more modern defaults
-   backward-compatibile. Methods like `get-translation',
+(such as alpha channels by default).
-   `set-translation', `scale', etc. help hide the reundancy.
 
-   The alpha value of a `dc<%>' (as set by `set-alpha') is used for
+Image formats can be read into a `bitmap%' from from input ports,
-   all drawing operations, including drawing a bitmap.
+instead of requiring a file path. A newly created bitmap has an empty
+content (i.e., white with zero alpha), instead of unspecified content.
 
-   The `draw-bitmap' and `draw-bitmap-section' methods now smooth
-   bitmaps while scaling, so the `draw-bitmap-section-smooth' method
-   of `bitmap-dc%' simply calls `draw-bitmap-section'.
 
- * A `region%' can be created as independent of any `dc<%>', in which
+Canvases
-   cases it uses the drawing context's current transformation at the
+--------
-   time that it is installed as a clipping region.
 
- * The old 'xor mode for pens and brushes is no longer available
+Drawing to a canvas always draws into a bitmap that is kept offscreen
-   (since it is not supported by Cairo).
+and periodically flushed onto the screen. The new `suspend-flush' and
+`resume-flush' methods of `canvas%' provide some control over the
+timing of the flushes, which in many cases avoids the need for
+(additional) double buffering of canvas content.
 
- * The `draw-caret' argument to a `snip%' or `editor<%>' `draw' or
+OpenGL drawing in a canvas requires supplying 'gl as a style when
-   `refresh' method can be a pair, which indicates that the caret is
+creating the `canvas%' instance. OpenGL and normal dc<%> drawing no
-   owned by an enclosing display and the selection spans the snip or
+longer mix reliably in a canvas.
-   editor. In that case, the snip or editor should refrain from
-   drawing a background for the selected region, and it should draw
-   the foreground in the color specified by
-   `get-highlight-text-color', if any.
 
- * OpenGL drawing in a canvas requires supplying 'gl as a style when
-   creating the `canvas%' instance. OpenGL and normal dc<%> drawing no
-   longer mix reliably in a canvas.
 
-   OpenG drawing to a bitmap requires a bitmap created with
+Drawing-Context Transformations
-   `make-gl-bitmap'.
+-------------------------------
 
- * The `write-resource, `get-reource', and `send-event' functions have
+A `dc<%>' instance supports rotation (via `set-rotation'), negative
-   been removed from `racket/gui/base'. If there is any demand for the
+scaling factors for flipping, and a general transformation matrix (via
-   removed functionality, it will be implemented in a new library.
+`set-initial-matrix'). A transformation matrix has the form `(vector
+xx xy yx yy x0 y0)', where a point (x1, y1) is transformed to a point
+(x2, y2) with x2 = xx*x1 + yx*y1 + x0 and y2 = xy*x1 + yy*y1 + y0,
+which is the usual convention.
+
+New methods `translate', `scale', `rotate', and `transform' simplify
+adding a further translation, scaling, rotation, or arbitrary matrix
+transformation on top of the current transformation. The new
+`get-translation' and `set-translation' methods help to capture and
+restore transformation settings.
+
+The old translation and scaling transformations apply after the
+initial matrix. The new rotation transformation applies after the
+other transformations. This layering is redundant, since all
+transformations can be expressed in a single matrix, but it is
+backward-compatibile. Methods like `get-translation',
+`set-translation', `scale', etc. help hide the reundancy.
+
+
+Others Drawing-Context Changes
+------------------------------
+
+The alpha value of a `dc<%>' (as set by `set-alpha') is used for all
+drawing operations, including drawing a bitmap.
+
+The `draw-bitmap' and `draw-bitmap-section' methods now smooth bitmaps
+while scaling, so the `draw-bitmap-section-smooth' method of
+`bitmap-dc%' simply calls `draw-bitmap-section'.
+
+A `region%' can be created as independent of any `dc<%>', in which
+cases it uses the drawing context's current transformation at the time
+that it is installed as a clipping region.
+
+The old 'xor mode for pens and brushes is no longer available (since
+it is not supported by Cairo).
+
+
+Editor Changes
+--------------
+
+The `draw-caret' argument to a `snip%' or `editor<%>' `draw' or
+`refresh' method can be a pair, which indicates that the caret is
+owned by an enclosing display and the selection spans the snip or
+editor. In that case, the snip or editor should refrain from drawing a
+background for the selected region, and it should draw the foreground
+in the color specified by `get-highlight-text-color', if any.
+
+
+Removed Functions
+-----------------
+
+The `write-resource, `get-reource', and `send-event' functions have
+been removed from `racket/gui/base'. If there is any demand for the
+removed functionality, it will be implemented in a new library.

src/gracket/grmain.c

@@ -45,12 +45,9 @@ static void pre_filter_cmdline_arguments(int *argc, char ***argv);
 #define INITIAL_BIN_TYPE "ri"
 
 #define CMDLINE_STDIO_FLAG
-#define YIELD_BEFORE_EXIT
 #define INITIAL_NAMESPACE_MODULE "scheme/gui/init"
 #define GRAPHICAL_REPL
 
-static void yield_indefinitely();
-
 # include "../racket/main.c"
 
 static char *get_gr_init_filename(Scheme_Env *env)
@@ -76,35 +73,6 @@ static char *get_gr_init_filename(Scheme_Env *env)
   return s;
 }
 
-static void yield_indefinitely()
-{
-#ifdef MZ_PRECISE_GC
-  void *dummy;
-#endif
-  mz_jmp_buf * volatile save, newbuf;
-  Scheme_Thread * volatile p;
-  Scheme_Object *a[2], *yld;
-
-  p = scheme_get_current_thread();
-  save = p->error_buf;
-  p->error_buf = &newbuf;
-
-  if (!scheme_setjmp(newbuf)) {
-    a[0] = scheme_intern_symbol("mred/mred");
-    a[1] = scheme_intern_symbol("yield");
-    yld = scheme_dynamic_require(2, a);
-
-    a[0] = scheme_intern_symbol("wait");
-    scheme_apply(yld, 1, a);
-  }
-
-  p->error_buf = save;
-
-#ifdef MZ_PRECISE_GC
-  dummy = NULL; /* makes xform think that dummy is live, so we get a __gc_var_stack__ */
-#endif
-}
-
 /***********************************************************************/
 /*                        Win32 handling                               */
 /***********************************************************************/

src/racket/cmdline.inc

@@ -150,7 +150,7 @@ typedef struct {
   int use_repl;
   int script_mode;
 #endif
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
   int add_yield;
 #endif
 #ifdef CMDLINE_STDIO_FLAG
@@ -433,7 +433,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
       exit_val = 0;
     } else {
       exit_val = 1;
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
       fa->a->add_yield = 0;
 #endif
     }
@@ -441,15 +441,18 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
   }
 #endif /* DONT_RUN_REP */
 
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
   if (fa->a->add_yield) {
     mz_jmp_buf * volatile save, newbuf;
     Scheme_Thread * volatile p;
+    Scheme_Object *yh, *yha[1];
     p = scheme_get_current_thread();
     save = p->error_buf;
     p->error_buf = &newbuf;
     if (!scheme_setjmp(newbuf)) {
-      yield_indefinitely();
+      yh = scheme_get_param(scheme_current_config(), MZCONFIG_EXE_YIELD_HANDLER);
+      yha[0] = scheme_make_integer(exit_val);
+      scheme_apply(yh, 1, yha);
     }
     p->error_buf = save;
   }
@@ -564,7 +567,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 #if !defined(DONT_LOAD_INIT_FILE) || !defined(DONT_PARSE_COMMAND_LINE)
   int no_init_file = 0;
 #endif
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
   int add_yield = 1;
 #endif
 #ifdef CMDLINE_STDIO_FLAG
@@ -800,9 +803,9 @@ static int run_from_cmd_line(int argc, char *_argv[],
     else if (!strcmp("--stdio", argv[0]))
       argv[0] = "-z";
     else if (!strcmp("--back", argv[0]))
-      argv[0] = "-G";
+      argv[0] = "-K";
 # endif
-# ifdef YIELD_BEFORE_EXIT
+# ifndef NO_YIELD_BEFORE_EXIT
     else if (!strcmp("--no-yield", argv[0]))
       argv[0] = "-V";
 # endif
@@ -988,7 +991,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	case 'v':
 	  show_vers = 1;
 	  break;
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
 	case 'V':
 	  show_vers = 1;
 	  add_yield = 0;
@@ -1022,6 +1025,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  break;
 	case 'K':
 	  no_front = 1;
+          was_config_flag = 1;
 	  break;
 #endif
 #ifdef USE_OSKIT_CONSOLE
@@ -1212,12 +1216,14 @@ static int run_from_cmd_line(int argc, char *_argv[],
   fa->a->use_repl = use_repl;
   fa->a->script_mode = script_mode;
 #endif
-#ifdef YIELD_BEFORE_EXIT
+#ifndef NO_YIELD_BEFORE_EXIT
   fa->a->add_yield = add_yield;
 #endif
 #ifdef CMDLINE_STDIO_FLAG
   fa->a->alternate_rep = alternate_rep;
   fa->a->no_front = no_front;
+  if (no_front)
+    scheme_register_process_global("Racket-GUI-no-front", (void *)0x1);
 #endif
   fa->init_lib = init_lib;
   fa->global_env = global_env;
@@ -1256,8 +1262,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
 # ifdef CMDLINE_STDIO_FLAG
 	 "  -K, --back : Don't bring application to the foreground (Mac OS X)\n"
 # endif
-# ifdef YIELD_BEFORE_EXIT
+# ifndef NO_YIELD_BEFORE_EXIT
-	 "  -V, --no-yield : Don't `(yield 'wait)'\n"
+	 "  -V, --no-yield : Skip `((executable-yield-handler) <status>)' on exit\n"
 # endif
 	 " Configuration options:\n"
          "  -c, --no-compiled : Disable loading of compiled files\n"
@@ -1298,8 +1304,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
          " 3. Evaluate/load expressions/files in order, until first error\n"
          " 4. Load \"" INIT_FILENAME "\" [when -i]\n"
          " 5. Run read-eval-print loop [when -i]\n"
-# ifdef YIELD_BEFORE_EXIT
+# ifndef NO_YIELD_BEFORE_EXIT
-         " 6. Run `(yield 'wait)' [unless -V]\n"
+         " 6. Run `((executable-yield-handler) <status>)' [unless -V]\n"
 # endif
 	 );
   PRINTF(prog, BANNER);

src/racket/include/scheme.h

@@ -1231,6 +1231,8 @@ enum {
 
   MZCONFIG_ERROR_ESCAPE_HANDLER,
 
+  MZCONFIG_EXE_YIELD_HANDLER,
+
   MZCONFIG_ALLOW_SET_UNDEFINED,
   MZCONFIG_COMPILE_MODULE_CONSTS,
   MZCONFIG_USE_JIT,

src/racket/src/error.c

@@ -71,6 +71,7 @@ ROSYM static Scheme_Object *def_err_val_proc;
 ROSYM static Scheme_Object *def_error_esc_proc;
 ROSYM static Scheme_Object *default_display_handler;
 ROSYM static Scheme_Object *emergency_display_handler;
+ROSYM static Scheme_Object *def_exe_yield_proc;
 READ_ONLY Scheme_Object *scheme_def_exit_proc;
 READ_ONLY Scheme_Object *scheme_raise_arity_error_proc;
 
@@ -90,6 +91,7 @@ static Scheme_Object *error_escape_handler(int, Scheme_Object *[]);
 static Scheme_Object *error_display_handler(int, Scheme_Object *[]);
 static Scheme_Object *error_value_string_handler(int, Scheme_Object *[]);
 static Scheme_Object *exit_handler(int, Scheme_Object *[]);
+static Scheme_Object *exe_yield_handler(int, Scheme_Object *[]);
 static Scheme_Object *error_print_width(int, Scheme_Object *[]);
 static Scheme_Object *error_print_context_length(int, Scheme_Object *[]);
 static Scheme_Object *error_print_srcloc(int, Scheme_Object *[]);
@@ -98,6 +100,7 @@ static Scheme_Object *def_error_display_proc(int, Scheme_Object *[]);
 static Scheme_Object *emergency_error_display_proc(int, Scheme_Object *[]);
 static Scheme_Object *def_error_value_string_proc(int, Scheme_Object *[]);
 static Scheme_Object *def_exit_handler_proc(int, Scheme_Object *[]);
+static Scheme_Object *default_yield_handler(int, Scheme_Object *[]);
 
 static Scheme_Object *log_message(int argc, Scheme_Object *argv[]);
 static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]);
@@ -570,6 +573,7 @@ void scheme_init_error(Scheme_Env *env)
   GLOBAL_PARAMETER("error-value->string-handler", error_value_string_handler, MZCONFIG_ERROR_PRINT_VALUE_HANDLER,   env);
   GLOBAL_PARAMETER("error-escape-handler",        error_escape_handler,       MZCONFIG_ERROR_ESCAPE_HANDLER,        env);
   GLOBAL_PARAMETER("exit-handler",                exit_handler,               MZCONFIG_EXIT_HANDLER,                env);
+  GLOBAL_PARAMETER("executable-yield-handler",    exe_yield_handler,          MZCONFIG_EXE_YIELD_HANDLER,           env);
   GLOBAL_PARAMETER("error-print-width",           error_print_width,          MZCONFIG_ERROR_PRINT_WIDTH,           env);
   GLOBAL_PARAMETER("error-print-context-length",  error_print_context_length, MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH,  env);
   GLOBAL_PARAMETER("error-print-source-location", error_print_srcloc,         MZCONFIG_ERROR_PRINT_SRCLOC,          env);
@@ -620,6 +624,11 @@ void scheme_init_error(Scheme_Env *env)
   }
                                                             
   scheme_add_global_constant("prop:arity-string", arity_property, env);
+
+  REGISTER_SO(def_exe_yield_proc);
+  def_exe_yield_proc = scheme_make_prim_w_arity(default_yield_handler,
+                                                "default-executable-yield-handler",
+                                                1, 1);
 }
 
 void scheme_init_logger()
@@ -639,6 +648,7 @@ void scheme_init_error_config(void)
   scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_exit_proc);
   scheme_set_root_param(MZCONFIG_ERROR_DISPLAY_HANDLER, default_display_handler);
   scheme_set_root_param(MZCONFIG_ERROR_PRINT_VALUE_HANDLER, def_err_val_proc);
+  scheme_set_root_param(MZCONFIG_EXE_YIELD_HANDLER, def_exe_yield_proc);
 }
 
 void scheme_init_logger_config() {
@@ -2569,6 +2579,20 @@ void scheme_immediate_exit(int status)
   exit(status);
 }
 
+static Scheme_Object *
+exe_yield_handler(int argc, Scheme_Object *argv[])
+{
+  return scheme_param_config("exeuctable-yield-handler",
+			     scheme_make_integer(MZCONFIG_EXE_YIELD_HANDLER),
+			     argc, argv,
+			     1, NULL, NULL, 0);
+}
+
+static Scheme_Object *default_yield_handler(int argc, Scheme_Object **argv)
+{
+  return scheme_void;
+}
+
 /***********************************************************************/
 
 void update_want_level(Scheme_Logger *logger)

src/racket/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1014
+#define EXPECTED_PRIM_COUNT 1015
 #define EXPECTED_UNSAFE_COUNT 76
 #define EXPECTED_FLFXNUM_COUNT 68
 #define EXPECTED_FUTURES_COUNT 5

src/racket/src/schvers.h

@@ -13,11 +13,11 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.0.2.1"
+#define MZSCHEME_VERSION "5.4.99.1"
 
 #define MZSCHEME_VERSION_X 5
-#define MZSCHEME_VERSION_Y 0
+#define MZSCHEME_VERSION_Y 4
-#define MZSCHEME_VERSION_Z 2
+#define MZSCHEME_VERSION_Z 99
 #define MZSCHEME_VERSION_W 1
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)