;; [ Copyright (C) 2008 Dave Griffiths : GPLv2 see LICENCE ]

;; StartSectionDoc-en
;; scratchpad
;; Functions available as part of the fluxus scratchpad.
;; Example:
;; EndSectionDoc	

#lang scheme/base
(require "fluxus-modules.ss")
(provide 
 key-pressed
 keys-down
 key-special-pressed
 keys-special-down
 key-pressed-this-frame
 key-special-pressed-this-frame
 mouse-x
 mouse-y
 mouse-button
 mouse-over
 register-down
 register-up
 clear-down
 update-input
 mouse-wheel)

(define keys '())
(define keys-this-frame '())
(define special-keys '())
(define special-keys-this-frame '())
(define mouse (vector 0 0 #f))
(define mouse-wheel-v 0)

; utils funcs for using lists as sets
(define (set-remove a l)
  (if (null? l)
      '()
      (if (eq? (car l) a)
          (set-remove a (cdr l))
          (cons (car l) (set-remove a (cdr l))))))		  

(define (set-add a l)
  (if (not (memq a l))
      (cons a l)
      l))			  

(define (set-contains a l)
  (if (not (memq a l))
      #f
      #t))		  

(define (clear-down)
  (set! keys '()))

(define (update-input)
	(set! keys-this-frame '())
	(set! special-keys-this-frame '())
	(set! mouse-wheel-v 0))

(define (register-down key button special state x y mod)
  (when (not (or (number? key) (eq? key -1))) ; ordinary keypress
    (set! keys (set-add key keys))
	(set! keys-this-frame (set-add key keys-this-frame)))
  (when (not (= special -1)) ; special keypress
    (set! special-keys (set-add special special-keys))
	(set! special-keys-this-frame (set-add special special-keys-this-frame)))
  (cond  ; mouse
    ((and (eq? key 0) (eq? special -1)) 
	 (when (eq? button 3) (set! mouse-wheel-v 1))
	 (when (eq? button 4) (set! mouse-wheel-v -1))
     (when (eq? state 0) (vector-set! mouse 2 (+ button 1)))
     (when (eq? state 1) (vector-set! mouse 2 0))
     (vector-set! mouse 0 x)
     (vector-set! mouse 1 y))))

(define (register-up key button special state x y mod)
  (when (not (eq? key -1))
    (set! keys (set-remove key keys)))
  (when (not (eq? special -1))
    (set! special-keys (set-remove special special-keys))))

;; StartFunctionDoc-en
;; key-pressed key-string
;; Returns: boolean 
;; Description:
;; Returns true if the specified key is currently pressed down.
;; Example:
;; (when (key-pressed "q") (display "q pressed!"))
;; EndFunctionDoc	

(define (key-pressed s)
  (set-contains (car (string->list s)) keys))

;; StartFunctionDoc-en
;; keys-down
;; Returns: keys-list 
;; Description:
;; Returns a list of keys pressed down
;; Example:
;; (display (keys-down))(newline)
;; EndFunctionDoc

(define (keys-down)
  keys)

;; StartFunctionDoc-en
;; key-special-pressed key-number
;; Returns: boolean 
;; Description:
;; Returns true if the specified special key is currently pressed down. Special
;; keys are ones which do not map to ascii values. The easiest way of finding
;; what they are is to print out the result of key-special-pressed while holding
;; down the key you are after.
;; Example: 
;; (when (key-special-pressed 100) (display "left cursor pressed"))
;; (when (key-special-pressed 102) (display "right cursor pressed"))
;; (when (key-special-pressed 101) (display "up cursor pressed"))
;; (when (key-special-pressed 103) (display "down cursor pressed"))
;; EndFunctionDoc	

(define (key-special-pressed k)
  (set-contains k special-keys))

;; StartFunctionDoc-en
;; keys-special-down
;; Returns: keys-list 
;; Description:
;; Returns a list of special keys pressed down
;; Example:
;; (display (keys-special-down))
;; EndFunctionDoc	

(define (keys-special-down)
  special-keys)

;; StartFunctionDoc-en
;; key-pressed-this-frame key-string
;; Returns: boolean 
;; Description:
;; Returns true if the specified key was first pressed down this frame.
;; Example:
;; (when (key-pressed-this-frame "q") (display "q pressed!"))
;; EndFunctionDoc	

(define (key-pressed-this-frame s)
  (set-contains (car (string->list s)) keys-this-frame))

;; StartFunctionDoc-en
;; key-special-pressed-this-frame key-string
;; Returns: boolean 
;; Description:
;; Returns true if the specified special key was first pressed down this frame.
;; Example:
;; (when (key-special-pressed-this-frame "q") (display "q pressed!"))
;; EndFunctionDoc	

(define (key-special-pressed-this-frame s)
  (set-contains s special-keys-this-frame))
  
;; StartFunctionDoc-en
;; mouse-x
;; Returns: coord-number 
;; Description:
;; Returns the x position of the mouse
;; Example:
;; (display (mouse-x))
;; EndFunctionDoc	

(define (mouse-x)
  (vector-ref mouse 0))

;; StartFunctionDoc-en
;; mouse-y
;; Returns: coord-number 
;; Description:
;; Returns the y position of the mouse
;; Example:
;; (display (mouse-y))
;; EndFunctionDoc	

(define (mouse-y)
  (vector-ref mouse 1))

;; StartFunctionDoc-en
;; mouse-button
;; Returns: boolean
;; Description:
;; Returns true if the specifed mouse button is pressed
;; Example:
;; (display (mouse-button 1))
;; EndFunctionDoc	

(define (mouse-button n)
  (eq? n (vector-ref mouse 2)))
  
;; StartFunctionDoc-en
;; mouse-wheel
;; Returns: boolean
;; Description:
;; Returns 1 if the mouse wheel was moved in one direction in the last frame
;; or -1 if it was turned the other way, otherwise returns 0.
;; Example:
;; (display (mouse-wheel))
;; EndFunctionDoc

(define (mouse-wheel)
	mouse-wheel-v)

;; StartFunctionDoc-en
;; mouse-over
;; Returns: primitiveid-number
;; Description:
;; Returns the object the mouse is currently over.
;; Example:
;; (grab (mouse-over))
;; (colour (vector 1 0 0)) ; paints objects the mouse is over red
;; (ungrab)
;; EndFunctionDoc	

(define (mouse-over)
  (select (vector-ref mouse 0) (vector-ref mouse 1) 3))


