diff --git a/collects/2htdp/private/image-core.rkt b/collects/2htdp/private/image-core.rkt
new file mode 100644
index 0000000000..01d21f7bee
--- /dev/null
+++ b/collects/2htdp/private/image-core.rkt
@@ -0,0 +1,4 @@
+#lang racket/base
+;; this is here as a backwards compatibility file to provide the snipclass 
+(require mrlib/image-core)
+(provide snip-class)
\ No newline at end of file
diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt
index 1ff306ff4e..baf6ecccdc 100644
--- a/collects/2htdp/private/image-more.rkt
+++ b/collects/2htdp/private/image-more.rkt
@@ -427,6 +427,8 @@
              (min (ltrb-top ltrb1) (ltrb-top ltrb2))
              (max (ltrb-right ltrb1) (ltrb-right ltrb2))
              (max (ltrb-bottom ltrb1) (ltrb-bottom ltrb2))))
+
+;; only intersection if they already overlap.
 (define (intersect-ltrb ltrb1 ltrb2)
   (make-ltrb (max (ltrb-left ltrb1) (ltrb-left ltrb2))
              (max (ltrb-top ltrb1) (ltrb-top ltrb2))
diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt
index e598d324bd..dcfb64c884 100644
--- a/collects/2htdp/tests/test-image.rkt
+++ b/collects/2htdp/tests/test-image.rkt
@@ -45,6 +45,7 @@
          lang/posn
          racket/math
          racket/class
+         racket/file
          racket/gui/base
          rackunit
          (prefix-in 1: htdp/image)
@@ -1611,7 +1612,13 @@
          (crop coord coord size size image)
          (scale/xy factor factor image)
          (scale factor image)
-         (rotate angle image))
+         (rotate angle image)
+         (flip-vertical image)
+         (flip-horizontal image)
+         (bitmap bmp-spec))
+  
+  (bmp-spec icons/b-run.png
+            icons/stop-16x16.png)
 
   (factor (+ 1 big-nat) 1/2 1/3 1/4) ;; scaling factors
   (size big-nat)
