;------------------------------------------------------
; lsystem sketching prototype
; ---------------------------
;
; an idea for putting lsystems under human control, 
; and making them sketchable. 
; not sure how this would be best extended to 3D.
; [I need to work on the mouse stuff in fluxus]
;
; instructions:
; * draw from the centre by dragging with left mouse
; * repeat to make a new plant/drawing
;
; don't make the drawing too long, it'll make your computer cry

(require "ls.ss")

; gets a line representing a segment of the projection of the mouse into 3D space
; should move this into the fluxus scheme library 
(define (get-line-from-mouse)
    (let* ((ndcpos (vector (* (- (/ (mouse-x) (vx (get-screen-size))) 0.5) 2)
                    (* (- (- (/ (mouse-y) (vy (get-screen-size))) 0.5)) 1.5) -1))
            (scrpos2 (vtransform (vmul ndcpos 50) (minverse (get-camera-transform))))
            (scrpos (vtransform ndcpos (minverse (get-camera-transform)))))
        (list scrpos scrpos2)))

; we'll just use the end of the projection line here
(define (mouse-pos)
    (cadr (get-line-from-mouse)))

; converts a 2D vector into an angle, with some dodgy dave maths
(define (2dvec->angle x y)
    (let ((q (/ 3.141 2)))
        (when (zero? y) (set! y 0.0001))
        (cond 
            ((>= y 0)
                (fmod (* (+ q q q (- q (atan (/ x y)))) 57.2957795) 360))
            (else
                (fmod (* (+ q (- q (atan (/ x y)))) 57.2957795) 360)))))

;-----------------------------------------------------
; builds objects from a string
; would be good to abstract this asap

(define (ls-build string angle branch-scale branch-col leaf-col)
    (hint-depth-sort)
    (for-each 
        (lambda (char)
            (cond 
                ((char=? #\F char)
                    (with-state
                        (translate (vector 1 0 0))
                        (translate (vmul (crndvec) 0.01))
                        (scale (vector 1.2 2 2))
                        (rotate (vector 0 90 0))         
                        (colour (vector 0.5 1 0.2))                        
                        (with-primitive (build-ribbon 2)
                        ;    (texture (load-texture "textures/fade4.png"))
                        ;    (hint-unlit)
                            (pdata-set! "w" 0 0.1)
                            (pdata-set! "w" 1 0.1)
                            (pdata-set! "p" 0 (vector 0 0 1))
                            (pdata-set! "p" 1 (vector 0 0 0))))
                    (translate (vector 1 0 0)))
                ((char=? #\L char)
                    #;                   (with-state
                        (translate (vector 1 0 0))
                        (scale (vector 2 1 1))
                        ;         (rotate (vector 0 90 0))         
                        (colour leaf-col)
                        (texture (load-texture "../textures/leaf.png"))
                        (build-plane))
                    (translate (vector 1 0 0)))
                ((char=? #\f char)
                    (translate (vector 1 0 0)))
                ((char=? #\/ char)
                    (rotate (vector angle 0 0)))
                ((char=? #\\ char)
                    (rotate (vector (- angle) 0 0)))
                ((char=? #\+ char)
                    (rotate (vector 0 angle 0)))
                ((char=? #\- char)
                    (rotate (vector 0 (- angle) 0)))
                ((char=? #\^ char)
                    (rotate (vector 0 0 angle)))
                ((char=? #\& char)
                    (rotate (vector 0 0 (- angle))))
                ((char=? #\| char)
                    (rotate (vector 0 0 180)))
                ((char=? #\[ char)
                        (push)
                        (scale (vector branch-scale branch-scale branch-scale)))
                    ((char=? #\] char)
                    (pop))))
        (string->list string)))

;------------------------------------------------------
; strokes are collections of points representing mouse movement

(define-struct stroke ((points #:mutable)))

(define (build-stroke)
    (make-stroke (list (vector 0 0 -40)))) ; start with a point in the middle of the screen

(define (stroke-clear stroke)
    (set-stroke-points! stroke (list (vector 0 0 -40))))

(define (stroke-add stroke pos)
    (set-stroke-points! stroke (cons pos (stroke-points stroke))))

(define (stroke-last-point stroke)
    (car (stroke-points stroke)))

(define (stroke-update stroke)
    ; make a new point when the mouse is suitibly far from the last point
    (when (> (vdist (stroke-last-point stroke) (mouse-pos)) 2)
        (stroke-add stroke (mouse-pos))))

; draw some blobs to indicate the path drawn
(define (stroke-render stroke)
    (for-each 
        (lambda (pos)
            (with-state
                (opacity 0.7)
                (translate pos)
                (hint-unlit)
                (colour (vector 1 1 0))
                (draw-sphere)))
        (stroke-points stroke)))

; converts a stroke into the corresponding lsystem string, 
; with some branchpoints to recurse the drawing - would be 
; better to get the branchpoints from the drawing somehow...
(define (stroke->string stroke angle)
    (define (collect pos next-pos last-angle str c)
        (cond ((null? next-pos) str)
            (else
                (let* ((v (vsub (car pos) (car next-pos)))
                        (a (2dvec->angle (vx v) (vy v))) ; get the absolute angle
                        (ra (- a last-angle)) ; get angle relative to the last angle
                        ; make a string which represents this turn
                        (new-str (if (> ra 0) ; which way are we turning?
                                (make-string (inexact->exact (round (/ ra angle))) #\-)
                                (make-string (inexact->exact (round (abs (/ ra angle)))) #\+)))
                        (out (if (zero? (modulo c 10))
                                (string-append str new-str "F") ; add branch
                                (string-append str new-str "F")))) ; normal
                    
                    (collect (cdr pos) (cdr next-pos) a out (+ c 1))))))
    (collect 
        (reverse (stroke-points stroke))
        (cdr (reverse (stroke-points stroke))) 0 "" 0))

;------------------------------------------------------

; a fluxus mouse pointer!
(define (draw-mouse)
    (with-state
        (translate (mouse-pos))
        (hint-unlit)
        (colour (vector 1 0.4 0.3))
        (draw-sphere)))

(define stroke (build-stroke))
(define root (build-locator))
(define debounce #t)

(define (animate)
    (draw-mouse)
    (when (mouse-button 1) (stroke-update stroke))
    (stroke-render stroke)

    (when (and (not debounce) (not (mouse-button 1)))
        (display (stroke->string stroke 45))(newline)
        (with-state
            (parent root)
;            (translate (vector 0 -30 -40))
            (scale 0.75)
            (rotate (vector 90 90 0))
            (ls-build 
                (lsystem-generate 4 "A" (list (list "A" "B[----AB][++++AB]")
                                              (list "B" (stroke->string stroke 10))))
                10 0.75 (vector 1 1 1) (vector 1 1 1)))
        (set! debounce #t))

    
    (when (and debounce (mouse-button 1))
        (set! debounce #f)
        (stroke-clear stroke)
        (destroy root)
        (set! root (build-locator))))

(clear)
(clear-colour (vector 0.2 0.4 0.3))
(set-camera-transform (mtranslate (vector 0 0 -10)))
(light-diffuse 0 (vector 0 0 0))
(define l (make-light 'point 'free))
(light-diffuse l (vector 1 1 1))
(light-position l (vector -50 50 0))

(every-frame (animate))