home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / HYPRMBR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  14.0 KB  |  485 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.      { HyprMBR - draw hyperbola using modified Bresenham with }
  8.      {           rotation and aspect correction               }
  9.  
  10. const
  11.    s = 8.0 ;
  12.  
  13. var
  14.    Color            : word ;    { default color }
  15.    a2,b2            : single ;  { radii parameters }
  16.    costa,costa2     : single ;  { rotation angle parameters }
  17.    sinta,sinta2     : single ;  {            "              }
  18.    px,py            : single ;  { aspect variables }
  19.    pxx,pxy,pyy      : single ;  {        "         }
  20.    x0,y0            : single ;  { starting point, float }
  21.    ix0,iy0          : integer ; {        "      , fixed }
  22.    ix,iy            : integer ; { coordinate variables }
  23.    ixx,iyx          : integer ; { coordinate limits }
  24.    ie,iex,iey       : longint ; { error variables }
  25.    idex,idey        : longint ; { error offsets }
  26.    idex0,idey0      : longint ; {       "      , initial }
  27.    idexx,idexy      : longint ; { error increments }
  28.    ideyx,ideyy      : longint ; {        "         }
  29.  
  30. begin
  31.                                 { ignore rectilinear hyperbola }
  32.    if (a > 0) and (b > 0) then begin
  33.  
  34.       a2 := sqr(a) ;
  35.       b2 := sqr(b) ;
  36.  
  37.       Color := GetColor ;
  38.                                 { aspect ratio parameters }
  39.       px := 3 * GetMaxY ;
  40.       py := 2 * GetMaxX ;
  41.       if px > py then begin
  42.          py := s * py / px ;
  43.          px := s
  44.       end
  45.       else begin
  46.          px := s * px / py ;
  47.          py := s
  48.       end ;
  49.                                 { rotation angle functions }
  50.       costa := cos(ta) ;
  51.       costa2 := sqr(costa) ;
  52.       sinta := sin(ta) ;
  53.       sinta2 := sqr(sinta) ;
  54.  
  55.       pxx := sqr(px)*(b2*costa2 - a2*sinta2) ;
  56.       pxy := px*py*(a2+b2)*sinta*costa ;
  57.       pyy := sqr(py)*(b2*sinta2 - a2*costa2) ;
  58.                                 { error increments }
  59.       idexx := Round(2*pxx) ;
  60.       idexy := Round(2*pxy) ;
  61.       ideyx := idexy ;
  62.       ideyy := Round(2*pyy) ;
  63.                                 { coordinate limits }
  64.       if xc > 0 then
  65.          if xc > GetMaxX + 1 then
  66.             ixx := xc
  67.          else
  68.             if xc > GetMaxX div 2 then
  69.                ixx := xc
  70.             else
  71.                ixx := GetMaxX - xc
  72.       else
  73.          ixx := abs(xc) + GetMaxX + 1 ;
  74.  
  75.       if yc > 0 then
  76.          if yc > GetMaxY + 1 then
  77.             iyx := yc
  78.          else
  79.             if yc > GetMaxY div 2 then
  80.                iyx := yc
  81.             else
  82.                iyx := GetMaxY - yc
  83.       else
  84.          iyx := abs(yc) + GetMaxY + 1 ;
  85.                                 { step in y }
  86.       if abs(sinta) < abs(costa) then begin
  87.                                 { starting coordinates }
  88.          x0 := a*costa ;
  89.          y0 := a*sinta*px/py ;
  90.          if x0 < 0.0 then begin
  91.             x0 := -x0 ;
  92.             y0 := -y0
  93.          end ;
  94.          ix0 := Round(x0) ;
  95.          iy0 := Round(y0) ;
  96.  
  97.          idex0 := Round((2*x0+1)*pxx + 2*y0*pxy) ;
  98.          idey0 := Round((2*y0+1)*pyy + 2*x0*pxy) ;
  99.                                 { starting point }
  100.          ix := ix0 ;
  101.          iy := iy0 ;
  102.          ie := 0 ;
  103.                                 { vertex point }
  104.          PutPixel(xc+ix,yc-iy,Color) ;
  105.          PutPixel(xc-ix,yc+iy,Color) ;
  106.  
  107.          idex := -idex0 + idexx ;
  108.          idey := idey0 ;
  109.                                 { vertex to dy = 0 }
  110.          while (idey > 0) and
  111.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  112.  
  113.             Inc(ie,idey) ;
  114.             Inc(idey,ideyy) ;
  115.             Inc(iy) ;
  116.             Dec(idex,idexy) ;
  117.             iex := ie + idex ;
  118.             if abs(ie) > abs(iex) then begin
  119.                Inc(idex,idexx) ;
  120.                Dec(ix) ;
  121.                Dec(idey,ideyx) ;
  122.                ie := iex
  123.             end ;
  124.  
  125.             PutPixel(xc+ix,yc-iy,Color) ;
  126.             PutPixel(xc-ix,yc+iy,Color)
  127.  
  128.          end ;
  129.  
  130.          idex := -idex + idexx ;
  131.                                 { dy = 0 to dx = dy }
  132.          while (idex > -idey) and
  133.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  134.  
  135.             Inc(ie,idey) ;
  136.             Inc(idey,ideyy) ;
  137.             Inc(iy) ;
  138.             Inc(idex,idexy) ;
  139.             iex := ie + idex ;
  140.             if abs(ie) > abs(iex) then begin
  141.                Inc(idex,idexx) ;
  142.                Inc(ix) ;
  143.                Inc(idey,ideyx) ;
  144.                ie := iex
  145.             end ;
  146.  
  147.             PutPixel(xc+ix,yc-iy,Color) ;
  148.             PutPixel(xc-ix,yc+iy,Color)
  149.  
  150.          end ;
  151.                                 { dx = xy to dy = 0 }
  152.          while (idex > 0) and
  153.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  154.  
  155.             Inc(ie,idex) ;
  156.             Inc(idex,idexx) ;
  157.             Inc(ix) ;
  158.             Inc(idey,ideyx) ;
  159.             iey := ie + idey ;
  160.             if abs(ie) > abs(iey) then begin
  161.                Inc(idey,ideyy) ;
  162.                Inc(iy) ;
  163.                Inc(idex,idexy) ;
  164.                ie := iey
  165.             end ;
  166.  
  167.             PutPixel(xc+ix,yc-iy,Color) ;
  168.             PutPixel(xc-ix,yc+iy,Color)
  169.  
  170.          end ;
  171.  
  172.          idey := -idey + ideyy ;
  173.                                 { dy = 0 to asymptote }
  174.          while (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  175.  
  176.             Inc(ie,idex) ;
  177.             Inc(idex,idexx) ;
  178.             Inc(ix) ;
  179.             Dec(idey,ideyx) ;
  180.             iey := ie + idey ;
  181.             if abs(ie) > abs(iey) then begin
  182.                Inc(idey,ideyy) ;
  183.                Dec(iy) ;
  184.                Dec(idex,idexy) ;
  185.                ie := iey
  186.             end ;
  187.  
  188.             PutPixel(xc+ix,yc-iy,Color) ;
  189.             PutPixel(xc-ix,yc+iy,Color)
  190.  
  191.          end ;
  192.                                 { reinitialize }
  193.          ix := ix0 ;
  194.          iy := iy0 ;
  195.          ie := 0 ;
  196.  
  197.          idex := -idex0 + idexx ;
  198.          idey := -idey0 + ideyy ;
  199.                                 { vertex to dy = 0 }
  200.          while (idey > 0) and
  201.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  202.  
  203.             Inc(ie,idey) ;
  204.             Inc(idey,ideyy) ;
  205.             Dec(iy) ;
  206.             Inc(idex,idexy) ;
  207.             iex := ie + idex ;
  208.             if abs(ie) > abs(iex) then begin
  209.                Inc(idex,idexx) ;
  210.                Dec(ix) ;
  211.                Inc(idey,ideyx) ;
  212.                ie := iex
  213.             end ;
  214.  
  215.             PutPixel(xc+ix,yc-iy,Color) ;
  216.             PutPixel(xc-ix,yc+iy,Color)
  217.  
  218.          end ;
  219.  
  220.          idex := -idex + idexx ;
  221.                                 { dy = 0 to dx = dy }
  222.          while (idex > -idey) and
  223.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  224.  
  225.             Inc(ie,idey) ;
  226.             Inc(idey,ideyy) ;
  227.             Dec(iy) ;
  228.             Dec(idex,idexy) ;
  229.             iex := ie + idex ;
  230.             if abs(ie) > abs(iex) then begin
  231.                Inc(idex,idexx) ;
  232.                Inc(ix) ;
  233.                Dec(idey,ideyx) ;
  234.                ie := iex
  235.             end ;
  236.  
  237.             PutPixel(xc+ix,yc-iy,Color) ;
  238.             PutPixel(xc-ix,yc+iy,Color)
  239.  
  240.          end ;
  241.                                 { dx = xy to dy = 0 }
  242.          while (idex > 0) and
  243.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  244.  
  245.             Inc(ie,idex) ;
  246.             Inc(idex,idexx) ;
  247.             Inc(ix) ;
  248.             Dec(idey,ideyx) ;
  249.             iey := ie + idey ;
  250.             if abs(ie) > abs(iey) then begin
  251.                Inc(idey,ideyy) ;
  252.                Dec(iy) ;
  253.                Dec(idex,idexy) ;
  254.                ie := iey
  255.             end ;
  256.  
  257.             PutPixel(xc+ix,yc-iy,Color) ;
  258.             PutPixel(xc-ix,yc+iy,Color)
  259.  
  260.          end ;
  261.  
  262.          idey := -idey + ideyy ;
  263.                                 { dy = 0 to asymptote }
  264.          while (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  265.  
  266.             Inc(ie,idex) ;
  267.             Inc(idex,idexx) ;
  268.             Inc(ix) ;
  269.             Inc(idey,ideyx) ;
  270.             iey := ie + idey ;
  271.             if abs(ie) > abs(iey) then begin
  272.                Inc(idey,ideyy) ;
  273.                Inc(iy) ;
  274.                Inc(idex,idexy) ;
  275.                ie := iey
  276.             end ;
  277.  
  278.             PutPixel(xc+ix,yc-iy,Color) ;
  279.             PutPixel(xc-ix,yc+iy,Color)
  280.  
  281.          end
  282.       end
  283.                                 { step in x }
  284.       else begin
  285.                                 { starting coordinates }
  286.          x0 := a*costa ;
  287.          y0 := a*sinta*px/py ;
  288.          if y0 < 0.0 then begin
  289.             x0 := -x0 ;
  290.             y0 := -y0
  291.          end ;
  292.          ix0 := Round(x0) ;
  293.          iy0 := Round(y0) ;
  294.  
  295.          idex0 := Round((2*x0+1)*pxx + 2*y0*pxy) ;
  296.          idey0 := Round((2*y0+1)*pyy + 2*x0*pxy) ;
  297.                                 { starting point }
  298.          ix := ix0 ;
  299.          iy := iy0 ;
  300.          ie := 0 ;
  301.                                 { vertex point }
  302.          PutPixel(xc+ix,yc-iy,Color) ;
  303.          PutPixel(xc-ix,yc+iy,Color) ;
  304.  
  305.          idex := idex0 ;
  306.          idey := -idey0 + ideyy ;
  307.                                 { vertex to dy = 0 }
  308.          while (idex > 0) and
  309.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  310.  
  311.             Inc(ie,idex) ;
  312.             Inc(idex,idexx) ;
  313.             Inc(ix) ;
  314.             Dec(idey,ideyx) ;
  315.             iey := ie + idey ;
  316.             if abs(ie) > abs(iey) then begin
  317.                Inc(idey,ideyy) ;
  318.                Dec(iy) ;
  319.                Dec(idex,idexy) ;
  320.                ie := iey
  321.             end ;
  322.  
  323.             PutPixel(xc+ix,yc-iy,Color) ;
  324.             PutPixel(xc-ix,yc+iy,Color)
  325.  
  326.          end ;
  327.  
  328.          idey := -idey + ideyy ;
  329.                                 { dy = 0 to dx = dy }
  330.          while (idey > -idex) and
  331.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  332.  
  333.             Inc(ie,idex) ;
  334.             Inc(idex,idexx) ;
  335.             Inc(ix) ;
  336.             Inc(idey,ideyx) ;
  337.             iey := ie + idey ;
  338.             if abs(ie) > abs(iey) then begin
  339.                Inc(idey,ideyy) ;
  340.                Inc(iy) ;
  341.                Inc(idex,idexy) ;
  342.                ie := iey
  343.             end ;
  344.  
  345.             PutPixel(xc+ix,yc-iy,Color) ;
  346.             PutPixel(xc-ix,yc+iy,Color)
  347.  
  348.          end ;
  349.                                 { dx = xy to dx = 0 }
  350.          while (idey > 0) and
  351.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  352.  
  353.             Inc(ie,idey) ;
  354.             Inc(idey,ideyy) ;
  355.             Inc(iy) ;
  356.             Inc(idex,idexy) ;
  357.             iex := ie + idex ;
  358.             if abs(ie) > abs(iex) then begin
  359.                Inc(idex,idexx) ;
  360.                Inc(ix) ;
  361.                Inc(idey,ideyx) ;
  362.                ie := iex
  363.             end ;
  364.  
  365.             PutPixel(xc+ix,yc-iy,Color) ;
  366.             PutPixel(xc-ix,yc+iy,Color)
  367.  
  368.          end ;
  369.  
  370.          idex := -idex + idexx ;
  371.                                 { dx = 0 to asymptote }
  372.          while (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  373.  
  374.             Inc(ie,idey) ;
  375.             Inc(idey,ideyy) ;
  376.             Inc(iy) ;
  377.             Dec(idex,idexy) ;
  378.             iex := ie + idex ;
  379.             if abs(ie) > abs(iex) then begin
  380.                Inc(idex,idexx) ;
  381.                Dec(ix) ;
  382.                Dec(idey,ideyx) ;
  383.                ie := iex
  384.             end ;
  385.  
  386.             PutPixel(xc+ix,yc-iy,Color) ;
  387.             PutPixel(xc-ix,yc+iy,Color)
  388.  
  389.          end ;
  390.                                 { reinitialize }
  391.          ix := ix0 ;
  392.          iy := iy0 ;
  393.          ie := 0 ;
  394.  
  395.          idex := -idex0 + idexx ;
  396.          idey := -idey0 + ideyy ;
  397.                                 { vertex to dy = 0 }
  398.          while (idex > 0) and
  399.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  400.  
  401.             Inc(ie,idex) ;
  402.             Inc(idex,idexx) ;
  403.             Dec(ix) ;
  404.             Inc(idey,ideyx) ;
  405.             iey := ie + idey ;
  406.             if abs(ie) > abs(iey) then begin
  407.                Inc(idey,ideyy) ;
  408.                Dec(iy) ;
  409.                Inc(idex,idexy) ;
  410.                ie := iey
  411.             end ;
  412.  
  413.             PutPixel(xc+ix,yc-iy,Color) ;
  414.             PutPixel(xc-ix,yc+iy,Color)
  415.  
  416.          end ;
  417.  
  418.          idey := -idey + ideyy ;
  419.                                 { dy = 0 to dx = dy }
  420.          while (idey > -idex) and
  421.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  422.  
  423.             Inc(ie,idex) ;
  424.             Inc(idex,idexx) ;
  425.             Dec(ix) ;
  426.             Dec(idey,ideyx) ;
  427.             iey := ie + idey ;
  428.             if abs(ie) > abs(iey) then begin
  429.                Inc(idey,ideyy) ;
  430.                Inc(iy) ;
  431.                Dec(idex,idexy) ;
  432.                ie := iey
  433.             end ;
  434.  
  435.             PutPixel(xc+ix,yc-iy,Color) ;
  436.             PutPixel(xc-ix,yc+iy,Color)
  437.  
  438.          end ;
  439.                                 { dx = dy to dx = 0 }
  440.          while (idey > 0) and
  441.                  (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  442.  
  443.             Inc(ie,idey) ;
  444.             Inc(idey,ideyy) ;
  445.             Inc(iy) ;
  446.             Dec(idex,idexy) ;
  447.             iex := ie + idex ;
  448.             if abs(ie) > abs(iex) then begin
  449.                Inc(idex,idexx) ;
  450.                Dec(ix) ;
  451.                Dec(idey,ideyx) ;
  452.                ie := iex
  453.             end ;
  454.  
  455.             PutPixel(xc+ix,yc-iy,Color) ;
  456.             PutPixel(xc-ix,yc+iy,Color)
  457.  
  458.          end ;
  459.  
  460.          idex := -idex + idexx ;
  461.                                 { dx = 0 to asymptote }
  462.          while (abs(ix) < ixx) and (abs(iy) < iyx) do begin
  463.  
  464.             Inc(ie,idey) ;
  465.             Inc(idey,ideyy) ;
  466.             Inc(iy) ;
  467.             Inc(idex,idexy) ;
  468.             iex := ie + idex ;
  469.             if abs(ie) > abs(iex) then begin
  470.                Inc(idex,idexx) ;
  471.                Inc(ix) ;
  472.                Inc(idey,ideyx) ;
  473.                ie := iex
  474.             end ;
  475.  
  476.             PutPixel(xc+ix,yc-iy,Color) ;
  477.             PutPixel(xc-ix,yc+iy,Color)
  478.  
  479.          end
  480.       end
  481.    end
  482. end ;
  483.  
  484. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  485.