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

slideshow: add a couple of contracts

Browse Source 
--- more needed
This commit is contained in:
Matthew Flatt 2011-03-08 07:54:44 -06:00
parent cd4d3e3d95
commit 501892c0ca
2 changed files with 43 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/slideshow/initial-ones.rkt
View File

@ -36,10 +36,8 @@
(item "Instead of a WYSIWYG interface," (item "Instead of a WYSIWYG interface,"
"you get the power of Racket")) "you get the power of Racket"))
(define (symbol n) (define sym:rightarrow (t "→"))
(text (string (integer->char n)) 'symbol (current-font-size))) (define sym:leftarrow (t "←"))
(define sym:rightarrow (symbol 174))
(define sym:leftarrow (symbol 172))
(define (meta key) (define (meta key)
(hbl-append (t "Alt-") (hbl-append (t "Alt-")

57
collects/slideshow/slide.rkt
View File

@ -1,7 +1,6 @@
(module slide racket/base
(module slide mzscheme (require racket/unit
(require mzlib/unit racket/contract
mzlib/contract
texpict/mrpict texpict/mrpict
texpict/utils texpict/utils
"sig.ss" "sig.ss"
@ -33,19 +32,28 @@
(define (slide-sequence? l) #t) (define (slide-sequence? l) #t)
(define slide-contract (define slide-contract
(() slide-sequence? . ->* . any)) (() () #:rest slide-sequence? . ->* . any))
(define slide/title-contract (define slide/title-contract
((string?) slide-sequence? . ->* . any)) ((string?) () #:rest slide-sequence? . ->* . any))
(define slide/inset-contract (define slide/inset-contract
((sinset?) slide-sequence? . ->* . any)) ((sinset?) () #:rest slide-sequence? . ->* . any))
(define slide/title/inset-contract (define slide/title/inset-contract
((string? sinset?) slide-sequence? . ->* . any)) ((string? sinset?) () #:rest slide-sequence? . ->* . any))
(define (side-inset? n) (and (number? n) (define (side-inset? n) (and (number? n)
(exact? n) (exact? n)
(integer? n) (integer? n)
(n . >= . 0))) (n . >= . 0)))
(define elem/c (flat-rec-contract elem/c (or/c string? pict? (listof elem/c))))
(define item-contract (() (#:bullet pict?
#:width real?
#:align (or/c 'left 'center 'right)
#:fill? any/c
#:decode? any/c)
#:rest elem/c
. ->* . pict?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exports ;; ;; Exports ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -76,21 +84,36 @@
[slide/name/inset slide/title/inset-contract] [slide/name/inset slide/title/inset-contract]
[slide/name/tall/inset slide/title/inset-contract] [slide/name/tall/inset slide/title/inset-contract]
[slide/name/center/inset slide/title/inset-contract] [slide/name/center/inset slide/title/inset-contract]
[comment (() (listof (or/c string? pict?)) . ->* . any)]) [comment (() () #:rest (listof (or/c string? pict?)) . ->* . any)]
[para/kw (() (#:width real?
#:align (or/c 'left 'center 'right)
#:fill? any/c
#:decode? any/c)
#:rest elem/c
. ->* . pict?)]
[item/kw item-contract]
[subitem/kw item-contract]
[t (string? . -> . pict?)]
[bt (string? . -> . pict?)]
[it (string? . -> . pict?)]
[bit (string? . -> . pict?)]
[tt (string? . -> . pict?)]
[titlet (string? . -> . pict?)]
[rt (string? . -> . pict?)]
[tt* (() () #:rest (listof string?) . ->* . pict?)])
(provide slide/kw (provide slide/kw
most-recent-slide retract-most-recent-slide re-slide start-at-recent-slide most-recent-slide retract-most-recent-slide re-slide start-at-recent-slide
scroll-transition pause-transition scroll-transition pause-transition
make-outline make-outline
item/kw item item* page-item page-item* item item* page-item page-item*
item/bullet item*/bullet page-item/bullet page-item*/bullet item/bullet item*/bullet page-item/bullet page-item*/bullet
subitem/kw subitem subitem* page-subitem page-subitem* subitem subitem* page-subitem page-subitem*
itemize itemize* page-itemize page-itemize* itemize itemize* page-itemize page-itemize*
para/kw para para* page-para page-para* para para* page-para page-para*
para/c para/r para*/c para*/r page-para/c page-para/r page-para*/c page-para*/r para/c para/r para*/c para*/r page-para/c page-para/r page-para*/c page-para*/r
font-size gap-size current-font-size current-line-sep line-sep title-size font-size gap-size current-font-size current-line-sep line-sep title-size
main-font current-main-font with-font current-title-color main-font current-main-font with-font current-title-color
red green blue purple orange size-in-pixels red green blue purple orange size-in-pixels
t it bt bit tt titlet tt* rt
bullet o-bullet bullet o-bullet
margin get-margin set-margin! margin get-margin set-margin!
client-w client-h get-client-w get-client-h client-w client-h get-client-w get-client-h
@ -107,13 +130,13 @@
slide/title/timeout slide/title/timeout
slide/center/timeout slide/center/timeout
slide/title/center/timeout slide/title/center/timeout
(rename sinset? slide-inset?)) (rename-out [sinset? slide-inset?]))
(provide/contract [clickback (provide/contract [clickback
((pict? (lambda (x) ((pict? (lambda (x)
(and (procedure? x) (and (procedure? x)
(procedure-arity-includes? x 0)))) (procedure-arity-includes? x 0))))
(any/c) (any/c)
. opt-> . . ->* .
pict?)] pict?)]
[make-slide-inset [make-slide-inset
(side-inset? side-inset? side-inset? side-inset? (side-inset? side-inset? side-inset? side-inset?
@ -122,5 +145,5 @@
[apply-slide-inset [apply-slide-inset
(sinset? pict? . -> . pict?)]) (sinset? pict? . -> . pict?)])
;; Things not at all in the core unit: ;; Things not at all in the core unit:
(provide (all-from texpict/mrpict) (provide (all-from-out texpict/mrpict)
(all-from texpict/utils))) (all-from-out texpict/utils)))