Ah, right: that code didn't actually save the bitmap itself. How do
you like this code?
Robby
#lang racket/gui
(require (prefix-in - racket/base))
(provide (rename-out [image-data-snip-class snip-class])
image-data-snip%)
(define image-data-snip%
(class image-snip%
(inherit set-snipclass
get-flags set-flags
get-admin
get-extent
draw)
(define metadata (make-hash))
(define/public (set-metadata md) (set! metadata md))
(super-new)
(set-snipclass image-data-snip-class)
(set-flags (cons 'handles-events (get-flags)))
(inherit get-bitmap)
(define/override (copy)
(define ids (new image-data-snip%))
(send ids set-bitmap (get-bitmap))
(send ids set-metadata metadata)
ids)
(define/override (write f)
(define bmp (get-bitmap))
(define w (send bmp get-width))
(define h (send bmp get-height) )
(define p (open-output-bytes))
(-write (list metadata w h) p)
(define b (get-output-bytes p))
(define ib (make-bytes (* 4 w h)))
(send bmp get-argb-pixels 0 0 w h ib)
(send f put (bytes-length b) b)
(send f put (bytes-length ib) ib))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Operations on the metadata ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/public (get-arg-pos arg)
(hash-ref metadata arg '(0.5 0.5)))
(define/public (set-arg-pos arg pos)
(hash-set! metadata arg pos))
(define/public (get-args-pos)
(hash->list metadata))))
(define image-data-snip-class%
(class snip-class%
(inherit set-classname)
(super-new)
(set-classname (~s '(lib "main.rkt" "image-data-snip")))
(define/override (read f)
(match-define (list md w h)
(-read (open-input-bytes (send f get-unterminated-bytes))))
(define img-bytes (send f get-unterminated-bytes))
(define bmp (make-bitmap w h))
(send bmp set-argb-pixels 0 0 w h img-bytes)
(define ids (new image-data-snip%))
(send ids set-metadata md)
(send ids set-bitmap bmp)
ids)))
(define image-data-snip-class (new image-data-snip-class%))
(send (get-the-snip-class-list) add image-data-snip-class)
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.
