'===========================================================================
' Subject: ELLIPSES                          Date: 08-15-00 (15:47)       
' Author:  Jacob Wieles                      Code: QB, QBasic, PDS, PB    
' Origin:  j.wieles@hccnet.nl              Packet: GRAPHICS.ABC
'===========================================================================
'programma    : ELLIPSE.BAS  (15-08-2000)
'auteur       : Jacob Wieles
'               Playing with sine and cosine and find oval shapes
'basic        : PowerBASIC en Q(uick)Basic


dim col(15),x0(15),y0(15),x1(15),y1(15)
dim sides(15),oval(15)
restore sidedata
for i=0 to 9
read sides(i)
next i
restore ovaldata
for i=0 to 9
read oval(i)
next i
screen 12
xm=point(0)
ym=point(1)
asp=ym/xm
radius=xm/2-2
window(-xm,ym)-(xm-1,-(ym-1))
'Find out on which basic the program runs
  out &H3C7,15
  cr=inp(&H3C9)
  cg=inp(&H3C9)
  cb=inp(&H3C9)
'    if cr=42 then the program runs on PowerBasic
'    if cr=63 then the program runs on Q(uick)Basic
  timedivisor=10'=====================>> For PowerBASIC
  if cr=63 then timedivisor=.8'=========>> For Q(uick)BASIC
'The value for the timedivisor are found for a Pentium 100 PC
'For an other PC maybe you must change this value
'To prevent flickering monitor and SetUpDrawSpeed
  t!=timer
  wp&=0
  do while timer< t!+1
    wp&=wp&+1
  loop
DrawLoop&=wp&/timedivisor

gosub SetupColor
RunFlag=1
TS$=" Key for stop.               "
pi#=4*atn(1)
steps=120
for picture=0 to 9
n=sides(picture)
f=oval(picture)
locate 1,1
print TS$
locate 1,60
print picture+1;"from 10"
'********************************************>> Draw picture
for k=0 to steps
  anglek=k*2*pi#/steps
  for i=0 to n
    col=col(i+1)
    anglei=i*2*pi#/n
    x1(i)=x0(i)
    y1(i)=y0(i)
    x0=radius*cos(anglek)*cos(anglei)
    y0=radius*cos(anglek)*sin(anglei)
    x1=radius*cos(anglek-f*anglei)
    y1=radius*sin(anglek-f*anglei)
    x0(i)=x0+x1
    y0(i)=asp*(y0+y1)
    if i<>0 then'***********>> draw polygon
      line-(x0(i),y0(i)),col
    else
      pset(x0(i),y0(i))
    end if
  next i
  if k<>0 then
    for t=0 to n'***********>> connect angular points
      line(x1(t),y1(t))-(x0(t),y0(t)),14
    next t
    for w&=0 to DrawLoop&:next w&
    inv$=inkey$
    if inv$<>"" then gosub KeyNext
    if RunFlag=0 then goto QuitProg
  end if
next k
'********************************************>> Line up ellipse
for k=0 to steps
  anglek=k*2*pi#/steps
  for i=0 to n
    x1(i)=x0(i)
    y1(i)=y0(i)
    anglei=i*2*pi#/n
    x0=radius*cos(anglek)*cos(anglei)
    y0=radius*cos(anglek)*sin(anglei)
    x1=radius*cos(anglek-f*anglei)
    y1=radius*sin(anglek-f*anglei)
    x0(i)=x0+x1
    y0(i)=asp*(y0+y1)
  next i
  for t=0 to n
    line(x1(t),y1(t))-(x0(t),y0(t)),14
  next t
next k
while inkey$<>"":wend
t!=timer
while timer< t!+2:wend
if k=steps+1 and inkey$<>"" then
  gosub KeyNext
end if
'********************************************>> Remove picture
for k=0 to steps
  anglek=k*2*pi#/steps
  for i=0 to n
    col=0
    anglei=i*2*pi#/n
    x1(i)=x0(i)
    y1(i)=y0(i)
    x0=radius*cos(anglek)*cos(anglei)
    y0=radius*cos(anglek)*sin(anglei)
    x1=radius*cos(anglek-f*anglei)
    y1=radius*sin(anglek-f*anglei)
    x0(i)=x0+x1
    y0(i)=asp*(y0+y1)
    if i<>0 then
      line-(x0(i),y0(i)),col
    else
      pset(x0(i),y0(i))
    end if
  next i
  if k<>0 then
    for t=0 to n
      line(x1(t),y1(t))-(x0(t),y0(t)),col
    next t
    for w&=0 to DrawLoop&:next w&
    inv$=inkey$
    if inv$<>"" then gosub KeyNext
    if RunFlag=0 then goto QuitProg
  end if
next k
next picture
QuitProg:
cls
screen 0
print" Hit a key for the source."
end

SetupColor:
restore SetupColorData
for i=0 to 15
  read col(i)
next i
return


KeyNext:
  while inkey$<>"":wend
  RunFlag=1
  locate 1,1
  print" Key for go on. Esc for end."
  do
    keyhit$=inkey$
  loop until keyhit$<>""
  if keyhit$=CHR$(27) then RunFlag=0
  locate 1,1
  print TS$
return

SetupColorData:
data 0,9,10,11,12,13,2,3
data 4,5,6,9,10,11,12,14

sidedata:
data 6,6,7,7,7,8,8,9,10,12
ovaldata:
data 2,4,2,3,5,2,6,2,2,2