diff --git a/lang-slide.ss b/lang-slide.ss index dee32ac..57a5c23 100644 --- a/lang-slide.ss +++ b/lang-slide.ss @@ -1,5 +1,7 @@ #lang scheme -(provide langs-pict) +(provide langs-pict + langs-in-tree + langs-with-colors) (require "draw-plain.ss" slideshow slideshow/code scheme/runtime-path) @@ -58,14 +60,13 @@ (text (car cl) (current-code-font) (current-font-size))))) (define (langs-pict color? #:picts [p (if (pict? color?) (list color?) (list))]) - (define colors (map line->color - (append colored-langs (list (list "everything else" "#000000"))))) + (define colors (langs-with-colors)) (define len (length colors)) (define start (ceiling (/ len 2))) (define-values (one two) (split-at colors start)) (ht-append 0 - (inset (lang-pict 550 color?) 20 0 0 0) + (langs-in-tree color?) (apply vc-append 40 (ht-append 20 ((if color? values ghost) @@ -74,4 +75,11 @@ (apply vl-append 2 two))) p))) +(define (langs-with-colors) + (map line->color + (append colored-langs (list (list "everything else" "#000000"))))) + +(define (langs-in-tree color?) + (inset (lang-pict 550 color?) 14 -30 10 10)) + ;(slide (langs-pict #f)) (slide (langs-pict #t)) diff --git a/main.rkt b/main.rkt index c9ca8f7..6757039 100644 --- a/main.rkt +++ b/main.rkt @@ -1,6 +1,8 @@ #lang racket/base (require "lang-slide.rkt" - slideshow unstable/gui/slideshow) + slideshow + slideshow/code + unstable/gui/slideshow) (provide langs hudak-quote perlis-quote) @@ -18,15 +20,16 @@ (define (langs) (define p1+p2 (vl-append 10 p1 p2)) - (slide/staged [#;hudak one two] - ;#:title "Files in Racket" - ;#:layout 'tall - (cond - [(eq? stage-name 'hudak) - (mini-slide (vr-append 60 hudak-quote perlis-quote))] - [(eq? stage-name 'one) - (langs-pict #f #:picts (list (lt-superimpose p1 (ghost p1+p2))))] - [else - (langs-pict p1+p2)]))) + (parameterize ([current-code-font 'default]) + (slide/staged [#;hudak one two] + ;#:title "Files in Racket" + ;#:layout 'tall + (cond + [(eq? stage-name 'hudak) + (mini-slide (vr-append 60 hudak-quote perlis-quote))] + [(eq? stage-name 'one) + (langs-pict #f #:picts (list (lt-superimpose p1 (ghost p1+p2))))] + [else + (langs-pict p1+p2)])))) (langs)