#! /usr/bin/env racket

;;; Wallpaper generator 1
;;; Usage: racket wp-1.rkt out.png

;;; Written in 2017 by Mikhail Kryshen <mikhail@kryshen.net>

;;; To the extent possible under law, the author has dedicated all
;;; copyright and related and neighboring rights to this software to
;;; the public domain worldwide.  This software is distributed without
;;; any warranty.  See the CC0 Public Domain Dedication at
;;; <http://creativecommons.org/publicdomain/zero/1.0/>.

#lang racket/base

(require racket/math
         racket/function
         racket/list
         racket/draw
         racket/cmdline
         pict
         pict/shadow
         pict/color
         file/convertible)

;; NB: also change internal-width and internal-height to the same
;; aspect ratio.
(define output-width 3840)
(define output-height 2160)

;; Affects blurring.
(define internal-width 800)
(define internal-height 450)

(define aspect-ratio (/ internal-width internal-height))
(define ratio-tolerance 0.05)

(define (gen-configuration depth)
  (if (= depth 1)
      (disk depth #:draw-border? #f)
      (case (random 2)
        [(0) (hc-append 1
                        (gen-configuration (sub1 depth))
                        (disk depth #:draw-border? #f)
                        (gen-configuration (sub1 depth)))]
        [(1) (vc-append 1
                        (gen-configuration (sub1 depth))
                        (disk depth #:draw-border? #f)
                        (gen-configuration (sub1 depth)))])))

(define (try-ratio gen . args)
  (let* ([l (apply gen args)]
         [l (if (< (pict-width l) (pict-height l))
                (rotate l (/ pi 2))
                l)])
    (if (< (- aspect-ratio ratio-tolerance)
           (/ (pict-width l) (pict-height l))
           (+ aspect-ratio ratio-tolerance))
        l
        (apply try-ratio gen args)))) ; bad aspect ratio — try again

(define (internal-fit pic)
  (scale-to-fit (inset pic 2) internal-width internal-height))

(define (output-fit pic)
  (scale-to-fit pic output-width output-height))

(define (gen-layer depth)
  (internal-fit (try-ratio gen-configuration depth)))

(define (blur/relative pict r)
  (blur pict (* r
                (sqrt (+ (sqr (pict-width pict))
                         (sqr (pict-height pict))))
                0.001)))

(define (gen-wp)
  (displayln (pseudo-random-generator->vector
              (current-pseudo-random-generator)))
  (cc-superimpose
   (filled-rectangle internal-width internal-height
                     #:draw-border? #f
                     #:color (make-color 30 30 30))
   (colorize (blur/relative (gen-layer 9) 66) "white")
   (cellophane (colorize (blur/relative (gen-layer 9) 33)
                         (make-color 255 255 200))
               0.3)
   (cellophane (colorize (blur/relative (gen-layer 9) 45) "cyan") 0.8)
   (colorize (blur/relative (gen-layer 10) 32) "red")
   (let ([l (gen-layer 10)])
     (cc-superimpose
      (colorize (blur/relative l 22) (make-color 80 0 255))
      (colorize (blur/relative l 11) (make-color 80 80 80))))
   (colorize (blur/relative (gen-layer 10) 11) (make-color 0 200 0))
   (colorize (blur/relative (gen-layer 10) 5.5) "yellow")
   (colorize (blur/relative (gen-layer 10) 11) (make-color 200 100 100))
   (let ([l (gen-layer 10)])
     (cc-superimpose
      (cellophane (colorize (blur/relative l 5.5) "yellow") 0.3)
      (cellophane (colorize l "white") 0.3)))
   (cellophane (colorize (gen-layer 10) "white") 0.8)))

(define (pict->png pict filename)
  (call-with-output-file filename
    (λ (out)
      (write-bytes (convert pict 'png-bytes) out))))

;; (define (gen-files n proc)
;;   (with-output-to-file "log.txt"
;;     (thunk
;;      (for ((i (range n)))
;;        (let ((filename (format "out~a.png" i)))
;;          (displayln filename)
;;          (pict->png (proc) filename)
;;          (flush-output))))))

(define (seed! vec)
  (vector->pseudo-random-generator! (current-pseudo-random-generator) vec))

;; (seed! #(4200625384 1398789386 370514709 3988346253 1056935580 1065533761))

(command-line
 #:args (pngfile)
 (pict->png (output-fit (gen-wp)) pngfile))
