commit 40f30a8ce128493c887dc0c0bb0798fab6514837
parent dba4283aa82cec2805d0ee75bb7feb523ab15d42
Author: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 12 Nov 2012 18:21:32 -0500
name files more sensibly, improve readme
Diffstat:
5 files changed, 154 insertions(+), 145 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -1,35 +1,103 @@
-#lang racket/base
-(require "lang-slide.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)]))))
-
-(langs)
+#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/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)
