
A pentagram is a star polygon, consisting of a central pentagon of which each side forms the base of an isosceles triangle. The vertex of each triangle, a point of the star, is 36 degrees.




Task

Draw (or print) a regular pentagram, in any orientation. Use a different color (or token) for stroke and fill, and background. For the fill it should be assumed that all points inside the triangles and the pentagon are inside the pentagram.




See also
 Angle sum of a pentagram


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