#lang racket/gui

#|
The evil-snip% tries to render updates on a separate rendering thread. The
rendering threads are always created from the main program thread or another
rendering thread, never the GUI thread.

They do it like this to inherit their parameters ultimately from the program
thread. Inheriting parameters from the GUI thread would be bad, because setting
them in the program would apparently have no effect on rendering.
|#

(define evil-snip%
  (class image-snip%
    (init-field bm [rth (make-render-thread)])
    (super-make-object bm)
    
    ; Comment this out to create new render threads from the GUI thread when
    ; the snip is copied (e.g. when it is displayed in DrRacket's REPL)
    (define/override (copy)
      (make-object evil-snip% bm (render-thread-copy rth)))
    
    ; Render every 3 seconds after constructing a snip
    (define timer (make-object timer%
                    (λ () (render-thread-render rth)) 3000))))

;; -----------------------------------------------------------------------------
;; Rendering thread interface

;; A render-thread is a channel and a thread
(struct render-thread (ch th) #:transparent)

(define (render-thread-render rth)
  (match-define (render-thread ch _) rth)
  (channel-put ch 'render)
  (channel-get ch))

(define (render-thread-copy rth)
  (match-define (render-thread ch _) rth)
  (channel-put ch 'copy)
  (channel-get ch))

(define (make-render-thread)
  (define ch (make-channel))
  (define (thread-proc)
    ; Wait for a command over the channel
    (match (channel-get ch)
      ; Make a render thread on this thread to inherit this thread's parameters
      ['copy  (channel-put ch (make-render-thread))]
      ['render
       #;
       (error 'render-thread "something happened during rendering")
       ; On program thread: locks up DrRacket without showing the error
       ; On GUI thread: doesn't ever lock up, displays errors properly
       
       #;
       (dynamic-wind
        (λ () (void))
        (λ () (error 'render-thread "something happened during rendering"))
        (λ () (channel-put ch #f)))
       ; On program thread: locks up DrRacket, but lets the error display
       ; On GUI thread: locks up REPL on the SECOND render until user break
       
       #;
       (with-handlers ([(λ (e) #t)
                        (λ (e)
                          (channel-put ch #f)
                          (raise e))])
         (error 'render-thread "something happened during rendering"))
       ; On program thread: locks up DrRacket, displays the error twice
       ; On GUI thread: locks up REPL on the second render until user break
       
       (begin
         (with-handlers ([(λ (e) #t)
                          (λ (e) (void))])
           (error 'render-thread "something happened during rendering"))
         (channel-put ch #f))
       ; On program thread: successfully ignores error once, then locks up
       ; DrRacket some random time in the future (re-running program, closing
       ; editor and doing REPL stuff in another, doing REPL stuff in this one)
       ; On GUI thread: works great, but displays no errors!
       ])
    (thread-proc))
  (render-thread ch (thread thread-proc)))

;; -----------------------------------------------------------------------------
;; Testing

; Make and display an evil-snip%
(define bm (make-bitmap 100 100))
(define dc (make-object bitmap-dc% bm))
(send dc draw-text "Hello!" 0 0)
(make-object evil-snip% bm)