home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / HYPRRAF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  3.6 KB  |  105 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.      { HyprRAF - draw hyperbola using rotation angle }
  8.      {           method and fixed point arithmetic   }
  9.  
  10. var
  11.    ixar,iyar        : word ;    { aspect ratio parameters }
  12.    iar              : longint ; { aspect ratio B15 }
  13.    icosta,isinta    : longint ; { rotation angle functions B15 }
  14.    iacosta,iasinta  : longint ; { rotation angle functions - aspect B15 }
  15.    dx,coshdx        : single ;  { step and function }
  16.    icoshdx,isinhdx  : longint ; { step functions B16 }
  17.    it,ixa,iya       : longint ; { coordinate variables B0 }
  18.    ixb,iyb          : longint ; { coordinate variables B0 }
  19.    xx,yx            : single ;  { coordinate limits }
  20.    r,idx,ndx        : integer ; { loop control }
  21.    ix0,iy0,ix1,iy1  : integer ; { display variables B0 }
  22.    ix2,iy2,ix3,iy3  : integer ; { display variables B0 }
  23.  
  24. begin
  25.                                 { aspect ratio }
  26.    GetAspectRatio(ixar,iyar) ;
  27.    iar := longint(ixar) shl 15 div iyar ;
  28.                                 { step and functions }
  29.    if a > b then
  30.       r := a
  31.    else
  32.       r := b ;
  33.    dx := 2.0 * sqrt(1.0/r) ;
  34.    coshdx := cosh(dx) ;
  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.  
  60.    icoshdx := Round(coshdx * 65536) ;
  61.    isinhdx := Round(sinh(dx) * 65536) ;
  62.                                 { rotation angle functions }
  63.    icosta := Round(cos(ta) * 32768) ;
  64.    isinta := Round(sin(ta) * 32768);
  65.    iacosta := RoundScaleB16(iar * icosta shl 1) ;
  66.    iasinta := RoundScaleB16(iar * isinta shl 1) ;
  67.                                 { offset }
  68.    ixa := a ;
  69.    iya := 0 ;
  70.    ixb := b ;
  71.    iyb := 0 ;
  72.                                 { starting points }
  73.    ix0:= RoundScaleB16(icosta * ixa shl 1) ;
  74.    iy0 := -RoundScaleB16(iasinta * ixa shl 1)  ;
  75.    ix2 := ix0 ;
  76.    iy2 := iy0 ;
  77.                                 { hyperbola }
  78.    for idx := 1 to ndx do begin
  79.                                 { step coordinates }
  80.       it := RoundScaleB16(ixa * icoshdx + iya * isinhdx) ;
  81.       iya := RoundScaleB16(ixa * isinhdx + iya * icoshdx) ;
  82.       ixa := it ;
  83.  
  84.       it := RoundScaleB16(ixb * icoshdx + iyb * isinhdx) ;
  85.       iyb := RoundScaleB16(ixb * isinhdx + iyb * icoshdx) ;
  86.       ixb := it ;
  87.                                 { rotate coordinates }
  88.       ix1 := RoundScaleB16((icosta * ixa + isinta * iyb) shl 1) ;
  89.       iy1 := RoundScaleB16((-iasinta * ixa + iacosta * iyb) shl 1);
  90.       Line(xc+ix0,yc+iy0,xc+ix1,yc+iy1) ;
  91.       Line(xc-ix0,yc-iy0,xc-ix1,yc-iy1) ;
  92.  
  93.       ix3 := RoundScaleB16((icosta * ixa - isinta * iyb) shl 1) ;
  94.       iy3 := RoundScaleB16((-iasinta * ixa - iacosta * iyb) shl 1);
  95.       Line(xc+ix2,yc+iy2,xc+ix3,yc+iy3) ;
  96.       Line(xc-ix2,yc-iy2,xc-ix3,yc-iy3) ;
  97.                                 { ladder down }
  98.       ix2 := ix3 ;  iy2 := iy3 ;
  99.       ix0 := ix1 ;  iy0 := iy1
  100.  
  101.    end
  102. end ;
  103.  
  104. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  105.