home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / HYPRDA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  3.2 KB  |  102 lines
  1. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. procedure StrokeHyperbola ( xc, yc : integer ; { center }
  4.                               a, b : word ; { radii }
  5.                                 ta : single ) ; { rotation angle (rad) }
  6.  
  7.      { HyprDA - draw hyperbola using difference angle method }
  8.  
  9. var
  10.    ixar,iyar        : word ;    { aspect ratio parameters }
  11.    ar               : single ;  { aspect ratio }
  12.    dx,coshdx        : single ;  { step and function }
  13.    coshdxt2         : single ;  { difference equation coefficient }
  14.    xx,yx            : single ;  { coordinate limits }
  15.    r,idx,ndx        : integer ; { loop control }
  16.    xa0,xa1,xa2      : single ;  { cosh generator }
  17.    yb0,yb1,yb2      : single ;  { sinh generator }
  18.    costa,sinta      : single ;  { rotation variables }
  19.    acosta,asinta    : single ;  {           "       , aspect }
  20.    ix0,iy0,ix1,iy1  : integer ; { display variables }
  21.    ix2,iy2,ix3,iy3  : integer ; {         "         }
  22.  
  23. begin
  24.                                 { aspect ratio }
  25.    GetAspectRatio(ixar,iyar) ;
  26.    ar := ixar/iyar ;
  27.                                 { step angle and functions }
  28.    if a > b then
  29.       r := a
  30.    else
  31.       r := b ;
  32.    dx := 2.0 * sqrt(1.0/r) ;
  33.    coshdx := cosh(dx) ;
  34.    coshdxt2 := coshdx * 2.0 ;
  35.  
  36.    if xc > 0 then
  37.       if xc > GetMaxX + 1 then
  38.          xx := xc
  39.       else
  40.          if xc > GetMaxX div 2 then
  41.             xx := xc
  42.          else
  43.             xx := GetMaxX - xc
  44.    else
  45.       xx := abs(xc) + GetMaxX + 1 ;
  46.  
  47.    if yc > 0 then
  48.       if yc > GetMaxY + 1 then
  49.          yx := yc
  50.       else
  51.          if yc > GetMaxY div 2 then
  52.             yx := yc
  53.          else
  54.             yx := GetMaxY - yc
  55.    else
  56.       yx := abs(yc) + GetMaxY + 1 ;
  57.  
  58.    ndx := Round(ln(2*sqrt(sqr(xx)+sqr(yx))/r)/ln(coshdx+dx)) ;
  59.                                 { offset and initialize }
  60.                                 { difference equations  }
  61.    xa1 := (a+0.5) ;
  62.    xa2 := (a+0.5) * coshdx ;
  63.    yb1 := 0.0 ;
  64.    yb2 := -(b+0.5) * sinh(dx) ;
  65.                                 { aspect and rotation }
  66.    costa := cos(ta) ;
  67.    sinta := sin(ta) ;
  68.    acosta := ar * costa ;
  69.    asinta := ar * sinta ;
  70.                                 { starting points }
  71.    ix0 := Round(xa1 * costa) ;
  72.    iy0 := Round(-xa1 * asinta) ;
  73.    ix2 := ix0 ;
  74.    iy2 := iy0 ;
  75.                                 { hyperbola }
  76.    for idx := 1 to ndx do begin
  77.                                 { step coordinates }
  78.       xa0 := coshdxt2 * xa1 - xa2 ;
  79.       yb0 := coshdxt2 * yb1 - yb2 ;
  80.  
  81.       ix1 := Round(xa0 * costa + yb0 * sinta) ;
  82.       iy1 := Round(-xa0 * asinta + yb0 * acosta) ;
  83.  
  84.       Line(xc+ix0,yc+iy0,xc+ix1,yc+iy1) ;
  85.       Line(xc-ix0,yc-iy0,xc-ix1,yc-iy1) ;
  86.  
  87.       ix3 := Round(xa0 * costa - yb0 * sinta) ;
  88.       iy3 := Round(-xa0 * asinta - yb0 * acosta) ;
  89.  
  90.       Line(xc+ix2,yc+iy2,xc+ix3,yc+iy3) ;
  91.       Line(xc-ix2,yc-iy2,xc-ix3,yc-iy3) ;
  92.                                 { ladder down }
  93.       xa2 := xa1 ;  xa1 := xa0 ;
  94.       yb2 := yb1 ;  yb1 := yb0 ;
  95.       ix0 := ix1 ;  iy0 := iy1 ;
  96.       ix2 := ix3 ;  iy2 := iy3
  97.  
  98.    end
  99. end ;
  100.  
  101. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  102.