'===========================================================================
' Subject: FAN SHAPE                         Date: 08-15-00 (15:47)       
' Author:  Jacob Wieles                      Code: QB, QBasic, PDS, PB    
' Origin:  j.wieles@hccnet.nl              Packet: GRAPHICS.ABC
'===========================================================================
'program          : FANSHAPE.BAS   (15-08-2000)
'
'auteur           : Jacob Wieles
'basics ?         : POWER and Q(UICK)
'
dim DrawCol(15)
Yes=1
No=0
screen 12
'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=100'=====================>> 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
xm=point(0)
ym=point(1)
asp=ym/xm
pi=4*atn(1)
ts$=" Hit a key for stop.                "
window (-XM,+YM)-(XM-1,-YM+1)
Steps = 960
Radius0=.6*XM
Radius1=.3*XM
LineColor=Yes
restore FanShapeData
for fan=1 to 12
  read FanAngle,var0,var1
  RunFlag=1
  locate 1,1
  print ts$;"           ";fan;"from 12"
  ColorYesNo:
  for count=0 to Steps-1
    Angle0=count*2*pi/Steps
    Angle1=FanAngle*Angle0
    X0=Radius0*COS(Angle0)
    Y0=Radius0*SIN(Angle0*VAR0)
    X1=Radius1*COS(Angle1)
    Y1=Radius1*SIN(Angle1+Angle0*VAR1)
    x=X0+X1
    y=asp*(Y0+Y1)
    if LineColor=Yes then
      Drawcol=DrawCol(1+count mod 2+fan mod 10)
    else
      DrawCol=0
    end if
    if count=0 then
      PSET (x,y)
    else
      line-(x,y),DrawCol
      for w&=0 to DrawLoop&:next w&
    end if
    inv$ = INKEY$
    if inv$<>"" then gosub KeyNext
    if RunFlag=0 then goto QuitProg
  next count
  if LineColor=Yes then
    w!=timer
    while timer<w!+2:wend
    LineColor=No
    goto ColorYesNo
  end if
  LineColor=Yes
next fan
QuitProg:
cls
screen 0
print" Hit a key for the source."
end

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


KeyNext:
  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,12,14,13,10,12,14,13
data 9,14,13,10,12,14,13,10

FanShapedata:
data 486,1,1
data 485,1,2
data 484,1,3
data 486,2,1
data 485,2,2
data 483,2,3
data 486,3,1
data 485,3,2
data 484,3,3
data 475,1,-1
data 474,1,-2
data 473,1,-3