#lang racket/gui
(require racket/draw)

(provide (rename-out [my-app #%app]
                     [my-module-begin #%module-begin]
                     [my-interaction #%top-interaction])
         #%datum save show)

(define bezier-canvas%
  (class canvas%
    (init-field a-bitmap)
    (super-new)
    (inherit get-dc)
    
    (define/override (on-paint)
      (send (get-dc) draw-bitmap a-bitmap 0 0))))

(define-syntax save
  (syntax-rules ()
    ((_ file-path file-type)
     (begin
       (send (dc) draw-path (path))
       (send (bitmap) save-file file-path file-tipe)))))

(define-syntax show
  (syntax-rules ()
    ((_ frame-label)
     (begin
       (define frame (new frame% [min-width (send (bitmap) get-width)]
                          [min-height (send (bitmap) get-height)]
                          [label frame-label]))
       (send (dc) draw-path (path))
       (define canvas (new bezier-canvas% [parent frame] [a-bitmap (bitmap)]))
       (send frame show #t)))))

(define bitmap (make-parameter #f))
(define dc (make-parameter #f))
(define path (make-parameter #f))

(define-syntax-rule (my-module-begin width height body ...)
  (#%plain-module-begin
   (parameterize* ([bitmap (make-bitmap width height #f)]
                   [dc (let ((temp (new bitmap-dc% [bitmap (bitmap)])))
                         (send temp set-pen "black" 2 'solid)
                         temp)]
                   [path (new dc-path%)])
     body ...)))

(define-syntax my-app
  (syntax-rules ()
    ((_ x1 y1 x2 y2 x3 y3 x4 y4)
     (begin
       (send (path) move-to x1 y1)
       (send (path) curve-to x2 y2 x3 y3 x4 y4)
       (send (path) curve-to x3 y3 x2 y2 x1 y1)))
    ((_ x1 y1 x2 y2)
     (begin
       (send (path) move-to x1 y1)
       (send (path) line-to x2 y2)
       (send (path) line-to x1 y1)))
    ((_ proc args ...)
     (#%app proc args ...))))

(define-syntax my-interaction
  (syntax-rules ()
    ((_ anything ...)
     (my-app anything ...))))