diff --git a/collects/plot/common/contract.rkt b/collects/plot/common/contract.rkt index aa99d2a733..3866f896fd 100644 --- a/collects/plot/common/contract.rkt +++ b/collects/plot/common/contract.rkt @@ -12,6 +12,7 @@ plot-colors/c pen-widths/c plot-pen-styles/c plot-brush-styles/c alphas/c labels/c) (rename-out [natural-number/c nat/c]) + font-family/c truth/c) ;; =================================================================================================== @@ -36,9 +37,6 @@ 'bdiagonal-hatch 'fdiagonal-hatch 'crossdiag-hatch 'horizontal-hatch 'vertical-hatch 'cross-hatch))) -(defcontract font-family/c (one-of/c 'default 'decorative 'roman 'script 'swiss - 'modern 'symbol 'system)) - (defthing known-point-symbols (listof symbol?) #:document-value (list 'dot 'point 'pixel 'plus 'times 'asterisk diff --git a/collects/plot/scribblings/contracts.scrbl b/collects/plot/scribblings/contracts.scrbl index 72d7aa573d..de2027c5c5 100644 --- a/collects/plot/scribblings/contracts.scrbl +++ b/collects/plot/scribblings/contracts.scrbl @@ -1,6 +1,7 @@ #lang scribble/manual -@(require "common.rkt") +@(require "common.rkt" + (for-label (rename-in racket/draw [font-family/c ff/c]))) @declare-exporting[plot/utils] @@ -48,8 +49,18 @@ The contract for @(racket #:style) arguments (when they refer to fills), and par For the meaning of integer brush styles, see @(racket ->brush-style). } -@doc-apply[font-family/c]{ -Identifies legal font family values. See @(racket plot-font-family). +@;; This is to let me link to a different font-family/c +@;; Builds an element inside the submodule that links to the +@;; right identifier and exports it. +@(module id-holder racket/base + (require scribble/manual (for-label racket/draw)) + (provide ff/c-element) + (define ff/c-element (racket font-family/c))) +@(require 'id-holder) + +@defthing[font-family/c flat-contract?]{ +Identifies legal font family values. The same as @ff/c-element +from @racketmodname[racket/draw]. } @doc-apply[point-sym/c]{ diff --git a/collects/racket/draw.rkt b/collects/racket/draw.rkt index cadf62203c..6b0b9f1513 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -6,6 +6,7 @@ "draw/private/point.rkt" "draw/private/font.rkt" "draw/private/font-dir.rkt" + "draw/private/font-syms.rkt" "draw/private/pen.rkt" "draw/private/brush.rkt" "draw/private/gradient.rkt" @@ -36,7 +37,18 @@ make-bitmap make-platform-bitmap read-bitmap - make-monochrome-bitmap) + make-monochrome-bitmap + + ;; predicates/contracts + brush-style/c + pen-cap-style/c + pen-join-style/c + pen-style/c + font-family/c + font-weight/c + font-style/c + font-smoothing/c + font-hinting/c) (provide/contract [color% color%/c] [point% point%/c] @@ -59,3 +71,4 @@ [make-color make-color/c] [make-pen make-pen/c] [make-brush make-brush/c]) + diff --git a/collects/racket/draw/private/contract.rkt b/collects/racket/draw/private/contract.rkt index 59b25424ac..0175e72233 100644 --- a/collects/racket/draw/private/contract.rkt +++ b/collects/racket/draw/private/contract.rkt @@ -8,6 +8,7 @@ "point.rkt" "font.rkt" "font-dir.rkt" + "font-syms.rkt" "pen.rkt" "brush.rkt" "gradient.rkt" @@ -74,16 +75,6 @@ 'xor-dot 'xor-long-dash 'xor-short-dash 'xor-dot-dash)) -(define font-family/c - (or/c 'default 'decorative 'roman 'script - 'swiss 'modern 'symbol 'system)) - -(define font-weight/c (or/c 'normal 'bold 'light)) -(define font-style/c (or/c 'normal 'italic 'slant)) -(define font-smoothing/c (or/c 'default 'partly-smoothed - 'smoothed 'unsmoothed)) -(define font-hinting/c (or/c 'aligned 'unaligned)) - (define transformation-vector/c (vector/c (vector/c real? real? real? real? real? real?) real? real? real? real? real?)) diff --git a/collects/racket/draw/private/font-syms.rkt b/collects/racket/draw/private/font-syms.rkt index 5648aa5f6d..2102a37bc1 100644 --- a/collects/racket/draw/private/font-syms.rkt +++ b/collects/racket/draw/private/font-syms.rkt @@ -6,7 +6,8 @@ (provide family-symbol? style-symbol? weight-symbol? smoothing-symbol? hinting-symbol? - font-family/c font-weight/c font-style/c) + font-family/c font-weight/c font-style/c + font-smoothing/c font-hinting/c) (define (family-symbol? s) (memq s '(default decorative roman script @@ -26,10 +27,12 @@ ;; TODO: eventually once all old checks are converted to ;; contracts, the above can be removed -(define font-family/c - (or/c 'default 'decorative 'roman 'script - 'swiss 'modern 'symbol 'system)) +(define font-family/c (or/c 'default 'decorative 'roman 'script 'swiss + 'modern 'symbol 'system)) (define font-weight/c (or/c 'normal 'bold 'light)) (define font-style/c (or/c 'normal 'italic 'slant)) +(define font-smoothing/c (or/c 'default 'partly-smoothed + 'smoothed 'unsmoothed)) +(define font-hinting/c (or/c 'aligned 'unaligned)) diff --git a/collects/racket/snip/private/contract.rkt b/collects/racket/snip/private/contract.rkt index 422a9a60a4..5cee88188e 100644 --- a/collects/racket/snip/private/contract.rkt +++ b/collects/racket/snip/private/contract.rkt @@ -36,19 +36,6 @@ any/c)))) ;; contract utilities: -(define font-family/c - (or/c 'base 'default 'decorative 'roman 'script - 'swiss 'modern 'symbol 'system)) - -(define font-smoothing/c - (or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)) - -(define font-style/c - (or/c 'base 'normal 'italic 'slant)) - -(define font-weight/c - (or/c 'base 'normal 'bold 'light)) - (define alignment/c (or/c 'base 'top 'center 'bottom)) @@ -68,7 +55,7 @@ (get-background-add (->m (is-a?/c add-color<%>))) (get-background-mult (->m (is-a?/c mult-color<%>))) (get-face (->m (or/c string? false/c))) - (get-family (->m font-family/c)) + (get-family (->m (or/c 'base font-family/c))) (get-foreground-add (->m (is-a?/c add-color<%>))) (get-foreground-mult (->m (is-a?/c mult-color<%>))) (get-size-add (->m byte?)) @@ -113,25 +100,26 @@ (is-a?/c style-delta%)))) (set-delta-background (->m (or/c string? (is-a?/c color%)) (is-a?/c style-delta%))) - (set-delta-face (->*m (string?) (font-family/c) (is-a?/c style-delta%))) + (set-delta-face (->*m (string?) ((or/c 'base font-family/c)) + (is-a?/c style-delta%))) (set-delta-foreground (->m (or/c string? (is-a?/c color%)) (is-a?/c style-delta%))) (set-face (->m (or/c string? false/c) void?)) - (set-family (->m font-family/c void?)) + (set-family (->m (or/c 'base font-family/c) void?)) (set-size-add (->m byte? void?)) (set-size-in-pixels-off (->m any/c void?)) (set-size-in-pixels-on (->m any/c void?)) (set-size-mult (->m real? void?)) - (set-smoothing-off (->m font-smoothing/c void?)) - (set-smoothing-on (->m font-smoothing/c void?)) - (set-style-off (->m font-style/c void?)) - (set-style-on (->m font-style/c void?)) + (set-smoothing-off (->m (or/c 'base font-smoothing/c) void?)) + (set-smoothing-on (->m (or/c 'base font-smoothing/c) void?)) + (set-style-off (->m (or/c 'base font-style/c) void?)) + (set-style-on (->m (or/c 'base font-style/c) void?)) (set-transparent-text-backing-off (->m any/c void?)) (set-transparent-text-backing-on (->m any/c void?)) (set-underlined-off (->m any/c void?)) (set-underlined-on (->m any/c void?)) - (set-weight-off (->m font-weight/c void?)) - (set-weight-on (->m font-weight/c void?)))) + (set-weight-off (->m (or/c 'base font-weight/c) void?)) + (set-weight-on (->m (or/c 'base font-weight/c) void?)))) (define (arity-1-procedure? x) (and (procedure? x) diff --git a/collects/scribblings/draw/draw-contracts.scrbl b/collects/scribblings/draw/draw-contracts.scrbl new file mode 100644 index 0000000000..1b0ea27df6 --- /dev/null +++ b/collects/scribblings/draw/draw-contracts.scrbl @@ -0,0 +1,101 @@ +#lang scribble/doc +@(require "common.rkt" + unstable/latent-contract) + +@title{Drawing Contracts} + +@local-table-of-contents[] + +This page documents the contracts that are used to describe +the specification of @racketmodname[racket/draw] objects +and functions. + +@defthing[font-family/c flat-contract?]{ + Recognizes font designations. Corresponds to the @racket[_family] + initialization argument of the @racket[font%] class. + + Equivalent to the following definition: + @racketblock[ + (or/c 'default 'decorative 'roman 'script 'swiss + 'modern 'symbol 'system)] +} + +@defthing[font-style/c flat-contract?]{ + Recognizes font styles. Corresponds to the @racket[_style] + initialization argument of the @racket[font%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'normal 'italic 'slant)] +} + +@defthing[font-weight/c flat-contract?]{ + Recognizes font weights. Corresponds to the @racket[_weight] + initialization argument of the @racket[font%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'normal 'bold 'light)] +} + +@defthing[font-smoothing/c flat-contract?]{ + Recognizes a font smoothing amount. + Corresponds to the @racket[_smoothing] + initialization argument of the @racket[font%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'default 'partly-smoothed + 'smoothed 'unsmoothed)] +} + +@defthing[font-hinting/c flat-contract?]{ + Recognizes font hinting modes. Corresponds to the @racket[_hinting] + initialization argument of the @racket[font%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'aligned 'unaligned)] +} + +@defthing[pen-style/c flat-contract?]{ + Recognizes pen styles. Corresponds + to the @racket[_style] initialization argument of the + @racket[pen%] class. + + Equivalent to the following definition: + @racketblock[ + (or/c 'transparent 'solid 'xor 'hilite + 'dot 'long-dash 'short-dash 'dot-dash + 'xor-dot 'xor-long-dash 'xor-short-dash + 'xor-dot-dash)] +} + +@defthing[pen-cap-style/c flat-contract?]{ + Recognizes pen cap styles. Corresponds + to the @racket[_cap] initialization argument of the + @racket[pen%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'round 'projecting 'butt)] +} + +@defthing[pen-join-style/c flat-contract?]{ + Recognizes pen join styles. Corresponds + to the @racket[_join] initialization argument of the + @racket[pen%] class. + + Equivalent to the following definition: + @racketblock[(or/c 'round 'bevel 'miter)] +} + +@defthing[brush-style/c flat-contract?]{ + Recognizes brush styles. Corresponds + to the @racket[_style] initialization argument of the + @racket[brush%] class. + + Equivalent to the following definition: + @racketblock[ + (or/c 'transparent 'solid 'opaque + 'xor 'hilite 'panel + 'bdiagonal-hatch 'crossdiag-hatch + 'fdiagonal-hatch 'cross-hatch + 'horizontal-hatch 'vertical-hatch)] +} + diff --git a/collects/scribblings/draw/draw.scrbl b/collects/scribblings/draw/draw.scrbl index d7a96cec80..563a5fd185 100644 --- a/collects/scribblings/draw/draw.scrbl +++ b/collects/scribblings/draw/draw.scrbl @@ -41,6 +41,7 @@ interface, and procedure bindings defined in this manual.} @include-section["region-class.scrbl"] @include-section["svg-dc-class.scrbl"] @include-section["draw-funcs.scrbl"] +@include-section["draw-contracts.scrbl"] @include-section["draw-unit.scrbl"] @include-section["unsafe.scrbl"] @include-section["libs.scrbl"]