diff --git a/README.md b/README.md index 4a9dbb0..2ecc1f6 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,20 @@ -## Finding files - -`find.rkt` generates `lang.plain` (I don't remember how) - ## Pictures -`main.rkt` draws the picture, with some options. +`main.rkt` provides several picts, with some options. When run on the +command line, it shows a slide that demos the pict. ## Slides -`lang-slide.rkt` has a slideshow slide that uses the picture. +`hudak-quote.rkt` has a slideshow slide that uses the picture along +with a quote from Paul Hudak. + +## PNG + +`mk-img.rkt` generates a PNG of the image. + +## Regenerating the data + +`find.rkt` regenerates `lang.plain` and `lang-colors.rktd` +automatically when run. ##### Originally by Robby Findler. diff --git a/lang-slide/hudak-quote.rkt b/lang-slide/hudak-quote.rkt new file mode 100644 index 0000000..447768f --- /dev/null +++ b/lang-slide/hudak-quote.rkt @@ -0,0 +1,37 @@ +#lang racket/base +(require "main.rkt" + slideshow + slideshow/code + unstable/gui/slideshow) + +(provide langs hudak-quote perlis-quote) + + +(define hudak-quote + (vr-append 10 (vl-append (t "“A domain specific language is the ultimate abstraction.” ")) + (t " — Paul Hudak"))) + +(define perlis-quote (vr-append 10 (vr-append (t "“There will always be things we wish to say in our programs") + (t "that in all known languages can only be said poorly.”")) + (t " — Alan Perlis"))) + +(define p2 (vl-append (t "Racket ships more than") (t "40 documented languages"))) +(define p1 (lt-superimpose (ghost p2) (vl-append (t "In 6000+ files of") (t "Racket source code ...")))) + +(define (langs) + (define p1+p2 (vl-append 10 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) + (frame (langs-pict #f #:picts (list (lt-superimpose p1 (ghost p1+p2)))))] + [else + (langs-pict p1+p2)])))) + +(module+ main + (langs)) + diff --git a/lang-slide/lang-slide.rkt b/lang-slide/lang-slide.rkt deleted file mode 100644 index 62da466..0000000 --- a/lang-slide/lang-slide.rkt +++ /dev/null @@ -1,103 +0,0 @@ -#lang scheme -(provide langs-pict - langs-in-tree - langs-with-colors) -(require "draw-plain.ss" - "orig-colors.rkt" - slideshow slideshow/code - scheme/runtime-path - racket/gui/base) -(define-runtime-path lang-colors.rktd "lang-colors.rktd") - -(define (color->name c) - (define-values (r g b) (split-out-color c)) - (cond - [(and (equal? r 0) (equal? g 0) (equal? b 0)) - 'black] - [else - (define res - (for/or ([(k v) (in-hash orig-colors)]) - (for/or ([c (in-list v)]) - (define rgb (cond - [(string? c) - (define clr (send the-color-database find-color c)) - (list (send clr red) (send clr green) (send clr blue))] - [else - c])) - (and (equal? rgb (list r g b)) - k)))) - (unless res (error 'color->name "unable to find color name for ~s" c)) - res])) - -(define (color-name->index c) - (case c - [(blue) 0] - [(red) 1] - [(orange) 1.5] - [(green) 2] - [(gray) 3] - [(pink) 4] - [(cyan) 5] - [(purple) 5.5] - [(yellow) 7] - [(brown) 8] - [(black) 100] - [else (error 'color-name->index "unk ~s" c)])) - -(define (split-out-color c) - (values - (string->number (substring c 1 3) 16) - (string->number (substring c 3 5) 16) - (string->number (substring c 5 7) 16))) - -(define (color<=? c1 c2) - (let ([n1 (color->name c1)] - [n2 (color->name c2)]) - (cond - [(equal? n1 n2) - (string<=? c1 c2)] - [else - (<= (color-name->index n1) - (color-name->index n2))]))) - -(define lang-colors - (sort (call-with-input-file lang-colors.rktd read) - color<=? - #:key cadr)) - -(define-values (black-langs colored-langs) - (partition (λ (x) (equal? (cadr x) "#000000")) lang-colors)) - -(define (line->color cl) - (parameterize ([current-font-size 16]) - (hc-append 6 - (colorize (filled-ellipse 14 14) - (string->color (cadr cl))) - (text (car cl) (current-code-font) (current-font-size))))) - -(define (langs-pict color? #:picts [p (if (pict? color?) (list color?) (list))]) - (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 - (langs-in-tree color?) - (apply vc-append 40 - (ht-append 20 - ((if color? values ghost) - (apply vl-append 2 one)) - ((if color? values ghost) - (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 10 10 10)) - -(module+ main - (slide (langs-pict #f)) - (slide (langs-pict #t))) diff --git a/lang-slide/main.rkt b/lang-slide/main.rkt index 212779b..62da466 100644 --- a/lang-slide/main.rkt +++ b/lang-slide/main.rkt @@ -1,35 +1,103 @@ -#lang racket/base -(require "lang-slide.rkt" - slideshow - slideshow/code - unstable/gui/slideshow) +#lang scheme +(provide langs-pict + langs-in-tree + langs-with-colors) +(require "draw-plain.ss" + "orig-colors.rkt" + slideshow slideshow/code + scheme/runtime-path + racket/gui/base) +(define-runtime-path lang-colors.rktd "lang-colors.rktd") -(provide langs hudak-quote perlis-quote) +(define (color->name c) + (define-values (r g b) (split-out-color c)) + (cond + [(and (equal? r 0) (equal? g 0) (equal? b 0)) + 'black] + [else + (define res + (for/or ([(k v) (in-hash orig-colors)]) + (for/or ([c (in-list v)]) + (define rgb (cond + [(string? c) + (define clr (send the-color-database find-color c)) + (list (send clr red) (send clr green) (send clr blue))] + [else + c])) + (and (equal? rgb (list r g b)) + k)))) + (unless res (error 'color->name "unable to find color name for ~s" c)) + res])) +(define (color-name->index c) + (case c + [(blue) 0] + [(red) 1] + [(orange) 1.5] + [(green) 2] + [(gray) 3] + [(pink) 4] + [(cyan) 5] + [(purple) 5.5] + [(yellow) 7] + [(brown) 8] + [(black) 100] + [else (error 'color-name->index "unk ~s" c)])) -(define hudak-quote - (vr-append 10 (vl-append (t "“A domain specific language is the ultimate abstraction.” ")) - (t " — Paul Hudak"))) +(define (split-out-color c) + (values + (string->number (substring c 1 3) 16) + (string->number (substring c 3 5) 16) + (string->number (substring c 5 7) 16))) -(define perlis-quote (vr-append 10 (vr-append (t "“There will always be things we wish to say in our programs") - (t "that in all known languages can only be said poorly.”")) - (t " — Alan Perlis"))) +(define (color<=? c1 c2) + (let ([n1 (color->name c1)] + [n2 (color->name c2)]) + (cond + [(equal? n1 n2) + (string<=? c1 c2)] + [else + (<= (color-name->index n1) + (color-name->index n2))]))) -(define p2 (vl-append (t "Racket ships more than") (t "40 documented languages"))) -(define p1 (lt-superimpose (ghost p2) (vl-append (t "In 6000+ files of") (t "Racket source code ...")))) +(define lang-colors + (sort (call-with-input-file lang-colors.rktd read) + color<=? + #:key cadr)) -(define (langs) - (define p1+p2 (vl-append 10 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) - (frame (langs-pict #f #:picts (list (lt-superimpose p1 (ghost p1+p2)))))] - [else - (langs-pict p1+p2)])))) +(define-values (black-langs colored-langs) + (partition (λ (x) (equal? (cadr x) "#000000")) lang-colors)) -(langs) +(define (line->color cl) + (parameterize ([current-font-size 16]) + (hc-append 6 + (colorize (filled-ellipse 14 14) + (string->color (cadr cl))) + (text (car cl) (current-code-font) (current-font-size))))) + +(define (langs-pict color? #:picts [p (if (pict? color?) (list color?) (list))]) + (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 + (langs-in-tree color?) + (apply vc-append 40 + (ht-append 20 + ((if color? values ghost) + (apply vl-append 2 one)) + ((if color? values ghost) + (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 10 10 10)) + +(module+ main + (slide (langs-pict #f)) + (slide (langs-pict #t))) diff --git a/lang-slide/mk-img.rkt b/lang-slide/mk-img.rkt index 30bafd1..5cfc9fe 100644 --- a/lang-slide/mk-img.rkt +++ b/lang-slide/mk-img.rkt @@ -1,5 +1,5 @@ #lang scheme/gui -(require "lang-slide.ss" slideshow) +(require "main.rkt" slideshow) (define the-margin 32)