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