candle.scm

candle.scm

#!/usr/bin/env guile \
-L modules -e main -s
!#

;; This work is dedicated to the victims of the terrorist attack that took
;; place on March 22, 2024 at "Crocus City Hall" in Moscow.
;;
;; Copyright (C) 2024 Artyom V. Poptsov <poptsov.artyom@gmail.com>
;;
;; Mastodon:  https://fosstodon.org/@avp
;; GitHub:    https://github.com/artyom-poptsov
;; Home page: https://memory-heap.org
;;
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved.  This file is offered as-is,
;; without any warranty.
;;
;; This program uses Guile-PNG:
;; https://github.com/artyom-poptsov/guile-png

(use-modules (rnrs bytevectors)
             (oop goops)
             (png)
             (png image)
             (png graphics))

(define (constrain byte)
  (cond
   ((> byte 255) 255)
   ((< byte 0)   0)
   (else
    byte)))

(define (change-lightness color modifier)
  (let ((r (bytevector-u8-ref color 0))
        (g (bytevector-u8-ref color 1))
        (b (bytevector-u8-ref color 2)))
    (u8-list->bytevector (list (constrain (+ r modifier))
                               (constrain (+ g modifier))
                               (constrain (+ b modifier))))))

(define (main args)
  (let* ((width 500)
         (height width)
         (center (/ width 2))
         (color:white #vu8(255 255 255 0))
         (color:black #vu8(0 0 0 0))
         (color:flame #vu8(199 131 26 0))
         (image  (make <png-image>
                   #:width      width
                   #:height     height
                   #:bit-depth  8
                   #:color-type 2)))
    (draw! image
           (make <filled-rectangle>
             #:color    color:black
             #:position (make <point> #:x 0 #:y 0)
             #:width    (png-image-width image)
             #:height   (png-image-height image)))
    (let loop ((width 100)
               (color-modifier 0))
      (when (> width 10)
        (draw! image
               (make <filled-rectangle>
                 #:color    (change-lightness (change-lightness color:white
                                                                -200)
                                              color-modifier)
                 #:position (make <point>
                              #:x (- center (/ width 2))
                              #:y (+ center 40))
                 #:width    width
                 #:height   (- center 40)))
        (loop (- width 10)
              (+ color-modifier 10))))

    (draw! image
           (make <filled-rectangle>
             #:color color:white
             #:position (make <point> #:x (- center 5) #:y center)
             #:width    10
             #:height   40))
    (let loop ((y-offset (- center 30))
               (diameter 60)
               (color-modifier 0))
      (when (> diameter 2)
        (let circle-loop ((n 10))
          (when (> n 0)
            (draw! image
                   (make <circle>
                     #:color (change-lightness (change-lightness color:flame
                                                                 (random 100))
                                               color-modifier)
                     #:center (make <point>
                                #:x (+ center (- (random 20) 10))
                                #:y (+ y-offset (- (random 20) 10)))
                     #:diameter diameter))
            (circle-loop (- n 1))))
        (loop (- y-offset (floor/ diameter 2))
              (- diameter (+ (random 5) 5))
              (- color-modifier 10))))

    (scm->png image)))