scale-pocket.rkt

#lang racket
(require 2htdp/image)
(require racket/list/grouping)


; (run "pocket_screenshots/20230114_103712.png" "gb2-scaled.png")
; passes any keyword args through to pixelize-image e.g.
; (run "pocket_screenshots/20230114_103712.png" "gb2-scaled.png" #:subpixel-size 2 #:grid-color "Blue")
(define run
  (make-keyword-procedure
   (λ (kws kw-args input-path output-path)
     (let* ([original (bitmap/file input-path)]
            [pixelized (keyword-apply pixelize-image kws kw-args (list original))])
       (save-image pixelized output-path)
       pixelized))))

(define (pixelize-image img
                        #:subpixel-size [sub-w 3]
                        #:subpixel-height [sub-h (* sub-w 3)]
                        #:color-boost [factor-up 1.0]
                        #:color-ambient [factor-down 0.9]
                        #:grid-color [grid-color "Black"])
  (define W (image-width img))
  (define H (image-height img))
  (define rows (windows W W (image->color-list img)))

  (define (make-sub-rect color)
    (rectangle sub-w sub-h "solid" color))
  (define (make-grid-rect w h)
    (rectangle w h "solid" grid-color))
  (define (boost-color c)
    (clamp-color (* c factor-up)))
  (define (diminish-color c)
    (clamp-color (* c factor-down)))
  
  (define (scale-color-pixel color)
    (let* ([A (color-alpha color)]
           [R (boost-color (color-red color))]
           [G (boost-color (color-green color))]
           [B (boost-color (color-blue color))]
           [r (diminish-color (color-red color))]
           [g (diminish-color (color-green color))]
           [b (diminish-color (color-blue color))]
           [red   (make-sub-rect (make-color R g b A))]
           [green (make-sub-rect (make-color r G b A))]
           [blue  (make-sub-rect (make-color r g B A))]
           [right-edge (make-grid-rect 1 sub-h)]
           [bottom-edge (make-grid-rect (+ 1 (* sub-w 3)) 1)]
           [body (beside blue green red)])
      (above (beside body right-edge)
             bottom-edge)))

  (apply above
         (for/list ([row rows])
           (apply beside
                  (for/list ([color row])
                    (scale-color-pixel color))))))

(define (clamp low high n)
  (min (max n low) high))

(define (clamp-color n)
  (clamp 0 255 (exact-round n)))