| Line 1... |
Line 1... |
| 1 |
(* |
1 |
(* |
| 2 |
Copyright 2013, 2014, 2018, 2019 Anton Krotov |
2 |
BSD 2-Clause License |
| Line 3... |
Line -... |
| 3 |
|
- |
|
| 4 |
This program is free software: you can redistribute it and/or modify |
- |
|
| 5 |
it under the terms of the GNU Lesser General Public License as published by |
3 |
|
| 6 |
the Free Software Foundation, either version 3 of the License, or |
4 |
Copyright (c) 2013-2014, 2018-2020 Anton Krotov |
| 7 |
(at your option) any later version. |
- |
|
| 8 |
|
- |
|
| 9 |
This program is distributed in the hope that it will be useful, |
- |
|
| 10 |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
- |
|
| 11 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
- |
|
| 12 |
GNU Lesser General Public License for more details. |
- |
|
| 13 |
|
- |
|
| 14 |
You should have received a copy of the GNU Lesser General Public License |
- |
|
| 15 |
along with this program. If not, see . |
5 |
All rights reserved. |
| Line 16... |
Line 6... |
| 16 |
*) |
6 |
*) |
| Line 17... |
Line 7... |
| 17 |
|
7 |
|
| Line 233... |
Line 223... |
| 233 |
) |
223 |
) |
| 234 |
RETURN 0.0 |
224 |
RETURN 0.0 |
| 235 |
END frac; |
225 |
END frac; |
| Line -... |
Line 226... |
| - |
|
226 |
|
| - |
|
227 |
|
| - |
|
228 |
PROCEDURE sqri* (x: INTEGER): INTEGER; |
| - |
|
229 |
RETURN x * x |
| - |
|
230 |
END sqri; |
| - |
|
231 |
|
| - |
|
232 |
|
| - |
|
233 |
PROCEDURE sqrr* (x: REAL): REAL; |
| - |
|
234 |
RETURN x * x |
| - |
|
235 |
END sqrr; |
| 236 |
|
236 |
|
| 237 |
|
237 |
|
| 238 |
PROCEDURE arcsin* (x: REAL): REAL; |
238 |
PROCEDURE arcsin* (x: REAL): REAL; |
| Line 347... |
Line 347... |
| 347 |
END |
347 |
END |
| 348 |
RETURN res |
348 |
RETURN res |
| 349 |
END power; |
349 |
END power; |
| Line -... |
Line 350... |
| - |
|
350 |
|
| - |
|
351 |
|
| - |
|
352 |
PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| - |
|
353 |
VAR |
| - |
|
354 |
i: INTEGER; |
| - |
|
355 |
a: REAL; |
| - |
|
356 |
|
| - |
|
357 |
BEGIN |
| - |
|
358 |
a := 1.0; |
| - |
|
359 |
|
| - |
|
360 |
IF base # 0.0 THEN |
| - |
|
361 |
IF exponent # 0 THEN |
| - |
|
362 |
IF exponent < 0 THEN |
| - |
|
363 |
base := 1.0 / base |
| - |
|
364 |
END; |
| - |
|
365 |
i := ABS(exponent); |
| - |
|
366 |
WHILE i > 0 DO |
| - |
|
367 |
WHILE ~ODD(i) DO |
| - |
|
368 |
i := LSR(i, 1); |
| - |
|
369 |
base := sqrr(base) |
| - |
|
370 |
END; |
| - |
|
371 |
DEC(i); |
| - |
|
372 |
a := a * base |
| - |
|
373 |
END |
| - |
|
374 |
ELSE |
| - |
|
375 |
a := 1.0 |
| - |
|
376 |
END |
| - |
|
377 |
ELSE |
| - |
|
378 |
ASSERT(exponent > 0); |
| - |
|
379 |
a := 0.0 |
| - |
|
380 |
END |
| - |
|
381 |
|
| - |
|
382 |
RETURN a |
| - |
|
383 |
END ipower; |
| 350 |
|
384 |
|
| 351 |
|
385 |
|
| 352 |
PROCEDURE sgn* (x: REAL): INTEGER; |
386 |
PROCEDURE sgn* (x: REAL): INTEGER; |
| Line 353... |
Line 387... |
| 353 |
VAR |
387 |
VAR |
| Line 379... |
Line 413... |
| 379 |
|
413 |
|
| 380 |
RETURN res |
414 |
RETURN res |
| Line -... |
Line 415... |
| - |
|
415 |
END fact; |
| - |
|
416 |
|
| - |
|
417 |
|
| - |
|
418 |
PROCEDURE DegToRad* (x: REAL): REAL; |
| - |
|
419 |
RETURN x * (pi / 180.0) |
| - |
|
420 |
END DegToRad; |
| - |
|
421 |
|
| - |
|
422 |
|
| - |
|
423 |
PROCEDURE RadToDeg* (x: REAL): REAL; |
| - |
|
424 |
RETURN x * (180.0 / pi) |
| - |
|
425 |
END RadToDeg; |
| - |
|
426 |
|
| - |
|
427 |
|
| - |
|
428 |
(* Return hypotenuse of triangle *) |
| - |
|
429 |
PROCEDURE hypot* (x, y: REAL): REAL; |
| - |
|
430 |
VAR |
| - |
|
431 |
a: REAL; |
| - |
|
432 |
|
| - |
|
433 |
BEGIN |
| - |
|
434 |
x := ABS(x); |
| - |
|
435 |
y := ABS(y); |
| - |
|
436 |
IF x > y THEN |
| - |
|
437 |
a := x * sqrt(1.0 + sqrr(y / x)) |
| - |
|
438 |
ELSE |
| - |
|
439 |
IF x > 0.0 THEN |
| - |
|
440 |
a := y * sqrt(1.0 + sqrr(x / y)) |
| - |
|
441 |
ELSE |
| - |
|
442 |
a := y |
| - |
|
443 |
END |
| - |
|
444 |
END |
| - |
|
445 |
|
| - |
|
446 |
RETURN a |
| 381 |
END fact; |
447 |
END hypot; |
| 382 |
|
448 |
|