#lang scheme
(require scheme/gui)
(require slideshow)

(define (make-motivator pict label description)
  (let ([motiv
         (colorize
          (vc-append
           (cc-superimpose
            (linewidth 2 (rectangle (+ (pict-width pict) 8) (+ (pict-height pict) 8))) pict)
           (text label 'roman 40)
           (text description 'roman 24))
          "white")
         ])
    (cc-superimpose
     (colorize (filled-rectangle (+ (pict-width motiv) 50) (+ (pict-height motiv) 50)) "black")
     motiv)))

(define (get-param name)
  (begin
    (display name)
    (read-line)))

(define (make-motivator/interactive)
  (make-motivator (bitmap (path->string (get-file))) (get-param "Label: ") (get-param "Description: ")))

(define (save-motivator pict name kind)
  (let* ([bmp (make-object bitmap% (inexact->exact (floor (pict-width pict))) (inexact->exact (floor (pict-height pict))))]
         [dc (make-object bitmap-dc% bmp)])
    (begin
      (draw-pict pict dc 0 0)
      (send bmp save-file name kind))))

(save-motivator (make-motivator/interactive) (put-file) 'png)