#lang racket/base
(require 2htdp/image
         racket/runtime-path
         (for-syntax racket/syntax "private/planetcute-image-list.rkt")
         (for-syntax racket/base))

(define-syntax (definitions stx)
  #`(begin
      #,@(for/list ([img (in-list (apply append (map cdr images)))])
           #`(begin
               (provide #,img)
               (define-syntax #,img (make-planetcute-transformer '#,img))))))


(define-for-syntax (make-planetcute-transformer img)
  (make-set!-transformer
   (let ([saved-id-table (make-hasheq)])
     (λ (stx)
       (if (eq? 'expression (syntax-local-context))
           ;; In an expression context:
           (let* ([key (syntax-local-lift-context)]
                  [id (generate-temporary)]
                  ;; Already lifted in this lifting context?
                  [lifted-id
                   (or (hash-ref saved-id-table key #f)
                       ;; No: lift the require for the image:
                       (syntax-local-lift-require `(rename (lib ,(format "~a.rkt" img) "2htdp" "planetcute") ,id ,img)
                                                  (datum->syntax stx id)))])
             (when key (hash-set! saved-id-table key lifted-id))
             ;; Expand to a use of the lifted expression:
             (with-syntax ([saved-id (syntax-local-introduce lifted-id)])
               (syntax-case stx (set!)
                 [name (identifier? #'name) #'saved-id]
                 [(set! id arg)
                  (raise-syntax-error
                   '2htdp/planetcute
                   "cannot set! a Planet Cute variable"
                   stx #'id)]
                 [(name . more)
                  (raise-syntax-error
                   '2htdp/planetcute
                   "the Planet Cute variables cannot be used after an open parenthesis as they are not functions"
                   stx #'id)])))
           ;; In case of partial expansion for module-level and internal-defn
           ;; contexts, delay expansion until it's a good time to lift
           ;; expressions:
           (quasisyntax/loc stx (#%expression #,stx)))))))

(definitions)
