#lang scheme/base
(provide (all-defined-out))

;; Driver hub, glues together the parts to get a working PK2 USB
;; connection and device database.

(require
 "util.ss"
 "libusb.ss"       ;; FFI + tools
 "usbconst.ss"     ;; standard USB bits
 "pk2const.ss"     ;; PICkit2 bits
 "pk2script.ss"    ;; command and scripting languages
 "interpreter.ss"  ;; interpreter (for send/receive dep inject)
 "device-file.ss"  ;; Reader for Microchip's programming scripts
 scheme/pretty)

;; Load database + connect
(define (boot)
  (let ((datfile "/usr/local/bin/PK2DeviceFile.dat"))
    (printf "datfile:  ~a\n" datfile)
    (connect!)
    (load-device-file datfile)
    ; (set! pk2-boot reboot)
    ))

;(define (reboot)
;  ; (RESET)
;  (sleep 1)
;  (boot))

(define pk2-boot boot)






;; Current PK2 device
(define pk2-handle (make-parameter #f))

;; Patch interpreter to use current.
;; No device -> default to debug mode.
(define (if-handle param fn)
  (let ((debug-fn (param)))
    (param
     (lambda args
       (apply (if (pk2-handle) fn debug-fn) args)))))

(define (send-usb-debug handle bytes)
  (printf "SEND\n")
  (dump-list (bytes->list bytes))
  (send-usb handle bytes))
(define (receive-usb-debug handle)
  (printf "RECEIVE\n")
  (let ((bytes (receive-usb handle)))
    (dump-list (bytes->list bytes))
    bytes))


;; Change these to the -debug versions above for log.
(if-handle interpreter-snd (lambda (bytes) (send-usb (pk2-handle) bytes)))
(if-handle interpreter-rcv (lambda ()      (receive-usb (pk2-handle))))

;; Get all PK2s
(define (pickit2-list) (usb-device-list #x04d8 #x0033))


;; Open/Close a particular one

(define (pk2-first)
  (usb_init)
  (usb_find_busses)
  (usb_find_devices)
  (let ((pk2s (pickit2-list)))
    (when (null? pk2s)
      (error 'no-pickit2-found))
    (car pk2s)))

(define (pk2-open [dev (pk2-first)])
  (let ((handle (usb_open dev)))
    ;; Detach if necessary.
    (with-handlers ((void void))
      (usb_get_driver_np handle 0 (make-bytes 31) 31)
      (usb_detach_kernel_driver_np handle 0))
    (usb_set_configuration handle 2)  ;; try vendor config (not HID!)
    (usb_claim_interface handle 0)
    (printf "iProduct: ~a\n"
            (usb-device-product dev))
    handle))

(define (pk2-close [handle
                    (let ((h (pk2-handle)))
                      (pk2-handle #f) h)])
  (when handle
    ;; (display "Releasing PicKit2.\n")
    (usb_release_interface handle 0))
  (set! pk2-boot (lambda () (printf "trying to reopen PK2\n")))
  )
  

;; Send/Receive
(define endpoint-in  #x81)
(define endpoint-out #x01)
(define timeout 5000)
(define (send-usb dev buffer)
  (let ((l (bytes-length buffer)))
    (unless (= reqLen l)
      (error 'send-usb-wrong-size "~a" l))
    (usb_interrupt_write dev endpoint-out
                         buffer l timeout)))
(define (receive-usb dev [bufsize reqLen])
  (let ((b (make-bytes bufsize)))
    (let ((size
           (usb_interrupt_read dev endpoint-in
                               b reqLen timeout)))
      ;; (printf "size ~a\n" size)
      (subbytes b 0 size))))



(define-syntax-rule (pk2 . a)
  (with-pk2 (lambda () (append . a))))

;; Command and Script exec
(define (with-pk2 thunk)
  (let* ((already (pk2-handle))
         (handle (or already (pk2-open))))
    (parameterize ((pk2-handle handle))
      (dynamic-wind
          READ_STATUS
          thunk
          (lambda ()
            (unless already
              (pk2-close (pk2-handle))))))))

;; So commands can be entered directly.
(define (connect!)
  (pk2-handle (pk2-open)))