diff --git a/pitfall/pitfall/annotations.rkt b/pitfall/pitfall/annotations.rkt index 45d7f167..a45026bc 100644 --- a/pitfall/pitfall/annotations.rkt +++ b/pitfall/pitfall/annotations.rkt @@ -1,67 +1,56 @@ #lang racket/base (require "core.rkt" - "reference.rkt" + "reference.rkt" racket/class racket/match - racket/contract - sugar/unstable/class - sugar/unstable/js sugar/unstable/dict) (provide annotation-mixin) -(define (annotation-mixin [% mixin-tester%]) +(define (annotation-mixin [% object%]) (class % (super-new) + (inherit-field @ctm) + + (define/public (annotate x y w h options) + (hash-set*! options + 'Type "Annot" + 'Rect (convert-rect x y w h) + 'Border '(0 0 0)) + (unless (equal? (hash-ref options 'Subtype #f) "Link") + (hash-ref! options 'C + (λ () + (send this normalize-color (or (hash-ref options 'color #f) '(0 0 0)))))) + (hash-remove! options 'color) + + (when (string? (hash-ref options 'Dest #f)) (hash-update! options 'Dest String)) + + (for ([(k v) (in-hash options)]) + (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v)) + + (define annots-ref (make-ref options)) + (send (send this page) annotations annots-ref) + (send annots-ref end) + this) + + (define/public (link x y w h url [options (mhasheq)]) + (hash-set*! options + 'Subtype "Link" + 'A (make-ref (mhash 'S "URI" + 'URI (String url)))) + (send (hash-ref options 'A) end) + (annotate x y w h options)) + + (define/public (convert-rect x1 y1 w h) + ;; flip y1 and y2 + (let ([y2 y1] + [y1 (+ y1 h)] + [x2 (+ x1 w)]) + (match-define (list m0 m1 m2 m3 m4 m5) @ctm) + (let* ([x1 (+ (* x1 m0) (* y1 m2) m4)] + [y1 (+ (* x1 m1) (* y1 m3) m5)] + [x2 (+ (* x2 m0) (* y2 m2) m4)] + [y2 (+ (* x2 m1) (* y2 m3) m5)]) + (list x1 y1 x2 y2)))))) - (as-methods - annotate - link - _convertRect))) - -(define/contract (annotate this x y w h options) - (number? number? number? number? hash? . ->m . object?) - (hash-set*! options - 'Type "Annot" - 'Rect (send this _convertRect x y w h) - 'Border '(0 0 0)) - (unless (equal? (· options Subtype) "Link") - (hash-ref! options 'C - (λ () - (send this normalize-color (or (· options color) '(0 0 0)))))) - (hash-remove! options 'color) - - (when (string? (· options Dest)) (hash-update! options 'Dest String)) - - (for ([(k v) (in-hash options)]) - (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v)) - - (define annots-ref (make-ref options)) - (send (· this page) annotations annots-ref) - (· annots-ref end) - this) - - -(define/contract (link this x y w h url [options (mhash)]) - ((number? number? number? number? string?) (hash?) . ->*m . object?) - (hash-set*! options - 'Subtype "Link" - 'A (make-ref (mhash 'S "URI" - 'URI (String url)))) - (send (· options A) end) - (send this annotate x y w h options)) - - -(define/contract (_convertRect this x1 y1 w h) - (number? number? number? number? . ->m . (list/c number? number? number? number?)) - ;; flip y1 and y2 - (let ([y2 y1] - [y1 (+ y1 h)] - [x2 (+ x1 w)]) - (match-define (list m0 m1 m2 m3 m4 m5) (· this @ctm)) - (let* ([x1 (+ (* x1 m0) (* y1 m2) m4)] - [y1 (+ (* x1 m1) (* y1 m3) m5)] - [x2 (+ (* x2 m0) (* y2 m2) m4)] - [y2 (+ (* x2 m1) (* y2 m3) m5)]) - (list x1 y1 x2 y2)))) \ No newline at end of file