%include "edwin:specs.inc"
%include "inc:maths.imp"
%external %routine %spec RECTANGLE      %alias "EDWIN_RECTANGLE"  (%integer XL, YL, XU, YU)
%external %routine %spec CIRCLE         %alias "EDWIN_CIRCLE"     (%integer RAD)
!spirograph

%begin
  %constinteger win=1000
  %constreal mult=10.0, twopi=6.28318
  %integer li,di,ri,dri,steps,revs,inc
  %real l,dr,trinc,tdinc,turn


%integerfunction hcf(%integer a,b)
  %if a=0 %then %start; %result=b
  %finish %elseif b=0 %then %start; %result=a
  %finish %elseif a>b %then %start; %result=hcf(a-b,b)
  %finish %else %result=hcf(b-a,a)
%end


%routine scribble
  %integer i
  %real tr,td,x,y

  set colour(4)
  move abs(int pt(l+dr),0)
  tr=0.0; td=0.0

  %for i=1,1,steps %cycle
    tr=tr+trinc
    td=td-tdinc
    x= dr*cos(td)+l*cos(tr+td)
    y= dr*sin(td)+ l*sin(tr+td)
    line abs(int pt(x),int pt(y))
  %repeat
%end


%routine setup

  set colour(1)
  rectangle(-380,-900,380,-750)
  set colour(4)
  move abs(-360,-860)
  text("spirograph")
  move abs(-364,-860)
  text("spirograph")

  di=0
  %while (di>100) %or (di<1) %cycle
    prompt("outer wheel radius, 1..100: ")
    read(di)
  %repeat
  move abs(0,0)
  newframe
  set colour(2)
  circle((di*win)//100)

  ri=0
  %while (ri>=di) %or (ri<1) %cycle
    print string("inner wheel radius, 1..");write(di-1,0);prompt(": ")
    read(ri)
  %repeat
  set colour(3)
  dri=di-ri
  move abs(0,(win*dri)//100)
  circle((ri*win)//100)

  li=0
  %while (li>ri) %or (li<1) %cycle
    print string("pen position, 1..");write(ri,0);prompt(": ")
    read(li)
  %repeat

  inc=ri
  turn=twopi/inc
  revs=dri//hcf(dri,ri)
  steps=revs*inc
  trinc= turn
  tdinc=trinc*ri/dri
  l= mult*li
  dr= mult*dri

  set colour(2)
  circle((ri*win)//100)

  newline

%end
  


  initialise for(defaultdevice)
  window(-win,win,-win,win)
  newframe
  set char quality(1)
  set char size(72)

  %cycle
    setup
!    open output(1,"spiro.pdf")
!    store on(1)
    window(-win,win,-win,win)
    scribble
!    close output
  %repeat

  terminate edwin

%endofprogram

