suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

shuffle some unstable modules and fix doc dependencies

Browse Source 
Includes a repair for mapping a collection name to a set of
linked paths.
This commit is contained in:
Matthew Flatt 2013-07-12 09:00:21 -06:00
parent 4b42e6974b
commit 8a9d885774
24 changed files with 306 additions and 231 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

200
pkgs/drracket-pkgs/drracket/drracket/arrow.rkt
View File

@ -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)))

3
pkgs/drracket-pkgs/drracket/info.rkt
View File

@ -32,7 +32,8 @@
"macro-debugger"
"net-lib"
"srfi-lib"
"srfi-doc"))
"srfi-doc"
"unstable"))
(define build-deps '("compatibility-doc"
"draw-doc"
"errortrace-doc"

4
pkgs/macro-debugger-pkgs/macro-debugger/info.rkt
View File

@ -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"))

2
pkgs/macro-debugger-pkgs/macro-debugger/macro-debugger/syntax-browser/text.rkt
View File

@ -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)

4
pkgs/macro-debugger-pkgs/macro-debugger/unstable/info.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang info
(define scribblings
'(("unstable-find.scrbl" (multi-page) (experimental))))

5
pkgs/unstable/scribblings/find.scrbl → pkgs/macro-debugger-pkgs/macro-debugger/unstable/unstable-find.scrbl
View File

@ -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]

2
pkgs/main-distribution/info.rkt
View File

@ -76,6 +76,8 @@
"unstable-list-lib"
"unstable-options-lib"
"unstable-parameter-group-lib"
"unstable-flonum-doc"
"unstable-redex"
"web-server"
"wxme"
"xrepl"))

14
pkgs/unstable-flonum-pkgs/unstable-flonum-doc/info.rkt Normal file
View File

@ -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"))

6
pkgs/unstable/scribblings/flonum.scrbl → pkgs/unstable-flonum-pkgs/unstable-flonum-doc/unstable-flonum.scrbl
View File

@ -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].

0
pkgs/unstable-flonum-lib/info.rkt → pkgs/unstable-flonum-pkgs/unstable-flonum-lib/info.rkt
View File

0
pkgs/unstable-flonum-lib/unstable/flonum.rkt → pkgs/unstable-flonum-pkgs/unstable-flonum-lib/unstable/flonum.rkt
View File

0
pkgs/unstable/gui/redex.rkt → pkgs/unstable-redex/gui/redex.rkt
View File

5
pkgs/unstable/scribblings/gui/redex.scrbl → pkgs/unstable-redex/gui/unstable-redex.scrbl
View File

@ -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]

16
pkgs/unstable-redex/info.rkt Normal file
View File

@ -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"))

203
pkgs/unstable/arrow.rkt Normal file
View File

@ -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)))

9
pkgs/unstable/info.rkt
View File

@ -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"

23
pkgs/unstable/scribblings/gui.scrbl Normal file
View File

@ -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"]

8
pkgs/unstable/scribblings/gui/snip.scrbl
View File

@ -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)

1
pkgs/unstable/scribblings/gui/unstable-gui.scrbl
View File

@ -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"]

3
pkgs/unstable/scribblings/parameter-group.scrbl
View File

@ -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.

5
pkgs/unstable/scribblings/unstable.scrbl
View File

@ -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"]

11
pkgs/unstable/scribblings/utils.rkt
View File

@ -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))))

11
racket/lib/collects/setup/link.rkt
View File

@ -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)))))

2
racket/lib/collects/setup/private/pkg-deps.rkt
View File

@ -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)