lib.l (2105B)
1 # 15dec04abu 2 # (c) Software Lab. Alexander Burger 3 4 (setq *Scl 6) # Keep in sync with `SCL' in "src/z3d.c" 5 6 (load "lib/simul.l") 7 (load "simul/rgb.l") 8 9 # Unity Matrix 10 (setq 11 *UMat (1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0) 12 PI 3.1415927 13 PI/2 1.5707963 ) 14 15 # Mirror in y-direction 16 (de y-mirror (Lst) 17 (make 18 (while (sym? (car Lst)) 19 (link (pop 'Lst)) ) 20 (link 21 (pop 'Lst) # pos-x 22 (- (pop 'Lst)) # pos-y 23 (pop 'Lst) ) # pos-z 24 (for L Lst 25 (link 26 (if (sym? (car L)) 27 (y-mirror L) 28 (make 29 (link (cadr L) (car L)) 30 (when (sym? (car (setq L (cddr L)))) 31 (link (pop 'L)) ) 32 (while L 33 (link (pop 'L) (- (pop 'L)) (pop 'L)) ) ) ) ) ) ) ) 34 35 # Create model 36 (de model (Obj Lst) 37 (let X Obj 38 (while (sym? (cadr Lst)) 39 (setq X (get X (pop 'Lst))) ) 40 (unless X 41 (quit "Can't attach (sub)model" (car Lst)) ) 42 (prog1 43 (put X (pop 'Lst) (new (ext? Obj))) 44 (set @ 45 (make 46 (link (pop 'Lst) (pop 'Lst) (pop 'Lst)) 47 (mapc link *UMat) 48 (for M Lst 49 (link 50 (if (and (car M) (sym? (car M))) 51 (model Obj M) 52 M ) ) ) ) ) ) ) ) 53 54 # Duplicate position and orientation 55 (de placement (Sym) 56 (prog1 57 (new (ext? Sym)) 58 (set @ 59 (conc 60 (head 12 (val Sym)) 61 (mapcan 62 '((X) 63 (and 64 (sym? X) 65 (list (placement X)) ) ) 66 (nth (val Sym) 13) ) ) ) ) ) 67 68 # Reset orientation 69 (de straight (M) 70 (touch M) 71 (map 72 '((V L) (set L (car V))) 73 *UMat 74 (cdddr (val M)) ) ) 75 76 # Movements 77 (de z3d:dx (X M) 78 (touch M) 79 (set (val M) 80 (+ X (car (val M))) ) ) 81 82 (de z3d:dy (Y M) 83 (touch M) 84 (set (cdr (val M)) 85 (+ Y (cadr (val M))) ) ) 86 87 (de z3d:dz (Z M) 88 (touch M) 89 (set (cddr (val M)) 90 (+ Z (caddr (val M))) ) )