; ono-arc.lsp  4july2009  dmemos

; get the possible centers of a circle,  2 points and a radius given
( define ( getcenter x1 y1 x2 y2 radius )
  ( set 'DX ( sub x2 x1 ) 'DY ( sub y2 y1 ) )
  ( set 'dist-x1-x2 ( sqrt ( add (pow DX 2) (pow DY 2))))
  ( set 'min-radius (div dist-x1-x2 2 ))

  ( if ( < radius min-radius )
    nil ; return nil, no solution radius too small
    ( begin ; else radius ok )
     ; a == length of middle-perpendicular to p1 and p2 
     (set 'a (sqrt (sub (pow radius 2) (pow min-radius 2 ))))
     ( set 'xm12 ( add x1 (div DX 2 ))) ; middle btw. p1 p2
     ( set 'ym12 ( add y1 (div DY 2 )))
   
     ( if ( = DY 0 )
       ; p1 p2 on horizontal line - return points list
       ( list xm12 (sub ym12 a) xm12 ( add ym12 a ))

       ( if ( = DX 0 )
          ; else p1 p2 on vertical line - return points list
          ( list (sub xm12 a) ym12 (add xm12 a)  ym12 )

          ( begin ; else normal line 
            ( set 'alpha ( atan ( sub (div DX DY))))
            ( set 'dy ( mul a ( sin alpha )))
            ( set 'dx ( mul a ( cos alpha )))
            ( list (sub xm12 dx) (sub ym12 dy) (add xm12 dx) (add ym12 dy))
          ))))))

; get the angle of a point on a circle
( define ( getangle xm ym x y r , dx dy alpha )
  ( set 'dx ( sub x xm ))
  ( set 'dy ( sub y ym ))
  ( if ( not r ) 
    ( set 'r (sqrt (add (pow dx 2) (pow dy 2 )))))
  ( set 'alpha (asin (div dy r )))
  ( if ( < dx 0 ) ( set 'alpha ( sub PI alpha)))
  ( if ( < alpha 0 ) ( set 'alpha ( add PI PI alpha )))
   alpha  ; return alpha
)

; test if x is in the range of minval..maxval
( define (inrange? minval maxval x)
   ( if ( and (>= x minval ) (<= x maxval )) true nil ))

; basic arc, if all is given , as part of a circle
; use: ( arc1 xm ym radius alpha beta )
( define ( arc1 xm ym radius malpha mbeta, dalpha mang )
  ( set 'dalpha ( asin ( div 1 radius )))
  ( for ( mang malpha mbeta dalpha )
    ( set 'x ( add 0.5 xm (mul radius (cos mang))))
    ( set 'y ( add 0.5 ym (mul radius (sin mang))))
    ( point (int x) (int y))))

; draws the short arc from point1 to point2 on a circle
; use: (arc2 xm ym x1 y1 x2 y2 )
( define ( arc2 xm ym x1 y1 x2 y2 , alpha1 beta1 df )
   ( set 'alpha1 ( getangle xm ym x1 y1 radius ))
   ( set 'beta1 ( getangle xm ym x2 y2 radius ))
   ( set 'df ( sub beta1 alpha1 ))
   ( if ( inrange? 0 PI df )
      ( arc1 xm ym radius alpha1 beta1 ) ; ok - simple arc
      ( if ( inrange? (mul 2 (sub PI)) (sub PI) df )
         ( begin ; from P1 to 0 , from 0 to P2
           ( arc1 xm ym radius alpha1 ( mul 2 PI ))
           ( arc1 xm ym radius 0 beta1 ))
           nil  ))); else no solution 

; finds the right circle and draws the short arc from p1 to p2 
; use: (arc  ym x1 y1 x2 y2 radius )   
( define (arc x1 y1 x2 y2 radius )
   ( set 'centers ( getcenter x1 y1 x2 y2 radius ))
   ( set 'xm (centers 0) 'ym (centers 1))
   ( set 'mok ( arc2 xm ym x1 y1 x2 y2 ))
   ( if  ( not mok )
      ( begin
        ( set 'xm (centers 2) 'ym (centers 3))
          ( arc2 xm ym x1 y1 x2 y2 ) )))
   
; draw a path of arcs from p1-p2 , p2-p3, p3-p4 ... 
(define ( drawarc radius closed  plist)
      ( for ( i 0 (- ( length plist ) 4)  2  )
         ( arc (plist (+ i 0)) (plist (+ i 1)) 
               (plist (+ i 2)) (plist (+ i 3))  radius inv ))
      ( if ( = 1 closed )
         ( arc ( plist -2) (plist -1 ) 
               ( plist 0) (plist 1) radius inv)))