;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;    Labirinth Generator    ;
;    ;;;;;;;;;;;;;;;;;;;    ;
;                           ;
; File: project.scm         ;
;                           ;
; Authors:                  ;
;  * Iacob Alexandru        ;
;  * Neagu Marius Razvan    ;
;  * Patru Dragos           ;
;                           ;
; Class: 344C4              ;
;                           ;
; CopyRight 2004            ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require (lib "draw.ss" "htdp"))
(define LATURA 10)
;(define SCALE 60)
(define END_TIME 5);seconds
(define STEP_TIME 10);mili-seconds

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; draw-cell: Deseneaza o celula (peretii si calea spre solutie/calea de back-tracking
(define draw-cell
  (lambda (r c N W S E solN solW solS solE)
    (begin
      ;N
      (draw-solid-line (make-posn (* c LATURA) (* r LATURA))
                       (make-posn (+ (* c LATURA) LATURA) (* r LATURA))
                       (cond ((eq? N 'up) 'black) ((eq? N 'border) 'red) (else 'white))
      );N
      
      ;W
      (draw-solid-line (make-posn (* c LATURA) (* r LATURA))
                       (make-posn (* c LATURA) (+ (* r LATURA) LATURA))
                       (cond ((eq? W 'up) 'black) ((eq? W 'border) 'red) (else 'white))
      );W
      
      ;S
      (draw-solid-line (make-posn (* c LATURA) (+ (* r LATURA) LATURA))
                       (make-posn (+ (* c LATURA) LATURA) (+ (* r LATURA) LATURA))
                       (cond ((eq? S 'up) 'black) ((eq? S 'border) 'red) (else 'white))
      );S
      
      ;E
      (draw-solid-line (make-posn (+ (* c LATURA) LATURA) (* r LATURA))
                       (make-posn (+ (* c LATURA) LATURA) (+ (* r LATURA) LATURA))
                       (cond ((eq? E 'up) 'black) ((eq? E 'border) 'red) (else 'white))
      );E

      ;solN
            (draw-solid-line (make-posn (+ (* c LATURA) (/ LATURA 2)) (+ (* r LATURA) (/ LATURA 2)))
                       (make-posn (+ (* c LATURA) (/ LATURA 2)) (* r LATURA))
                       (cond ((eq? solN 'sol-track) 'yellow) ((eq? solN 'back-track) 'blue) (else 'white))
      );solN
            
      ;solW
      (draw-solid-line (make-posn (+ (* c LATURA) (/ LATURA 2)) (+ (* r LATURA) (/ LATURA 2)))
                       (make-posn (* c LATURA) (+ (* r LATURA) (/ LATURA 2)))
                       (cond ((eq? solW 'sol-track) 'yellow) ((eq? solW 'back-track) 'blue) (else 'white))
      );solW
      
      ;solS
      (draw-solid-line (make-posn (+ (* c LATURA) (/ LATURA 2)) (+ (* r LATURA) (/ LATURA 2)))
                       (make-posn (+ (* c LATURA) (/ LATURA 2)) (+ (* r LATURA) LATURA))
                       (cond ((eq? solS 'sol-track) 'yellow) ((eq? solS 'back-track) 'blue) (else 'white))
      );solS
      
      ;solE
      (draw-solid-line (make-posn (+ (* c LATURA) (/ LATURA 2)) (+ (* r LATURA) (/ LATURA 2)))
                       (make-posn (+ (* c LATURA) LATURA) (+ (* r LATURA) (/ LATURA 2)))
                       (cond ((eq? solE 'sol-track) 'yellow) ((eq? solE 'back-track) 'blue) (else 'white))
      );solE
      void
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; draw-labirinth: Deseneaza intregul labirint pe panza (Canvas)
(define draw-labirinth
  (lambda (labirinth m n)
    (let loop_row ((i 0)) 
     (if (< i m) 
         (begin
           (let loop_col ((j 0))
               (if (< j n)
                   (begin 
                     (draw-cell i j (cube-ref labirinth i j 0) (cube-ref labirinth i j 1) (cube-ref labirinth i j 2) (cube-ref labirinth i j 3)
                                    (cube-ref labirinth i j 4) (cube-ref labirinth i j 5) (cube-ref labirinth i j 6) (cube-ref labirinth i j 7)
                     )
                     (loop_col (+ j 1))
                   )
                   #t
               )
           )
           (loop_row (+ i 1))
         )
      )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; init-graphics: initializeaza ecranul si deseneaza un labirint cu peretii sus
(define init-graphics
  (lambda(m n)
   (start (* n LATURA) (* m LATURA))
   (let loop_row ((i 0)) 
     (if (< i m) 
         (begin
           (let loop_col ((j 0))
               (if (< j n)
                   (begin 
                     (draw-cell i j 'up 'up 'up 'up 'e 'e 'e 'e)
                     ;(write i)
                     (loop_col (+ j 1))
                   )
                   #t
               )
           )
           (loop_row (+ i 1))
         )
         #t
      )
   )
  )
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                       Acces la matrici si cuburi                                             ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(define matrix-set!
  (lambda (matrix i j value)
    (vector-set! (vector-ref matrix i) j value)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(define matrix-ref
  (lambda (matrix i j)
    (vector-ref (vector-ref matrix i) j)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(define cube-set!
  (lambda (cube i j k value)
    (vector-set! (vector-ref (vector-ref cube i) j) k value)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(define cube-ref
  (lambda (cube i j k)
    (vector-ref (vector-ref (vector-ref cube i) j) k)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(define make-matrix
  (lambda (m n)
    (call/cc
      (lambda(continue-with)
        (begin
          (define matrix (make-vector m))
          (let loop ((i 0))
               (if (< i m)
                   (begin
                     (vector-set! matrix i (make-vector n))
                     (loop (+ i 1))
                   )
                   (continue-with matrix)
               );if
          );let
        );begin
      );lambda
    );call/cc
  );lambda
);define

(define pick
  (lambda (L index Lrest)
    (if (null? L)
        (list Lrest)
        (if (> index 0)
            (pick (cdr L) (- index 1) (append Lrest (list (car L))))
            (list (car L) (append Lrest (cdr L)))
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                        Lucru cu matricea Labirint                                            ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; is_isolated: verifica daca o celula e izolata
; - are nevoie de coordonate corecte!
(define is_isolated
  (lambda(labirinth i j)
    (not
      (or
        (eq? (cube-ref labirinth i j 0) 'dn)
        (eq? (cube-ref labirinth i j 1) 'dn)
        (eq? (cube-ref labirinth i j 2) 'dn)
        (eq? (cube-ref labirinth i j 3) 'dn)
      )
    )
  )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; init-labirit: initializeaza matricea labirint: peretii sus, calea spre solutie vida
(define init-labirinth
  (lambda (m n params)
    (call/cc
      (lambda(continue-with)
        (begin
          (define labirinth (make-vector m))
          (define labirinth_row '())
          ;;; Prima linie
          (set! labirinth_row (make-vector n))
          (vector-set! labirinth_row 0 (vector 'border 'border 'up 'up 'e 'e 'e 'e))
          (let loop_col_r0 ((j 1))
               (if (< j (- n 1))
                   (begin
                     (vector-set! labirinth_row j (vector 'border 'up 'up 'up 'e 'e 'e 'e))
                     (loop_col_r0 (+ j 1))
                   )
               )
          );let
          (vector-set! labirinth_row (- n 1) (vector 'border 'up 'up 'border 'e 'e 'e 'e))
          (vector-set! labirinth 0 labirinth_row)

          ;;; Liniile intermediare
          (let loop_row ((i 1))
               (if (< i (- m 1))
                   (begin
                     (set! labirinth_row (make-vector n));un nou rand
                     (vector-set! labirinth_row 0 (vector 'up 'border 'up 'up 'e 'e 'e 'e))
                     (let loop_col_g ((j 1))
                          (if (< j (- n 1))
                              (begin
                                (vector-set! labirinth_row j (vector 'up 'up 'up 'up 'e 'e 'e 'e))
                                (loop_col_g (+ j 1))
                              )
                          )
                     );let
                     (vector-set! labirinth_row (- n 1) (vector 'up 'up 'up 'border 'e 'e 'e 'e))
                     (vector-set! labirinth i labirinth_row)
                     (loop_row (+ i 1))
                   );begin
              )
          );let
          
          ;;;Ultima Linie
          (set! labirinth_row (make-vector n));un nou rand
          (vector-set! labirinth_row 0 (vector 'up 'border 'border 'up 'e 'e 'e 'e))
          (let loop_col_last ((j 1))
               (if (< j (- n 1))
                   (begin
                     (vector-set! labirinth_row j (vector 'up 'up 'border 'up 'e 'e 'e 'e))
                     (loop_col_last (+ j 1))
                   )
               )
          );let
          (vector-set! labirinth_row (- n 1) (vector 'up 'up 'border 'border 'e 'e 'e 'e))
          (vector-set! labirinth (- m 1) labirinth_row)
          (continue-with labirinth)
        );begin
      );lambda
    );call/cc
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; knock-down: darama peretele specificat (prin direction: 'N 'W 'S sau 'E) si face desenarea (g_commit = #t)
; + intoarce noua pozitie
(define knock-down
  (lambda (labirinth i j direction m n g_commit)
    (cond
      ((eq? direction 'N) (if (eq? (cube-ref labirinth i j 0) 'up)
                              (begin
                                (cube-set! labirinth i j 0 'dn)

                                ;testul urmator nu se mai face - se considera ca matricea este consistenta (fara erori)
                                ;(if (> i 0) (if (eq? (cube-ref labirinth (- i 1) j 2) 'up)
                                (cube-set! labirinth (- i 1) j 2 'dn)
                                (if g_commit
                                    (draw-solid-line (make-posn (* j LATURA) (* i LATURA))
                                                     (make-posn (+ (* j LATURA) LATURA) (* i LATURA))
                                                     'white
                                    )
                                )
                                (list (- i 1) j);returneaza noua pozitie
                              );begin
                              (list i j)
                          );if
      );eq
     ((eq? direction 'W) (if (eq? (cube-ref labirinth i j 1) 'up)
                              (begin
                                (cube-set! labirinth i j 1 'dn)

                                ;testul urmator nu se mai face - se considera ca matricea este consistenta (fara erori)
                                ;(if (> j 0) (if (eq? (cube-ref labirinth i (- j 1) 3) 'up)

                                (cube-set! labirinth i (- j 1) 3 'dn)
                                (if g_commit
                                    (draw-solid-line (make-posn (* j LATURA) (* i LATURA))
                                                     (make-posn (* j LATURA) (+ (* i LATURA) LATURA))
                                                     'white
                                    )
                                )
                                (list i (- j 1));returneaza noua pozitie
                              );begin
                              (list i j)
                          );if
      );eq
      ((eq? direction 'S) (if (eq? (cube-ref labirinth i j 2) 'up)
                              (begin
                                (cube-set! labirinth i j 2 'dn)

                                ;testul urmator nu se mai face - se considera ca matricea este consistenta (fara erori)
                                ;(if (< i (- m 1)) (if (eq? (cube-ref labirinth (+ i 1) j 0) 'up)
                                (cube-set! labirinth (+ i 1) j 0 'dn)
                                (if g_commit
                                    (draw-solid-line (make-posn (* j LATURA) (+ (* i LATURA) LATURA))
                                                     (make-posn (+ (* j LATURA) LATURA) (+ (* i LATURA) LATURA))
                                                     'white
                                    )
                                )
                                (list (+ i 1) j);returneaza noua pozitie
                              );begin
                              (list i j)
                          );if
      );eq
      ((eq? direction 'E) (if (eq? (cube-ref labirinth i j 3) 'up)
                              (begin
                                (cube-set! labirinth i j 3 'dn)

                                ;testul urmator nu se mai face - se considera ca matricea este consistenta (fara erori)
                                ;(if (> j (- n 1)) (if (eq? (cube-ref labirinth i (+ j 1) 1) 'up)

                                (cube-set! labirinth i (+ j 1) 1 'dn)
                                (if g_commit
                                    (draw-solid-line (make-posn (+ (* j LATURA) LATURA) (* i LATURA))
                                                     (make-posn (+ (* j LATURA) LATURA) (+ (* i LATURA) LATURA))
                                                     'white
                                    )
                                )
                                (list i (+ j 1));returneaza noua pozitie
                              );begin
                              (list i j)
                          );if
      );eq
      (else (list i j))
    );cond
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; generate: Genereaza labirintul conform algoritmului dat
(define generate
  (lambda (algorithm m n params)
    (call/cc
      (lambda(continue-with)
        (begin
          (define labirinth 1)
          (set! labirinth (init-labirinth m n params)) ;Intai initializare labirint
          (algorithm labirinth (random m) (random n) m n params) ;Aplicare algoritm
          (continue-with labirinth);labirinth este o referinta! deci algorithm primeste o referinta la matrice, nu toata matricea!
        )
      )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; solve: Rezolva labirintul dadu-i-se pozitia de start si cea de sfarsit
; - neimplementata!
(define solve
  (lambda (labirinth start_i startj goal_i goal_j m n params)
    (begin
      (sleep-for-a-while 1)
      (print "DRAWN!")
      (draw-labirinth labirinth m n)
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; play: Ruleaza generarea si rezolvarea labirintului
(define play
  (lambda (alghorithm m n params)
    (begin
      (init-graphics m n)
      (let ((labirinth (generate alghorithm m n params)))
           (solve labirinth (random m) (random n) (random m) (random n) m n params)
      )
      (sleep-for-a-while END_TIME)
      (stop)
    )
  )
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;                                          DFS                                          ;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; dfs_checkNorth: verifica daca poate sa darame pereti la Nord
(define dfs_checkNorth
  (lambda (labirinth current_i current_j m n)
    (if (> current_i 0);in interiorul matricii?
        (if (is_isolated labirinth (- current_i 1) current_j);daca e izolata sigur nu fac bucle in labirint intrand in ea!
            (begin
              (knock-down labirinth current_i current_j 'N m n #t)
              (my_dfs labirinth (- current_i 1) current_j m n)
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; dfs_checkWest: verifica daca poate sa darame pereti la Vest
(define dfs_checkWest
  (lambda (labirinth current_i current_j m n)
    (if (> current_j 0);in interiorul matricii?
        (if (is_isolated labirinth current_i (- current_j 1));daca e izolata sigur nu fac bucle in labirint intrand in ea!
            (begin
              (knock-down labirinth current_i current_j 'W m n #t)
              (my_dfs labirinth current_i (- current_j 1) m n)
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; dfs_checkSouth: verifica daca poate sa darame pereti la Sud
(define dfs_checkSouth
  (lambda (labirinth current_i current_j m n)
    (if (< current_i (- m 1));in interiorul matricii?
        (if (is_isolated labirinth (+ current_i 1) current_j);daca e izolata sigur nu fac bucle in labirint intrand in ea!
            (begin
              (knock-down labirinth current_i current_j 'S m n #t)
              (my_dfs labirinth (+ current_i 1) current_j m n)
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; dfs_checkEast: verifica daca poate sa darame pereti la Est
(define dfs_checkEast
  (lambda (labirinth current_i current_j m n)
    (if (< current_j (- n 1));in interiorul matricii?
        (if (is_isolated labirinth current_i (+ current_j 1));daca e izolata sigur nu fac bucle in labirint intrand in ea!
            (begin
              (knock-down labirinth current_i current_j 'E m n #t)
              (my_dfs labirinth current_i (+ current_j 1) m n)
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; my_dfs: alege aleator directiile cardinale si construieste labirintul recursiv
(define my_dfs
  (lambda(labirinth current_i current_j m n)
    (begin       ;exemplu check_list: (dfs_checkSouth (dfs_checkNorth dfs_checkWest dfs_checkEast))
      (let loop ((check_list (pick (list dfs_checkNorth dfs_checkWest dfs_checkSouth dfs_checkEast) (random 4) '())) (i 3))
        (begin
          ((car check_list) labirinth current_i current_j m n); execut procedura aleasa aleator
          (if (> i 0);daca lista de 'directii' nu e vida
              (loop (pick (cadr check_list) (random i) '()) (- i 1)); trec mai departe si aleg alta directie random
          )
        )
      )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;dfs: infasuratoare pentru my_dfs pentru a suporta forma generalizata de algoritm pentru generare labirint :D
(define dfs
  (lambda(labirinth current_i current_j m n params)
    (my_dfs labirinth current_i current_j m n)
  )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;                                Eller's Algorithm                                      ;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;fill-ncremented-vector: initializeaza un vector in fiecare locatie cu indexul locatiei inceepand de la offset
(define fill-incremented-vector
  (lambda(v offset limit)
    (if (< offset limit)
        (begin
          (vector-set! v offset offset)
          (fill-incremented-vector v (+ offset 1) limit)
          v
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; propagate-sets: in vectorul row, daca se intalneste valoarea din value2 se inlocuieste cu value1
; + astfel daca value1 reprezinta multimea 5 si value2 reprezinta multimea 7, iar in algoritmul lui Eller
; +        s-a creeat un pasaj intre cele 2 multimi (5 si 7) reunirea lor va fi multimea notata cu 5!
(define propagate-sets
  (lambda (row value1 value2 n)
    (let loop((col 0))
         (if (< col n)
             (begin
               (if (eq? (vector-ref row col) value2)
                   (vector-set! row col value1);unde dam de multimea 2 punem 1
               )
               (loop (+ col 1))
             )
         )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ellers_choose_horizontally: la generarea unui rad nou in labirint, genereaza pasaje (legaturi) orizontale aleator
(define ellers_choose_horizontally
  (lambda (row labirinth row_number priority m n)
    (let loop ((col 0))
         (if (< col (- n 1)) ;scanam pana la penultima coloana
             (if (not (eq? (vector-ref row col) (vector-ref row (+ col 1))));multimi diferite
                 (if (> (random 100) priority);dam jos perete pe orizontala? - aici poate fi o fct de random care depinde si de coloana sau rand
                     (begin
                       (knock-down labirinth row_number col 'E m n #t);daram peretele
                       (propagate-sets row (vector-ref row col) (vector-ref row (+ col 1)) n);reunesc multimile
                       (loop (+ col 1));urmatoarea coloana
                     )
                     (loop (+ col 1))
                 )
                 (loop (+ col 1))
             )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ellers_choose_vertically: la generarea unui rad nou in labirint, genereaza pasaje (legaturi) verticale aleator
; + de fapt genereaza urmatorul rand!
(define ellers_choose_vertically
  (lambda (row labirinth row_number max_set priority m n)
    (let loop ((col 0))
         (if (< col n);scanam TOATE coloanele
             (if (> (random 100) priority);dam jos perete pe verticala?
                 (begin
                   (knock-down labirinth row_number col 'S m n #t);doar atat! valoarea din row ramane aceeasi (aceeasi multime)
                   (loop (+ col 1));urmatoarea coloana
                 )
                 (begin
                   (vector-set! row col (vector-ref max_set 0));celula (probabil) izolata => are propria multime - propriul numar de ordine
                   (vector-set! max_set 0 (+ (vector-ref max_set 0) 1));pentru a beneficia de un nou numar de ordine!
                   (loop (+ col 1))
                 )
             )
             row;s-a terminat scanarea => returnam randul pentru a fi prelucrat mai departe
         )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; horiz_priority: extrage priorirtatea pe orizontala din lista de parametri, daca este posibil; daca nu returneaza valori implicite
(define horiz_priority
  (lambda(params)
    (if (null? params)
        50
        (if (list? params)
            (if (number? (car params))
                (car params)
                50
            )
            (if (number? params)
                params
                50
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; vert_priority: extrage priorirtatea pe verticala din lista de parametri, daca este posibil; daca nu returneaza valori implicite
(define vert_priority
  (lambda(params)
    (if (null? params)
        50
        (if (list? params)
            (if (number? (cadr params))
                (cadr params)
                50
            )
            (if (number? params)
                params
                50
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ellers: implementeaza algoritmul lui Eller
(define ellers
  (lambda(labirinth dummy1 dummy2 m n params)
    (let loop ((row (fill-incremented-vector (make-vector n) 0 n)) (row_number 0) (max_set (vector n)));initial fiecare celula e in multimea ei (0 1 2 ...)
         (if (< row_number (- n 1));in afara de ultimul rand
             (begin
               (ellers_choose_horizontally row labirinth row_number (horiz_priority params) m n);fac pasaje orizontale
               (loop (ellers_choose_vertically row labirinth row_number max_set (vert_priority params) m n) (+ row_number 1) max_set);apoi verticale
             )
             (let loop ((col 0));pentru ultimul rand trebuie sa fac neaparat pasaje intre celulele adiacente astfel incat toate multimile sa se reuneasca
                  (if (< col (- n 1))
                      (if (not (eq? (vector-ref row col) (vector-ref row (+ col 1))));in multimi diferite?
                          (begin
                            (knock-down labirinth row_number col 'E m n #t);daram peretele
                            (propagate-sets row (vector-ref row col) (vector-ref row (+ col 1)) n);reunesc cele 2 multimi
                          )
                      )
                  )
             )
         )
    )
  )
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;                                     Hunt and Kill                                     ;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; stupidity-length: extrage primul parametru dintr-o lista de parametri, avand valori implicite in caz de eroare
(define stupidity-length
  (lambda(params)
    (if (null? params)
        5
        (if (list? params)
            (if (number? (car params))
                (car params)
                5
            )
            (if (number? params)
                params
                5
            )
        )
    )
  )
)

(define directions (vector 'N 'W 'S 'E))
(define h_ofs (vector 0 -1 0 +1))
(define v_ofs (vector -1 0 +1 0))
(define get_i car)
(define get_j cadr)
(define % modulo)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; carve: functie care la fiecare iteratie darama cate un perete fara sa faca bucle (numai celule izolate)
(define carve
  (lambda (labirinth start_i start_j m n stupidity)
      (let loop ((pos (list start_i start_j)) (nwalls (- (* m n) 1)) (from_dir (random 4))); pos = pozitia curenta de forma (linia coloana)
           (let loop_dir ((dir_list (pick '(0 1 2 3) (% (+ from_dir 2) 4) '())) (ndir 3));incerc pana gasesc o directie cu o celula izolata
                (if (not (eq? (cube-ref labirinth (get_i pos) (get_j pos) (car dir_list)) 'border));am voie in directia respectiva? (bordura?)
                    (if (is_isolated labirinth 
                                     (+ (get_i pos) (vector-ref v_ofs (car dir_list))) ;calculez linia conform directiei in care vreau sa escavez
                                     (+ (get_j pos) (vector-ref h_ofs (car dir_list))) ;calculez coloana conform directiei in care vreau sa escavez
                        );can carve it?
                              ;atunci trec la iteratia urmatoare, nu inainte de a darama peretele ca sa ajung in cel. izolata; vvv-->inca un perete daramat
                        (loop (knock-down labirinth (get_i pos) (get_j pos) (vector-ref directions (car dir_list)) m n #t) (- nwalls 1) (car dir_list))
                              ;altfel ori incerc alta directie ori trec pe hunt mode...
                        (if (> ndir 0);mai am directii de incercat?
                            (loop_dir (pick (cadr dir_list) (random ndir) '()) (- ndir 1))
                            (if (> nwalls 0)
                                (loop (hunt labirinth pos (* m n) (% (+ from_dir 2) 4) stupidity) nwalls (random 4));caut o celula cu una adiacenta si izol
                                                                  ;^^^--> hunt backwards the first tried direction
                            )
                        )
                    )
                    (if (> ndir 0);mai am directii de incercat?
                        (loop_dir (pick (cadr dir_list) (random ndir) '()) (- ndir 1))
                        (if (> nwalls 0)
                            (loop (hunt labirinth pos (* m n) (% (+ from_dir 2) 4) stupidity) nwalls (random 4))
                        )
                    )
                )
           )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; get-direction: returneaza directia DINSPRE care se intra in current_po din last_pos
(define get-direction ;se prespune ca celulele sunt adiacente; daca nu sunt adiacente rezultatul este corect intai pe verticala apoi pe orizontala!
  (lambda (current_pos last_pos)
    (if (< (get_i current_pos) (get_i last_pos));dinspre sud
        2
        (if (> (get_i current_pos) (get_i last_pos));dinspre nord
            0
            (if (< (get_j current_pos) (get_j last_pos));dinspre est
                3
                (if (> (get_j current_pos) (get_j last_pos));dinspre vest
                    1
                    0;implicit se considera ca vin dinspre nord (current_pos == last_pos)
                )
            )
        )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; right-hand: daca i se da o celula neizolata, cauta o iesire din celula dupa regula mainii drepte
(define right-hand
  (lambda (labirinth current_pos last_pos)
    (let loop ((dir (% (+ (get-direction current_pos last_pos) 1) 4)) (ndir 0))
                    ;^^^-->prima directie este la dreapta fata de cum am sosit in celula
         (if (eq? (cube-ref labirinth (get_i current_pos) (get_j current_pos) dir) 'dn);drum liber
             (list (+ (get_i current_pos) (vector-ref v_ofs dir)) (+ (get_j current_pos) (vector-ref h_ofs dir)))
             (if (< ndir 3);daca nu am gasit pasaj trec la urmatoarea directie tinand mana dreapta pe perete! => (++ la directie) modulo 4
                 (loop (% (+ dir 1) 4) (+ ndir 1))
                 current_pos;nu am gasit o directie libera! (cand curent_pos este o celula isolata! iar last_pos e aiurea,probabil,chiar daca e adiacenta)
             )
         )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; hunt: cauta dupa regula mainii drepte o celula care are alta adiacenta izolata
(define hunt
  (lambda (labirinth pos ntotalcells from_dir stupidity)
    (let loop ((pos pos) (stop (* 2 ntotalcells)) (last_pos pos));fiind labirint perfect nu se poate trece de mai mult de 2 ori
                                                  ;prin aceeasi celula folosind regula mainii drepte
         (if (> stop 0)
             (let loop_testdir ((testdir 0));testez cele 4 directii! daca am gasit o celula izolata, atunci celula curenta este un scop atins!
                  (if (not (eq? (cube-ref labirinth (get_i pos) (get_j pos)  testdir) 'border));am voie in directia respectiva? (bordura?)
                      (if (is_isolated labirinth (+ (get_i pos) (vector-ref v_ofs testdir)) (+ (get_j pos) (vector-ref h_ofs testdir)));isolated?
                          pos;returnez positia curenta (in vecinatatea unei celule izolate)
                          (if (< testdir 3)
                              (loop_testdir (+ testdir 1));incearca urmatoarea directie
                              (loop (right-hand labirinth pos last_pos) (- stop 1) pos);deplaseare intr-o noua celula dupa regula mainii drepte
                          )
                      )
                      (if (< testdir 3)
                          (loop_testdir (+ testdir 1))
                          (loop (right-hand labirinth pos last_pos) (- stop 1) pos);go next cell by rigth-hand rule
                      )
                  )
                
             )
             pos;ultima pozitie incercata (pentru care ar trebui sa gasesc o vecinatate izolata)
         )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; hunt-kill: infasuratoare pentru carve, pentru a pastra forma generalizata a funtiei pentru generarea labirintului
(define hunt-kill
  (lambda(labirinth current_i current_j m n params)
    (carve labirinth current_i current_j m n (stupidity-length params))
  )
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;                                 PLAY                                          ;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;LET's PLAY SOME!
(play dfs 50 50 '())
(play ellers 50 50 '(10 50))
(play hunt-kill 50 50 '())
;SSSSMOKIN'!!! ain't it?

void