name files more sensibly, improve readme

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.

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))
+

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)))

lang-slide/main.rkt

@@ -1,35 +1,103 @@
-#lang racket/base
+#lang scheme
-(require "lang-slide.rkt"
+(provide langs-pict
-         slideshow
+         langs-in-tree
-         slideshow/code
+         langs-with-colors)
-         unstable/gui/slideshow)
+(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
+(define (split-out-color c)
-  (vr-append 10 (vl-append (t "“A domain specific language is the ultimate abstraction.” "))
+  (values
-             (t "    — Paul Hudak")))
+   (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") 
+(define (color<=? c1 c2)
-                                              (t "that in all known languages can only be said poorly.”"))
+  (let ([n1 (color->name c1)]
-                                (t "   — Alan Perlis")))
+        [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 lang-colors 
-(define p1 (lt-superimpose (ghost p2) (vl-append (t "In 6000+ files of") (t "Racket source code ..."))))
+  (sort (call-with-input-file lang-colors.rktd read)
+        color<=?
+        #:key cadr))
 
-(define (langs)
+(define-values (black-langs colored-langs)
-  (define p1+p2 (vl-append 10 p1 p2))
+  (partition (λ (x) (equal? (cadr x) "#000000")) lang-colors))
-  (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)
+(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)))

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)