← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/inc/graph/clip.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/inc/graph/clip.inc
1
 
{
2
 
    $Id: clip.inc,v 1.4 2002/09/07 15:07:46 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by the Free Pascal development team
5
 
 
6
 
    This include implements the different clipping algorithms
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
const
17
 
  LEFT   = 1;    { Left window   }
18
 
  RIGHT  = 2;    { Right window  }
19
 
  BOTTOM = 4;    { Bottom window }
20
 
  TOP    = 8;    { Top window    }
21
 
                 { 0 = in window }
22
 
 
23
 
 
24
 
 
25
 
 
26
 
 
27
 
 
28
 
 
29
 
  function LineClipped(var x1, y1,x2,y2: smallint; xmin, ymin,
30
 
      xmax, ymax:smallint): boolean;
31
 
  {********************************************************}
32
 
  { Function LineClipped()                                 }
33
 
  {--------------------------------------------------------}
34
 
  { This routine clips the line coordinates to the         }
35
 
  { min. and max. values of the window. Returns TRUE if    }
36
 
  { the ENTIRE line was clipped.  Updated                  }
37
 
  { clipped line endpoints are also returned.              }
38
 
  { This algorithm is the classic Cohen-Sutherland line    }
39
 
  { clipping algorithm.                                    }
40
 
  {--------------------------------------------------------}
41
 
  var
42
 
   code1, code2: longint;
43
 
   code: longint;
44
 
   newx,newy: smallint;
45
 
   done:boolean;
46
 
 
47
 
 
48
 
    function outcode(x,y:smallint): longint;
49
 
    {********************************************************}
50
 
    { Function OutCode()                                     }
51
 
    {--------------------------------------------------------}
52
 
    { This routine determines if the specified end point     }
53
 
    { of a line lies within the visible window, if not it    }
54
 
    { determines in which window the point is.               }
55
 
    {--------------------------------------------------------}
56
 
 
57
 
    var
58
 
     code: longint;
59
 
    begin
60
 
      code := 0;
61
 
      if (x<xmin) then
62
 
        code:=code or LEFT
63
 
      else if (x>xmax) then
64
 
        code:=code or RIGHT;
65
 
      if (y>ymax) then
66
 
        code:=code or BOTTOM
67
 
      else if (y<ymin) then
68
 
        code:=code or TOP;
69
 
 
70
 
      outcode:=code;
71
 
    end;
72
 
 
73
 
  begin
74
 
    done:=false;
75
 
    code1:= OutCode(x1,y1);
76
 
    code2:= OutCode(x2,y2);
77
 
 
78
 
    while not done do
79
 
     begin
80
 
       { Accept trivially }
81
 
       { both points are in window }
82
 
       if ((code1=0) and (code2=0)) then
83
 
         begin
84
 
           done:=TRUE;
85
 
           LineClipped:=FALSE;
86
 
               exit;
87
 
             end
88
 
       else
89
 
       { Reject trivially }
90
 
       { Neither points are in window }
91
 
       if (code1 and code2) <> 0 then
92
 
         begin
93
 
           done:=true;
94
 
           LineClipped:=TRUE;
95
 
           exit;
96
 
         end
97
 
       else
98
 
          begin
99
 
            { Some points are partially out of the window }
100
 
            { find the new end point of the lines...      }
101
 
            if code1 = 0 then
102
 
             code:=code2
103
 
            else
104
 
             code:=code1;
105
 
            if (code and LEFT) <> 0 then
106
 
              begin
107
 
                newy:=y1+((y2-y1)*(xmin-x1)) div (x2-x1);
108
 
                newx:=xmin;
109
 
              end
110
 
            else
111
 
            if (code and RIGHT) <> 0 then
112
 
              begin
113
 
                newy:=y1+((y2-y1)*(xmax-x1)) div (x2-x1);
114
 
                newx:=xmax;
115
 
              end
116
 
            else
117
 
            if (code and BOTTOM) <> 0 then
118
 
              begin
119
 
                newx:=x1+((x2-x1)*(ymax-y1)) div (y2-y1);
120
 
                newy:=ymax;
121
 
              end
122
 
            else
123
 
            if (code and TOP) <> 0 then
124
 
              begin
125
 
                newx:=x1+((x2-x1)*(ymin-y1)) div (y2-y1);
126
 
                newy:=ymin;
127
 
              end;
128
 
           if (code1 = code) then
129
 
            begin
130
 
              x1 := newx;  y1:= newy;
131
 
              code1:=outcode(x1,y1)
132
 
            end
133
 
               else
134
 
            begin
135
 
              x2:= newx; y2:= newy;
136
 
              code2:=outcode(x2,y2);
137
 
            end
138
 
         end;
139
 
      end;
140
 
  LineClipped:=FALSE;
141
 
end;
142
 
 
143
 
{
144
 
  $Log: clip.inc,v $
145
 
  Revision 1.4  2002/09/07 15:07:46  peter
146
 
    * old logs removed and tabs fixed
147
 
 
148
 
}