;|
   LABG1.LSP (12 Luglio 2005)
   Copyright (C) 2005 Claudio Piccini.
   All rights reserved
   www.cg-cad.com

   Disegna un labirinto casuale

   INPUT
   -Altezza e larghezza del labirinto
   -Un punto nel disegno

   OUTPUT
   Disegno su file DWG

   Implementa l'algoritmo di ricerca depth-first.
|;

(defun vArray ( ii jj valore / i j e rigo X )
 (setq i 0)
 (while (<= i NR)
  (setq j 0)
  (while (<= j NC)
   (setq e (nth j (nth i A)))
   (if (and (= j jj)(= i ii))
    (setq rigo (append rigo (list valore)))
    (setq rigo (append rigo (list e))) 
   )
   (setq j (1+ j))
  )
  (setq X (append X (list rigo))) 
  (setq rigo nil)
  (setq i (1+ i))
 )
 (setq X X)
)
;|
  Estrae un numero intero casuale da 0 a x-1
  Il seme e' inizializzato con la variabile DATE
  in questo modo la serie di numeri casuali
  e' diversa in ogni sessione di gioco.
|; 
(defun random ( x / m b c) 
 (if (not sd) (setq sd (getvar "DATE")))
 (setq m 65521 b 15937 c 33503)
 (setq sd (rem (+ (* b sd) c) m))
 (fix (* (/ sd m) x))
)

