Pentagram: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: added syntax colouring, marked p2js compatible) |
(Added solution for Action!) |
||
Line 12: | Line 12: | ||
* [http://proofsfromthebook.com/2013/08/04/angle-sum-of-a-pentagram/ Angle sum of a pentagram] |
* [http://proofsfromthebook.com/2013/08/04/angle-sum-of-a-pentagram/ Angle sum of a pentagram] |
||
<br><br> |
<br><br> |
||
=={{header|Action!}}== |
|||
{{libheader|Action! Tool Kit}} |
|||
<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit |
|||
DEFINE REALPTR="CARD" |
|||
TYPE PointR=[REALPTR x,y] |
|||
INT ARRAY SinTab=[ |
|||
0 4 9 13 18 22 27 31 36 40 44 49 53 58 62 66 71 75 79 83 |
|||
88 92 96 100 104 108 112 116 120 124 128 132 136 139 143 |
|||
147 150 154 158 161 165 168 171 175 178 181 184 187 190 |
|||
193 196 199 202 204 207 210 212 215 217 219 222 224 226 |
|||
228 230 232 234 236 237 239 241 242 243 245 246 247 248 |
|||
249 250 251 252 253 254 254 255 255 255 256 256 256 256] |
|||
INT FUNC Sin(INT a) |
|||
WHILE a<0 DO a==+360 OD |
|||
WHILE a>360 DO a==-360 OD |
|||
IF a<=90 THEN |
|||
RETURN (SinTab(a)) |
|||
ELSEIF a<=180 THEN |
|||
RETURN (SinTab(180-a)) |
|||
ELSEIF a<=270 THEN |
|||
RETURN (-SinTab(a-180)) |
|||
ELSE |
|||
RETURN (-SinTab(360-a)) |
|||
FI |
|||
RETURN (0) |
|||
INT FUNC Cos(INT a) |
|||
RETURN (Sin(a-90)) |
|||
PROC Det(REAL POINTER x1,y1,x2,y2,res) |
|||
REAL tmp1,tmp2 |
|||
RealMult(x1,y2,tmp1) |
|||
RealMult(y1,x2,tmp2) |
|||
RealSub(tmp1,tmp2,res) |
|||
RETURN |
|||
BYTE FUNC IsZero(REAL POINTER a) |
|||
CHAR ARRAY s(10) |
|||
StrR(a,s) |
|||
IF s(0)=1 AND s(1)='0 THEN |
|||
RETURN (1) |
|||
FI |
|||
RETURN (0) |
|||
BYTE FUNC Intersection(PointR POINTER p1,p2,p3,p4,res) |
|||
REAL det1,det2,dx1,dx2,dy1,dy2,nom,denom |
|||
Det(p1.x,p1.y,p2.x,p2.y,det1) |
|||
Det(p3.x,p3.y,p4.x,p4.y,det2) |
|||
RealSub(p1.x,p2.x,dx1) |
|||
RealSub(p1.y,p2.y,dy1) |
|||
RealSub(p3.x,p4.x,dx2) |
|||
RealSub(p3.y,p4.y,dy2) |
|||
Det(dx1,dy1,dx2,dy2,denom) |
|||
IF IsZero(denom) THEN |
|||
RETURN (0) |
|||
FI |
|||
Det(det1,dx1,det2,dx2,nom) |
|||
RealDiv(nom,denom,res.x) |
|||
Det(det1,dy1,det2,dy2,nom) |
|||
RealDiv(nom,denom,res.y) |
|||
RETURN (1) |
|||
PROC FloodFill(BYTE x0,y0) |
|||
BYTE ARRAY xs(300),ys(300) |
|||
INT first,last |
|||
first=0 last=0 |
|||
xs(first)=x0 |
|||
ys(first)=y0 |
|||
WHILE first<=last |
|||
DO |
|||
x0=xs(first) y0=ys(first) |
|||
first==+1 |
|||
IF Locate(x0,y0)=0 THEN |
|||
Plot(x0,y0) |
|||
IF Locate(x0-1,y0)=0 THEN |
|||
last==+1 xs(last)=x0-1 ys(last)=y0 |
|||
FI |
|||
IF Locate(x0+1,y0)=0 THEN |
|||
last==+1 xs(last)=x0+1 ys(last)=y0 |
|||
FI |
|||
IF Locate(x0,y0-1)=0 THEN |
|||
last==+1 xs(last)=x0 ys(last)=y0-1 |
|||
FI |
|||
IF Locate(x0,y0+1)=0 THEN |
|||
last==+1 xs(last)=x0 ys(last)=y0+1 |
|||
FI |
|||
FI |
|||
OD |
|||
RETURN |
|||
PROC Pentagram(INT x0,y0,r,a0 BYTE c1,c2) |
|||
INT ARRAY xs(16),ys(16) |
|||
INT angle |
|||
BYTE i |
|||
PointR p1,p2,p3,p4,p |
|||
REAL p1x,p1y,p2x,p2y,p3x,p3y,p4x,p4y,px,py |
|||
p1.x=p1x p1.y=p1y |
|||
p2.x=p2x p2.y=p2y |
|||
p3.x=p3x p3.y=p3y |
|||
p4.x=p4x p4.y=p4y |
|||
p.x=px p.y=py |
|||
;outer points |
|||
angle=a0 |
|||
FOR i=0 TO 4 |
|||
DO |
|||
xs(i)=r*Sin(angle)/256+x0 |
|||
ys(i)=r*Cos(angle)/256+y0 |
|||
angle==+144 |
|||
OD |
|||
;intersection points |
|||
FOR i=0 TO 4 |
|||
DO |
|||
IntToReal(xs(i MOD 5),p1x) |
|||
IntToReal(ys(i MOD 5),p1y) |
|||
IntToReal(xs((1+i) MOD 5),p2x) |
|||
IntToReal(ys((1+i) MOD 5),p2y) |
|||
IntToReal(xs((2+i) MOD 5),p3x) |
|||
IntToReal(ys((2+i) MOD 5),p3y) |
|||
IntToReal(xs((3+i) MOD 5),p4x) |
|||
IntToReal(ys((3+i) MOD 5),p4y) |
|||
Intersection(p1,p2,p3,p4,p) |
|||
xs(5+i)=RealToInt(px) |
|||
ys(5+i)=RealToInt(py) |
|||
OD |
|||
;centers of triangles |
|||
FOR i=0 TO 4 |
|||
DO |
|||
xs(10+i)=(xs(i)+xs(5+i)+xs(5+(i+2) MOD 5))/3 |
|||
ys(10+i)=(ys(i)+ys(5+i)+ys(5+(i+2) MOD 5))/3 |
|||
OD |
|||
;center of pentagon |
|||
xs(15)=0 ys(15)=0 |
|||
FOR i=5 TO 9 |
|||
DO |
|||
xs(15)==+xs(i) |
|||
ys(15)==+ys(i) |
|||
OD |
|||
xs(15)==/5 ys(15)==/5 |
|||
;draw lines |
|||
COLOR=c1 |
|||
FOR i=0 TO 5 |
|||
DO |
|||
IF i=0 THEN |
|||
Plot(xs(i MOD 5),ys(i MOD 5)) |
|||
ELSE |
|||
DrawTo(xs(i MOD 5),ys(i MOD 5)) |
|||
FI |
|||
OD |
|||
;fill |
|||
COLOR=c2 |
|||
FOR i=10 TO 15 |
|||
DO |
|||
FloodFill(xs(i),ys(i)) |
|||
OD |
|||
RETURN |
|||
PROC Main() |
|||
BYTE CH=$02FC |
|||
Graphics(7+16) |
|||
SetColor(0,8,4) |
|||
SetColor(1,8,8) |
|||
SetColor(2,8,12) |
|||
Pentagram(40,48,40,0,1,2) |
|||
Pentagram(119,48,40,15,2,3) |
|||
DO UNTIL CH#$FF OD |
|||
CH=$FF |
|||
RETURN</lang> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Pentagram.png Screenshot from Atari 8-bit computer] |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |