home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / HYPRRAM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-19  |  3.6 KB  |  108 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.      { HyprRAM - draw hyperbola using rotation angle       }
  8.      {           method and `minimum' angle step           }
  9.  
  10. const
  11.    dx = 0.12468 ;
  12.    coshdx = 1.007783 ;
  13.    isinhdx : longint = $0800 ;
  14.    icoshdx : longint = $4080 ;
  15.  
  16. var
  17.    ixar,iyar        : word ;    { aspect ratio parameters }
  18.    iar              : longint ; { aspect ratio B16 }
  19.    icosta,isinta    : longint ; { rotation angle functions B15 }
  20.    iacosta,iasinta  : longint ; { rotation angle functions - aspect B15 }
  21.    it,ixa,iya       : longint ; { coordinate variables B0 }
  22.    ixb,iyb          : longint ; { coordinate variables B0 }
  23.    xx,yx            : single ;  { coordinate limits }
  24.    r,idx,ndx        : integer ; { loop control }
  25.    ix0,iy0,ix1,iy1  : integer ; { display variables B0 }
  26.    ix2,iy2,ix3,iy3  : integer ; { display variables B0 }
  27.  
  28. begin
  29.                                 { aspect ratio }
  30.    GetAspectRatio(ixar,iyar) ;
  31.    iar := SwapLong(longint(ixar)) div longint(iyar) ;
  32.                                 { step }
  33.    if a > b then
  34.       r := a
  35.    else
  36.       r := b ;
  37.  
  38.    if xc > 0 then
  39.       if xc > GetMaxX + 1 then
  40.          xx := xc
  41.       else
  42.          if xc > GetMaxX div 2 then
  43.             xx := xc
  44.          else
  45.             xx := GetMaxX - xc
  46.    else
  47.       xx := abs(xc) + GetMaxX + 1 ;
  48.  
  49.    if yc > 0 then
  50.       if yc > GetMaxY + 1 then
  51.          yx := yc
  52.       else
  53.          if yc > GetMaxY div 2 then
  54.             yx := yc
  55.          else
  56.             yx := GetMaxY - yc
  57.    else
  58.       yx := abs(yc) + GetMaxY + 1 ;
  59.  
  60.    ndx := Round(ln(2*sqrt(sqr(xx)+sqr(yx))/r)/ln(coshdx+dx)) ;
  61.                                 { rotation angle functions }
  62.    icosta := Round(cos(ta) * 32768) ;
  63.    isinta := Round(sin(ta) * 32768);
  64.    iacosta := RoundScaleB16(iar * icosta) ;
  65.    iasinta := RoundScaleB16(iar * isinta) ;
  66.                                 { prescale }
  67.    ixa := SwapLong(longint(a)) ;
  68.    iya := 0 ;
  69.    ixb := SwapLong(longint(b)) ;
  70.    iyb := 0 ;
  71.                                 { starting points }
  72.    ix0:= RoundScaleB16(longint(a) * icosta shl 1) ;
  73.    iy0 := -RoundScaleB16(longint(a) * iasinta shl 1)  ;
  74.    ix2 := ix0 ;
  75.    iy2 := iy0 ;
  76.                                 { hyperbola }
  77.    for idx := 1 to ndx do begin
  78.                                 { step coordinates }
  79.       it := (ixa div 16 + iya) div 8 + ixa ;
  80.       iya := (iya div 16 + ixa) div 8 + iya ;
  81.       ixa := it ;
  82.  
  83.       it := (ixb div 16 + iyb) div 8 + ixb ;
  84.       iyb := (iyb div 16 + ixb) div 8 + iyb ;
  85.       ixb := it ;
  86.                                 { rotate coordinates }
  87.       ix1 := RoundScaleB16((LongHi(ixa) * icosta  +
  88.               LongHi(iyb) * isinta) shl 1) ;
  89.       iy1 := RoundScaleB16((-LongHi(ixa) * iasinta +
  90.               LongHi(iyb) * iacosta) shl 1);
  91.       Line(xc+ix0,yc+iy0,xc+ix1,yc+iy1) ;
  92.       Line(xc-ix0,yc-iy0,xc-ix1,yc-iy1) ;
  93.  
  94.       ix3 := RoundScaleB16((LongHi(ixa) * icosta -
  95.               LongHi(iyb) * isinta) shl 1) ;
  96.       iy3 := RoundScaleB16((-LongHi(ixa) * iasinta -
  97.               LongHi(iyb) * iacosta) shl 1);
  98.       Line(xc+ix2,yc+iy2,xc+ix3,yc+iy3) ;
  99.       Line(xc-ix2,yc-iy2,xc-ix3,yc-iy3) ;
  100.                                 { ladder down }
  101.       ix2 := ix3 ;  iy2 := iy3 ;
  102.       ix0 := ix1 ;  iy0 := iy1
  103.  
  104.    end
  105. end ;
  106.  
  107. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  108.