;; -*- mode: scheme; -*-
;; Viruscraft Copyright (C) 2018 FoAM Kernow

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(define screen-width 0)
(define screen-height 0)

(define canvas-mouse-x 0)
(define canvas-mouse-y 0)
(define canvas-mouse-state 0)
(define canvas-mouse-zoom 0)
(define canvas-mouse-zoom-delta 0)
(define canvas-drag-x 0)
(define canvas-drag-y 0)
(define canvas-is-dragging #f)
(define canvas-drag-fn (lambda () 0))
(define canvas-mouse-clicked #f)

(define canvas-event-occurred #f)

(define webgl-canvas (document.getElementById "webgl-canvas"))
(define canvas webgl-canvas)
;;(define canvas (document.getElementById "canvas"))
;;(define ctx (canvas.getContext "2d"))

(define canvas-timeout-trigger (* 2 60))
(define canvas-timeout-time 0)
(define canvas-delta 0)
(define canvas-time (js "new Date()"))

(define (canvas-update-time)
  ;;(set! canvas-timeout-time (+ canvas-timeout-time canvas-delta))
  ;;(when (> timeout-time timeout-trigger)
  ;;	(window.location.reload))
  (let ((delta (/ (- (js "new Date()") canvas-time) 1000.0)))
    ;; cap delta in case window, and rendering is paused for a while
    (set! canvas-delta (min 0.5 delta)))
	      
  (set! canvas-time (js "new Date()")))

(define (set-canvas-drag-fn fn)
  (set! canvas-drag-fn fn))

(define canvas-font "Arial")
(define (set-font! f) (set! canvas-font f))

(define (canvas-init-defaults)
  (set! ctx.fillStyle "#000")
  (set! ctx.font (string-append "30pt " canvas-font)))

(define (resize-canvas canvas) 
  ;; Lookup the size the browser is displaying the canvas.
  ;; (let ((displayWidth canvas.clientWidth)
  ;; 	(displayHeight canvas.clientHeight)) 
  ;;   ;; Check if the canvas is not the same size.
  ;;   (when (or (not (eq? canvas.width displayWidth))
  ;; 	      (not (eq? canvas.height displayHeight))
  ;; 	      (zero? screen-width)
  ;; 	      (zero? screen-height))
  ;; 	  ;; Make the canvas the same size
  ;; 	  (set! canvas.width displayWidth)
  ;; 	  (set! canvas.height displayHeight)
  ;; 	  (set! screen-width canvas.width)
  ;; 	  (set! screen-height canvas.height)
  ;; 	  (canvas-init-defaults)))
  
  ;;(set! screen-width canvas.width)
  ;;(set! screen-height canvas.height)
  0
  )

;;(set! window.onresize 
;;      (lambda ()
;;		(resize-canvas canvas)))

(define (mouse-from-event canvas e state)
  (let ((rect (canvas.getBoundingClientRect)))
    (let ((sx (/ rect.width screen-width))
          (sy (/ rect.height screen-height)))
      (let ((nx (/ (- e.clientX rect.left) sx))
			(ny (/ (- e.clientY rect.top) sy)))
		
		;; deal with dragging
		(when (and canvas-is-dragging (not canvas-event-occurred))
			  (set! canvas-drag-x (- nx canvas-mouse-x))
			  (set! canvas-drag-y (- ny canvas-mouse-y))
			  (canvas-drag-fn))      
		
		(set! canvas-event-occurred #f)

	(cond 
	 ((and (eq? state "move") (eq? canvas-mouse-state "down"))
	  ;; starting drag
	  (set! canvas-is-dragging #t))
	 ((and canvas-is-dragging (eq? state "up"))
	  ;; ending drag
	  (set! canvas-is-dragging #f))
	 (else 0))

	(set! canvas-mouse-x nx)
	(set! canvas-mouse-y ny)

	(if (and (eq? state "down") (not (eq? canvas-mouse-state "down")))
	    (set! canvas-mouse-clicked #t)
	    (set! canvas-mouse-clicked #f))

	(set! canvas-mouse-state state)))))

(define (touch-from-event canvas e state)
  (let ((e (car e.targetTouches)))
    (mouse-from-event canvas e state)))

(define (canvas-zoom e)
  (let ((delta (if e.wheelDelta (/ e.wheelDelta 40) 
		   (if e.detail (- e.detail) 0))))
    (set! canvas-mouse-zoom-delta delta)
    (set! canvas-mouse-zoom (+ canvas-mouse-zoom delta))
    (e.preventDefault)))

(define image-lib ())
(define loaded-images #f)

(define (canvas-loaded?)
  loaded-images)

(define (find-image fn l)
  (cond
   ((null? l) #f)
   ((eq? (car (car l)) fn) (cadr (car l)))
   (else (find-image fn (cdr l)))))

(define (load-image! fn finished images)
  (let ((image (js "new Image()")))
    (set! image.onload
          (lambda ()	    
	    (console.log (+ "loaded " (+ "images/" fn)))
            (set! image-lib (cons (list fn image) image-lib))
            (when (eq? (length image-lib)
                       (length images))
		  (set! loaded-images #t)
                  (finished))))
    (set! image.src (+ "images/" fn))))

(define (load-images! l finished)
  (for-each
   (lambda (fn)
     (load-image! fn finished l))
   l))

(define (mousedown-handler e) (mouse-from-event canvas e "down"))
(define (touchstart-handler e) (touch-from-event canvas e "down"))
(define (mousemove-handler e) (mouse-from-event canvas e "move"))
(define (touchmove-handler e) 
  (e.preventDefault)
  (touch-from-event canvas e "move"))
(define (mouseup-handler e) (mouse-from-event canvas e "up"))
(define (DOMMouseWheel-handler e) (mouse-from-event canvas e "down"))
(define (mousewheel-handler e) (mouse-from-event canvas e "down"))

(define (canvas-setup)
  (canvas.addEventListener "mousedown" mousedown-handler)
  (canvas.addEventListener "touchstart" touchstart-handler)
  (canvas.addEventListener "mousemove" mousemove-handler)
  (canvas.addEventListener "touchmove" touchmove-handler)      
  (canvas.addEventListener "mouseup" mouseup-handler)
;;  (canvas.addEventListener
;;   "touchend" (lambda (e) (mouse-from-event canvas e "up")))
;;  (canvas.addEventListener
;;   "touchcancel" (lambda (e) (mouse-from-event canvas e "up")))
  (canvas.addEventListener "DOMMouseScroll" canvas-zoom)
  (canvas.addEventListener "mousewheel" canvas-zoom)

  )

