IT Wallpaper Generator

wallpaper.rkt

#lang racket/base

(require br/macro
         pict
         racket/class
         racket/draw)

;; Make wallpaper for use on server desktops

(define mint-green (make-object color% 1 133 116))
(define sport-green (make-object color% 16 137 62))
(define std-blue (make-object color% 0 83 148))
(define metal-blue (make-object color% 81 92 107))

(define output-dir (current-directory))

(define font "IBM Plex Mono")
(define-values (width height) (values 1366 1024))

;; (make-it std-blue "Exchange" "192.168.1.13")  -- will output a .png file
(define (make-it bgcolor srv-str ip-str)
  (define servername
    (text srv-str
          (cons (make-object color% "white")
                (cons 'bold font))
          96))
  (define info
    (text ip-str
          (cons (make-object color% "white")
                font)
          36))
  (define servertext (vr-append servername info))
  (define bg (filled-rectangle width height
                               #:color bgcolor
                               #:border-color bgcolor))
  (define combined
    (rb-superimpose bg
                    (lt-superimpose (filled-rectangle (+ (pict-width servertext) 100)
                                                      (+ (pict-height servertext) 100)
                                                      #:color bgcolor
                                                      #:border-color bgcolor)
                                    servertext)))
  (define img (pict->bitmap combined))
  (define outfile (build-path output-dir (string-append srv-str ".png")))
  (send img save-file (build-path output-dir (string-append srv-str ".png")) 'png)
  (displayln (format "Saved to ~a" outfile))
  (scale combined 0.25)) ; thumbnail for REPL output