#lang racket (provide make-figures figure-ref figures) (require scribble/base csv-reading scriblib/figure racket/string scribble/core scribble/html-properties scribble/latex-properties racket/runtime-path file/convertible [only-in pict bitmap scale-to-fit pict->bitmap]) (define-runtime-path pwd ".") (define image-dir (build-path pwd "static")) (define scaled-dir (build-path pwd "scaled")) (unless (directory-exists? scaled-dir) (make-directory scaled-dir)) (define (write/get-scaled-image image-filename #:max-width [max-width 800] #:max-height [max-height 600]) (define scaled-path (build-path scaled-dir (path-replace-extension image-filename #".png"))) (define source-path (build-path image-dir image-filename)) (unless (file-exists? scaled-path) (call-with-output-file scaled-path (lambda (op) (define scaled-as-bytes (convert (scale-to-fit (bitmap source-path) max-width max-height) 'png-bytes)) (write-bytes scaled-as-bytes op)))) scaled-path) (define scaled-fig-style (make-style "ScaledFig" '())) (define (scaled-centered-image filename . content) (apply image #:style scaled-fig-style (write/get-scaled-image filename #:max-width 800 #:max-height 600) content)) (define (csv->hash-table-list filename) "loops through csv file at FILENAME creating a list of hash tables" (define our-csv-reader (make-csv-reader (open-input-file filename) '((strip-leading-whitespace? . #t) (strip-trailing-whitespace? . #t)))) ;; establishes the first line of the csv as the headers (define header (our-csv-reader)) ;; pairs the information in each row with the header to create a ;; hash table (define (row->hash-table row) (define hash-row (make-hash)) ;; loop through and add to hash table (for ([header-item header] [row-item row]) (hash-set! hash-row header-item row-item)) ;; returns the completed hash row hash-row) ;; Repeats the previous function for each line of the csv and ;; builds it into a list (csv-map row->hash-table our-csv-reader)) (define image-list-tables (csv->hash-table-list (build-path pwd "DissertationDB.csv"))) (define image-list-vector (list->vector image-list-tables)) (define image-list-key->vector-pos (for/fold ([ht #hash()]) ([csv-table image-list-tables] [i (in-naturals)]) (hash-set ht (hash-ref csv-table "self") i))) (define (figure-ref key . pre-content) (define-values (csv-table self-name listed-num) (match key ;; We have to deal with the values being off by one, basically [(? integer? listed-num) (define csv-table (vector-ref image-list-vector (sub1 listed-num))) #;(displayln (format "WARNING: @figure[~a] should be @figure[\"~a\"]" listed-num (hash-ref csv-table "self")) (current-error-port)) (values csv-table (hash-ref csv-table "self") listed-num)] [(? string? self-name) (define real-pos (hash-ref image-list-key->vector-pos key)) (define listed-num (add1 real-pos)) (define csv-table (vector-ref image-list-vector real-pos)) (values csv-table self-name listed-num)])) (let ([pre-content (match pre-content ['() (bold (format "(Fig. ~a)" listed-num))] [pc pc])]) (elemref self-name pre-content))) (define (figures . keys) (match keys [(list key) (figure-ref key)] [_ ;; First we need to grab all the keys and order them (define key-nums (map (match-lambda [(? number? key-num) (sub1 key-num)] [(? string? key-str) (hash-ref image-list-key->vector-pos key-str)]) keys)) (define sorted-key-nums (sort key-nums <)) ;; Now we need to break them into ranges (define ranges (let ranges-lp ([keys sorted-key-nums] [ranges '()]) (match keys ;; ranges-lp never called while empty I think? oh well ['() (reverse ranges)] ;; pull the first item off... [(list first-item rest-items ...) (let range-lp ([keys keys] [this-range (list first-item)]) (match keys ;; we're done, as in totally done ['() (reverse (cons (reverse this-range) ranges))] [(list this-key rest-keys ...) (define last-key (car this-range)) (cond [(= last-key this-key) ;; guess it's a duplicate; remove by continuing (range-lp rest-keys this-range)] [(= (add1 last-key) this-key) ;; nice, it's the next item in a loop (range-lp rest-keys (cons this-key this-range))] [else (ranges-lp (cons this-key rest-keys) (cons (reverse this-range) ranges))])]))]))) (define (figure-elem index-num) (define listed-num (add1 index-num)) ;; figure-ref takes listed-num rather than vector index for writer's ;; convenience... (figure-ref listed-num (number->string listed-num))) ;; Now we need to do the appropriate rendering (define figure-elems (for/list [(this-range ranges)] (match this-range [(list key) (figure-elem key)] [(list first-key middle ... last-key) (elem (figure-elem first-key) "-" (figure-elem last-key))]))) (define comma-joined-figure-elems (let lp ([figure-elems figure-elems]) (match figure-elems ['() '()] [(list last-item) figure-elems] [(list next-item rest-items ...) (append (list next-item ", ") (lp rest-items))]))) (bold "(Figs. " (apply elem comma-joined-figure-elems) ")")])) (define (image-tag csv-table) (define (csv-ref key) (hash-ref csv-table key)) (define (csv-has? key) (not (equal? (csv-ref key) ""))) (define (csv-comma-join lst) (string-join (filter (lambda (x) (not (equal? x ""))) (map csv-ref lst)) ", ")) (string-append (csv-ref "description") " from " (csv-ref "context") (if (csv-has? "city") (string-append " in " (csv-ref "city")) "") (if (or (csv-has? "materials") (csv-has? "date") (csv-has? "collection") (csv-has? "number")) (string-append ", " (csv-comma-join '("materials" "date" "collection" "number"))) "") "." (if (csv-has? "notes") (string-append " " (string-trim (csv-ref "notes") "." #:right? #t #:left? #f) ".") "") (if (csv-has? "credit") (string-append " Image by " (csv-ref "credit") (if (or (csv-has? "license") (csv-has? "link")) (string-append (if (and (csv-has? "license") (csv-has? "link")) (string-append (csv-ref "license") " " (csv-ref "link")) "") (if (csv-has? "license") (csv-ref "license") "") (if (csv-has? "link") (csv-ref "link") "") ".") "")) "") )) ;;"(description) from (a/an/the) (context) in (city), (materials), (date), (collection) (number). Image by (credit), (license) (link)" (define (make-figures) (for/list ([csv-table image-list-tables] [i (in-naturals 1)]) (define csv-image-name (hash-ref csv-table "image1")) (define x (hash-ref csv-table "x")) (define (elemtag-it x) (elemtag (hash-ref csv-table "self") x)) (cond [(equal? x "x") (nested-flow (make-style "SCentered" '()) (list (paragraph (make-style #f '()) (list (bold (format "Figure ~a: " i)) (elem (image-tag csv-table)) (emph " (Image withheld due to inadequate legal permissions.)")))))] [(equal? csv-image-name "") (paragraph (make-style #f '()) (list (elemtag-it (bold (format "Figure ~a: " i))) "Missing image1 field"))] [else (let ([image-filepath (build-path image-dir csv-image-name)]) (cond [(not (file-exists? image-filepath)) (paragraph (make-style #f '()) (list (elemtag-it (bold (format "Figure ~a: " i))) (format "Missing file: ~a" image-filepath)))] [else (nested-flow (make-style "SCentered" '()) (list (paragraph (make-style #f '()) (elemtag-it (scaled-centered-image csv-image-name))) (paragraph (make-style #f '()) (list (bold (format "Figure ~a: " i)) (elem (image-tag csv-table))))))]))])))