home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / PARARAF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-19  |  4.5 KB  |  116 lines
  1. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. procedure StrokeParabola ( xf, yf : integer ; { focus }
  4.                                 p : word ; { parameter }
  5.                                ta : single ) ; { rotation angle (rad) }
  6.  
  7.      { ParaRAF - draw parabola using rotation of coordinates }
  8.      {           and fixed point arithmetic                  }
  9.  
  10. const
  11.    iONEB16 : longint = $10000 ;
  12.    iONEB14 : longint = $4000 ;
  13.    iONEB12 : longint = $1000 ;
  14.  
  15. var
  16.    ixar,iyar        : word ;    { aspect ratio parameters }
  17.    iar              : longint ; { aspect ratio B16 }
  18.    icosta,isinta    : longint ; { rotation angle functions B15 }
  19.    iacosta,iasinta  : longint ; { rotation angle functions - aspect B15 }
  20.    xx,yx,rx         : single ;  { coordinate limits }
  21.    ax               : single ;  { maximum polar angle }
  22.    it,icosa,isina   : longint ; { polar angle functions B14 }
  23.    da               : single ;  { step angle }
  24.    icosda,isinda    : longint ; { step angle functions B15 }
  25.    ida,nda          : word ;    { loop control }
  26.    ip               : longint ; { parameter B19 }
  27.    ir               : longint ; { polar radius B3 }
  28.    ircosa,irsina    : longint ; { polar coordinate factors B3 }
  29.    ixp1,iyp1,ixp2,iyp2 : longint ; { coordinate variables B3 }
  30.    ix0,iy0,ix1,iy1,ix2,iy2,ix3,iy3 : integer ; { display variables B0 }
  31.  
  32. begin
  33.                                 { ignore rectilinear parabola }
  34.    if (p > 0) and (p < iONEB12) then begin
  35.                                 { aspect ratio }
  36.       GetAspectRatio(ixar,iyar) ;
  37.       iar := SwapLong(longint(ixar)) div longint(iyar) ;
  38.                                 { coordinate variables with }
  39.                                 { aspect and reflection     }
  40.       icosa := iONEB14 ;
  41.       isina := 0 ;
  42.       icosta := Round(cos(ta) * 32768) ;
  43.       isinta := Round(sin(ta) * 32768) ;
  44.       iacosta := RoundScaleB16(icosta * iar) ;
  45.       iasinta := RoundScaleB16(isinta * iar) ;
  46.                                 { starting point }
  47.       ip := SwapLong(longint(p) shl 3) ;
  48.       ir := RoundScaleB16(ip shr 1) ;
  49.       ix0 := xf + RoundScaleB3(RoundScaleB16(ir * icosta shl 1)) ;
  50.       iy0 := yf - RoundScaleB3(RoundScaleB16(ir * iasinta shl 1)) ;
  51.       ix2 := ix0 ;
  52.       iy2 := iy0 ;
  53.                                 { coordinate limits }
  54.       if xf > 0 then
  55.          if xf > GetMaxX + 1 then
  56.             xx := xf
  57.          else
  58.             if xf > GetMaxX div 2 then
  59.                xx := xf
  60.             else
  61.                xx := GetMaxX - xf
  62.       else
  63.          xx := abs(xf) + GetMaxX + 1 ;
  64.  
  65.       if yf > 0 then
  66.          if yf > GetMaxY + 1 then
  67.             yx := yf
  68.          else
  69.             if yf > GetMaxY div 2 then
  70.                yx := yf
  71.             else
  72.                yx := GetMaxY - yf
  73.       else
  74.          yx := abs(yf) + GetMaxY + 1 ;
  75.                                 { step angle and functions }
  76.       rx := sqrt(sqr(xx) + sqr(yx)) ;
  77.       da := 2.0 * sqrt(1.0/rx) ;
  78.       ax := Pi - sqrt(2.0*p/rx) ;
  79.       nda := Round(ax/da) ;
  80.       da := ax/nda ;
  81.       icosda := Round(cos(da) * 32768) ;
  82.       isinda := Round(sin(da) * 32768) ;
  83.  
  84.       for ida := 1 to nda do begin
  85.                                 { polar angle functions }
  86.          it := RoundScaleB16((icosa * icosda - isina * isinda) shl 1) ;
  87.          isina := RoundScaleB16((isina * icosda + icosa * isinda) shl 1) ;
  88.          icosa := it ;
  89.                                 { polar radius }
  90.          ir := ip div (iONEB16 + icosa shl 2) ;
  91.                                 { rotation terms }
  92.          ircosa := RoundScaleB16(ir * icosa shl 2) ;
  93.          irsina := RoundScaleB16(ir * isina shl 2) ;
  94.  
  95.          ixp1 := RoundScaleB16(ircosa * icosta shl 1) ;
  96.          ixp2 := RoundScaleB16(irsina * isinta shl 1) ;
  97.          iyp1 := RoundScaleB16(irsina * iacosta shl 1) ;
  98.          iyp2 := RoundScaleB16(ircosa * iasinta shl 1) ;
  99.                                 { display coordinates }
  100.          ix1 := xf + RoundScaleB3(ixp1 - ixp2) ;
  101.          iy1 := yf - RoundScaleB3(iyp1 + iyp2) ;
  102.          ix3 := xf + RoundScaleB3(ixp1 + ixp2) ;
  103.          iy3 := yf + RoundScaleB3(iyp1 - iyp2) ;
  104.                                 { draw chords }
  105.          Line(ix0,iy0,ix1,iy1) ;
  106.          Line(ix2,iy2,ix3,iy3) ;
  107.                                 { ladder down }
  108.          ix0 := ix1 ;  iy0 := iy1 ;
  109.          ix2 := ix3 ;  iy2 := iy3
  110.  
  111.       end
  112.    end
  113. end ;
  114.  
  115. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  116.