@@ -1632,7 +1639,7 @@
     (let loop ([obj obj])
       (when (struct? obj)
         (let ([stuff (vector->list (struct->vector obj))])
-          (unless (member (car stuff) '(struct:translate struct:scale)) ;; skip these becuase normalization eliminates them
+          (unless (member (car stuff) '(struct:flip struct:translate struct:scale)) ;; skip these becuase normalization eliminates them
             (hash-set! counts (car stuff) (+ 1 (hash-ref counts (car stuff) 0))))
           (for-each loop (cdr stuff)))))
     (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))
@@ -1640,20 +1647,44 @@
 (define (check-image-properties img-sexp img)
   (let* ([raw-size (image-struct-count (image-shape img))]
          [normalized (normalize-shape (image-shape img) values)]
-         [norm-size (image-struct-count normalized)])
+         [norm-size (image-struct-count normalized)]) 
     (unless (normalized-shape? normalized)
       (error 'test-image.ss "found a non-normalized shape after normalization:\n~s" 
              img-sexp))
     (unless (equal? norm-size raw-size)
       (error 'test-image.ss "found differing sizes for ~s:\n  ~s\n  ~s" 
-             img-sexp raw-size norm-size))))       
-  
+             img-sexp raw-size norm-size))))
+
+(define (test-save/load img fn)
+  (let ([t1 (new text%)]
+        [t2 (new text%)])
+    (send t1 insert img)
+    (send t1 save-file fn)
+    (send t2 load-file fn)
+    (let ([s1 (send t1 find-first-snip)]
+          [s2 (send t2 find-first-snip)])
+      (equal? s1 s2))))
+
 (time
  (redex-check
   2htdp/image
   image
   (check-image-properties 
    (term image)
-   (eval (term image) (namespace-anchor->namespace anchor)))
+   (to-img (eval (term image) (namespace-anchor->namespace anchor))))
   #:attempts 1000))
 
+;; this one is commented out because it catches 
+;; a bug where cropping a shape outside of its
+;; bounding box leads to strange, bad behavior.
+#;
+(time
+ (let ([fn (make-temporary-file "test-image~a")])
+   (redex-check
+    2htdp/image
+    image
+    (let ([img (to-img (eval (term image) (namespace-anchor->namespace anchor)))])  
+      (unless (test-save/load img fn)  
+        (error 'test-image.rkt "saving and loading this image fails:\n  ~s" (term image))))
+    #:attempts 1000)))
+
diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt
index 63b21dbb26..9e474ebbef 100644
--- a/collects/mrlib/image-core.rkt
+++ b/collects/mrlib/image-core.rkt
@@ -150,7 +150,8 @@ has been moved out).
 ;;  - (make-bitmap (is-a?/c bitmap%) angle positive-real (or/c #f (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 [rendered-bitmap #:mutable] [rendered-mask #:mutable])
-  #:omit-define-syntaxes #:transparent)
+  #:omit-define-syntaxes #:transparent
+  #:property prop:custom-write (λ (x y z) (bitmap-write x y z)))
 
 ;; a flip is:
 ;;   - (make-flip boolean bitmap)
@@ -158,7 +159,7 @@ has been moved out).
 ;; * this struct is here to avoid adding a field to bitmaps, so that old save files
 ;;   from when the library did not support flipping still load
 ;;   (since normalization will add a flip structure if necessary)
-(define-struct/reg-mk flip (flipped? shape))
+(define-struct/reg-mk flip (flipped? shape) #:transparent)
 
 ;; a polygon is:
 ;;
@@ -312,7 +313,7 @@ has been moved out).
     (define/override (find-scroll-step y)
       (calc-scroll-step)
       (inexact->exact (ceiling (/ y scroll-step))))
-               
+
     (define/override (copy) (make-image shape bb normalized?))
     (define/override (draw dc x y left top right bottom dx dy draw-caret?)
       (let ([smoothing (send dc get-smoothing)])
@@ -342,8 +343,8 @@ has been moved out).
   (and (= (round (bb-right bb1)) (round (bb-right bb2)))
        (= (round (bb-bottom bb1)) (round (bb-bottom bb2)))
        (= (round (bb-baseline bb1)) (round (bb-baseline bb2)))))
-(define racket/base:read read)
 
+(define racket/base:read read)
 (define image-snipclass% 
   (class snip-class%
     (define/override (read f)
@@ -370,7 +371,7 @@ has been moved out).
 
 (provide snip-class) 
 (define snip-class (new image-snipclass%))
-(send snip-class set-classname (format "~s" '(lib "image-core.ss" "2htdp" "private")))
+(send snip-class set-classname (format "~s" '(lib "image-core.ss" "mrlib")))
 (send snip-class set-version 1)
 (send (get-the-snip-class-list) add snip-class)
 
@@ -384,12 +385,17 @@ has been moved out).
         [(vector? sexp)
          (if (= (vector-length sexp) 0)
              (k #f)
-             (let ([constructor (id->constructor (vector-ref sexp 0))]
-                   [args (cdr (vector->list sexp))])
-               (if (and constructor
-                        (procedure-arity-includes? constructor (length args)))
-                   (apply constructor (map loop args))
-                   (k #f))))]
+             (cond
+               [(bytes? (vector-ref sexp 0))
+                ;; bitmaps are vectors with a bytes in the first field
+                (apply bytes->bitmap (vector->list sexp))]
+               [else
+                (let ([constructor (id->constructor (vector-ref sexp 0))]
+                      [args (cdr (vector->list sexp))])
+                  (if (and constructor
+                           (procedure-arity-includes? constructor (length args)))
+                      (apply constructor (map loop args))
+                      (k #f)))]))]
         [else sexp]))))
 
 (define-id->constructor id->constructor)
@@ -829,7 +835,7 @@ the mask bitmap and the original bitmap are all together in a single bytes!
       (let-values ([(rotated-bytes rotated-w rotated-h)
                     (rotate-bytes bytes w h θ)])
         (let* ([flipped-bytes (if flip?
-                                  (flip-bytes rotated-bytes w h)
+                                  (flip-bytes rotated-bytes rotated-w rotated-h)
                                   rotated-bytes)]
                [bm (bytes->bitmap flipped-bytes rotated-w rotated-h)]
                [mask (send bm get-loaded-mask)])
@@ -1005,6 +1011,24 @@ the mask bitmap and the original bitmap are all together in a single bytes!
                 (make-bb w h h)
                 #f)))
 
+(define (bitmap-write bitmap port mode)
+  (let* ([v (struct->vector bitmap)]
+         [recur (case mode
+                  [(#t) write]
+                  [(#f) display]
+                  [else (lambda (p port) (print p port mode))])]
+         [update 
+          (λ (i)
+            (let ([o (vector-ref v i)])
+              (let ([nv (call-with-values (λ () (bitmap->bytes o)) vector)])
+                (vector-set! v i nv))))])
+    (update 1)
+    (update 2)
+    ;; don't save the rendered bitmap (if it is there)
+    (vector-set! v 6 #f)
+    (vector-set! v 7 #f)
+    (recur v port)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
diff --git a/collects/mrlib/private/image-core-bitmap.rkt b/collects/mrlib/private/image-core-bitmap.rkt
index 200429fecc..7b6b2baf5d 100644
--- a/collects/mrlib/private/image-core-bitmap.rkt
+++ b/collects/mrlib/private/image-core-bitmap.rkt
@@ -67,7 +67,11 @@ instead of this scaling code, we use the dc<%>'s scaling code.
 
 (define (bytes->bitmap bytes w h)
   (unless (= (bytes-length bytes) (* w h NUM-CHANNELS))
-    (error 'bytes->bitmap "wrong sizes"))
+    (error 'bytes->bitmap "wrong sizes, got ~a bytes, w ~a h ~a (which should be ~a bytes)"
+           (bytes-length bytes)
+           w
+           h
+           (* w h NUM-CHANNELS)))
   (let* ([bm (make-object bitmap% w h)]
          [mask (make-object bitmap% w h)]
          [bdc (make-object bitmap-dc% bm)])