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