home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / PARARA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-19  |  3.3 KB  |  97 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.      { ParaRA - draw parabola using rotation of coordinates }
  8.  
  9. var
  10.    ixar,iyar        : word ;    { aspect ratio parameters }
  11.    ar               : single ;  { aspect ratio }
  12.    costa,sinta,acosta,asinta : single ; { rotation angle functions }
  13.    xx,yx            : single ;  { coordinate limits }
  14.    r,rx,t           : single ;  { polar radius and limit }
  15.    x1,y1,x2,y2      : single ;  { coordinate variables }
  16.    a,cosa,sina      : single ;  { polar angle and functions }
  17.    da,cosda,sinda   : single ;  { step angle and functions }
  18.    ix0,iy0,ix1,iy1,ix2,iy2,ix3,iy3 : integer ; { display variables }
  19.  
  20. begin
  21.                                 { ignore rectilinear parabola }
  22.    if p > 0 then begin
  23.                                 { aspect ratio }
  24.       GetAspectRatio(ixar,iyar) ;
  25.       ar := ixar/iyar ;
  26.                                 { coordinate variables with }
  27.                                 { aspect and reflection     }
  28.       cosa := 1.0 ;
  29.       sina := 0.0 ;
  30.       costa := cos(ta) ;
  31.       sinta := sin(ta) ;
  32.       acosta := ar * costa ;
  33.       asinta := ar * sinta ;
  34.                                 { starting point }
  35.       r := p/2 ;
  36.       ix0 := xf + Round(r * costa) ;
  37.       iy0 := yf - Round(r * asinta) ;
  38.       ix2 := ix0 ;
  39.       iy2 := iy0 ;
  40.                                 { coordinate limits }
  41.       if xf > 0 then
  42.          if xf > GetMaxX + 1 then
  43.             xx := xf
  44.          else
  45.             if xf > GetMaxX div 2 then
  46.                xx := xf
  47.             else
  48.                xx := GetMaxX - xf
  49.       else
  50.          xx := abs(xf) + GetMaxX + 1 ;
  51.  
  52.       if yf > 0 then
  53.          if yf > GetMaxY + 1 then
  54.             yx := yf
  55.          else
  56.             if yf > GetMaxY div 2 then
  57.                yx := yf
  58.             else
  59.                yx := GetMaxY - yf
  60.       else
  61.          yx := abs(yf) + GetMaxY + 1 ;
  62.                                 { step angle and functions }
  63.       rx := sqrt(sqr(xx) + sqr(yx)) ;
  64.       da := 2.0 * sqrt(1.0/rx) ;
  65.       cosda := cos(da) ;
  66.       sinda := sin(da) ;
  67.  
  68.       while r < rx do begin
  69.                                 { polar angle functions }
  70.          t := cosa * cosda - sina * sinda ;
  71.          sina := sina * cosda + cosa * sinda ;
  72.          cosa := t ;
  73.                                 { polar radius }
  74.          r := p/(1.0 + cosa) ;
  75.                                 { rotation terms }
  76.          x1 := r * cosa * costa ;
  77.          x2 := r * sina * sinta ;
  78.          y1 := r * sina * acosta ;
  79.          y2 := r * cosa * asinta ;
  80.                                 { display coordinates }
  81.          ix1 := xf + Round(x1-x2) ;
  82.          iy1 := yf - Round(y1+y2) ;
  83.          ix3 := xf + Round(x1+x2) ;
  84.          iy3 := yf + Round(y1-y2) ;
  85.                                 { draw chords }
  86.          Line(ix0,iy0,ix1,iy1) ;
  87.          Line(ix2,iy2,ix3,iy3) ;
  88.                                 { ladder down }
  89.          ix0 := ix1 ;  iy0 := iy1 ;
  90.          ix2 := ix3 ;  iy2 := iy3
  91.  
  92.       end
  93.    end
  94. end ;
  95.  
  96. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  97.