home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / PARAMB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  3.1 KB  |  111 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.      { ParaMB - draw parabola using modified Bresenham }
  8.  
  9. var
  10.    Color            : word ;    { default color }
  11.    px,py            : single ;  { aspect variables }
  12.    x0,y0            : single ;  { starting point }
  13.    ix,iy            : integer ; { coordinate variables }
  14.    ixx,iyx          : integer ; { coordinate limits }
  15.    ie,iex,iey       : longint ; { error variables }
  16.    idex,idey        : longint ; { error offsets }
  17.    idexx,ideyy      : longint ; { error increments }
  18.  
  19. begin
  20.                                 { ignore rectilinear parabola }
  21.    if p > 0 then begin
  22.  
  23.       Color := GetColor ;
  24.                                 { coordinate limits }
  25.       if xf > 0 then
  26.          if xf > GetMaxX + 1 then
  27.             ixx := xf
  28.          else
  29.             if xf > GetMaxX div 2 then
  30.                ixx := xf
  31.             else
  32.                ixx := GetMaxX - xf
  33.       else
  34.          ixx := abs(xf) + GetMaxX + 1 ;
  35.  
  36.       if yf > 0 then
  37.          if yf > GetMaxY + 1 then
  38.             iyx := yf
  39.          else
  40.             if yf > GetMaxY div 2 then
  41.                iyx := yf
  42.             else
  43.                iyx := GetMaxY - yf
  44.       else
  45.          iyx := abs(yf) + GetMaxY + 1 ;
  46.                                 { error and offset control }
  47.       px := 3 * GetMaxY ;
  48.       py := 2 * GetMaxX ;
  49.                                 { scaling parameters }
  50.       if px > py then begin
  51.          py := py / px ;
  52.          px := 1.0
  53.       end
  54.       else begin
  55.          px := px / py ;
  56.          py := 1.0
  57.       end ;
  58.                                 { starting point }
  59.       x0 := p/2 ;
  60.       y0 := 0.0 ;
  61.  
  62.       idex := -Round(2.0 * p * sqr(px)) ;
  63.       idey := Round((2.0*y0+1.0) * sqr(py)) ;
  64.  
  65.       idexx := 0 ;
  66.       ideyy := Round(2.0 * sqr(py)) ;
  67.  
  68.       ix := Round(x0) ;
  69.       iy := Round(y0) ;
  70.       ie := 0 ;
  71.                                 { vertex point }
  72.       PutPixel(xf+ix,yf,Color) ;
  73.                                 { vertex to px = py }
  74.       while (idey < -idex) and (-ix < ixx) and (iy < iyx) do begin
  75.  
  76.          Inc(ie,idey) ;
  77.          Inc(idey,ideyy) ;
  78.          Inc(iy) ;
  79.          iex := ie + idex ;
  80.          if abs(ie) > abs(iex) then begin
  81.             ie := iex ;
  82.             Inc(idex,idexx) ;
  83.             Dec(ix)
  84.          end ;
  85.  
  86.          PutPixel(xf+ix,yf+iy,Color) ;
  87.          PutPixel(xf+ix,yf-iy,Color)
  88.  
  89.       end ;
  90.                                 { px = py to asymptote }
  91.       while (-ix < ixx) and (iy < iyx) do begin
  92.  
  93.          Inc(ie,idex) ;
  94.          Inc(idex,idexx) ;
  95.          Dec(ix) ;
  96.          iey := ie + idey ;
  97.          if abs(ie) > abs(iey) then begin
  98.             ie := iey ;
  99.             Inc(idey,ideyy) ;
  100.             Inc(iy)
  101.          end ;
  102.  
  103.          PutPixel(xf+ix,yf+iy,Color) ;
  104.          PutPixel(xf+ix,yf-iy,Color)
  105.  
  106.       end
  107.    end
  108. end ;
  109.  
  110. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  111.