Commit | Line | Data |
---|---|---|
88b9d363 | 1 | -- Copyright 2021-2022 Free Software Foundation, Inc. |
c04da66c TT |
2 | -- |
3 | -- This program is free software; you can redistribute it and/or modify | |
4 | -- it under the terms of the GNU General Public License as published by | |
5 | -- the Free Software Foundation; either version 3 of the License, or | |
6 | -- (at your option) any later version. | |
7 | -- | |
8 | -- This program is distributed in the hope that it will be useful, | |
9 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | -- GNU General Public License for more details. | |
12 | -- | |
13 | -- You should have received a copy of the GNU General Public License | |
14 | -- along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | package body Twovecs is | |
17 | ||
18 | function Pt (X, Y : My_Integer) return Twovec is | |
19 | begin | |
20 | return Twovec'(X, Y); | |
21 | end Pt; | |
22 | ||
23 | function "+" (P0, P1 : Twovec) return Twovec is | |
24 | begin | |
25 | return Twovec' (P0.X + P1.X, P0.Y + P1.Y); | |
26 | end "+"; | |
27 | ||
28 | function "-" (P0, P1 : Twovec) return Twovec is | |
29 | begin | |
30 | return Twovec' (P0.X - P1.X, P0.Y - P1.Y); | |
31 | end "-"; | |
32 | ||
33 | function "*" (P0, P1 : Twovec) return Twovec is | |
34 | begin | |
35 | return Twovec' (P0.X * P1.X, P0.Y * P1.Y); | |
36 | end "*"; | |
37 | ||
38 | function "/" (P0, P1 : Twovec) return Twovec is | |
39 | begin | |
40 | return Twovec' (P0.X / P1.X, P0.Y / P1.Y); | |
41 | end "/"; | |
42 | ||
43 | function "mod" (P0, P1 : Twovec) return Twovec is | |
44 | begin | |
45 | -- Make sure we get a different answer than "-". | |
46 | return Twovec' (17, 18); | |
47 | end "mod"; | |
48 | ||
49 | function "rem" (P0, P1 : Twovec) return Twovec is | |
50 | begin | |
51 | -- Make sure we get a different answer than "-". | |
52 | return Twovec' (38, 39); | |
53 | end "rem"; | |
54 | ||
55 | function "**" (P0, P1 : Twovec) return Twovec is | |
56 | begin | |
57 | -- It just has to do something recognizable. | |
58 | return Twovec' (20 * P0.X + P1.X, 20 * P0.Y + P1.Y); | |
59 | end "**"; | |
60 | ||
61 | function "<" (P0, P1 : Twovec) return Boolean is | |
62 | begin | |
63 | return P0.X < P1.X and then P0.Y < P1.Y; | |
64 | end "<"; | |
65 | ||
66 | function "<=" (P0, P1 : Twovec) return Boolean is | |
67 | begin | |
68 | return P0.X <= P1.X and then P0.Y <= P1.Y; | |
69 | end "<="; | |
70 | ||
71 | function ">" (P0, P1 : Twovec) return Boolean is | |
72 | begin | |
73 | return P0.X > P1.X and then P0.Y > P1.Y; | |
74 | end ">"; | |
75 | ||
76 | function ">=" (P0, P1 : Twovec) return Boolean is | |
77 | begin | |
78 | return P0.X >= P1.X and then P0.Y >= P1.Y; | |
79 | end ">="; | |
80 | ||
81 | function "=" (P0, P1 : Twovec) return Boolean is | |
82 | begin | |
83 | return P0.X = P1.X and then P0.Y = P1.Y; | |
84 | end "="; | |
85 | ||
86 | function "and" (P0, P1 : Twovec) return Twovec is | |
87 | begin | |
88 | return Twovec' (P0.X and P1.X, P0.Y and P1.Y); | |
89 | end "and"; | |
90 | ||
91 | function "or" (P0, P1 : Twovec) return Twovec is | |
92 | begin | |
93 | return Twovec' (P0.X or P1.X, P0.Y or P1.Y); | |
94 | end "or"; | |
95 | ||
96 | function "xor" (P0, P1 : Twovec) return Twovec is | |
97 | begin | |
98 | return Twovec' (P0.X xor P1.X, P0.Y xor P1.Y); | |
99 | end "xor"; | |
100 | ||
101 | function "&" (P0, P1 : Twovec) return Twovec is | |
102 | begin | |
103 | -- It just has to do something recognizable. | |
104 | return Twovec' (10 * P0.X + P1.X, 10 * P0.Y + P1.Y); | |
105 | end "&"; | |
106 | ||
107 | function "abs" (P0 : Twovec) return Twovec is | |
108 | begin | |
109 | return Twovec' (abs (P0.X), abs (P0.Y)); | |
110 | end "abs"; | |
111 | ||
112 | function "not" (P0 : Twovec) return Twovec is | |
113 | begin | |
114 | return Twovec' (not (P0.X), not (P0.Y)); | |
115 | end "not"; | |
116 | ||
117 | function "+" (P0 : Twovec) return Twovec is | |
118 | begin | |
119 | -- It just has to do something recognizable. | |
120 | return Twovec' (+ (P0.Y), + (P0.X)); | |
121 | end "+"; | |
122 | ||
123 | function "-" (P0 : Twovec) return Twovec is | |
124 | begin | |
125 | return Twovec' (- (P0.X), - (P0.Y)); | |
126 | end "-"; | |
127 | ||
128 | procedure Do_Nothing (P : Twovec) is | |
129 | begin | |
130 | null; | |
131 | end Do_Nothing; | |
132 | ||
133 | end Twovecs; |