| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587 |
- Listing:
- 1 IMPLEMENTATION MODULE Rectangles;
- 2 (*
- 3 * REPERTOIRE
- 4 * Release 1.6
- 5 * By Charles Bradford and Cole Brecheen
- 6 * (c) Copyright 1985-1992 PMI
- 7 * Green Bay, Wisconsin
- 8 * All rights reserved
- 9 * (414) 468-6040
- 10 *
- 11 * $Header: D:/logfiles/mods/rectangl.mov 1.5 10 Mar 1991 15:35:22 coleb $
- 12 *
- 13 *
- 14 * Adapted from an earlier version written and contributed
- 15 * by Martin Johnston of GTJ Consultants, New York, NY.
- 16 *
- 17 *)
- 18
- 19
- 20 IMPORT Numbers;
- 21
- 22 VAR
- 23 Initialized : BOOLEAN;
- 24
- 25 PROCEDURE Init();
- 26 BEGIN
- 27 IF Initialized THEN
- 28 RETURN;
- 29 ELSE
- 30 Initialized := TRUE;
- 31 END;
- 32 Numbers.Init();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 33 END Init;
- ***** ^ not supported yet
- 34
- 35
- 36 PROCEDURE PointInside( VAR p : APoint; VAR r : ARectangle) :
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 37 BOOLEAN;
- 38 BEGIN
- 39 RETURN (p.col >= r.col1) AND (p.col < r.col2) AND (p.row >= r.row1) AND
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 40 (p.row < r.row2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 41 END PointInside;
- ***** ^ not supported yet
- 42
- 43
- 44 PROCEDURE Distance(p1, p2 : APoint) : CARDINAL;
- ***** ^ undeclared identifier
- 45 VAR
- 46 colDiff, rowDiff : CARDINAL;
- 47
- 48 PROCEDURE IntToCardRange(n : INTEGER) : CARDINAL;
- 49 BEGIN
- 50 IF n >= 0 THEN
- 51 RETURN CARDINAL(n)+32767+1;
- ***** ^ not supported yet
- 52 ELSE
- 53 RETURN CARDINAL(n+32767+1);
- ***** ^ not supported yet
- 54 END;
- 55 END IntToCardRange;
- ***** ^ not supported yet
- 56
- 57 PROCEDURE dist(a, b : INTEGER) : CARDINAL;
- 58 BEGIN
- 59 IF a > b THEN
- 60 RETURN IntToCardRange(a) - IntToCardRange(b);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 61 ELSE
- 62 RETURN IntToCardRange(b) - IntToCardRange(a);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 63 END;
- 64 END dist;
- ***** ^ not supported yet
- 65
- 66 BEGIN
- 67 colDiff := dist(p1.col, p2.col);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 68 rowDiff := dist(p1.row, p2.row);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 69 RETURN Numbers.CardSqrt( (colDiff * colDiff) + (rowDiff * rowDiff) );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 70 END Distance;
- ***** ^ not supported yet
- 71
- 72
- 73 PROCEDURE RectsIntersect(VAR r1, r2, intersection : ARectangle) : BOOLEAN;
- ***** ^ undeclared identifier
- 74 BEGIN
- 75 IF r1.row1 > r2.row1 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 76 intersection.row1 := r1.row1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 77 ELSE
- 78 intersection.row1 := r2.row1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 79 END;
- 80 IF r1.row2 < r2.row2 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 81 intersection.row2 := r1.row2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 82 ELSE
- 83 intersection.row2 := r2.row2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 84 END;
- 85 IF r1.col1 > r2.col1 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 86 intersection.col1 := r1.col1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 87 ELSE
- 88 intersection.col1 := r2.col1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 89 END;
- 90 IF r1.col2 < r2.col2 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 91 intersection.col2 := r1.col2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 92 ELSE
- 93 intersection.col2 := r2.col2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 94 END;
- 95 RETURN (intersection.row1 <= intersection.row2) AND
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 96 (intersection.col1 <= intersection.col2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 97 END RectsIntersect;
- ***** ^ not supported yet
- 98
- 99
- 100 PROCEDURE FindRowOnCol(VAR col1, row1, col2, row2, col : INTEGER) : INTEGER;
- 101 VAR
- 102 dcol, rise, run : INTEGER;
- 103
- 104 PROCEDURE HalfPoint(xl, yl, xr, yr : INTEGER) : INTEGER;
- 105 VAR
- 106 syl, sxr, syr : INTEGER;
- 107 BEGIN
- 108 REPEAT
- 109 syl := yl;
- 110 sxr := xr;
- 111 syr := yr;
- 112 xr := (xl+xr) DIV 2;
- 113 yr := (yl+yr) DIV 2;
- 114 IF xr < col THEN
- 115 xl := xr;
- 116 yl := yr;
- 117 xr := sxr;
- 118 yr := syr;
- 119 END;
- 120 UNTIL ((syl=yl) AND (syr=yr));
- 121 RETURN yr;
- 122 END HalfPoint;
- ***** ^ not supported yet
- 123
- 124 BEGIN
- 125 IF row1 = row2 THEN
- 126 RETURN row1;
- 127 ELSE
- 128 rise := row2-row1;
- 129 run := col2-col1;
- 130 dcol := Numbers.LowestCommonDenom(rise, run);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 131 IF dcol # rise THEN
- 132 rise := rise DIV dcol;
- 133 run := run DIV dcol;
- 134 END;
- 135 dcol := col-col1;
- 136 IF (ABS(32767 DIV rise) < ABS(dcol)) OR ((32767 DIV ABS(dcol)) <
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 137 ABS(rise)) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 138 RETURN HalfPoint(col1, row1, col2, row2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 139 ELSE
- 140 RETURN ((rise*dcol) DIV run)+row1;
- 141 END;
- 142 END;
- 143 END FindRowOnCol;
- ***** ^ not supported yet
- 144
- 145
- 146 PROCEDURE LineInside(TheLine : ALine; r : ARectangle; VAR
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 147 intersection : ALine) : BOOLEAN;
- ***** ^ undeclared identifier
- 148
- 149 PROCEDURE order(VAR col1, col2, row1, row2 : INTEGER);
- 150 VAR
- 151 col : INTEGER;
- 152 BEGIN
- 153 IF col1 > col2 THEN
- 154 col := col1;
- 155 col1 := col2;
- 156 col2 := col;
- 157 col := row1;
- 158 row1 := row2;
- 159 row2 := col;
- 160 END;
- 161 END order;
- ***** ^ not supported yet
- 162
- 163 BEGIN
- 164 WITH TheLine DO
- ***** ^ not supported yet
- 165 order(p1.col, p2.col, p1.row, p2.row);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 166 IF (p1.col < r.col1) AND (p2.col > r.col1) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 167 p1.row := FindRowOnCol(p1.col, p1.row, p2.col, p2.row, r.col1);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 168 p1.col := r.col1;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 169 END;
- 170 IF (p1.col < r.col2) AND (p2.col > r.col2) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 171 p2.row := FindRowOnCol(p1.col, p1.row, p2.col, p2.row, r.col2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 172 p2.col := r.col2;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 173 END;
- 174 order(p1.row, p2.row, p1.col, p2.col);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 175 IF (p1.row < r.row1) AND (p2.row > r.row1) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 176 p1.col := FindRowOnCol(p1.row, p1.col, p2.row, p2.col, r.row1);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 177 p1.row := r.row1;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 178 END;
- 179 IF (p1.row < r.row2) AND (p2.row > r.row2) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 180 p2.col := FindRowOnCol(p1.row, p1.col, p2.row, p2.col, r.row2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 181 p2.row := r.row2;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 182 END;
- 183 IF PointInside(p1, r) AND PointInside(p2, r) THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 184 intersection := TheLine;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 185 RETURN TRUE;
- 186 ELSE
- 187 RETURN FALSE;
- 188 END;
- 189 END;
- ***** ^ not supported yet
- 190 END LineInside;
- ***** ^ not supported yet
- 191
- 192
- 193 PROCEDURE DefineRectangle(VAR r : ARectangle; col1, row1, col2, row2 :
- ***** ^ undeclared identifier
- 194 INTEGER);
- 195 BEGIN
- 196 r.col1 := col1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 197 r.row1 := row1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 198 r.col2 := col2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 199 r.row2 := row2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 200 END DefineRectangle;
- ***** ^ not supported yet
- 201
- 202
- 203 PROCEDURE DefineByPoints(VAR r : ARectangle; TopLeft, BottomRight
- ***** ^ undeclared identifier
- 204 : APoint);
- ***** ^ undeclared identifier
- 205 BEGIN
- 206 r.TopLeft := TopLeft;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 207 r.BottomRight := BottomRight;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 208 END DefineByPoints;
- ***** ^ not supported yet
- 209
- 210
- 211 PROCEDURE RectIsInside( VAR r1, r2 : ARectangle) : BOOLEAN;
- ***** ^ undeclared identifier
- 212 BEGIN
- 213 RETURN (r1.col1 >= r2.col1) AND (r1.col2 <= r2.col2) AND
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 214 (r1.row1 >= r2.row1) AND (r1.row2 <= r2.row2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 215 END RectIsInside;
- ***** ^ not supported yet
- 216
- 217
- 218 PROCEDURE ShrinkRect( VAR r : ARectangle );
- ***** ^ undeclared identifier
- 219 BEGIN
- 220 IF r.col2 > (r.col1 + 1) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 221 INC( r.col1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 222 DEC( r.col2 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 223 END;
- 224 IF r.row2 > (r.row1 + 1) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 225 INC( r.row1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 226 DEC( r.row2 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 227 END;
- 228 END ShrinkRect;
- ***** ^ not supported yet
- 229
- 230 PROCEDURE ExpandRect( VAR r : ARectangle );
- ***** ^ undeclared identifier
- 231 BEGIN
- 232 IF r.col1 > 1 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 233 DEC( r.col1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 234 END;
- 235 IF r.row1 > 1 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 236 DEC( r.row1 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 237 END;
- 238 INC( r.col2 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 239 INC( r.row2 );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 240 END ExpandRect;
- ***** ^ not supported yet
- 241
- 242 BEGIN
- 243 Initialized := FALSE;
- 244 Init();
- ***** ^ not supported yet
- ***** ^ not supported yet
- 245 END Rectangles.
- ***** ^ not supported yet
- 336 errors
|