| Paste number 42957: | g2 cube |
| Pasted by: | mod |
| 1 year, 6 months ago | |
| None | |
| Paste contents: |
(defpackage :g2cube (:use :cl :g2) (:export :3d-line :3d-cube :*a-cube*)) (in-package :g2cube) (defun 3d-line (a b &key (ox 0)(oy 0)(f 0.3)(draw nil)) ;; ax, ay = a[0]+(a[2]*f)+ORIGINX, a[1]+(a[2]*f)+ORIGINY ;; bx, by = b[0]+(b[2]*f)+ORIGINX, b[1]+(b[2]*f)+ORIGINY (let ((ax (+ (* (third a) f) (first a) ox)) (ay (+ (* (third a) f) (second a) oy)) (bx (+ (* (third b) f) (first b) ox)) (by (+ (* (third b) f) (second b) oy))) (if draw (g2:line ax ay bx by) (list (list ax ay) (list bx by))))) (defun 3d-cube (cube &key (ox 0)(oy 0)(draw nil)) (let ((a (first cube)) (b (second cube)) (c (third cube)) (d (fourth cube)) (e (fifth cube)) (f (sixth cube)) (g (seventh cube)) (h (eighth cube))) (let ((s1 (list (3d-line a b :ox ox :oy oy :draw draw) (3d-line b c :ox ox :oy oy :draw draw) (3d-line c d :ox ox :oy oy :draw draw) (3d-line d a :ox ox :oy oy :draw draw))) (s2 (list (3d-line e f :ox ox :oy oy :draw draw) (3d-line f g :ox ox :oy oy :draw draw) (3d-line g h :ox ox :oy oy :draw draw) (3d-line h e :ox ox :oy oy :draw draw))) (s3 (list (3d-line a e :ox ox :oy oy :draw draw) (3d-line b f :ox ox :oy oy :draw draw) (3d-line c g :ox ox :oy oy :draw draw) (3d-line d h :ox ox :oy oy :draw draw)))) (if draw nil (list s1 s2 s3))))) (defparameter *a-cube* (list (list -50 50 50) (list 50 50 50) (list 50 -50 50) (list -50 -50 50) (list -50 50 -50) (list 50 50 -50) (list 50 -50 -50) (list -50 -50 -50))) (defun make-cube (n) (list (list (- n) n n) (list n n n) (list n (- n) n) (list (- n) (- n) n) (list (- n ) n (- n)) (list n n (- n)) (list n (- n) (- n)) (list (- n) (- n) (- n)))) (defmacro square (x) `(* ,x ,x)) (defun rotate-3d-point (point angle axis) (declare (list point axis) (optimize (speed 3))) (let ((ret (list 0 0 0)) (cs (cos angle)) (sn (sin angle))) (setf (first ret) (+ (* (* (square (first axis)) (+ cs (1- cs)))(first point)) (* (- (* (1- cs)(first axis)(second axis))(* (third axis) sn))(second point)) (* (- (* (1- cs)(first axis)(third axis))(* (second axis) sn))(third point)))) (setf (second ret) (+ (* (- (* (1- cs)(first axis)(second axis))(* (third axis) sn))(first point)) (* (* (square (second axis))(+ cs (1- cs)))(second point)) (* (- (* (1- cs)(second axis)(third axis))(* (first axis) sn))(third point)))) (setf (third ret) (+ (* (- (* (1- cs) (first axis) (third axis))(* (second axis) sn))(first point)) (* (- (* (1- cs) (second axis) (third axis))(* (first axis) sn))(second point)) (* (* (square (third axis)) (+ cs (1- cs)))(third point)))) ret)) (defun rotate-object (object angle axis) (declare (list object angle axis) (optimize (speed 3))) (map 'list #'(lambda (p) (rotate-3d-point p angle (case axis ('x (list 1 0 0)) ('y (list 0 1 0)) ('z (list 0 0 1))))) object)) (defun test-cube (w h) (g2:init-window w h) (3d-cube (make-cube 100) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t)) (defun cubology (n) (g2:init-file n n :out-file (concatenate 'string "cubology" (write-to-string n) ".wmf")) (loop for s from 10 to (- n 10) by 50 do (3d-cube (make-cube s) :ox (/ *device-width* 2) :oy (/ *device-width* 2) :draw t)) (g2:save-file) (g2:close-window)) (defun cubical-thing nil (g2:init-file 500 500 :out-file "cubical-thing.wmf") (3d-cube (rotate-object (make-cube 50) .03 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 100) .03 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 100) .5 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 100) -.03 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 100) -.03 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 50) .001 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 50) .001 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 50) .0 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 90) 90 'z) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 90) 90 'x) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (3d-cube (rotate-object (make-cube 90) 90 'y) :ox (/ *device-width* 2) :oy (/ *device-height* 2) :draw t) (g2:save-file) (g2:close-window)) |
This paste has no annotations.