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