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

Added documentation and integrated the pictures in it.

Browse Source
This commit is contained in:
Georges Dupéron 2016-04-01 00:40:30 +02:00
parent 1752047aa7
commit eff0f6cef3
6 changed files with 154 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,3 +1,5 @@
*~
lang.dot
compiled/
/doc/
/lang-slide/doc/

5
lang-slide/draw-plain.rkt
View File

@ -1,8 +1,9 @@
#lang scheme/gui
#lang racket ;scheme/gui
(provide lang-pict string->color)
(require scheme/runtime-path
slideshow)
slideshow/pict
racket/draw)
(define-runtime-path lang.plain "lang.plain")

5
lang-slide/info.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang info
(define build-deps '("scribble-lib" "racket-doc"))
(define scribblings '(("scribblings/lang-slide.scrbl" ())))
(define pkg-desc "A picture showing all the languages used to implement Racket.")
(define version "1.0")

105
lang-slide/main.rkt
View File

@ -1,110 +1,29 @@
#lang scheme
(provide langs-pict
(provide (rename-out [langs-pict1 langs-pict])
langs-in-tree
langs-with-colors)
(require "pictures.rkt")
(require "draw-plain.ss"
"orig-colors.rkt"
racket/draw slideshow/code
racket/draw
slideshow/code
scheme/runtime-path
slideshow)
(define-runtime-path lang-colors.rktd "lang-colors.rktd")
slideshow/pict
slideshow/base
"pictures.rkt")
(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 14])
(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?
(define (langs-pict1 color?
#:fit? [fit? #f]
#: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))
(define all
(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)))
(langs-pict color?
#:fit (λ (all)
(if fit?
(scale all (min 1
(/ client-w (pict-width all))
(/ client-h (pict-height all))))
all))
(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))
#:picts p))
(module+ main
(slide (langs-pict #f))

107
lang-slide/pictures.rkt Normal file
View File

@ -0,0 +1,107 @@
#lang racket
(require "draw-plain.ss"
"orig-colors.rkt"
racket/draw
slideshow/code-pict
racket/runtime-path
slideshow/pict)
(provide langs-pict
langs-in-tree
langs-with-colors)
(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)
(let ([font-size 14])
(hc-append 6
(colorize (filled-ellipse 14 14)
(string->color (cadr cl)))
(text (car cl) (current-code-font) font-size))))
(define (langs-pict color?
#:fit [fit (λ (x) x)]
#: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))
(define all
(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)))
(fit all))
(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))

18
lang-slide/scribblings/lang-slide.scrbl Normal file
View File

@ -0,0 +1,18 @@
#lang scribble/manual
@require[@for-label[lang-slide
racket/base]
lang-slide/pictures
;slideshow/pict
]
@title{A picture showing all the languages used to implement Racket.}
Source code: @url{https://github.com/samth/lang-slide}
Here is a bird's eye view of the modules implementing racket:
@(langs-pict #f)
And here is the languages they use:
@(langs-pict #t)