#lang racket/base

(require racket/port
         racket/system)

(provide windows-tray-available?
         start-windows-tray!)

(define (windows-tray-available?)
  (and (eq? (system-type 'os) 'windows)
       (find-executable-path "powershell.exe")
       #t))

(define tray-script
  #<<POWERSHELL
[Console]::OutputEncoding = [System.Text.Encoding]::UTF8
Add-Type -AssemblyName System.Windows.Forms
Add-Type -AssemblyName System.Drawing

$tray = New-Object System.Windows.Forms.NotifyIcon
$tray.Icon = [System.Drawing.SystemIcons]::Application
$tray.Text = "RKT Web Player Agent"
$tray.Visible = $true

$menu = New-Object System.Windows.Forms.ContextMenuStrip
$open = $menu.Items.Add("Open RKT Web Player Agent")
$quit = $menu.Items.Add("Exit")
$tray.ContextMenuStrip = $menu

$send = {
  param([string]$message)
  [Console]::Out.WriteLine($message)
  [Console]::Out.Flush()
}

$open.add_Click({ & $send "open" })
$tray.add_DoubleClick({ & $send "open" })
$quit.add_Click({
  & $send "quit"
  $tray.Visible = $false
  [System.Windows.Forms.Application]::Exit()
})

[System.Windows.Forms.Application]::Run()
$tray.Visible = $false
$tray.Dispose()
POWERSHELL
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Add a Windows notification-area icon with open and quit actions.
; pre    : Called on Windows with PowerShell and a GUI eventspace available.
; post   : Callbacks are delivered from a reader thread; the stop thunk removes
;          the helper process and its icon.
; result : A stop thunk, or #f when the platform has no supported tray helper.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (start-windows-tray! on-open on-quit)
  (cond
    ((not (windows-tray-available?)) #f)
    (else
     (let-values (((process output input error-output)
                   (subprocess
                    #f #f #f
                    (find-executable-path "powershell.exe")
                    "-NoLogo"
                    "-NoProfile"
                    "-NonInteractive"
                    "-WindowStyle"
                    "Hidden"
                    "-STA"
                    "-Command"
                    tray-script)))
       (close-output-port input)
       (define stopped? #f)
       (define reader
         (thread
          (λ ()
            (let loop ()
              (let ((line (read-line output 'any)))
                (unless (eof-object? line)
                  (cond
                    ((string=? line "open") (on-open))
                    ((string=? line "quit") (on-quit)))
                  (loop)))))))
       (thread
        (λ ()
          ;; Drain diagnostics so the helper cannot block on a full pipe.
          (copy-port error-output (open-output-nowhere))))
       (λ ()
         (unless stopped?
           (set! stopped? #t)
           (when (and reader (not (thread-dead? reader)))
             (kill-thread reader))
           (close-input-port output)
           (close-input-port error-output)
           (when (eq? (subprocess-status process) 'running)
             (subprocess-kill process #t))))))))