From 20a8a1143610bda5e4b77ab04073565e8992a44d Mon Sep 17 00:00:00 2001 From: DarrenN Date: Mon, 28 Sep 2015 15:37:13 -0400 Subject: [PATCH] 1.0.0 Release - Fixes #18, #16, #15 - Breaking changes to identikon API, see documentation - Added identikon->string and save-identikon - Can now output / save JPEGs - Can now generate identikons from files - Added tests --- CHANGELOG.md | 14 +++ info.rkt | 2 +- main.rkt | 193 ++++++++++++++++++++++-------------- rules/default.rkt | 8 +- scribblings/identikon.scrbl | 86 ++++++++++++++-- transforms.rkt | 109 ++++++++++++++++++++ utils.rkt | 120 +++++++++++++++------- 7 files changed, 407 insertions(+), 125 deletions(-) create mode 100644 CHANGELOG.md create mode 100644 transforms.rkt diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..9ea5106 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,14 @@ +# Change Log +All notable changes to this project will be documented in this file. +This project adheres to [Semantic Versioning](http://semver.org/). + +## [1.0.0] - 2015-10-04 +### Changed +- Significant changes to API for `identikon`. Please see updated documentation. Related to [#16](https://github.com/DarrenN/identikon/issues/16) +- Two new functions provided: `save-identikon`, `identikon->string`. Related to [#15](https://github.com/DarrenN/identikon/issues/15) +- `identikon` can now take a file as input via the `#:filename` flag. +- Added tests, dealt with weird errors in test submod w/ quickcheck +- Updated documentation + +### Fixed +- [#18](https://github.com/DarrenN/identikon/issues/18) Contract-violation when saving identikon to file diff --git a/info.rkt b/info.rkt index 4ba5b5c..af7ae88 100644 --- a/info.rkt +++ b/info.rkt @@ -1,6 +1,6 @@ #lang info (define collection "identikon") -(define version "0.2") +(define version "1.0.0") (define scribblings '(("scribblings/identikon.scrbl" ()))) (define deps '("base" "sugar" diff --git a/main.rkt b/main.rkt index 461e109..73f8922 100644 --- a/main.rkt +++ b/main.rkt @@ -1,7 +1,7 @@ #lang racket/base -; Identikon - parses username into a sha1-based identifier list and -; interfaces with rule-sets to create identicon image +;; Identikon - parses username into a sha1-based identifier list and +;; interfaces with rule-sets to create identicon image (require racket/date racket/list @@ -11,26 +11,33 @@ openssl/sha1 2htdp/image sugar - identikon/utils) + identikon/utils + identikon/transforms) (provide (contract-out [identikon (->* (exact-positive-integer? exact-positive-integer? any/c) - (string? - (or/c boolean? string?)) - image?)])) - -; ——————————— -; implementation - -; Identifier we overwrite dynamically with module functions + ((or/c string? symbol?) + #:filename boolean?) + image?)] + [save-identikon (->* (string? + (or/c symbol? string?) + image?) + (#:quality number?) + boolean?)] + [identikon->string (->* (image? + (or/c symbol? string?)) + (#:quality number?) + string?)])) + +;; Identifier we overwrite dynamically with module functions (define draw-rules null) (define-namespace-anchor a) (define-runtime-path RULES-DIR "rules") -; Dynamically load in a rules file +;; Dynamically load in a rules file (define (load-plug-in file) (let ([ns (make-base-empty-namespace)] [filename (build-path RULES-DIR file)]) @@ -40,76 +47,95 @@ (parameterize ([current-namespace ns]) (dynamic-require filename 'draw-rules)))) -; Create a filename and check if the file already exists, if so -; append a timestamp +;; Create a filename and check if the file already exists, if so +;; append a timestamp (define (make-filename name size extension) - (let* ([ext (string-join (list "." extension) "")] - [sizename (string-join (list name (number->string size)) "_")] + (let* ([ext (format ".~a" (->string extension))] + [sizename (format "~a_~a" (->string name) (number->string size))] [filename (string-join (list sizename ext) "")]) (if (file-exists? filename) - (string-join (list sizename "_" (number->string (date->seconds (current-date))) ext) "") + (string-join + (list sizename "_" + (number->string (date->seconds (current-date))) ext) "") filename))) -; Save the file based on type - png or svg -(define (save-identicon filename type rendered) - (cond - [(string=? "svg" type) (save-svg-image rendered filename)] - [(string=? "png" type) (save-image rendered filename)] - [else (error 'save-identicon "failed because could not not save file type of ~a" type)])) - -; Turn a SHA1 hash into a list of 20 base 10 numbers -(define (process-user user) - (let [(str (if (string? user) - user - (->string user)))] - (map (λ (x) (string->number x 16)) - (string-pairs (sha1 (open-input-bytes (string->bytes/utf-8 str))))))) - -; Identikon - build an identicon of a specific size based on username and -; using a rule-set. Will automatically drop the identicon in the repl unless -; you tell it to save -; -; ex: ;(identikon 300 300 "dfsdf") -; -(define (identikon width height username [rules "default"] [type #f]) - (let* ([processed-user (process-user username)] - [rule-file (string-join (list rules "rkt") ".")]) - - ; Load rules file if provided +;; Save the file based on type - png, jpeg or svg +(define (save-identikon filename type image #:quality [quality 75]) + (let* ([ext (->string type)] + [path (make-filename filename (image-width image) ext)]) + (cond + [(string=? "svg" ext) (save-svg image path)] + [(string=? "png" ext) (save-bitmap image path)] + [(string=? "jpeg" ext) (save-bitmap image path 'jpeg #:quality quality)] + [else (error 'save-identicon + "failed because could not not save file type of ~a" type)]))) + +;; Output the image as a string representation +;; (svg as xml, png/jpeg as base64 bytes) +(define (identikon->string type image #:quality [quality 75]) + (let* ([ext (->string type)]) + (cond + [(string=? "svg" ext) (image->svg-string image)] + [(or (string=? "png" ext) (string=? "jpeg" ext)) + (image->bitmap-string image type quality)] + [else (error 'identikon->string "~a is not a valid image type" ext)]))) + +;; Convert a symbol or string into a rules filename +(define (create-rules-filename rules) + (let ([root (if (string? rules) + rules + (->string rules))]) + (format "~a.rkt" rules))) + +#| + + Identikon - build an identicon of a specific size based on username and + using a rule-set. Will automatically drop the identicon in the repl unless + you tell it to save + + ex: (identikon 300 300 "dfsdf") + (identikon 300 300 'dfsdf 'qbert) + +|# +(define (identikon width height input + [rules "default"] #:filename [filename #f]) + (let* ([processed-input (if filename + (file->numberlist input) + (string->numberlist input))] + [rule-file (create-rules-filename rules)]) + + ;; Load rules file if provided (set! draw-rules (load-plug-in rule-file)) - ; Create identicon - (define rendered (draw-rules width height processed-user)) + ;; Create identicon + (define rendered (draw-rules width height processed-input)) - ; Either save the identicon or output to REPL - (if type - (save-identicon (make-filename username width type) type rendered) - rendered))) + ;; Return identikon (image) + rendered)) (module+ test - (require quickcheck + (require rackunit sugar 2htdp/image) - ; Ensure we get a list of 20 values - (define process-user-lengths-agree - (property ([val (choose-mixed (list (choose-integer 1 (random 10000)) (choose-string choose-printable-ascii-char (random 100))))]) - (= 20 (length (process-user val))))) + (test-case + "create-rules-filename will append .rkt to anything that can be stringed" + (check-regexp-match ".rkt" (create-rules-filename "rza")) + (check-regexp-match ".rkt" (create-rules-filename 'wutang)) + (check-regexp-match ".rkt" (create-rules-filename 187))) - (quickcheck process-user-lengths-agree) + (test-case + "identikon returns an image" + (check-pred image? (identikon 100 100 'rza))) - ; Ensure identikon returns images - ; !! Warning: this is computationally expensive as it generates 100 - ; !! identicons - (define identikon-images-agree - (property ([dim arbitrary-natural] - [str arbitrary-printable-ascii-string]) - (image? (identikon dim dim str)))) - - (quickcheck identikon-images-agree)) + (test-case + "identikon->string returns a string" + (check-pred string? (identikon->string 'jpeg (identikon 100 100 'rza))) + (check-pred string? (identikon->string 'png (identikon 100 100 'rza))) + (check-pred string? (identikon->string 'svg (identikon 100 100 'rza))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Command line handling for Identikon +;; Command line handling for Identikon ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (module+ main @@ -118,16 +144,21 @@ (define size-flags (make-parameter null)) (define rules-set (make-parameter '("default"))) - (define name (make-parameter null)) + (define input-str (make-parameter null)) + (define file-name (make-parameter null)) (define ext (make-parameter "png")) (define make-identikon (command-line #:program "identikon" #:once-each - [("-n" "--name") nm - "Username to convert to identikon" - (name nm)] + [("-i" "--input-str") in + "String input-str to convert to identikon" + (input-str in)] + + [("-f" "--file") fl + "File or input stream used to generate identikon" + (file-name fl)] [("-t" "--type") ty "File type: png or svg" @@ -139,16 +170,24 @@ #:multi [("-s" "--size") sz - "Add a square size to generate" + "Add a square size(s) to generate. You can create multiple sizes." (size-flags (cons sz (size-flags)))])) (cond - [(and (empty? (size-flags)) (empty? (name))) (printf "No information provided ~n")] + [(and (empty? (size-flags)) + (empty? (input-str))) (printf "No information provided ~n")] [(empty? (size-flags)) (printf "No sizes were provided, -s ~n")] - [(empty? (name)) (printf "No name provided to process, -n ~n")] + [(empty? (input-str)) (printf "No input provided to process, -i ~n")] + [(not (empty? (file-name))) (for ([s (size-flags)]) + (save-identikon (file-name) (ext) (identikon (string->number s) + (string->number s) + (file-name) + (first (rules-set)) + #:filename #t)) + (printf "Saved ~apx identicon for ~a ~n" s (file-name)))] [else (for ([s (size-flags)]) - (identikon (string->number s) - (string->number s) - (name) - (first (rules-set)) (ext)) - (printf "Saved ~apx identicon for ~a ~n" s (name)))])) + (save-identikon (input-str) (ext) (identikon (string->number s) + (string->number s) + (input-str) + (first (rules-set)))) + (printf "Saved ~apx identicon for ~a ~n" s (input-str)))])) diff --git a/rules/default.rkt b/rules/default.rkt index 19a9350..58887b1 100644 --- a/rules/default.rkt +++ b/rules/default.rkt @@ -1,5 +1,9 @@ #lang racket/base +(require racket/list + 2htdp/image + identikon/utils) + ; Default rule-set for identikon. ; All rule-sets must provide a single function, draw-rules ; which is called by identikon. This function should always @@ -10,10 +14,6 @@ ; ——————————— ; implementation -(require racket/list - 2htdp/image - identikon/utils) - ; Constants (define BORDER-MAX 20) diff --git a/scribblings/identikon.scrbl b/scribblings/identikon.scrbl index 2057166..13aee1d 100644 --- a/scribblings/identikon.scrbl +++ b/scribblings/identikon.scrbl @@ -2,6 +2,7 @@ @(require scribble/eval identikon + 2htdp/image (prefix-in q: identikon/rules/qbert) (for-label racket identikon)) @@ -25,23 +26,39 @@ At the command line: After that, you can update the package from the command line: @verbatim{raco pkg update identikon} -@section{Generate identicon} +Identikon has a full command line interface which you can view with +@verbatim{raco identikon --help} -Identikon exposes a single function that generates an identicon based on a rules module. +@section{Generating identicons} @defproc[ (identikon [width exact-positive-integer?] [height exact-positive-integer?] - [username string?] - [rules string? "default"] - [type (or/c #f string?) #f]) - image?] + [input (or/c symbol? string?)] + [rules (or/c symbol? string?) "default"] + [#:filename boolean? #t #f]) + image?]{ +Identikon provides a single function, @racket[identikon], which produces images +based on input. If input is a string or symbole, a SHA1 hash will be produced +and used to geneate an image. If a filename is provided a SHA1 of the file will +be produced and used as input for generating images. -@racket[rules] is the name of the rules module to use in generating the identicon. This defaults to @racket["default"]. +Produces an @racket[identikon] with dimensions specified by @racket[width] and +@racket[height]. -@racket[type] is the filetype of the image to save, and can be either @racket["png"] or @racket["svg"]. If omitted no file will be saved and the identicon will be output to the REPL. +@racket[input] is converted into a list of numbers based on a SHA1 hash and +passed to a @racket[rules] module for processing into an @racket[image?]. + +@racket[rules] is the name of the rules module to use in generating the +identicon. This defaults to @racket["default"]. + +If @racket[#:filename] is @racket[#t] then @racket[identikon] will treat the +value of @racket[input] as a filename and attempt fo open it for processing. +} + +@bold{Examples:} Create a 300x300px identicon for @racket["racket"] using the @racket["default.rkt"] rule module. @@ -52,7 +69,58 @@ Create a 300x300px identicon for @racket["racket"] using the @racket["default.rk Create a 300x300 identicon for @racket["racket"] using the @racket["squares.rkt"] rule module. @examples[#:eval my-eval -(identikon 300 300 "racket" "squares") +(identikon 300 300 "racket" 'squares) +] + +Create a 300x300 identicon from this file using the @racket["qbert.rkt"] rule module. + +@examples[#:eval my-eval +(identikon 300 300 "identikon.scrbl" 'qbert #:filename #t) +] + +@defproc[ +(save-identikon + [filename string?] + [type (or/c symbol? string?)] + [image image?] + [#:quality number? natural-number/c 75]) +boolean?]{ + +Save an @racket[identikon] image to disk. Available types are @code[]{svg}, +@code[]{png} and @code[]{jpeg}. If the file already exists, a new version +of the file will be saved with a timestamp (seconds) appended. + +@racket[#:quality] only affects @code[]{jpeg} images. +} + +@racketblock[ + (save-identikon "foo" 'png + (identikon 300 300 'racket 'qbert)) +] + +@defproc[ +(identikon->string + [type (or/c symbol? string?)] + [image image?] + [#:quality number? natural-number/c 75]) +string?]{ + +Return an @racket[identikon] in a string format. This is useful if you want to +inject the image directly into an HTML page as an @code[]{} element or +as a data-uri. + +Available types are @code[]{svg}, @code[]{png} and @code[]{jpeg}. + +@code[]{svg} will emit a well formed @hyperlink["http://www.w3.org/TR/SVG11/"]{SVG element}. + +@code[]{png} and @code[]{jpeg} types will emit a string of base-64 encoded bytes +suitable for use in an @hyperlink["https://en.wikipedia.org/wiki/Data_URI_scheme"]{HTML data-uri}. + +@racket[#:quality] only affects @code[]{jpeg} images. +} + +@racketblock[ +(identikon->string (identikon 300 300 'racket 'qbert) 'svg) ] @section{Rules modules} diff --git a/transforms.rkt b/transforms.rkt new file mode 100644 index 0000000..a0b36c3 --- /dev/null +++ b/transforms.rkt @@ -0,0 +1,109 @@ +#lang racket + +(require mrlib/image-core + (except-in racket/draw + make-pen make-color) + (only-in 2htdp/image + image-height + image-width) + net/base64 + sugar) + +(provide image->svg-port + image->bitmap-dc + image->bitmap-string + image->svg-string + save-svg + save-bitmap) + +;; /////////////////////// +;; // SVG Operations +;; ////////////////////// + +;; Render image as an SVG and return its data in a string port +(define (image->svg-port image) + (let* ([width (image-width image)] + [height (image-height image)] + [out (open-output-string)] + [sdc (new svg-dc% [width width] [height height] [output out])]) + (send sdc start-doc "") + (send sdc start-page) + (send sdc set-smoothing 'aligned) + (render-image image sdc 0 0) + (send sdc end-page) + (send sdc end-doc) + out)) + +;; Return string representation of SVG from port +(define (image->svg-string image) + (get-output-string (image->svg-port image))) + +;; Save SVG string to disk +(define (save-svg image filename) + (display-to-file (image->svg-string image) + filename + #:mode 'binary + #:exists 'replace)) + +(module+ test + (require rackunit + 2htdp/image) + + (test-case + "image->svg-port returns a port" + (check-pred port? (image->svg-port (circle 20 "outline" "red")))) + + (test-case + "image->svg-string returns a string" + (check-pred string? (image->svg-string (circle 20 "outline" "red"))))) + +;; /////////////////////// +;; // Bitmap Operations +;; ////////////////////// + +;; Convert image to a bitmap +(define (image->bitmap-dc image) + (let* ([width (image-width image)] + [height (image-height image)] + [bm (make-bitmap (inexact->exact (ceiling width)) + (inexact->exact (ceiling height)))] + [bdc (make-object bitmap-dc% bm)]) + ;(send bdc set-smoothing 'aligned) + (send bdc erase) + (render-image image bdc 0 0) + (send bdc set-bitmap #f) + bm)) + +;; Dump bitmap into port to use as a string +(define (image->bitmap-bytes image [type 'png] [quality 75]) + (let* ([out (open-output-bytes)] + [bmp (image->bitmap-dc image)]) + (send bmp save-file out type quality) + out)) + +;; Return a bitmap as a base-64 encoded byte string +(define (image->bitmap-string image [type 'png] [quality 75]) + (bytes->string/utf-8 (base64-encode (get-output-bytes (image->bitmap-bytes image type quality))))) + +;; Save Bitmap to disk as 'png or 'jpeg +(define (save-bitmap image filename [type 'png] #:quality [quality 75]) + (let* ([out (open-output-bytes)] + [bmp (image->bitmap-dc image)]) + (send bmp save-file out type quality) + (display-to-file (get-output-bytes out) + filename + #:mode 'binary + #:exists 'replace))) + +(module+ test + (test-case + "image->bitmap-dc returns a bitmap" + (check-true (is-a? (image->bitmap-dc (circle 20 "outline" "red")) bitmap%))) + + (test-case + "image->bitmap-bytes returns a port" + (check-pred port? (image->bitmap-bytes (circle 20 "outline" "red")))) + + (test-case + "image->bitmap-string returns a string" + (check-pred string? (image->bitmap-string (circle 20 "outline" "red"))))) diff --git a/utils.rkt b/utils.rkt index 3b18c08..4585882 100644 --- a/utils.rkt +++ b/utils.rkt @@ -1,16 +1,13 @@ #lang racket -; A grab-bag of helper fucntions for identikon - -(provide (all-defined-out)) - -; ——————————— -; implementation - (require 2htdp/image + openssl/sha1 css-tools/colors sugar) +; A grab-bag of helper futions for identikon +(provide (all-defined-out)) + ; Default Constants (define DEFAULT-MAX-USER-LENGTH 18) (define DEFAULT-SATURATION "60%") @@ -57,12 +54,12 @@ ; Convert a string into a list of string pairs ; (string-pairs "Apple") returns ("Ap" "pl" "e") (define (string-pairs s) - (define (loop p l) - (cond - [(empty? l) (reverse p)] - [(eq? (length l) 1) (reverse (cons (list->string l) p))] - [else (loop (cons (list->string (take l 2)) p) (drop l 2))])) - (loop '() (string->list (string-join (string-split s) "")))) + (define (loop p l) + (cond + [(empty? l) (reverse p)] + [(eq? (length l) 1) (reverse (cons (list->string l) p))] + [else (loop (cons (list->string (take l 2)) p) (drop l 2))])) + (loop '() (string->list (string-join (string-split s) "")))) ; Partition list into lists of n elements ; example: (chunk-mirror 3 '(1 2 3 4 5 6)) returns @@ -94,25 +91,28 @@ [inside (dim iw ih)]) (canvas outside inside border))) -; TEST: Make canvas should calculate a border and internal area and create data structures -(module+ test - (define make-canvas-structs-agree - (property ([w arbitrary-natural] - [h arbitrary-natural]) - (let* ([c (make-canvas w h)] - [outside (canvas-outside c)] - [inside (canvas-inside c)] - [border (min (* w .1) DEFAULT-BORDER-MAX)]) - (and (canvas? c) - (dim? outside) - (dim? inside) - (= (dim-w outside) w) - (= (dim-h outside) h) - (= (canvas-border c) border) - (= (->int (- (dim-w outside) (* border 2))) (dim-w inside)) - (= (->int (- (dim-h outside) (* border 2))) (dim-h inside)))))) - - (quickcheck make-canvas-structs-agree)) +;; /////////////////////// +;; // SHA1 Operations +;; ////////////////////// + +;; Convert contents of port into a list of 20 base-10 numbers from a SHA1 hash +(define (process-input-port pt) + (let* ([pairs (map (λ (x) (string->number x 16)) + (string-pairs (sha1 pt)))]) + (when (input-port? pt) + (close-input-port pt)) + pairs)) + +;; Convert a string into a byte port +(define (string->numberlist str) + (process-input-port (open-input-bytes (string->bytes/utf-8 (->string str))))) + +;; Convert a file into a byte portb +(define (file->numberlist filename) + (define fpath (->string filename)) + (if (and (> (string-length fpath) 0) (file-exists? (string->path fpath))) + (process-input-port (open-input-file fpath #:mode 'binary)) + (raise-argument-error 'file->numberlist "file-exists?" filename))) ; Pad a list with its last value to size (define (pad-list l size) @@ -144,10 +144,62 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Tests +(module+ test + (require rackunit + sugar) + + (test-case + "file->numberlist returns a list of 20 values" + (check-true (= 20 (length (file->numberlist "utils.rkt"))))) + + (test-case + "file->numberlist throws exn if no file exists" + (check-exn + exn:fail? + (λ () (file->numberlist "wutang.rkt"))) + (check-exn + exn:fail? + (λ () (file->numberlist "utils")))) + + (test-case + "file->numberlist throws exn if filename empty" + (check-exn + exn:fail? + (λ () (file->numberlist ""))))) + (module+ test (require quickcheck sugar) + ; TEST: Make canvas should calculate a border and internal area and create data structures + (define make-canvas-structs-agree + (property ([w arbitrary-natural] + [h arbitrary-natural]) + (let* ([c (make-canvas w h)] + [outside (canvas-outside c)] + [inside (canvas-inside c)] + [border (min (* w .1) DEFAULT-BORDER-MAX)]) + (and (canvas? c) + (dim? outside) + (dim? inside) + (= (dim-w outside) w) + (= (dim-h outside) h) + (= (canvas-border c) border) + (= (->int (- (dim-w outside) (* border 2))) (dim-w inside)) + (= (->int (- (dim-h outside) (* border 2))) (dim-h inside)))))) + + (quickcheck make-canvas-structs-agree) + + ;; Ensure we get a list of 20 values + (define process-user-lengths-agree + (property ([val (choose-mixed (list + (choose-integer 1 (random 10000)) + (choose-string choose-printable-ascii-char + (random 100))))]) + (= 20 (length (string->numberlist val))))) + + (quickcheck process-user-lengths-agree) + ; string-pairs length is equal to original string without spaces (define string-pairs-length-agree (property ([str arbitrary-printable-ascii-string]) @@ -219,7 +271,7 @@ (quickcheck relative-position-values-agree) - ; pad-list should increase the list to size + ; pad-list should increase the list to size (define pad-list-lengths-agree (property ([lst (arbitrary-list arbitrary-natural)] [size arbitrary-natural]) @@ -236,7 +288,7 @@ ; make-triplets should always return a list of 12 items (define make-triplets-lengths-agree (property ([lst (arbitrary-list arbitrary-natural)]) - (= (length (make-triplets lst)) 12))) + (= (length (make-triplets lst)) 12))) (quickcheck make-triplets-lengths-agree) ; make-triplets should always return a list of 12 lists of 3 items