Arc Forumnew | comments | leaders | submitlogin
6 points by kennytilton 6112 days ago | link | parent

Here's my damn submission:

  (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)))
Macroexpand that. :)