Update typed/pict to include functions that require the class system
This commit is contained in:
Alexis King
parent
c79b61a751
commit
9ad485e9d6
|
|
@ -3,15 +3,32 @@
|
|||
;; Typed base-env wrapper for the pict library
|
||||
|
||||
(require pict
|
||||
"racket/private/gui-types.rkt"
|
||||
(for-syntax (only-in typed-racket/rep/type-rep
|
||||
make-Name
|
||||
make-Union)))
|
||||
make-Union)
|
||||
(submod "racket/private/gui-types.rkt" #%type-decl)))
|
||||
|
||||
(begin-for-syntax
|
||||
(define (-improper-listof t)
|
||||
(-mu -ilof
|
||||
(Un (-pair t -ilof) t -Null)))
|
||||
(define -dc
|
||||
(-inst (parse-type #'DC<%>)))
|
||||
(define -color
|
||||
(-inst (parse-type #'Color%)))
|
||||
(define -pict (-struct-name #'pict))
|
||||
(define -pict-path
|
||||
(make-Union (list (-val #f) -pict (-lst -pict))))
|
||||
(define -child (-struct-name #'child))
|
||||
(define -text-style
|
||||
(-mu -text-style
|
||||
(Un -Null (-inst (parse-type #'Font%)) (parse-type #'Font-Family) -String
|
||||
(-pair -String (parse-type #'Font-Family))
|
||||
(-pair (Un (-val 'bold) (-val 'italic) (-val 'subscript) (-val 'superscript) (-val 'caps)
|
||||
(-val 'combine) (-val 'no-combine) (-val 'aligned) (-val 'unaligned)
|
||||
-color)
|
||||
-text-style))))
|
||||
(define -linestyle
|
||||
(one-of/c 'transparent 'solid 'xor 'hilite
|
||||
'dot 'long-dash 'short-dash 'dot-dash
|
||||
|
|
@ -29,8 +46,7 @@
|
|||
#:start-pull -Real #f
|
||||
#:end-pull -Real #f
|
||||
#:line-width (-opt -Real) #f
|
||||
;; FIXME: color%
|
||||
#:color (-opt (Un -String)) #f
|
||||
#:color (-opt (Un -String -color)) #f
|
||||
#:alpha -Real #f
|
||||
#:style -linestyle #f
|
||||
#:under? Univ #f
|
||||
|
|
@ -47,6 +63,7 @@
|
|||
(->* (list -pict) -pict -pict)))
|
||||
|
||||
(type-environment
|
||||
; 1 Pict Datatype
|
||||
[#:struct pict ([draw : Univ]
|
||||
[width : -Real]
|
||||
[height : -Real]
|
||||
|
|
@ -63,20 +80,19 @@
|
|||
[sxy : -Real]
|
||||
[syx : -Real])
|
||||
#:extra-constructor-name make-child]
|
||||
|
||||
;; dc
|
||||
; 2 Basic Pict Constructors
|
||||
[dc (->opt (-> -dc -Real -Real ManyUniv) -Real -Real [-Real -Real] -pict)]
|
||||
[blank (cl->* (-> -pict)
|
||||
(-> -Real -pict)
|
||||
(-> -Real -Real -pict)
|
||||
(-> -Real -Real -Real -pict)
|
||||
(-> -Real -Real -Real -Real -pict))]
|
||||
;; text
|
||||
[text (->opt -String [-text-style -Index -Real] -pict)]
|
||||
[hline (->key -Real -Real #:segment (-opt -Real) #f -pict)]
|
||||
[vline (->key -Real -Real #:segment (-opt -Real) #f -pict)]
|
||||
[frame (->key -pict
|
||||
#:segment (-opt -Real) #f
|
||||
;; FIXME: add color% with class support
|
||||
#:color (-opt -String) #f
|
||||
#:color (-opt (Un -String -color)) #f
|
||||
#:line-width (-opt -Real) #f
|
||||
-pict)]
|
||||
[ellipse (-> -Real -Real -pict)]
|
||||
|
|
@ -95,8 +111,8 @@
|
|||
#:angle -Real #f
|
||||
#:draw-border? Univ #f
|
||||
-pict)]
|
||||
;; FIXME: add bitmap% and image-snip%
|
||||
[bitmap (-> (Un -Pathlike) -pict)]
|
||||
;; FIXME: add image-snip%
|
||||
[bitmap (-> (Un -Pathlike (-inst (parse-type #'Bitmap%))) -pict)]
|
||||
[arrow (-> -Real -Real -pict)]
|
||||
[arrowhead (-> -Real -Real -pict)]
|
||||
[pip-line (-> -Real -Real -Real -pict)]
|
||||
|
|
@ -113,15 +129,14 @@
|
|||
#:start-pull -Real #f
|
||||
#:end-pull -Real #f
|
||||
#:line-width (-opt -Real) #f
|
||||
;; FIXME: color%
|
||||
#:color (-opt (Un -String)) #f
|
||||
#:color (-opt (Un -String -color)) #f
|
||||
#:alpha -Real #f
|
||||
#:style -linestyle #f
|
||||
#:under? Univ #f
|
||||
-pict)]
|
||||
[pin-arrow-line -pin-arrow-line]
|
||||
[pin-arrows-line -pin-arrow-line]
|
||||
[bitmap-draft-mode (-Param Univ Univ)]
|
||||
[bitmap-draft-mode (-Param Univ -Boolean)]
|
||||
|
||||
;; 3 Pict Combiners
|
||||
[vl-append -append-type]
|
||||
|
|
@ -162,7 +177,14 @@
|
|||
(-> -pict -pict (-values (list -Real -Real)))
|
||||
-pict))]
|
||||
|
||||
;; FIXME: table has a weird type
|
||||
[table
|
||||
(-> -PosInt
|
||||
(-pair -pict (-lst -pict))
|
||||
(-improper-listof (-> -pict -pict -pict))
|
||||
(-improper-listof (-> -pict -pict -pict))
|
||||
(-improper-listof -Real)
|
||||
(-improper-listof -Real)
|
||||
-pict)]
|
||||
|
||||
;; 4 Pict Drawing Adjusters
|
||||
[scale
|
||||
|
|
@ -175,14 +197,14 @@
|
|||
[ghost (-> -pict -pict)]
|
||||
[linewidth (-> (-opt -Real) -pict -pict)]
|
||||
[linestyle (-> -linestyle -pict -pict)]
|
||||
[colorize (-> -pict (Un -String (-lst* -Integer -Integer -Integer)) -pict)]
|
||||
[colorize (-> -pict (Un -String (-lst* -Byte -Byte -Byte) -color) -pict)]
|
||||
[cellophane (-> -pict -Real -pict)]
|
||||
[clip (-> -pict -pict)]
|
||||
[inset/clip
|
||||
(cl->* (-> -pict -Real -pict)
|
||||
(-> -pict -Real -Real -pict)
|
||||
(-> -pict -Real -Real -Real -Real -pict))]
|
||||
[black-and-white (-Param Univ Univ)]
|
||||
[black-and-white (-Param Univ -Boolean)]
|
||||
|
||||
;; 5 Bounding Box Adjusters
|
||||
[inset
|
||||
|
|
@ -217,17 +239,16 @@
|
|||
[launder (-> -pict -pict)]
|
||||
|
||||
;; 7.1 Dingbats
|
||||
;; FIXME: color% for many of these
|
||||
[cloud (->opt -Real -Real [-String] -pict)]
|
||||
[file-icon (->opt -Real -Real -String [Univ] -pict)]
|
||||
[cloud (->opt -Real -Real [(Un -String -color)] -pict)]
|
||||
[file-icon (->opt -Real -Real Univ [Univ] -pict)]
|
||||
[standard-fish
|
||||
(->key -Real -Real
|
||||
#:direction (one-of/c 'left 'right) #f
|
||||
#:color -String #f
|
||||
#:color (Un -String -color) #f
|
||||
#:eye-color (-opt -String) #f
|
||||
#:open-mouth (Un -Boolean -Real) #f
|
||||
-pict)]
|
||||
[jack-o-lantern (->opt -Real [-String -String] -pict)]
|
||||
[jack-o-lantern (->opt -Real [-String (Un -String -color)] -pict)]
|
||||
[angel-wing (-> -Real -Real Univ -pict)]
|
||||
[desktop-machine (->opt -Real [(-lst (one-of/c 'plt 'binary 'devil))] -pict)]
|
||||
;; thermometer
|
||||
|
|
@ -248,7 +269,30 @@
|
|||
|
||||
;; 10 Miscellaneous
|
||||
[hyperlinkize (-> -pict -pict)]
|
||||
;; FIXME:
|
||||
;; scale-color
|
||||
;; color-series
|
||||
[scale-color (-> -Real (Un -String -color) -color)]
|
||||
[color-series (-> -dc -Nat -PosRat
|
||||
(Un -String -color) (Un -String -color)
|
||||
(-> -Rat ManyUniv)
|
||||
Univ Univ
|
||||
-Void)]
|
||||
|
||||
;; 11 Rendering
|
||||
[dc-for-text-size (-Param (-opt -dc) (-opt -dc))]
|
||||
[convert-bounds-padding (-Param (-lst* -PosReal -PosReal -PosReal -PosReal)
|
||||
(-lst* -PosReal -PosReal -PosReal -PosReal))]
|
||||
[draw-pict (-> -pict -dc -Real -Real -Void)]
|
||||
[pict->bitmap (->opt -pict [(Un (-val 'unsmoothed) (-val 'smoothed) (-val 'aligned))]
|
||||
(-inst (parse-type #'Bitmap%)))]
|
||||
[pict->argb-pixels (->opt -pict [(Un (-val 'unsmoothed) (-val 'smoothed) (-val 'aligned))]
|
||||
-Bytes)]
|
||||
[argb-pixels->pict (-> -Bytes -Nat -pict)]
|
||||
[make-pict-drawer (-> -pict (-> -dc -Real -Real -Void))]
|
||||
[show-pict (->optkey -pict [(-opt -Nat) (-opt -Nat)]
|
||||
#:frame-x -Integer #t #:frame-y -Integer #t
|
||||
#:frame-style (-lst (Un (-val 'no-resize-border) (-val 'no-caption)
|
||||
(-val 'no-system-menu) (-val 'hide-menu-bar)
|
||||
(-val 'toolbar-button) (-val 'float)
|
||||
(-val 'metal))) #t
|
||||
-Void)]
|
||||
[current-expected-text-scale (-Param (-lst* -Real -Real) (-lst* -Real -Real))]
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user