sad-face-in-color-1.scm

#!/home/avp/.guix-profile/bin/guile \
-L modules -e main -s
!#

;; https://github.com/artyom-poptsov/guile-png

(use-modules (oop goops)
             (logging logger)
             (png)
             (png fsm context)
             (png image)
             (png graphics))

(define (draw-saddness image position size color)
  (let ((position-x (point-x position))
        (position-y (point-y position)))
    (draw! image
           (make <ellipse>
             #:color  color
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 2)))
                        #:y (+ position-y (inexact->exact (floor/ size 2))))
             #:width  (/ size 2)
             #:height size))
    (draw! image
           (make <filled-rectangle>
             #:color    #vu8(0 0 0)
             #:position (make <point>
                          #:x (+ position-x (inexact->exact (floor/ size 2)))
                          #:y position-y)
             #:width    (inexact->exact (floor/ size 2))
             #:height   size))
    (draw! image
           (make <circle>
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 8)))
                        #:y (+ position-y (inexact->exact (floor/ size 8))))
             #:radius (inexact->exact (floor/ size 8))
             #:color  color))
    (draw! image
           (make <circle>
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 8)))
                        #:y (- (+ position-y size)
                               (inexact->exact (floor/ size 8))))
             #:radius (inexact->exact (floor/ size 8))
             #:color  color))))

(define (main args)
  "Entry point."
  (let* ((image (make <png-image>
                  #:color-type 2
                  #:bit-depth 8
                  #:width  1000
                  #:height 1000)))
    (let loop ((count 10))
      (unless (zero? count)
        (let ((position (make <point>
                          #:x (+ (random (- (png-image-width image) 300)) 100)
                          #:y (+ (random (- (png-image-width image) 300)) 100)))
              (size (random 200))
              (color  (list->u8vector (list (random 255) (random 255) (random 255)))))
          (draw-saddness image position size color)
          (loop (- count 1)))))
    (let ((port (open-output-file "sad.png")))
      (scm->png image port)
      (close port))))

sad-face-in-color-2.scm

#!/home/avp/.guix-profile/bin/guile \
-L modules -e main -s
!#

;; https://github.com/artyom-poptsov/guile-png

(use-modules (oop goops)
             (logging logger)
             (png)
             (png fsm context)
             (png image)
             (png graphics))

(define (draw-saddness image position size color)
  (let ((position-x (point-x position))
        (position-y (point-y position)))
    (draw! image
           (make <ellipse>
             #:color  color
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 2)))
                        #:y (+ position-y (inexact->exact (floor/ size 2))))
             #:width  (/ size 2)
             #:height size))
    (draw! image
           (make <filled-rectangle>
             #:color    #vu8(0 0 0)
             #:position (make <point>
                          #:x (+ position-x (inexact->exact (floor/ size 2)))
                          #:y position-y)
             #:width    (inexact->exact (floor/ size 2))
             #:height   size))
    (draw! image
           (make <circle>
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 8)))
                        #:y (+ position-y (inexact->exact (floor/ size 8))))
             #:radius (inexact->exact (floor/ size 8))
             #:color  color))
    (draw! image
           (make <circle>
             #:center (make <point>
                        #:x (+ position-x (inexact->exact (floor/ size 8)))
                        #:y (- (+ position-y size)
                               (inexact->exact (floor/ size 8))))
             #:radius (inexact->exact (floor/ size 8))
             #:color  color))))

(define (main args)
  "Entry point."
  (let* ((image (make <png-image>
                  #:color-type 2
                  #:bit-depth 8
                  #:width  1000
                  #:height 1000)))
    (set! *random-state* (random-state-from-platform))
    (let loop ((count 10))
      (unless (zero? count)
        (let ((position (make <point>
                          #:x (+ (random (- (png-image-width image) 300)) 100)
                          #:y (+ (random (- (png-image-width image) 300)) 100)))
              (size (random 200)))
          (let inner-loop ((i 5))
            (unless (zero? i)
              (let ((color (list->u8vector (list (random 255) (random 255) (random 255))))
                    (pos   (make <point>
                             #:x (+ (point-x position) (random 5))
                             #:y (+ (point-y position) (random 5)))))
                (draw-saddness image pos size color)
                (inner-loop (- i 1)))))
          (loop (- count 1)))))
    (let loop ((count 10))
      (unless (zero? count)
        (let ((position (make <point>
                          #:x (+ (random (- (png-image-width image) 300))
                                 50)
                          #:y (+ (random (- (png-image-width image) 300))
                                 50)))
              (color  (list->u8vector (list (random 100) (random 100) (random 100)))))
          (draw! image
                 (make <filled-rectangle>
                   #:position position
                   #:width (random 250)
                   #:height (random 250)
                   #:color color))
          (loop (- count 1)))))
    (let ((port (open-output-file "sad-3.png")))
      (scm->png image port)
      (close port))))