(defun c:labg1 ( / snapp     ; salva la var. osmode
                   NR NC     ; numero righe e colonne di A 
                   A L       ; liste 'array'
                   pStart    ; punto del disegno dove inserire il labirinto
                   x y xx yy ; coordinate dei 2 punti estremi di un muro 
                   rn        ; numero casuale [0-3]
                   i j       ; indici dell'array
                   k         ; visitatore del labirinto
 )
 (setvar "cmdecho" 0)
 (setq snapp (getvar "osmode"))
 (command "_osnap" "_non")
 (initget (+ 2 4))
 (setq NR (getint "\nLarghezza del labirinto <20>: "))
 (if (= NR nil)(setq NR 20))
 (initget (+ 2 4))
 (setq NC (getint "\nAltezza del labirinto <20>: "))
 (if (= NC nil)(setq NC 20))
 (setq pStart (getpoint "\nSeleziona un punto nel disegno..."))
 ;|
    Genera la lista 'array'
    come uno spazio vuoto
    (una lista di 0)
 |;
 (setq i 0)
 (while (<= i NR)
  (setq j 0)
  (while (<= j NC)
   (setq L (append L (list 0)))
   (setq j (1+ j))
  )
  (setq A (append A (list L)))
  (setq L nil)
  (setq i (1+ i))
 )
 ;|
    Un muro a OVEST
    e un muro a EST...
 |;
 (setq i 0)
 (while (<= i NR)
  (setq A (vArray i 0  1))
  (setq A (vArray i (1- NC) 1))
  (setq i (1+ i))
 )
 ;|
    ...un muro a NORD
    e un muro a SUD.
 |;
 (setq i 0)
 (while (<= i NC)
  (setq A (vArray 0 i 1))
  (setq A (vArray (1- NR) i 1))
  (setq i (1+ i))
 )
 ;| 
    Visita tutto il 'labirinto' 
    esclusi i confini
 |;
 (setq k 0)
 (while (< k (* (- NR 2)(- NC 2)))
  (while
   (progn
    (setq x (random NR))
    (setq y (random NC))
    (if (= (nth y (nth x A)) 1) nil T)
   )
  )
  (setq xx x yy y)
  (while
   (progn
    ; sceglie una direzione a caso...
    (setq rn (random 4))
    (cond
     ((= rn 0)(setq y (1- y))(if (< y 0)(setq y 0)))
     ((= rn 1)(setq x (1- x))(if (< x 0)(setq x 0)))
     ((= rn 2)(setq y (1+ y))(if (> y NC)(setq y (1- NC))))
     ((= rn 3)(setq x (1+ x))(if (> x NR)(setq x (1- NR))))
    )
    (if (= (nth y (nth x A)) 0)
     (progn
      (command "_line" 
       (list (+ xx (car pStart))(+ yy (cadr pStart)) 0)
       (list (+ x (car pStart))(+ y (cadr pStart)) 0) 
       ""
      )
      (setq A (vArray x y 1))
      (setq k (1+ k))
      (setq xx x yy y)
     )
    )
    (if (/= (nth y (nth x A)) 0) nil T)
   )
  )   
 )
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof

;|
   LABG2.LSP (12 Luglio 2005)
   Copyright (C) 2005 Claudio Piccini.
   All rights reserved
   www.cg-cad.com

   Disegna un labirinto casuale
   (con piu' o meno muri)

   INPUT
   -Altezza e larghezza del labirinto (min. 20)
   -Parametro densita' del labirinto (da 1.18 a 2.0)
   -Un punto nel disegno

   OUTPUT
   Disegno su file DWG

   Implementa l'algoritmo di ricerca depth-first.
|;

(defun vArray ( ii jj valore / i j e rigo X )
 (setq i 0)
 (while (<= i NR)
  (setq j 0)
  (while (<= j NC)
   (setq e (nth j (nth i A)))
   (if (and (= j jj)(= i ii))
    (setq rigo (append rigo (list valore)))
    (setq rigo (append rigo (list e))) 
   )
   (setq j (1+ j))
  )
  (setq X (append X (list rigo))) 
  (setq rigo nil)
  (setq i (1+ i))
 )
 (setq X X)
)
;|
  Estrae un numero intero casuale da 0 a x-1
  Il seme e' inizializzato con la variabile DATE
  in questo modo la serie di numeri casuali
  e' diversa in ogni sessione di gioco.
|; 
(defun random ( x / m b c) 
 (if (not sd) (setq sd (getvar "DATE")))
 (setq m 65521 b 15937 c 33503)
 (setq sd (rem (+ (* b sd) c) m))
 (fix (* (/ sd m) x))
)

(defun c:labg2 ( / snapp     ; salva la var. osmode
                   NR NC     ; numero righe e colonne di A 
                   A L       ; liste 'array'
                   step      ; maglia della rete del labirinto
                   pStart    ; punto del disegno dove inserire il labirinto
                   x y xx yy ; coordinate dei 2 punti estremi di un muro 
                   rn        ; numero casuale [0-3]
                   i j       ; indici dell'array
                   k         ; visitatore del labirinto
 )
 (setvar "cmdecho" 0)
 (setq snapp (getvar "osmode"))
 (command "_osnap" "_non")
 (while
  (progn
   (initget (+ 2 4))
   (setq NR (getint "\nLarghezza del labirinto <20>: "))
   (if (= NR nil)(setq NR 20))
   (if (>= NR 20) nil T)
  )
 )
 (while
  (progn
   (initget (+ 2 4))
   (setq NC (getint "\nAltezza del labirinto <20>: "))
   (if (= NC nil)(setq NC 20))
   (if (>= NC 20) nil T)
  )
 )
 (while
  (progn
   (initget (+ 2 4))
   (setq step (getreal "\nRete del labirinto [1.180-2.0] <1.2>: "))
   (if (= step nil)(setq step 1.20))
   (if (and (>= step 1.180)(<= step 2)) nil T)
  )
 )
 (setq pStart (getpoint "\nSeleziona un punto nel disegno..."))
 ;|
    Genera la lista 'array'
    come uno spazio vuoto
    (una lista di 0)
 |;
 (setq i 0)
 (while (<= i NR)
  (setq j 0)
  (while (<= j NC)
   (setq L (append L (list 0)))
   (setq j (1+ j))
  )
  (setq A (append A (list L)))
  (setq L nil)
  (setq i (1+ i))
 )
 ;|
    Un muro a OVEST
    e un muro a EST...
 |;
 (setq i 0)
 (while (<= i NR)
  (setq A (vArray i 0  1))
  (setq A (vArray i (1- NC) 1))
  (setq i (1+ i))
 )
 ;|
    ...un muro a NORD
    e un muro a SUD.
 |;
 (setq i 0)
 (while (<= i NC)
  (setq A (vArray 0 i 1))
  (setq A (vArray (1- NR) i 1))
  (setq i (1+ i))
 )
 ;| 
    Visita tutto il 'labirinto' 
 |;
 (setq k 0)
 (while (< k (* NR NC))
  (while
   (progn
    (setq x (random NR))
    (setq y (random NC))
    (if (= (nth y (nth x A)) 1) nil T)
   )
  )
  (setq xx x yy y)
  (while
   (progn
    ; sceglie una direzione a caso...
    (setq rn (random 4))
    (cond
     ((= rn 0)(setq y (1- y))(if (< y 0)(setq y 0)))
     ((= rn 1)(setq x (1- x))(if (< x 0)(setq x 0)))
     ((= rn 2)(setq y (1+ y))(if (> y NC)(setq y (1- NC))))
     ((= rn 3)(setq x (1+ x))(if (> x NR)(setq x (1- NR))))
    )
    (if (= (nth y (nth x A)) 0)
     (progn
      (command "_line" 
       (list (+ xx (car pStart))(+ yy (cadr pStart)) 0)
       (list (+ x (car pStart))(+ y (cadr pStart)) 0) 
       ""
      )
      (setq A (vArray x y 1))
      (setq k (+ step k))
      (setq xx x yy y)
     )
    )
    (if (/= (nth y (nth x A)) 0) nil T)
   )
  )   
 )
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof