cg-Cad

Lisp »Tips 'n Tricks »Gioco del labirinto »1 »2 »3 »4

3 Lisp per disegnare labirinti casuali con pareti inclinate, con pareti dello spessore diverso da 0 e 3D.

LABG3

;|
   LABG3.LSP (13 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.11 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:labg3 ( / 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-7]
                   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.110-2.0] <1.11>: "))
   (if (= step nil)(setq step 1.110))
   (if (and (>= step 1.110)(<= 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 8))
    (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))))
     ((= rn 4)
      (setq y (1- y))
      (setq x (1- x))
      (if (< y 0)(setq y 0))
      (if (< x 0)(setq x 0))
     )
     ((= rn 5)
      (setq y (1+ y))
      (setq x (1- x))
      (if (> y NC)(setq y (1- NC)))
      (if (< x 0)(setq x 0))
     )
     ((= rn 6)
      (setq y (1+ y))
      (setq x (1+ x))
      (if (> y NC)(setq y (1- NC)))
      (if (> x NR)(setq x (1- NR)))
     )
     ((= rn 7)
      (setq y (1- y))
      (setq x (1+ x))
      (if (< y 0)(setq y 0))
      (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)
   )
  )   
 )
 (command "_rectang" pStart 
  (list (+ NR (car pStart))(+ NC (cadr pStart)) 0) 
 )
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof

Test del Lisp

Command: labg3
Larghezza del labirinto <20>: Invio
Altezza del labirinto <20>: Invio
Rete del labirinto [1.110-2.0] <1.11>: Invio
Seleziona un punto nel disegno...

LABG3.LSP

LABG4

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

   Disegna un labirinto casuale
   con pareti dello spessore diverso da 0

   INPUT
   -Altezza e larghezza del labirinto (min. 20)
   -Parametro densita' del labirinto (da 1.15 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:labg4 ( / 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.150-2.0] <1.15>: "))
   (if (= step nil)(setq step 1.150))
   (if (and (>= step 1.150)(<= 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
      (if (or 
           (= (/ (* (angle (list x y 0)(list xx yy 0)) 180) pi) 0)
           (= (/ (* (angle (list x y 0)(list xx yy 0)) 180) pi) 180)
          )
       (command "_rectang" 
        (list (+ xx (car pStart))(- (+ yy (cadr pStart)) 0.05) 0)
        (list (+ x  (car pStart))(+ (+ y  (cadr pStart)) 0.05) 0)
       )
       (command "_rectang" 
        (list (- (+ xx (car pStart)) 0.05)(+ yy (cadr pStart)) 0)
        (list (+ (+ x  (car pStart)) 0.05)(+ 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)
   )
  )   
 )
 (command "_rectang" pStart 
  (list (+ NR (car pStart))(+ NC (cadr pStart)) 0) 
 )
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof

Test del Lisp

Command: labg4
Larghezza del labirinto <20>: Invio
Altezza del labirinto <20>: Invio
Rete del labirinto [1.150-2.0] <1.15>: Invio
Seleziona un punto nel disegno...

LABG4.LSP
Particolare


LABG5

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

   Disegna un labirinto casuale
   con pareti 3D

   INPUT
   -Altezza e larghezza del labirinto (min. 20)
   -Parametro densita' del labirinto (da 1.15 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:labg5 ( / snapp     ; salva la variabile di sistema 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
                   p1 p2     ; punti estremi del muro p1(xx,yy) p2(x,y) 
                   rn        ; numero casuale [0-3]
                   i j       ; indici dell'array
                   k         ; visitatore del labirinto
                   s1        ; gruppo di selezione
                   spes      ; altezza pareti e base del labirinto
 )
 (setvar "cmdecho" 0)
 (setq snapp (getvar "osmode"))
 (command "_osnap" "_non")
 ;|
   Altezza unitaria pareti
   La base e' spes*-0.1
 |;
 (setq spes 1)
 ;|
   Larghezza labirinto
   Dimensione minima=20
 |;
 (while
  (progn
   (initget (+ 2 4))
   (setq NR (getint "\nLarghezza del labirinto <20>: "))
   (if (= NR nil)(setq NR 20))
   (if (>= NR 20) nil T)
  )
 )
 ;|
   Altezza labirinto
   Dimensione minima=20
 |;
 (while
  (progn
   (initget (+ 2 4))
   (setq NC (getint "\nAltezza del labirinto <20>: "))
   (if (= NC nil)(setq NC 20))
   (if (>= NC 20) nil T)
  )
 )
 ;|
   Rete del labirinto
   Misure empiriche 1.15-2.0
 |;
 (while
  (progn
   (initget (+ 2 4))
   (setq step (getreal "\nRete del labirinto [1.150-2.0] <1.15>: "))
   (if (= step nil)(setq step 1.150))
   (if (and (>= step 1.150)(<= 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
      (setq p1 (list x y 0))
      (setq p2 (list xx yy 0))
      (if (or 
           (= (/ (* (angle p1 p2) 180) pi) 0)
           (= (/ (* (angle p1 p2) 180) pi) 180)
          )
       (command "_rectang" 
        (list (+ xx (car pStart))(- (+ yy (cadr pStart)) 0.05) 0)
        (list (+ x  (car pStart))(+ (+ y  (cadr pStart)) 0.05) 0)
       )
       (command "_rectang" 
        (list (- (+ xx (car pStart)) 0.05)(+ yy (cadr pStart)) 0)
        (list (+ (+ x  (car pStart)) 0.05)(+ 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)
   )
  )   
 )
 ;|
   Salva in s1 gli oggetti interni alla finestra
   di selezione e gli estrude in alto (spes=1)
 |;
 (setq s1 
  (ssget "W" 
   (list (car pStart)(cadr pStart) 0) 
   (list (+ NR (car pStart))(+ NC (cadr pStart)) 0)
  )
 )  
 (command "_extrude" s1 "" spes "")
 ;|
    Disegna la base del labirinto
    la seleziona e salva in s1,
    quindi la estrude in basso (spes=-0.1)
 |;
 (command "_rectang" 
  pStart 
  (list (+ NR (car pStart))(+ NC (cadr pStart)) 0) 
 )
 (setq s1 (entlast)) ; seleziona l'ultima entita' disegnata
 (setq spes (* spes -0.1))
 (command "_extrude" s1 "" spes "")
 ;|
   Ripristina l'ambiente
 |;
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof

Test del Lisp

Command: labg5
Larghezza del labirinto <20>: 30
Altezza del labirinto <20>: 22
Rete del labirinto [1.150-2.0] <1.15>: 1.16
Seleziona un punto nel disegno...

LABG5.LSP

Lisp »Tips 'n Tricks

Ultimo Aggiornamento_Last Update: 13 Luglio 2005