(defun ix-render-oblong (lbox thickness baser slices stacks) (unless slices (setq slices 0)) (unless stacks (setq stacks (if (zerop thickness) 0 (min 10 (max 1 ;; force 3d if nonzero thickness (round (abs thickness) 2)))))) (when (eql (abs thickness) (abs baser)) (setf thickness (* .99 thickness))) (trc nil "oblong" baser thickness etages) (loop with theta = (/ pi 2 slices) with etages = stacks ;; french floors (etages) zero = ground floor with lw/2 = (/ (r-width lbox) 2) with lh/2 = (/ (r-height lbox) 2) with bx = (- lw/2 baser) with by = (- lh/2 baser) for etage upto etages for oe = 0 then ie for ie = (unless (= etage etages) (* (/ (1+ etage) etages) (/ pi 2))) for ii = (if (not ie) 0 ;; throwaway value to avoid forever testing if nil (+ (* (abs thickness) (- 1 (cos ie))))) for ox = lw/2 then ix for oy = lh/2 then iy for oz = 0 then iz for oc = (cornering baser slices) then ic for ic = (when ie (cornering (- baser ii) slices)) for ix = (- lw/2 ii) for iy = (- lh/2 ii) for iz = (when ie (* thickness (sin ie))) do (trc nil "staging" etage ie) (gl-translatef (+ (r-left lbox) lw/2)(+ (r-bottom lbox) lh/2) 0) (with-gl-begun ((if ie gl_quad_strip gl_polygon)) (loop for (dx dy no-turn-p) in '((1 1)(-1 1)(-1 -1)(1 -1)(1 1 t)) ;;for dbg = (and (eql dx 1)(eql dy 1)(not no-turn-p)) do (destructuring-bind (xyn0 ix0 iy0 ox0 oy0) (cons (+ (if oc (/ theta 2) 0) (ecase dx (1 (ecase dy (1 0)(-1 (/ pi -2)))) (-1 (ecase dy (1 (/ pi 2))(-1 pi))))) (if oc (case (* dx dy) (1 (list (* dx ix)(* dy by)(* dx ox)(* dy by))) (-1 (list (* dx bx)(* dy iy)(* dx bx)(* dy oy)))) (list (* dx ix)(* dy iy)(* dx ox)(* dy oy)))) ;; --- lay-down start/only ------------- (when ie (ogl-vertex-normaling ie xyn0 ix0 iy0 iz)) (ogl-vertex-normaling oe xyn0 ox0 oy0 oz) (trc nil "cornering!!!!!!----------------" dx dy) ;; --- corner if slices and not just finishing strip (unless no-turn-p (trc nil "------ start ------------------" (length oc)(length ic)) (loop for (oxn . oyn) in oc for icrem = ic then (cdr icrem) for (ixn . iyn) = (car icrem) for xyn upfrom (+ xyn0 theta) by theta do (macrolet ((vtx (elev gx sx gy sy gz) `(progn (when (minusp (* dx dy)) (rotatef ,sx ,sy)) (ogl-vertex-normaling ,elev xyn (incf ,gx (* dx ,sx)) (incf ,gy (* dy ,sy)) ,gz)))) (trc nil "ocn icn" oxn oyn (car icrem)) (when icrem (vtx ie ix0 ixn iy0 iyn iz)) (vtx oe ox0 oxn oy0 oyn oz))))))) (gl-translatef (- (+ (r-left lbox) lw/2)) (- (+ (r-bottom lbox) lh/2)) 0)))