diff --git a/pkgs/pict-snip-pkgs/pict-snip-doc/info.rkt b/pkgs/pict-snip-pkgs/pict-snip-doc/info.rkt new file mode 100644 index 0000000000..330ca9c308 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip-doc/info.rkt @@ -0,0 +1,16 @@ +#lang info + +(define collection 'multi) + +(define build-deps '("pict-snip-lib" + "gui-doc" + "pict-doc" + "pict-lib" + "racket-doc" + "scribble-lib" + "snip-lib")) +(define deps '("base")) + +(define pkg-desc "documentation part of \"pict\"") + +(define pkg-authors '(robby)) diff --git a/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/info.rkt b/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/info.rkt new file mode 100644 index 0000000000..3ef64a1dbd --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define scribblings + '(("pict-snip/pict-snip.scrbl" (multi-page) (gui-library 100)))) diff --git a/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/pict-snip/pict-snip.scrbl b/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/pict-snip/pict-snip.scrbl new file mode 100644 index 0000000000..111fd91fd2 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip-doc/scribblings/pict-snip/pict-snip.scrbl @@ -0,0 +1,75 @@ +#lang scribble/doc +@(require + scribble/manual + (for-label + pict/snip + pict + racket + racket/snip + racket/contract)) + + +@title{Pict Snip: Build Snips from Picts} + +@defmodule[pict/snip]{ + The @racketmodname[pict/snip] library + constructs @racket[snip%] instances that + draw based on a given @racket[pict?] object. +} + +@defclass[pict-snip% snip% ()]{ + @defconstructor[([pict pict?])]{ + Creates a @racket[pict-snip%] object, using + @racket[pict] to draw. + } + @defmethod[(get-pict) pict?]{ + Returns the pict passed to the constructor. + } + + @defmethod[(get-extent [dc (is-a?/c dc<%>)] [x real?] [y real?] + [w (or/c (box/c (and/c real? (not/c negative?))) #f)] + [h (or/c (box/c (and/c real? (not/c negative?))) #f)] + [descent (or/c (box/c (and/c real? (not/c negative?))) #f)] + [lspace (or/c (box/c (and/c real? (not/c negative?))) #f)] + [rspace (or/c (box/c (and/c real? (not/c negative?))) #f)]) + void?]{ + Updates the arguments based on the + size of the pict returned from @racket[get-pict]. + } + + @defmethod[#:mode + override + (draw [dc (is-a?/c dc<%>)] [x real?] [y real?] + [left real?] + [top real?] + [right real?] + [bottom real?] + [dx real?] + [dy real?] + [draw-caret (or/c 'no-caret 'show-inactive-caret 'show-caret + (cons/c exact-nonnegative-integer? + exact-nonnegative-integer?))]) + void?]{ + Draws the pict returned from @racket[get-pict]. + } + + @defmethod[(write [f (is-a?/c editor-stream-out%)]) void?]{ + Uses a @racket[record-dc%] to write the way that the + result of @racket[get-pict] draws and saves that + to @racket[f]. + } + + @defmethod[(copy) (is-a?/c pict-snip%)]{ + Returns a snip that has the same pict as @racket[this] one. + } + +} + +@defthing[snipclass (is-a?/c snip-class%)]{ + The @racket[snip-class%] instance used by + instances of @racket[pict-snip%]. +} +@defthing[reader (is-a?/c snip-reader<%>)]{ + The @racket[snip-reader<%>] instance used + by the @racketmodname[wxme] library. +} diff --git a/pkgs/pict-snip-pkgs/pict-snip-lib/info.rkt b/pkgs/pict-snip-pkgs/pict-snip-lib/info.rkt new file mode 100644 index 0000000000..822874c327 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip-lib/info.rkt @@ -0,0 +1,15 @@ +#lang info + +(define collection 'multi) + +(define deps '("draw-lib" + "snip-lib" + "pict-lib" + "wxme-lib" + "base")) +(define build-deps '("rackunit-lib" + "gui-lib")) + +(define pkg-desc "implementation (no documentation) part of \"pict-snip\"") + +(define pkg-authors '(robby)) diff --git a/pkgs/pict-snip-pkgs/pict-snip-lib/pict/snip.rkt b/pkgs/pict-snip-pkgs/pict-snip-lib/pict/snip.rkt new file mode 100644 index 0000000000..306c2e7c99 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip-lib/pict/snip.rkt @@ -0,0 +1,123 @@ +#lang racket/base +(require racket/class + racket/snip + racket/draw + racket/format + (prefix-in racket: racket/base) + pict + wxme) + +(provide snipclass + reader + pict-snip%) + +(define pict-snip% + (class snip% + (init-field pict) + (define drawer (make-pict-drawer pict)) + (define/override (get-extent dc x y wb hb db sb lb rb) + (set-box/f! wb (pict-width pict)) + (set-box/f! hb (pict-height pict)) + (set-box/f! db (pict-descent pict)) + (set-box/f! sb (pict-ascent pict)) + (set-box/f! lb 0) + (set-box/f! rb 0)) + (define/override (draw dc x y left top right bottom dx dy draw-caret) + (define smoothing (send dc get-smoothing)) + (send dc set-smoothing 'aligned) + (drawer dc x y) + (send dc set-smoothing smoothing)) + (define/override (copy) + (new pict-snip% [pict pict])) + + (define/override (write f) + (define dc (new record-dc% [width (pict-width pict)] [height (pict-height pict)])) + (send dc set-smoothing 'aligned) + (drawer dc 0 0) + (define bp (open-output-bytes)) + (racket:write (list (send dc get-recorded-datum) + (pict-width pict) + (pict-height pict) + (pict-descent pict) + (pict-ascent pict)) + bp) + (define bts (get-output-bytes bp)) + (send f put (bytes-length bts) bts)) + + (define/public (get-pict) pict) + + (inherit set-snipclass) + (super-new) + (set-snipclass snipclass))) + +(define snipclass + (new (class snip-class% + (define/override (read f) + (raw-data->snip (send f get-unterminated-bytes))) + (super-new)))) +(send snipclass set-classname (~s '((lib "snip.rkt" "pict") (lib "snip-wxme.rkt" "pict")))) +(send snipclass set-version 1) +(define (set-box/f! b v) (when (box? b) (set-box! b v))) +(send (get-the-snip-class-list) add snipclass) + +(define reader + (class* object% (snip-reader<%>) + (define/public (read-header version stream) (void)) + (define/public (read-snip text-only? version stream) + (cond + [text-only? + #"."] + [else + (raw-data->snip (send stream read-raw-bytes 'pict-snip%))])) + (super-new))) + +(define (raw-data->snip bts) + (define p (open-input-bytes bts)) + (define saved (read p)) + (define-values (recorded-datum w h d a) (apply values saved)) + (define drawer (recorded-datum->procedure recorded-datum)) + (new pict-snip% + [pict (dc (λ (dc dx dy) + (define-values (ox oy) (send dc get-origin)) + (send dc set-origin (+ ox dx) (+ oy dy)) + (drawer dc) + (send dc set-origin ox oy)) + w h d a)])) + +(module+ test + (require racket/gui/base + racket/file + racket/port + rackunit) + + (define tmp-file (make-temporary-file "pict-snip-test-case~a.rkt")) + + (dynamic-wind + void + (λ () + + ;; make sure that saving the file in graphical mode works + (define t1 (new text%)) + (define disk-size 10) + (define a-pict (disk disk-size)) + (send t1 insert (new pict-snip% [pict a-pict])) + (unless (send t1 save-file tmp-file 'standard) + (error 'snip.rkt "'standard didn't save properly")) + (define t2 + (parameterize ([current-namespace (make-gui-namespace)]) + (eval `(let () + (define t2 (new text%)) + (send t2 load-file ,tmp-file 'standard) + t2)))) + (define pict2 (send (send t2 find-first-snip) get-pict)) + (define bytes1 (pict->argb-pixels a-pict)) + (define bytes2 (pict->argb-pixels pict2)) + (check-equal? bytes1 bytes2) + + ;; make sure that saving the file in text mode works + (unless (send t1 save-file tmp-file 'text) + (error 'snip.rkt "'text didn't save properly")) + (define sp (open-output-string)) + (call-with-input-file tmp-file (λ (port) (copy-port port sp))) + (check-equal? (get-output-string sp) ".")) + (λ () (delete-file tmp-file)))) diff --git a/pkgs/pict-snip-pkgs/pict-snip/LICENSE.txt b/pkgs/pict-snip-pkgs/pict-snip/LICENSE.txt new file mode 100644 index 0000000000..1e7f9d7529 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip/LICENSE.txt @@ -0,0 +1,11 @@ +pict +Copyright (c) 2010-2014 PLT Design Inc. + +This package is distributed under the GNU Lesser General Public +License (LGPL). This means that you can link Racket into proprietary +applications, provided you follow the rules stated in the LGPL. You +can also modify this package; if you distribute a modified version, +you must distribute it under the terms of the LGPL, which in +particular means that you must release the source code for the +modified software. See http://www.gnu.org/copyleft/lesser.html +for more information. diff --git a/pkgs/pict-snip-pkgs/pict-snip/info.rkt b/pkgs/pict-snip-pkgs/pict-snip/info.rkt new file mode 100644 index 0000000000..f2a4a6f902 --- /dev/null +++ b/pkgs/pict-snip-pkgs/pict-snip/info.rkt @@ -0,0 +1,12 @@ +#lang info + +(define collection 'multi) + +(define deps '("pict-snip-lib" + "pict-snip-doc")) +(define implies '("pict-snip-lib" + "pict-snip-doc")) + +(define pkg-desc "Build snips out of picts") + +(define pkg-authors '(robby))