From eff0f6cef383b82a186a9793d9bde048f6a17382 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 1 Apr 2016 00:40:30 +0200 Subject: [PATCH] Added documentation and integrated the pictures in it. --- .gitignore | 2 + lang-slide/draw-plain.rkt | 5 +- lang-slide/info.rkt | 5 + lang-slide/main.rkt | 119 ++++-------------------- lang-slide/pictures.rkt | 107 +++++++++++++++++++++ lang-slide/scribblings/lang-slide.scrbl | 18 ++++ 6 files changed, 154 insertions(+), 102 deletions(-) create mode 100644 lang-slide/info.rkt create mode 100644 lang-slide/pictures.rkt create mode 100644 lang-slide/scribblings/lang-slide.scrbl diff --git a/.gitignore b/.gitignore index cfa39ad..12e5fc7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ *~ lang.dot compiled/ +/doc/ +/lang-slide/doc/ \ No newline at end of file diff --git a/lang-slide/draw-plain.rkt b/lang-slide/draw-plain.rkt index 2667217..44ad91c 100644 --- a/lang-slide/draw-plain.rkt +++ b/lang-slide/draw-plain.rkt @@ -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") diff --git a/lang-slide/info.rkt b/lang-slide/info.rkt new file mode 100644 index 0000000..a4e81d4 --- /dev/null +++ b/lang-slide/info.rkt @@ -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") diff --git a/lang-slide/main.rkt b/lang-slide/main.rkt index 1594f73..8840260 100644 --- a/lang-slide/main.rkt +++ b/lang-slide/main.rkt @@ -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? - #: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))) - (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)) +(define (langs-pict1 color? + #:fit? [fit? #f] + #:picts [p (if (pict? color?) (list color?) (list))]) + (langs-pict color? + #:fit (λ (all) + (if fit? + (scale all (min 1 + (/ client-w (pict-width all)) + (/ client-h (pict-height all)))) + all)) + #:picts p)) (module+ main (slide (langs-pict #f)) diff --git a/lang-slide/pictures.rkt b/lang-slide/pictures.rkt new file mode 100644 index 0000000..a3b41d4 --- /dev/null +++ b/lang-slide/pictures.rkt @@ -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)) diff --git a/lang-slide/scribblings/lang-slide.scrbl b/lang-slide/scribblings/lang-slide.scrbl new file mode 100644 index 0000000..89f6b35 --- /dev/null +++ b/lang-slide/scribblings/lang-slide.scrbl @@ -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)