'===========================================================================
' Subject: MOVING LIGHTS IN A TUBE           Date: 03-17-99 (13:15)       
' Author:  Jacob Wieles                      Code: QB, QBasic, PDS, PB    
' Origin:  jacwls@worldonline.nl           Packet: GRAPHICS.ABC
'===========================================================================
'program      : MOTION-0.BAS  (17-03-99)
'               Simple simulation of moving lights in an impossible tube
'               with data change in the DAC (Digital Analog Converter)
'auteur       : Jacob Wieles
'which basic  : PowerBASIC and Q(uick)BASIC

defint a-z
defsng w
rad1=160
rad2=20 '==============>> Try rad2=2
size=2+int((2*rad2+1+7)/8)*2*(2*rad2+1)
dim fig(size-1)
on error goto NoVGA
screen 12
w=timer
while timer<w+1:wend   'prevent screen flicker
gosub initialcolor
gosub Picture
color 7
locate 1,1:print" Hit a Key for start simulation."
keyhit$=input$(1)
gosub simulation
cls
screen 0
w=timer
while timer<w+1:wend   'prevent screen flicker
EndProg:
print" Thanks for running this program. Hit a key for the source."
end
'==================================================

Picture:
'border
line(20,20)-(639-20,479-20),12,b
line(40,40)-(639-40,479-40),12,b
paint(22,240),7,12
paint(320,240),5,12
line(20,20)-(40,40),12
line(20,479-20)-(40,479-40),12
line(639-20,20)-(639-40,40),12
line(639-20,479-20)-(639-40,479-40),12
'Picture
for count=0 to 369
  col=count mod 4 +1
  angle1!=count*8*atn(1)/180
  angle2!=angle1!/2
  x=320+1.5*rad1*cos(angle2!)
  y=240-rad1*sin(angle1!)
  circle(x,y),rad2,col
  paint(x,y),col,col
  if count=10 then
    xb=x
    yb=y
  end if
  if count=20 then
    get(xb-rad2+1,yb-rad2+1)-(xb+rad2+1,yb+rad2+1),fig
  end if
next count
put(xb-rad2+1,yb-rad2+1),fig,pset
return



sub ChangeColor(col1,col2)    'R, G and B value from DAC (col1)
  out &H3C7,col1              'to DAC (col2)
  R=inp(&H3C9)
  G=inp(&H3C9)
  B=inp(&H3C9)
  out &H3C8,col2
  out &H3C9,R
  out &H3C9,G
  out &H3C9,B
end sub

sub SetColor(R,G,B,Dac)       'New R, G and B value to DAC (Dac)
  out &H3C8,Dac
  out &H3C9,R
  out &H3C9,G
  out &H3C9,B
end sub

sub SetPalette
  dummy=inp(&H3DA)
  for attr=0 to 15
    out &H3C0,attr
    out &H3C0,attr
  next attr
  out &H3C0,32
end sub


initialcolor:
  call SetPalette             '===>>>  PB  set AC (0-15) to (0-15)
  call SetColor(0,0,42,0)     'DAC (0) (Background color) blue
  call SetColor(63,0,0,12)    'DAC (12) color Light red
  call SetColor(0,0,63,5)     'DAC (5) color Light blue
  call SetColor(0,63,0,10)    'DAC (10) color Light green
  call SetColor(0,40,0,11)    'DAC (11) color dark Green
  call SetColor(50,50,0,7)    'DAC (7) yellow
  call ChangeColor(10,1)      'circle 1 light green
  for i=2 to 4                'circles 2, 3 and 4 dark green
    call ChangeColor(11,i)    'color 1-4
  next i
return

simulation:
wt=.05   ' try an other value
do
  locate 1,1
  print" Hit spacebar for stop.";
  print"            "
  do
    for i=0 to 3
      call ChangeColor(11,1+i)              ' Make the color dark green
      call ChangeColor(10,4-((6-i) mod 4))  ' Make the color light green
      w=timer
      while timer<w+wt:wend
    next i
  loop until inkey$=chr$(32)
  locate 1,1
  print" Go on with Enter.";
  print"  Stop with Esc."
  do
    hitakey=asc(input$(1))
  loop until hitakey=27 or hitakey=13
loop while hitakey=13
return

NoVGA:
cls
print"No VGA Hardware."
print
resume EndProg