PYTHAGORAS.PAS
FILE INFORMATION
FILENAME(S): PYTHAGORAS.PAS
FILE TYPE(S): SEQ
FILE SIZE: 1.9K
FIRST SEEN: 2025-10-20 14:30:41
APPEARS ON: 2 disk(s)
FILE HASH
96524dcec2534b4b73484b31ae1dc552113f43fc043e0f7a8e6c9ab6ccf0232c
FOUND ON DISKS (2 DISKS)
| DISK TITLE | FILENAME | FILE TYPE | COLLECTION | TRACK | SECTOR | ACTIONS |
|---|---|---|---|---|---|---|
| DIMENSION 64 | PYTHAGORAS.PAS | SEQ | Treasure Chest - Klaus Der Suhler | 27 | 11 | DOWNLOAD FILE |
| DIMENSION 64 06 | PYTHAGORAS.PAS | SEQ | Treasure Chest - Klaus Der Suhler | 27 | 11 | DOWNLOAD FILE |
FILE CONTENT & ANALYSIS
00000000: 50 52 4F 47 52 41 4D 20 C2 41 55 4D 44 45 53 D0 |PROGRAM .AUMDES.| 00000010: 59 54 48 41 47 4F 52 41 53 3B 0D A0 0D 20 20 43 |YTHAGORAS;... C| 00000020: 4F 4E 53 54 0D 20 20 20 20 70 69 20 20 20 20 3D |ONST. pi =| 00000030: 20 33 2E 31 34 31 35 39 32 36 35 34 20 3B 0D 20 | 3.141592654 ;. | 00000040: 20 20 20 6C 61 20 20 20 20 3D 20 34 20 3B 0D 20 | la = 4 ;. | 00000050: 20 20 20 6C 62 20 20 20 20 3D 20 33 20 3B 0D 20 | lb = 3 ;. | 00000060: 20 20 20 6C 63 20 20 20 20 3D 20 35 20 3B 0D A0 | lc = 5 ;..| 00000070: 0D 20 20 54 59 50 45 0D 20 20 20 20 6B 6F 6F 72 |. TYPE. koor| 00000080: 64 69 6E 61 74 65 20 3D 20 52 45 43 4F 52 44 0D |dinate = RECORD.| 00000090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 | | 000000A0: 20 20 20 20 20 78 20 3A 20 72 65 61 6C 3B 0D 20 | x : real;. | 000000B0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 | | 000000C0: 20 20 20 20 79 20 3A 20 72 65 61 6C 3B 0D 20 20 | y : real;. | 000000D0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 45 | E| 000000E0: 4E 44 3B 0D 20 A0 0D A0 20 56 41 52 0D 20 20 20 |ND;. ... VAR. | 000000F0: 20 61 2C 62 2C 63 20 20 20 20 20 20 20 20 20 20 | a,b,c | 00000100: 20 20 20 20 20 3A 20 6B 6F 6F 72 64 69 6E 61 74 | : koordinat| 00000110: 65 3B 0D A0 20 20 20 61 6C 70 68 61 2C 77 69 6E |e;.. alpha,win| 00000120: 6B 65 6C 2C 6C 61 65 6E 67 65 2C 0D 20 A0 20 20 |kel,laenge,. . | 00000130: 74 65 74 61 20 2C 65 78 74 72 61 20 20 20 20 20 |teta ,extra | 00000140: 20 20 20 20 3A 20 72 65 61 6C 3B 0D 20 A0 0D 20 | : real;. .. | 00000150: 20 46 55 4E 43 54 49 4F 4E 20 61 72 63 63 6F 73 | FUNCTION arccos| 00000160: 69 6E 75 73 20 28 20 78 20 3A 20 72 65 61 6C 20 |inus ( x : real | 00000170: 29 20 3A 20 72 65 61 6C 3B 0D 20 20 20 20 42 45 |) : real;. BE| 00000180: 47 49 4E 0D 20 20 20 20 20 20 20 61 72 63 63 6F |GIN. arcco| 00000190: 73 69 6E 75 73 20 3A 3D 20 2D 61 72 63 74 61 6E |sinus := -arctan| 000001A0: 20 28 78 2F 73 71 72 74 28 31 2D 78 2A 78 29 29 | (x/sqrt(1-x*x))| 000001B0: 2B 70 69 2F 32 3B 0D 20 20 20 20 45 4E 44 3B 0D |+pi/2;. END;.| 000001C0: A0 0D 20 20 50 52 4F 43 45 44 55 52 45 20 6C 69 |.. PROCEDURE li| 000001D0: 6E 65 20 28 61 2C 65 20 3A 20 6B 6F 6F 72 64 69 |ne (a,e : koordi| 000001E0: 6E 61 74 65 20 29 3B 0D 20 20 20 20 42 45 47 49 |nate );. BEGI| 000001F0: 4E 0D 20 20 20 20 20 20 20 70 6C 6F 74 20 28 32 |N. plot (2| 00000200: 2C 72 6F 75 6E 64 20 28 61 2E 78 29 2C 72 6F 75 |,round (a.x),rou| 00000210: 6E 64 20 28 61 2E 79 29 2C 72 6F 75 6E 64 20 28 |nd (a.y),round (| 00000220: 65 2E 78 29 2C 72 6F 75 6E 64 20 28 65 2E 79 29 |e.x),round (e.y)| 00000230: 29 3B 0D 20 20 20 20 45 4E 44 3B 0D A0 A0 0D 20 |);. END;.... | 00000240: 20 50 52 4F 43 45 44 55 52 45 20 68 69 72 65 73 | PROCEDURE hires| 00000250: 69 6E 3B 0D 20 20 20 20 42 45 47 49 4E 0D 20 20 |in;. BEGIN. | 00000260: 20 20 20 20 20 77 69 6E 64 6F 77 20 28 32 35 29 | window (25)| 00000270: 3B 0D 20 20 20 20 20 20 20 62 6F 72 64 65 72 20 |;. border | 00000280: 28 30 29 3B 0D 20 20 20 20 20 20 20 70 61 70 65 |(0);. pape| 00000290: 72 20 28 30 29 3B 0D 20 20 20 20 20 20 20 69 6E |r (0);. in| 000002A0: 6B 20 28 31 29 3B 0D 20 20 20 20 20 20 20 70 6C |k (1);. pl| 000002B0: 6F 74 20 28 30 2C 30 2C 30 2C 30 2C 30 29 3B 0D |ot (0,0,0,0,0);.| 000002C0: 20 20 20 20 20 20 20 70 6C 6F 74 20 28 31 2C 30 | plot (1,0| 000002D0: 2C 30 2C 30 2C 30 29 3B 0D 20 20 20 20 20 20 20 |,0,0,0);. | 000002E0: 68 69 72 65 73 20 28 31 29 3B 0D 20 20 20 20 45 |hires (1);. E| 000002F0: 4E 44 3B 0D A0 0D 20 20 50 52 4F 43 45 44 55 52 |ND;... PROCEDUR| 00000300: 45 20 68 69 72 65 73 6F 75 74 3B 0D 20 20 20 20 |E hiresout;. | 00000310: 42 45 47 49 4E 0D 20 20 20 20 20 20 20 68 69 72 |BEGIN. hir| 00000320: 65 73 20 28 30 29 3B 0D 20 20 20 20 45 4E 44 3B |es (0);. END;| 00000330: 0D A0 0D 20 20 50 52 4F 43 45 44 55 52 45 20 62 |... PROCEDURE b| 00000340: 6C 6F 63 6B 20 28 20 76 61 72 20 61 2C 63 20 3A |lock ( var a,c :| 00000350: 20 6B 6F 6F 72 64 69 6E 61 74 65 20 29 3B 0D A0 | koordinate );..| 00000360: 0D 20 20 20 20 56 41 52 20 61 6E 2C 62 6E 20 3A |. VAR an,bn :| 00000370: 20 6B 6F 6F 72 64 69 6E 61 74 65 3B 0D A0 0D 20 | koordinate;... | 00000380: 20 20 20 42 45 47 49 4E 0D 20 20 20 20 20 20 20 | BEGIN. | 00000390: 62 6E 2E 78 20 3A 3D 20 63 2E 78 20 2D 20 28 20 |bn.x := c.x - ( | 000003A0: 63 2E 79 20 2D 20 61 2E 79 20 29 3B 0D 20 20 20 |c.y - a.y );. | 000003B0: 20 20 20 20 62 6E 2E 79 20 3A 3D 20 63 2E 79 20 | bn.y := c.y | 000003C0: 2B 20 28 20 63 2E 78 20 2D 20 61 2E 78 20 29 3B |+ ( c.x - a.x );| 000003D0: 0D 20 20 20 20 20 20 20 61 6E 2E 78 20 3A 3D 20 |. an.x := | 000003E0: 61 2E 78 20 2B 20 28 20 63 2E 79 20 2D 20 61 2E |a.x + ( c.y - a.| 000003F0: 79 20 29 2A 28 2D 31 29 3B 0D 20 20 20 20 20 20 |y )*(-1);. | 00000400: 20 61 6E 2E 79 20 3A 3D 20 61 2E 79 20 2B 20 28 | an.y := a.y + (| 00000410: 20 63 2E 78 20 2D 20 61 2E 78 20 29 3B 0D 20 20 | c.x - a.x );. | 00000420: 20 20 20 20 20 6C 69 6E 65 20 28 61 20 2C 63 20 | line (a ,c | 00000430: 29 3B 0D 20 20 20 20 20 20 20 6C 69 6E 65 20 28 |);. line (| 00000440: 63 20 2C 62 6E 29 3B 0D 20 20 20 20 20 20 20 6C |c ,bn);. l| 00000450: 69 6E 65 20 28 62 6E 2C 61 6E 29 3B 0D 20 20 20 |ine (bn,an);. | 00000460: 20 20 20 20 6C 69 6E 65 20 28 61 6E 2C 61 20 29 | line (an,a )| 00000470: 3B 0D 20 20 20 20 20 20 20 61 3A 3D 61 6E 20 3B |;. a:=an ;| 00000480: 20 63 3A 3D 62 6E 20 3B 0D 20 20 20 20 45 4E 44 | c:=bn ;. END| 00000490: 3B 0D A0 0D 20 20 50 52 4F 43 45 44 55 52 45 20 |;... PROCEDURE | 000004A0: 64 72 65 69 65 63 6B 20 28 61 2C 62 20 3A 20 6B |dreieck (a,b : k| 000004B0: 6F 6F 72 64 69 6E 61 74 65 20 29 3B 0D 20 20 20 |oordinate );. | 000004C0: 20 56 41 52 20 20 20 20 20 20 20 63 20 20 3A 20 | VAR c : | 000004D0: 6B 6F 6F 72 64 69 6E 61 74 65 3B 0D A0 0D 20 20 |koordinate;... | 000004E0: 20 20 42 45 47 49 4E 0D 20 20 20 20 20 20 20 42 | BEGIN. B| 000004F0: 4C 4F 43 4B 20 28 61 2C 62 29 3B 0D 20 20 20 20 |LOCK (a,b);. | 00000500: 20 20 20 6C 61 65 6E 67 65 20 3A 3D 20 73 71 72 | laenge := sqr| 00000510: 74 20 28 20 73 71 72 20 28 61 2E 78 2D 62 2E 78 |t ( sqr (a.x-b.x| 00000520: 29 20 2B 20 73 71 72 20 28 61 2E 79 2D 62 2E 79 |) + sqr (a.y-b.y| 00000530: 29 29 20 2A 20 28 20 6C 62 2F 6C 63 20 29 3B 0D |)) * ( lb/lc );.| 00000540: 20 20 20 20 20 20 20 49 46 20 72 6F 75 6E 64 20 | IF round | 00000550: 28 6C 61 65 6E 67 65 29 20 3E 20 32 20 54 48 45 |(laenge) > 2 THE| 00000560: 4E 0D 20 20 20 20 20 20 20 42 45 47 49 4E 0D 20 |N. BEGIN. | 00000570: 20 20 20 20 20 20 20 20 20 49 46 20 61 2E 78 20 | IF a.x | 00000580: 3E 20 62 2E 78 20 54 48 45 4E 20 65 78 74 72 61 |> b.x THEN extra| 00000590: 20 3A 3D 20 70 69 0D 20 20 20 20 20 20 20 20 20 | := pi. | 000005A0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4C | EL| 000005B0: 53 45 20 65 78 74 72 61 20 3A 3D 20 30 3B 0D 20 |SE extra := 0;. | 000005C0: 20 20 20 20 20 20 20 20 20 74 65 74 61 20 3A 3D | teta :=| 000005D0: 20 61 72 63 74 61 6E 20 28 20 28 61 2E 79 2D 62 | arctan ( (a.y-b| 000005E0: 2E 79 29 20 2F 20 28 61 2E 78 2D 62 2E 78 29 20 |.y) / (a.x-b.x) | 000005F0: 29 3B 0D 20 20 20 20 20 20 20 20 20 20 77 69 6E |);. win| 00000600: 6B 65 6C 20 3A 3D 20 61 6C 70 68 61 20 2B 20 74 |kel := alpha + t| 00000610: 65 74 61 20 2B 65 78 74 72 61 3B 0D 20 20 20 20 |eta +extra;. | 00000620: 20 20 20 20 20 20 63 2E 78 20 3A 3D 20 61 2E 78 | c.x := a.x| 00000630: 20 2B 20 63 6F 73 20 28 77 69 6E 6B 65 6C 29 20 | + cos (winkel) | 00000640: 2A 20 6C 61 65 6E 67 65 3B 0D 20 20 20 20 20 20 |* laenge;. | 00000650: 20 20 20 20 63 2E 79 20 3A 3D 20 61 2E 79 20 2B | c.y := a.y +| 00000660: 20 73 69 6E 20 28 77 69 6E 6B 65 6C 29 20 2A 20 | sin (winkel) * | 00000670: 6C 61 65 6E 67 65 3B 0D 20 20 20 20 20 20 20 20 |laenge;. | 00000680: 20 20 6C 69 6E 65 20 28 61 2C 63 29 20 3B 20 6C | line (a,c) ; l| 00000690: 69 6E 65 20 28 62 2C 63 29 3B 0D A0 0D 20 20 20 |ine (b,c);... | 000006A0: 20 20 20 20 20 20 20 44 52 45 49 45 43 4B 20 28 | DREIECK (| 000006B0: 61 2C 63 29 3B 0D 20 20 20 20 20 20 20 20 20 20 |a,c);. | 000006C0: 44 52 45 49 45 43 4B 20 28 63 2C 62 29 3B 0D A0 |DREIECK (c,b);..| 000006D0: 0D 20 20 20 20 20 20 20 45 4E 44 3B 0D 20 20 20 |. END;. | 000006E0: 20 45 4E 44 3B 0D A0 A0 A0 A0 0D 20 20 42 45 47 | END;...... BEG| 000006F0: 49 4E 0D 20 20 20 20 20 68 69 72 65 73 69 6E 3B |IN. hiresin;| 00000700: 0D 20 20 20 20 20 61 6C 70 68 61 20 3A 3D 20 61 |. alpha := a| 00000710: 72 63 63 6F 73 69 6E 75 73 20 28 28 6C 62 2A 6C |rccosinus ((lb*l| 00000720: 62 20 2B 20 6C 63 2A 6C 63 20 2D 20 6C 61 2A 6C |b + lc*lc - la*l| 00000730: 61 29 20 2F 20 28 20 32 2A 6C 62 2A 6C 63 20 29 |a) / ( 2*lb*lc )| 00000740: 29 3B 0D 20 20 20 20 20 61 2E 78 20 3A 3D 20 38 |);. a.x := 8| 00000750: 33 20 3B 20 61 2E 79 20 3A 3D 20 30 3B 0D 20 20 |3 ; a.y := 0;. | 00000760: 20 20 20 62 2E 78 20 3A 3D 20 31 32 37 3B 20 62 | b.x := 127; b| 00000770: 2E 79 20 3A 3D 20 30 3B 0D A0 0D 20 20 20 20 20 |.y := 0;... | 00000780: 44 52 45 49 45 43 4B 20 28 61 2C 62 29 3B 0D A0 |DREIECK (a,b);..| 00000790: 0D 20 20 20 20 20 68 69 72 65 73 6F 75 74 3B 0D |. hiresout;.| 000007A0: 20 20 45 4E 44 2E 0D | END.. |
PROGRAM BAUMDESPYTHAGORAS;. . CONST.
PI = 3.141592654 ;. LA = 4 ;.
LB = 3 ;. LC = 5 ;. . TYPE.
KOORDINATE = RECORD.
X : REAL;. Y :
REAL;. END;. . VAR.
A,B,C : KOORDINATE;. A
LPHA,WINKEL,LAENGE,. TETA ,EXTRA
: REAL;. . FUNCTION ARCCOSINUS ( X
: REAL ) : REAL;. BEGIN. ARCCO
SINUS := -ARCTAN (X/SQRT(1-X*X))+PI/2;.
END;. . PROCEDURE LINE (A,E : KOORDI
NATE );. BEGIN. PLOT (2,ROUND (
A.X),ROUND (A.Y),ROUND (E.X),ROUND (E.Y)
);. END;. . PROCEDURE HIRESIN;.
BEGIN. WINDOW (25);. BORDER
(0);. PAPER (0);. INK (1);.
PLOT (0,0,0,0,0);. PLOT (1,0
,0,0,0);. HIRES (1);. END;. .
PROCEDURE HIRESOUT;. BEGIN. HIR
ES (0);. END;. . PROCEDURE BLOCK ( V
AR A,C : KOORDINATE );. . VAR AN,BN :
KOORDINATE;. . BEGIN. BN.X :=
C.X - ( C.Y - A.Y );. BN.Y := C.Y
+ ( C.X - A.X );. AN.X := A.X + (
C.Y - A.Y )*(-1);. AN.Y := A.Y + (
C.X - A.X );. LINE (A ,C );.
LINE (C ,BN);. LINE (BN,AN);.
LINE (AN,A );. A:=AN ; C:=BN ;
. END;. . PROCEDURE DREIECK (A,B : K
OORDINATE );. VAR C : KOORDINA
TE;. . BEGIN. BLOCK (A,B);.
LAENGE := SQRT ( SQR (A.X-B.X) + SQR
(A.Y-B.Y)) * ( LB/LC );. IF ROUND
(LAENGE) > 2 THEN. BEGIN.
IF A.X > B.X THEN EXTRA := PI.
ELSE EXTRA := 0;.
TETA := ARCTAN ( (A.Y-B.Y) / (A.X-B.X)
);. WINKEL := ALPHA + TETA +EXT
RA;. C.X := A.X + COS (WINKEL)
* LAENGE;. C.Y := A.Y + SIN (WI
NKEL) * LAENGE;. LINE (A,C) ; L
INE (B,C);. . DREIECK (A,C);.
DREIECK (C,B);. . END;.
END;. . BEGIN. HIRESIN;. AL
PHA := ARCCOSINUS ((LB*LB + LC*LC - LA*L
A) / ( 2*LB*LC ));. A.X := 83 ; A.Y
:= 0;. B.X := 127; B.Y := 0;. .
DREIECK (A,B);. . HIRESOUT;. END..
> CLICK IMAGE PREVIEW FOR FULL MODAL