diff --git a/pkgs/drracket-pkgs/drracket/drracket/arrow.rkt b/pkgs/drracket-pkgs/drracket/drracket/arrow.rkt index 10d2627017..46e43236ec 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/arrow.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/arrow.rkt @@ -1,203 +1,5 @@ #lang racket/base -(require racket/class - racket/math - racket/gui/base) +(require unstable/arrow) (provide draw-arrow) - -(define largest 16383) -(define smallest -16383) - -(define arrow-head-angle (/ pi 8)) -(define cos-arrow-head-angle (cos arrow-head-angle)) -(define sin-arrow-head-angle (sin arrow-head-angle)) - -(define arrow-head-size 8) -(define arrow-head-size-cos-arrow-head-angle (* arrow-head-size cos-arrow-head-angle)) -(define arrow-head-size-sin-arrow-head-angle (* arrow-head-size sin-arrow-head-angle)) - -(define arrow-root-radius 2.5) -(define arrow-root-diameter (* 2 arrow-root-radius)) - -; If alpha is the angle between the x axis and the Start->End vector: -; -; p2-x = end-x + arrow-head-size * cos(alpha + pi - arrow-head-angle) -; = end-x - arrow-head-size * cos(alpha - arrow-head-angle) -; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) + sin(alpha) * sin(arrow-head-angle)) -; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha - arrow-head-size-sin-arrow-head-angle * sin-alpha -; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha - arrow-head-size-sin-arrow-head-angle-sin-alpha -; -; p2-y = end-y + arrow-head-size * sin(alpha + pi - arrow-head-angle) -; = end-y - arrow-head-size * sin(alpha - arrow-head-angle) -; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) - cos(alpha) * sin(arrow-head-angle)) -; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha + arrow-head-size-sin-arrow-head-angle * cos-alpha -; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha + arrow-head-size-sin-arrow-head-angle-cos-alpha -; -; p3-x = end-x + arrow-head-size * cos(alpha + pi + arrow-head-angle) -; = end-x - arrow-head-size * cos(alpha + arrow-head-angle) -; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) - sin(alpha) * sin(arrow-head-angle)) -; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha + arrow-head-size-sin-arrow-head-angle * sin-alpha -; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha + arrow-head-size-sin-arrow-head-angle-sin-alpha -; -; p3-y = end-y + arrow-head-size * sin(alpha + pi + arrow-head-angle) -; = end-y - arrow-head-size * sin(alpha + arrow-head-angle) -; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) + cos(alpha) * sin(arrow-head-angle)) -; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha - arrow-head-size-sin-arrow-head-angle * cos-alpha -; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha - arrow-head-size-sin-arrow-head-angle-cos-alpha - -; dc<%> real real real real real real -> void -; draw one arrow -(define (draw-arrow dc uncropped-pre-start-x uncropped-pre-start-y uncropped-pre-end-x uncropped-pre-end-y dx dy - #:pen-width [pen-width #f]) - (define the-pen-width (or pen-width (send (send dc get-pen) get-width))) - (let ([uncropped-start-x (+ uncropped-pre-start-x dx (- (/ the-pen-width 2)))] - [uncropped-start-y (+ uncropped-pre-start-y dy)] - [uncropped-end-x (+ uncropped-pre-end-x dx (- (/ the-pen-width 2)))] - [uncropped-end-y (+ uncropped-pre-end-y dy)] - [old-smoothed (send dc get-smoothing)]) - (let*-values ([(start-x start-y) (crop-to uncropped-start-x uncropped-start-y uncropped-end-x uncropped-end-y)] - [(end-x end-y) (crop-to uncropped-end-x uncropped-end-y uncropped-start-x uncropped-start-y)]) - (send dc set-smoothing 'aligned) - (define saved-pen (send dc get-pen)) - (when pen-width - (send dc set-pen - (let ([p (send dc get-pen)]) - (send the-pen-list find-or-create-pen - (send p get-color) - pen-width - (send p get-style) - (send p get-cap) - (send p get-join))))) - (send dc draw-line start-x start-y end-x end-y) - (send dc set-pen saved-pen) - (when (and (< smallest start-x largest) - (< smallest start-y largest)) - (send dc draw-ellipse - (- start-x arrow-root-radius) (- start-y arrow-root-radius) - arrow-root-diameter arrow-root-diameter)) - (when (and (< smallest end-x largest) - (< smallest end-y largest)) - (unless (and (= start-x end-x) (= start-y end-y)) - (let* ([offset-x (- end-x start-x)] - [offset-y (- end-y start-y)] - [arrow-length (sqrt (+ (* offset-x offset-x) (* offset-y offset-y)))] - [cos-alpha (/ offset-x arrow-length)] - [sin-alpha (/ offset-y arrow-length)] - [arrow-head-size-cos-arrow-head-angle-cos-alpha (* arrow-head-size-cos-arrow-head-angle cos-alpha)] - [arrow-head-size-cos-arrow-head-angle-sin-alpha (* arrow-head-size-cos-arrow-head-angle sin-alpha)] - [arrow-head-size-sin-arrow-head-angle-cos-alpha (* arrow-head-size-sin-arrow-head-angle cos-alpha)] - [arrow-head-size-sin-arrow-head-angle-sin-alpha (* arrow-head-size-sin-arrow-head-angle sin-alpha)] - ; pt1 is the tip of the arrow, pt2 is the first point going clockwise from pt1 - [pt1 (make-object point% end-x end-y)] - [pt2 (make-object point% - (- end-x arrow-head-size-cos-arrow-head-angle-cos-alpha arrow-head-size-sin-arrow-head-angle-sin-alpha) - (+ end-y (- arrow-head-size-cos-arrow-head-angle-sin-alpha) arrow-head-size-sin-arrow-head-angle-cos-alpha))] - [pt3 (make-object point% - (+ end-x (- arrow-head-size-cos-arrow-head-angle-cos-alpha) arrow-head-size-sin-arrow-head-angle-sin-alpha) - (- end-y arrow-head-size-cos-arrow-head-angle-sin-alpha arrow-head-size-sin-arrow-head-angle-cos-alpha))]) - (send dc draw-polygon (list pt1 pt2 pt3))))) - (send dc set-smoothing old-smoothed)))) - -;; crop-to : number number number number -> (values number number) -;; returns x,y if they are in the range defined by largest and smallest -;; otherwise returns the coordinates on the line from x,y to ox,oy -;; that are closest to x,y and are in the range specified by -;; largest and smallest -(define (crop-to x y ox oy) - (cond - [(and (< smallest x largest) (< smallest y largest)) - (values x y)] - [else - (let* ([xy-pr (cons x y)] - [left-i (find-intersection x y ox oy smallest smallest smallest largest)] - [top-i (find-intersection x y ox oy smallest smallest largest smallest)] - [right-i (find-intersection x y ox oy largest smallest largest largest)] - [bottom-i (find-intersection x y ox oy smallest largest largest largest)] - [d-top (and top-i (dist top-i xy-pr))] - [d-bottom (and bottom-i (dist bottom-i xy-pr))] - [d-left (and left-i (dist left-i xy-pr))] - [d-right (and right-i (dist right-i xy-pr))]) - (cond - [(smallest? d-top d-bottom d-left d-right) - (values (car top-i) (cdr top-i))] - [(smallest? d-bottom d-top d-left d-right) - (values (car bottom-i) (cdr bottom-i))] - [(smallest? d-left d-top d-bottom d-right) - (values (car left-i) (cdr left-i))] - [(smallest? d-right d-top d-bottom d-left) - (values (car right-i) (cdr right-i))] - [else - ;; uh oh... if this case happens, that's bad news... - (values x y)]))])) - -;; smallest? : (union #f number)^4 -> boolean -;; returns #t if can is less and o1, o2, and o3 -;; if can is #f, return #f. If o1, o2, or o3 is #f, assume that can is smaller than them -(define (smallest? can o1 o2 o3) - (and can - (andmap (λ (x) (< can x)) - (filter (λ (x) x) - (list o1 o2 o3))))) - - -;; inside? : (union #f (cons number number)) -> (union #f (cons number number)) -;; returns the original pair if the coordinates are between smallest and largest -;; and returns #f if the pair is #f or the coordinates are outside. -(define (inside? pr) - (and pr - (let ([x (car pr)] - [y (cdr pr)]) - (if (and (< smallest x largest) - (< smallest y largest)) - pr - #f)))) - -;; find-intersection : (number^2)^2 -> (union (cons number number) #f) -;; finds the intersection between the lines specified by -;; (x1,y1) -> (x2,y2) and (x3,y3) -> (x4,y4) -(define (find-intersection x1 y1 x2 y2 x3 y3 x4 y4) - (cond - [(and (= x1 x2) (= x3 x4)) - #f] - [(and (= x1 x2) (not (= x3 x4))) - (let* ([m2 (/ (- y3 y4) (- x3 x4))] - [b2 (- y3 (* m2 x3))]) - (cons x1 - (+ (* m2 x1) b2)))] - [(and (not (= x1 x2)) (= x3 x4)) - (let* ([m1 (/ (- y1 y2) (- x1 x2))] - [b1 (- y1 (* m1 x1))]) - (cons x3 - (+ (* m1 x3) b1)))] - [(and (not (= x1 x2)) (not (= x3 x4))) - (let* ([m1 (/ (- y1 y2) (- x1 x2))] - [b1 (- y1 (* m1 x1))] - [m2 (/ (- y3 y4) (- x3 x4))] - [b2 (- y3 (* m2 x3))]) - (if (= m1 m2) - #f - (let* ([x (/ (- b1 b2) (- m2 m1))] - [y (+ (* m1 x) b1)]) - (cons x y))))])) - -;; dist : (cons number number) (cons number number) -> number -(define (dist p1 p2) - (sqrt (+ (sqr (- (car p1) (car p2))) - (sqr (- (cdr p1) (cdr p2)))))) - -;; localled defined test code.... :( -;; use module language to run tests -(define (tests) - (and (equal? (find-intersection 0 1 0 10 0 2 0 20) #f) - (equal? (find-intersection 0 1 0 10 0 0 10 10) (cons 0 0)) - (equal? (find-intersection 0 0 10 10 0 1 0 10) (cons 0 0)) - (equal? (find-intersection 0 0 3 3 2 2 4 4) #f) - (equal? (find-intersection -3 3 3 -3 -3 -3 3 3) (cons 0 0)) - (equal? (smallest? 3 1 2 3) #f) - (equal? (smallest? 0 1 2 3) #t) - (equal? (smallest? 1 0 2 3) #f) - (equal? (smallest? 1 0 #f 4) #f) - (equal? (smallest? 1 #f #f 4) #t) - (equal? (smallest? 1 #f #f #f) #t) - (equal? (dist (cons 1 1) (cons 4 5)) 5))) diff --git a/pkgs/drracket-pkgs/drracket/info.rkt b/pkgs/drracket-pkgs/drracket/info.rkt index c1617bbbdc..4ee60ade84 100644 --- a/pkgs/drracket-pkgs/drracket/info.rkt +++ b/pkgs/drracket-pkgs/drracket/info.rkt @@ -32,7 +32,8 @@ "macro-debugger" "net-lib" "srfi-lib" - "srfi-doc")) + "srfi-doc" + "unstable")) (define build-deps '("compatibility-doc" "draw-doc" "errortrace-doc" diff --git a/pkgs/macro-debugger-pkgs/macro-debugger/info.rkt b/pkgs/macro-debugger-pkgs/macro-debugger/info.rkt index 9194935901..3e6e1a0078 100644 --- a/pkgs/macro-debugger-pkgs/macro-debugger/info.rkt +++ b/pkgs/macro-debugger-pkgs/macro-debugger/info.rkt @@ -5,11 +5,11 @@ (define deps '("base" "compatibility-lib" "data-lib" - "drracket" "gui-lib" "images" "parser-tools-lib" "unstable-list-lib" - "macro-debugger-text-lib")) + "macro-debugger-text-lib" + "unstable")) (define build-deps '("scribble-lib" "racket-doc")) diff --git a/pkgs/macro-debugger-pkgs/macro-debugger/macro-debugger/syntax-browser/text.rkt b/pkgs/macro-debugger-pkgs/macro-debugger/macro-debugger/syntax-browser/text.rkt index 3eb754afc8..57ea784c44 100644 --- a/pkgs/macro-debugger-pkgs/macro-debugger/macro-debugger/syntax-browser/text.rkt +++ b/pkgs/macro-debugger-pkgs/macro-debugger/macro-debugger/syntax-browser/text.rkt @@ -2,7 +2,7 @@ (require racket/class racket/gui/base data/interval-map - drracket/arrow + unstable/arrow framework data/interval-map macro-debugger/syntax-browser/interfaces) diff --git a/pkgs/macro-debugger-pkgs/macro-debugger/unstable/info.rkt b/pkgs/macro-debugger-pkgs/macro-debugger/unstable/info.rkt new file mode 100644 index 0000000000..2b2011421b --- /dev/null +++ b/pkgs/macro-debugger-pkgs/macro-debugger/unstable/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define scribblings + '(("unstable-find.scrbl" (multi-page) (experimental)))) diff --git a/pkgs/unstable/scribblings/find.scrbl b/pkgs/macro-debugger-pkgs/macro-debugger/unstable/unstable-find.scrbl similarity index 96% rename from pkgs/unstable/scribblings/find.scrbl rename to pkgs/macro-debugger-pkgs/macro-debugger/unstable/unstable-find.scrbl index 9ad88a5bc2..be0c11c03a 100644 --- a/pkgs/unstable/scribblings/find.scrbl +++ b/pkgs/macro-debugger-pkgs/macro-debugger/unstable/unstable-find.scrbl @@ -1,11 +1,12 @@ #lang scribble/manual -@(require scribble/eval "utils.rkt" +@(require scribble/eval + unstable/scribblings/utils (for-label unstable/find racket/contract racket/shared racket/base)) @(define the-eval (make-base-eval)) @(the-eval '(require unstable/find racket/shared)) -@title[#:tag "find"]{Find} +@unstable-title[#:tag "find"]{Find} @unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] @defmodule[unstable/find] diff --git a/pkgs/main-distribution/info.rkt b/pkgs/main-distribution/info.rkt index 12f37d3051..edc1f2fba5 100644 --- a/pkgs/main-distribution/info.rkt +++ b/pkgs/main-distribution/info.rkt @@ -76,6 +76,8 @@ "unstable-list-lib" "unstable-options-lib" "unstable-parameter-group-lib" + "unstable-flonum-doc" + "unstable-redex" "web-server" "wxme" "xrepl")) diff --git a/pkgs/unstable-flonum-pkgs/unstable-flonum-doc/info.rkt b/pkgs/unstable-flonum-pkgs/unstable-flonum-doc/info.rkt new file mode 100644 index 0000000000..4f8bdd875d --- /dev/null +++ b/pkgs/unstable-flonum-pkgs/unstable-flonum-doc/info.rkt @@ -0,0 +1,14 @@ +#lang info + +(define collection "unstable") + +(define scribblings + '(("unstable-flonum.scrbl" (multi-page) (experimental)))) + +(define deps '("base" + "scribble-lib" + "unstable" + "unstable-flonum-lib")) + +(define build-deps '("plot" ; used for an example + "racket-doc")) diff --git a/pkgs/unstable/scribblings/flonum.scrbl b/pkgs/unstable-flonum-pkgs/unstable-flonum-doc/unstable-flonum.scrbl similarity index 98% rename from pkgs/unstable/scribblings/flonum.scrbl rename to pkgs/unstable-flonum-pkgs/unstable-flonum-doc/unstable-flonum.scrbl index 700fe6e995..da8f3070a8 100644 --- a/pkgs/unstable/scribblings/flonum.scrbl +++ b/pkgs/unstable-flonum-pkgs/unstable-flonum-doc/unstable-flonum.scrbl @@ -1,7 +1,7 @@ #lang scribble/manual @(require scribble/eval - "utils.rkt" + unstable/scribblings/utils (for-label racket unstable/flonum racket/flonum)) @(define the-eval (make-base-eval)) @@ -10,13 +10,11 @@ [plot-bitmap plot] [plot3d-bitmap plot3d]))) -@title[#:tag "flonum"]{Flonums} +@unstable-title[#:tag "flonum"]{Flonums} @unstable[@author+email["Neil Toronto" "ntoronto@racket-lang.org"]] @defmodule[unstable/flonum] - - @defproc[(flonum->bit-field [x flonum?]) (integer-in 0 (- (expt 2 64) 1))]{ Returns the bits comprising @racket[x] as an integer. A convenient shortcut for composing @racket[integer-bytes->integer] with @racket[real->floating-point-bytes]. diff --git a/pkgs/unstable-flonum-lib/info.rkt b/pkgs/unstable-flonum-pkgs/unstable-flonum-lib/info.rkt similarity index 100% rename from pkgs/unstable-flonum-lib/info.rkt rename to pkgs/unstable-flonum-pkgs/unstable-flonum-lib/info.rkt diff --git a/pkgs/unstable-flonum-lib/unstable/flonum.rkt b/pkgs/unstable-flonum-pkgs/unstable-flonum-lib/unstable/flonum.rkt similarity index 100% rename from pkgs/unstable-flonum-lib/unstable/flonum.rkt rename to pkgs/unstable-flonum-pkgs/unstable-flonum-lib/unstable/flonum.rkt diff --git a/pkgs/unstable/gui/redex.rkt b/pkgs/unstable-redex/gui/redex.rkt similarity index 100% rename from pkgs/unstable/gui/redex.rkt rename to pkgs/unstable-redex/gui/redex.rkt diff --git a/pkgs/unstable/scribblings/gui/redex.scrbl b/pkgs/unstable-redex/gui/unstable-redex.scrbl similarity index 98% rename from pkgs/unstable/scribblings/gui/redex.scrbl rename to pkgs/unstable-redex/gui/unstable-redex.scrbl index f63a00b042..7f1405ba28 100644 --- a/pkgs/unstable/scribblings/gui/redex.scrbl +++ b/pkgs/unstable-redex/gui/unstable-redex.scrbl @@ -1,12 +1,13 @@ #lang scribble/manual -@(require racket/stxparam scribble/base scribble/eval "../utils.rkt" +@(require racket/stxparam scribble/base scribble/eval + unstable/scribblings/utils (for-syntax racket/base syntax/srcloc) (for-label racket/base racket/contract pict redex unstable/gui/redex)) @(define the-eval (make-base-eval)) @(the-eval '(require redex/reduction-semantics redex/pict unstable/gui/redex pict)) -@title[#:tag "redex"]{Redex} +@unstable-title[#:tag "redex"]{Redex} @unstable-header[] @defmodule[unstable/gui/redex] diff --git a/pkgs/unstable-redex/info.rkt b/pkgs/unstable-redex/info.rkt new file mode 100644 index 0000000000..a27055b85f --- /dev/null +++ b/pkgs/unstable-redex/info.rkt @@ -0,0 +1,16 @@ +#lang info + +(define collection "unstable") + +(define scribblings + '(("gui/unstable-redex.scrbl" (multi-page) (experimental)))) + +(define deps '("base" + "pict-lib" + "redex-lib" + "scribble-lib" + "unstable")) + +(define build-deps '("pict-doc" + "redex-doc" + "racket-doc")) diff --git a/pkgs/unstable/arrow.rkt b/pkgs/unstable/arrow.rkt new file mode 100644 index 0000000000..0205ca215f --- /dev/null +++ b/pkgs/unstable/arrow.rkt @@ -0,0 +1,203 @@ +#lang racket/base + +(require racket/class + racket/math + racket/draw) + +(provide draw-arrow) + +(define largest 16383) +(define smallest -16383) + +(define arrow-head-angle (/ pi 8)) +(define cos-arrow-head-angle (cos arrow-head-angle)) +(define sin-arrow-head-angle (sin arrow-head-angle)) + +(define arrow-head-size 8) +(define arrow-head-size-cos-arrow-head-angle (* arrow-head-size cos-arrow-head-angle)) +(define arrow-head-size-sin-arrow-head-angle (* arrow-head-size sin-arrow-head-angle)) + +(define arrow-root-radius 2.5) +(define arrow-root-diameter (* 2 arrow-root-radius)) + +; If alpha is the angle between the x axis and the Start->End vector: +; +; p2-x = end-x + arrow-head-size * cos(alpha + pi - arrow-head-angle) +; = end-x - arrow-head-size * cos(alpha - arrow-head-angle) +; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) + sin(alpha) * sin(arrow-head-angle)) +; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha - arrow-head-size-sin-arrow-head-angle * sin-alpha +; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha - arrow-head-size-sin-arrow-head-angle-sin-alpha +; +; p2-y = end-y + arrow-head-size * sin(alpha + pi - arrow-head-angle) +; = end-y - arrow-head-size * sin(alpha - arrow-head-angle) +; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) - cos(alpha) * sin(arrow-head-angle)) +; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha + arrow-head-size-sin-arrow-head-angle * cos-alpha +; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha + arrow-head-size-sin-arrow-head-angle-cos-alpha +; +; p3-x = end-x + arrow-head-size * cos(alpha + pi + arrow-head-angle) +; = end-x - arrow-head-size * cos(alpha + arrow-head-angle) +; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) - sin(alpha) * sin(arrow-head-angle)) +; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha + arrow-head-size-sin-arrow-head-angle * sin-alpha +; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha + arrow-head-size-sin-arrow-head-angle-sin-alpha +; +; p3-y = end-y + arrow-head-size * sin(alpha + pi + arrow-head-angle) +; = end-y - arrow-head-size * sin(alpha + arrow-head-angle) +; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) + cos(alpha) * sin(arrow-head-angle)) +; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha - arrow-head-size-sin-arrow-head-angle * cos-alpha +; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha - arrow-head-size-sin-arrow-head-angle-cos-alpha + +; dc<%> real real real real real real -> void +; draw one arrow +(define (draw-arrow dc uncropped-pre-start-x uncropped-pre-start-y uncropped-pre-end-x uncropped-pre-end-y dx dy + #:pen-width [pen-width #f]) + (define the-pen-width (or pen-width (send (send dc get-pen) get-width))) + (let ([uncropped-start-x (+ uncropped-pre-start-x dx (- (/ the-pen-width 2)))] + [uncropped-start-y (+ uncropped-pre-start-y dy)] + [uncropped-end-x (+ uncropped-pre-end-x dx (- (/ the-pen-width 2)))] + [uncropped-end-y (+ uncropped-pre-end-y dy)] + [old-smoothed (send dc get-smoothing)]) + (let*-values ([(start-x start-y) (crop-to uncropped-start-x uncropped-start-y uncropped-end-x uncropped-end-y)] + [(end-x end-y) (crop-to uncropped-end-x uncropped-end-y uncropped-start-x uncropped-start-y)]) + (send dc set-smoothing 'aligned) + (define saved-pen (send dc get-pen)) + (when pen-width + (send dc set-pen + (let ([p (send dc get-pen)]) + (send the-pen-list find-or-create-pen + (send p get-color) + pen-width + (send p get-style) + (send p get-cap) + (send p get-join))))) + (send dc draw-line start-x start-y end-x end-y) + (send dc set-pen saved-pen) + (when (and (< smallest start-x largest) + (< smallest start-y largest)) + (send dc draw-ellipse + (- start-x arrow-root-radius) (- start-y arrow-root-radius) + arrow-root-diameter arrow-root-diameter)) + (when (and (< smallest end-x largest) + (< smallest end-y largest)) + (unless (and (= start-x end-x) (= start-y end-y)) + (let* ([offset-x (- end-x start-x)] + [offset-y (- end-y start-y)] + [arrow-length (sqrt (+ (* offset-x offset-x) (* offset-y offset-y)))] + [cos-alpha (/ offset-x arrow-length)] + [sin-alpha (/ offset-y arrow-length)] + [arrow-head-size-cos-arrow-head-angle-cos-alpha (* arrow-head-size-cos-arrow-head-angle cos-alpha)] + [arrow-head-size-cos-arrow-head-angle-sin-alpha (* arrow-head-size-cos-arrow-head-angle sin-alpha)] + [arrow-head-size-sin-arrow-head-angle-cos-alpha (* arrow-head-size-sin-arrow-head-angle cos-alpha)] + [arrow-head-size-sin-arrow-head-angle-sin-alpha (* arrow-head-size-sin-arrow-head-angle sin-alpha)] + ; pt1 is the tip of the arrow, pt2 is the first point going clockwise from pt1 + [pt1 (make-object point% end-x end-y)] + [pt2 (make-object point% + (- end-x arrow-head-size-cos-arrow-head-angle-cos-alpha arrow-head-size-sin-arrow-head-angle-sin-alpha) + (+ end-y (- arrow-head-size-cos-arrow-head-angle-sin-alpha) arrow-head-size-sin-arrow-head-angle-cos-alpha))] + [pt3 (make-object point% + (+ end-x (- arrow-head-size-cos-arrow-head-angle-cos-alpha) arrow-head-size-sin-arrow-head-angle-sin-alpha) + (- end-y arrow-head-size-cos-arrow-head-angle-sin-alpha arrow-head-size-sin-arrow-head-angle-cos-alpha))]) + (send dc draw-polygon (list pt1 pt2 pt3))))) + (send dc set-smoothing old-smoothed)))) + +;; crop-to : number number number number -> (values number number) +;; returns x,y if they are in the range defined by largest and smallest +;; otherwise returns the coordinates on the line from x,y to ox,oy +;; that are closest to x,y and are in the range specified by +;; largest and smallest +(define (crop-to x y ox oy) + (cond + [(and (< smallest x largest) (< smallest y largest)) + (values x y)] + [else + (let* ([xy-pr (cons x y)] + [left-i (find-intersection x y ox oy smallest smallest smallest largest)] + [top-i (find-intersection x y ox oy smallest smallest largest smallest)] + [right-i (find-intersection x y ox oy largest smallest largest largest)] + [bottom-i (find-intersection x y ox oy smallest largest largest largest)] + [d-top (and top-i (dist top-i xy-pr))] + [d-bottom (and bottom-i (dist bottom-i xy-pr))] + [d-left (and left-i (dist left-i xy-pr))] + [d-right (and right-i (dist right-i xy-pr))]) + (cond + [(smallest? d-top d-bottom d-left d-right) + (values (car top-i) (cdr top-i))] + [(smallest? d-bottom d-top d-left d-right) + (values (car bottom-i) (cdr bottom-i))] + [(smallest? d-left d-top d-bottom d-right) + (values (car left-i) (cdr left-i))] + [(smallest? d-right d-top d-bottom d-left) + (values (car right-i) (cdr right-i))] + [else + ;; uh oh... if this case happens, that's bad news... + (values x y)]))])) + +;; smallest? : (union #f number)^4 -> boolean +;; returns #t if can is less and o1, o2, and o3 +;; if can is #f, return #f. If o1, o2, or o3 is #f, assume that can is smaller than them +(define (smallest? can o1 o2 o3) + (and can + (andmap (λ (x) (< can x)) + (filter (λ (x) x) + (list o1 o2 o3))))) + + +;; inside? : (union #f (cons number number)) -> (union #f (cons number number)) +;; returns the original pair if the coordinates are between smallest and largest +;; and returns #f if the pair is #f or the coordinates are outside. +(define (inside? pr) + (and pr + (let ([x (car pr)] + [y (cdr pr)]) + (if (and (< smallest x largest) + (< smallest y largest)) + pr + #f)))) + +;; find-intersection : (number^2)^2 -> (union (cons number number) #f) +;; finds the intersection between the lines specified by +;; (x1,y1) -> (x2,y2) and (x3,y3) -> (x4,y4) +(define (find-intersection x1 y1 x2 y2 x3 y3 x4 y4) + (cond + [(and (= x1 x2) (= x3 x4)) + #f] + [(and (= x1 x2) (not (= x3 x4))) + (let* ([m2 (/ (- y3 y4) (- x3 x4))] + [b2 (- y3 (* m2 x3))]) + (cons x1 + (+ (* m2 x1) b2)))] + [(and (not (= x1 x2)) (= x3 x4)) + (let* ([m1 (/ (- y1 y2) (- x1 x2))] + [b1 (- y1 (* m1 x1))]) + (cons x3 + (+ (* m1 x3) b1)))] + [(and (not (= x1 x2)) (not (= x3 x4))) + (let* ([m1 (/ (- y1 y2) (- x1 x2))] + [b1 (- y1 (* m1 x1))] + [m2 (/ (- y3 y4) (- x3 x4))] + [b2 (- y3 (* m2 x3))]) + (if (= m1 m2) + #f + (let* ([x (/ (- b1 b2) (- m2 m1))] + [y (+ (* m1 x) b1)]) + (cons x y))))])) + +;; dist : (cons number number) (cons number number) -> number +(define (dist p1 p2) + (sqrt (+ (sqr (- (car p1) (car p2))) + (sqr (- (cdr p1) (cdr p2)))))) + +;; localled defined test code.... :( +;; use module language to run tests +(define (tests) + (and (equal? (find-intersection 0 1 0 10 0 2 0 20) #f) + (equal? (find-intersection 0 1 0 10 0 0 10 10) (cons 0 0)) + (equal? (find-intersection 0 0 10 10 0 1 0 10) (cons 0 0)) + (equal? (find-intersection 0 0 3 3 2 2 4 4) #f) + (equal? (find-intersection -3 3 3 -3 -3 -3 3 3) (cons 0 0)) + (equal? (smallest? 3 1 2 3) #f) + (equal? (smallest? 0 1 2 3) #t) + (equal? (smallest? 1 0 2 3) #f) + (equal? (smallest? 1 0 #f 4) #f) + (equal? (smallest? 1 #f #f 4) #t) + (equal? (smallest? 1 #f #f #f) #t) + (equal? (dist (cons 1 1) (cons 4 5)) 5))) diff --git a/pkgs/unstable/info.rkt b/pkgs/unstable/info.rkt index 7dd8f52622..56bf907265 100644 --- a/pkgs/unstable/info.rkt +++ b/pkgs/unstable/info.rkt @@ -9,14 +9,15 @@ "draw-lib" "gui-lib" "pict-lib" - "redex-lib" "scribble-lib" "slideshow-lib")) -(define build-deps '("scribble-doc" - "plot" +(define build-deps '("draw-doc" + "gui-doc" + "pict-doc" + "slideshow-doc" + "scribble-doc" "at-exp-lib" "compatibility-lib" - "macro-debugger" "racket-doc" "rackunit-lib" "typed-racket-lib" diff --git a/pkgs/unstable/scribblings/gui.scrbl b/pkgs/unstable/scribblings/gui.scrbl new file mode 100644 index 0000000000..b7fdfbc157 --- /dev/null +++ b/pkgs/unstable/scribblings/gui.scrbl @@ -0,0 +1,23 @@ +#lang scribble/doc +@(require scribble/base + scribble/manual + (for-label scribble/base)) + +#lang scribble/doc +@(require scribble/base + scribble/manual + (for-syntax racket/base racket/path) + (for-label scribble/base)) + +@unstable-title[#:style '(toc) #:tag "unstable-gui"]{GUI} + +@local-table-of-contents[#:style 'immediate-only] + +@include-section["gui/notify.scrbl"] +@include-section["gui/prefs.scrbl"] +@include-section["gui/pict.scrbl"] +@include-section["gui/slideshow.scrbl"] +@include-section["gui/pslide.scrbl"] +@include-section["gui/redex.scrbl"] +@include-section["gui/snip.scrbl"] +@include-section["gui/scribble.scrbl"] diff --git a/pkgs/unstable/scribblings/gui/snip.scrbl b/pkgs/unstable/scribblings/gui/snip.scrbl index 0a1e31eaf3..97a3a0e0a5 100644 --- a/pkgs/unstable/scribblings/gui/snip.scrbl +++ b/pkgs/unstable/scribblings/gui/snip.scrbl @@ -5,8 +5,7 @@ racket/class racket/gui/base unstable/gui/snip - racket/contract - plot)) + racket/contract)) @title[#:tag "snip"]{Snip Utilities} @unstable[@author+email["Neil Toronto" "neil.toronto@gmail.com"]] @@ -17,7 +16,7 @@ A canvas that contains a single snip. Snips cannot be placed directly on dialogs, frames and panels. -To use an interactive snip (such as one returned by @racket[plot-snip]) in a GUI, +To use an interactive snip in a GUI, it must be inserted into an editor, which itself must be placed on a special canvas, which can be placed in a GUI container. To provide a seamless user experience, the editor should be enabled but not writable, not be able to receive focus, not have scrollbars, and other small details. @@ -70,7 +69,8 @@ On subsequent calls, @method[snip-canvas% on-size] calls the snip's @method[snip When a @racket[snip-canvas%] instance is intended to wrap an existing @racket[snip%] instance, @racket[make-snip] should simply resize it and return it. -Example: @racket[plot-frame] and @racket[plot3d-frame] create snips and call a function similar to the following to place them in a frame: +Example: functions from @racketmodname[plot #:indirect] +create snips and call a function similar to the following to place plots in a frame: @racketblock[ (define (make-snip-frame snip w h label) (define (make-snip width height) diff --git a/pkgs/unstable/scribblings/gui/unstable-gui.scrbl b/pkgs/unstable/scribblings/gui/unstable-gui.scrbl index ec62c2ec90..827179f4b0 100644 --- a/pkgs/unstable/scribblings/gui/unstable-gui.scrbl +++ b/pkgs/unstable/scribblings/gui/unstable-gui.scrbl @@ -17,6 +17,5 @@ unstable libraries. @include-section["pict.scrbl"] @include-section["slideshow.scrbl"] @include-section["pslide.scrbl"] -@include-section["redex.scrbl"] @include-section["snip.scrbl"] @include-section["scribble.scrbl"] diff --git a/pkgs/unstable/scribblings/parameter-group.scrbl b/pkgs/unstable/scribblings/parameter-group.scrbl index 8bcfb74c98..e34077c8f3 100644 --- a/pkgs/unstable/scribblings/parameter-group.scrbl +++ b/pkgs/unstable/scribblings/parameter-group.scrbl @@ -24,7 +24,8 @@ Parameter groups are parameter-like @italic{views} that represent multiple param (list (param1) (param2))] Use parameter groups to conveniently set multiple parameters. -For example, the @racketmodname[plot] library uses parameter groups to save and restore appearance-controlling parameters when it must draw plots within a thunk. +For example, the @racketmodname[plot #:indirect] library uses parameter groups +to save and restore appearance-controlling parameters when it must draw plots within a thunk. @defproc[(parameter-group? [v any/c]) boolean?]{ Returns @racket[#t] when @racket[v] is a parameter group. diff --git a/pkgs/unstable/scribblings/unstable.scrbl b/pkgs/unstable/scribblings/unstable.scrbl index f6e9068703..750b6ce4fc 100644 --- a/pkgs/unstable/scribblings/unstable.scrbl +++ b/pkgs/unstable/scribblings/unstable.scrbl @@ -1,10 +1,11 @@ #lang scribble/doc @(require scribble/base scribble/manual + "utils.rkt" (for-syntax racket/base racket/path) (for-label scribble/base)) -@title[#:tag "unstable"]{Unstable: May Change Without Warning} +@unstable-title[#:tag "unstable"] This manual documents some of the libraries available in the @racketidfont{unstable} collection. See also @other-doc['(lib @@ -83,8 +84,6 @@ Keep documentation and tests up to date. @include-section["debug.scrbl"] @include-section["define.scrbl"] @include-section["error.scrbl"] -@include-section["find.scrbl"] -@include-section["flonum.scrbl"] @include-section["future.scrbl"] @include-section["function.scrbl"] @include-section["hash.scrbl"] diff --git a/pkgs/unstable/scribblings/utils.rkt b/pkgs/unstable/scribblings/utils.rkt index 8f82fc9f11..5d62e5897b 100644 --- a/pkgs/unstable/scribblings/utils.rkt +++ b/pkgs/unstable/scribblings/utils.rkt @@ -1,6 +1,7 @@ #lang at-exp racket/base (require scribble/base scribble/manual scribble/core scribble/eval) (provide unstable + unstable-title unstable-header addition) @@ -22,3 +23,13 @@ Place either @unstable or @unstable-header immediately after the (define (addition name) @margin-note{The subsequent bindings were added by @|name|.}) + +(define unstable-title + (make-keyword-procedure + (lambda (kws kw-args . content) + (keyword-apply title kws kw-args + "Unstable" + (if (null? content) "" " ") + content + ": May Change Without Warning" + null)))) diff --git a/racket/lib/collects/setup/link.rkt b/racket/lib/collects/setup/link.rkt index f1e08483ef..72c138b5b5 100644 --- a/racket/lib/collects/setup/link.rkt +++ b/racket/lib/collects/setup/link.rkt @@ -207,9 +207,8 @@ (when (and (string? (car e)) (or (null? (cddr e)) (regexp-match? (caddr e) (version)))) - (hash-set! ht (car e) (cadr e)))) - (hash-map ht (lambda (k p) - (if with-path? - (cons k (simplify p)) - k))))))) - + (hash-set! ht (if with-path? + (cons (car e) (simplify (cadr e))) + (car e)) + #t))) + (hash-keys ht))))) diff --git a/racket/lib/collects/setup/private/pkg-deps.rkt b/racket/lib/collects/setup/private/pkg-deps.rkt index 3e50e1b45e..ba5b9da689 100644 --- a/racket/lib/collects/setup/private/pkg-deps.rkt +++ b/racket/lib/collects/setup/private/pkg-deps.rkt @@ -222,7 +222,7 @@ (define src-pkg (or (hash-ref mod-pkg mod #f) 'core)) (when src-pkg - (unless (check-dep! pkg src-pkg mod) + (unless (check-dep! pkg src-pkg mode) (define key (list pkg src-pkg (path-replace-suffix f #"") mod)) (unless (hash-ref reported key #f) (hash-set! reported key #t)