'===========================================================================
' Subject: SIMULATION OF MOVING LIGHTS       Date: 03-17-99 (13:15)       
' Author:  Jacob Wieles                      Code: QB, QBasic, PDS, PB    
' Origin:  jacwls@worldonline.nl           Packet: GRAPHICS.ABC
'===========================================================================
'program        : MOTION-1.BAS  (16-03-99)
'                 Playing with a look-a-like REUTERSVŽRD picture and
'                 simulation of moving lights with data change in DAC
'which basic    : PowerBASIC and Q(uick)BASIC
'auteur         : Jacob Wieles

defint a-z
ix=12
iy=6
x1=ix:x2=2*ix
y1=iy:y2=2*iy:y3=4*iy
gosub initdrawstrings
screen 12
gosub initialcolor
gosub drawboxes
color 1
locate 1,1
print" Hit a key for start."
keyhit$=input$(1)
gosub simulation
gosub MakeColorsLight
gosub LookShapes
while inkey$<>"":wend
locate 1,1
print" Hit a key for line-picture.            "
hitakey$=input$(1)
cls
gosub LinePict
while inkey$<>"":wend
locate 1,1
print" Hit a key for end.                      "
hitakey$=input$(1)
cls
screen 0
print" Thank you for running this program. Hit a key for the source."
end

drawboxes:
py=240-15*y2
px=320-12*x2
for i= 0 to 47
  select case i
  case <=7
    PY=PY+6*y1
    pset(px,py),1
    if i=0 then
       draw s5$
    else
      draw s2$
    end if
  case 8 to 23
    PX=PX+3*x1:PY=PY-3*y1
    PSET(PX,PY),1
    if i=8 or i=15 or i=16 then
      if i=8 then draw s6$
      if i=15 then draw s7$
      if i=16 then draw s8$
    else
      draw s3$
    end if
  case 24 to 31
    PY=PY+6*y1
    pset(px,py),1
    if i=24 then
      draw s10$
    else
      draw s2$
    end if
  case >31
    PX=PX-3*x1:PY=PY-3*y1
    pset(PX,PY),1
      if I=32 or i= 39 or i= 40 then
        if i=32 then draw s9$
        if i=39 then draw s7$
        if i=40 then draw s4$
      else
       draw s1$
    end if
  end select
call PaintBox
next i
return

LinePict:
py=240-15*y2
px=320-12*x2
pset(px,py-2*y2),1
line-step(-2*x1,y2),1
xstore1=point(0)
ystore1=point(1)
line-step(0,13*y3),1
line-step(x2,y2),1
xstore2=point(0)
ystore2=point(1)
line-step(24*x1,-24*y1),1
line-step(24*x1,24*y1),1
xstore3=point(0)
ystore3=point(1)
line-step(x2,-y2),1
line-step(0,-13*y3),1
xstore4=point(0)
ystore4=point(1)
line-step(-x2,-y2),1
line-step(-24*x1,24*y1),1
line-step(-24*x1,-24*y1),1
pset(xstore1,ystore1),1
line-step(24*x1,24*y1),1
line-step(-20*x1,20*y1),1
pset(xstore2,ystore2),1
line-step(0,-24*y2),1
line-step(20*x1,20*y1),1
pset(px+12*x2,py+12*y2),1
line-step(-22*x1,22*y1),1
line-step(0,-20*y2),1
pset(xstore4,ystore4),1
line-step(-24*x1,24*y1),1
line-step(20*x1,20*y1),1
pset(xstore3,ystore3),1
line-step(0,-24*y2),1
line-step(-20*x1,20*y1),1
pset(px+12*x2,py+12*y2),1
line-step(22*x1,22*y1),1
line-step(0,-20*y2),1
line(px+12*x2,py+12*y2)-(px+12*x2,py+12*y2+y3),1

paint(px+12*x2-x1,py+13*y2),10,1
paint(px+12*x2+x1,py+13*y2),6,1
paint(px+12*x2,py+12*y2-y1),2,1
paint(xstore1+x1,ystore1+y2),6,1
paint(xstore4-x1,ystore4+y2),10,1
return

LookShapes:
i=0:PY=300
PX=260:pset(PX,PY):draw s1$:call PaintBox
PX=320:pset(PX,PY):draw s2$:call PaintBox
PX=380:pset(PX,PY):draw s3$:call PaintBox
PY=360
PX=32*4:pset(PX,PY):draw s4$:call PaintBox
PX=32*6:pset(PX,PY):draw s5$:call PaintBox
PX=32*8:pset(PX,PY):draw s6$:call PaintBox
PX=32*10:pset(PX,PY):draw s7$:call PaintBox
PX=32*12:pset(PX,PY):draw s8$:call PaintBox
PX=32*14:pset(PX,PY):draw s9$:call PaintBox
PX=32*16:pset(PX,PY):draw s10$:call PaintBox
color 6
locate 26,1
print"                 Those shapes are used for the look-a-like"
print"                 OSCAR REUTERSVŽRD picture."
print"                 Can You find them all ?"
return

initialcolor:
  call NewPaletteUsing        '===>>>  PB  set AC (0-15) to (0-15)
  call SetColor(0,0,0,1)      'Draw color Black
  call SetColor(63,63,63,0)   'Background color White

  call SetColor(0,50,0,16)    'DAC (16) color Green
  for i=2 to 5                '4 x paint-color for top >> Green
    call ChangeColor(16,i)    'color 2-5
  next i
  call SetColor(0,63,0,19)    'DAC (19) color Light green

  call SetColor(50,0,0,17)    'DAC (17) color Red
  for i=6 to 9                '4 x paint-color for left >> Red
    call ChangeColor(17,i)    'color 6-9
  next i
  call SetColor(63,0,0,20)    'DAC (20) color Light red

  call SetColor(0,0,50,18)    'DAC (18) color Blue
  for i=10 to 13              '4 x paint-color for right >> Blue
    call ChangeColor(18,i)    'color 10-13
  next i
  call SetColor(0,0,63,21)    'DAC (21) color Light blue
return

MakeColorslight:
  for i=2 to 5
    call ChangeColor(19,i)
  next i
  for i=6 to 9
    call ChangeColor(20,i)
  next i
  for i=10 to 13
    call ChangeColor(21,i)
  next i
return

simulation:
dt!=.2   ' try an other value
do
  locate 1,1
  print" Hit spacebar for stop.";
  print"            "
  do
    call ChangeColor(19,2)    '\
    call ChangeColor(20,6)    '|  Make the colors of the boxes 1 light
    call ChangeColor(21,10)   '/
    call ChangeColor(16,5)    '\
    call ChangeColor(17,9)    '|  Make the colors of the boxes 4 dark
    call ChangeColor(18,13)   '/
    t!=timer
    while timer<t!+dt!:wend
    call ChangeColor(19,3)    '\
    call ChangeColor(20,7)    '|  Make the colors of the boxes 2 light
    call ChangeColor(21,11)   '/
    call ChangeColor(16,2)    '\
    call ChangeColor(17,6)    '|  Make the colors of the boxes 1 dark
    call ChangeColor(18,10)   '/
    t!=timer
    while timer<t!+dt!:wend
    call ChangeColor(19,4)    '\
    call ChangeColor(20,8)    '|  Make the colors of the boxes 3 light
    call ChangeColor(21,12)   '/
    call ChangeColor(16,3)    '\
    call ChangeColor(17,7)    '|  Make the colors of the boxes 2 dark
    call ChangeColor(18,11)   '/
    t!=timer
    while timer<t!+dt!:wend
    call ChangeColor(19,5)    '\
    call ChangeColor(20,9)    '|  Make the colors of the boxes 4 light
    call ChangeColor(21,13)   '/
    call ChangeColor(16,4)    '\
    call ChangeColor(17,8)    '|  Make the colors of the boxes 3 dark
    call ChangeColor(18,12)   '/
    t!=timer
    while timer<t!+dt!:wend
  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

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 PaintBox
  shared PX,PY,i
  paint(PX,PY-3),2+i mod 4,1
  paint(PX-3,PY),6+i mod 4,1
  paint(PX+3,PY),10+i mod 4,1
end sub

sub NewPaletteUsing
  restore acdata
  dummy=inp(&H3DA)
  for attr=0 to 15
    out &H3C0,attr
    read col
    out &H3C0,col
  next attr
  out &H3C0,32
end sub

initdrawstrings:
'========================================================================
  s1$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s1$=s1$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s1$=s1$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s1$=s1$+"M-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"U="+VARPTR$(y3)+"
  s1$=s1$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s1$=s1$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s1$=s1$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
  s2$="C1BU="+VARPTR$(y2)+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s2$=s2$+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s2$=s2$+"D="+VARPTR$(y3)+"M-="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s2$=s2$+"M-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"U="+VARPTR$(y3)+"
  s2$=s2$+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s2$=s2$+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"BD="+VARPTR$(y2)
'===================
  s2$=s2$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s2$=s2$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
  s3$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s3$=s3$+"D="+VARPTR$(y3)+"M-="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s3$=s3$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s3$=s3$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s3$=s3$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s3$=s3$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s3$=s3$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
  s4$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s4$=s4$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s4$=s4$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s4$=s4$+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s4$=s4$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y3)+"
  s4$=s4$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s4$=s4$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s4$=s4$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y2)
'========================================================================
  s5$="C1BU="+VARPTR$(y2)+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s5$=s5$+"D="+VARPTR$(y2)+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s5$=s5$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s5$=s5$+"M-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"U="+VARPTR$(y3)+"
  s5$=s5$+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s5$=s5$+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"BD="+VARPTR$(y2)
'===================
  s5$=s5$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s5$=s5$+"NM+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"ND="+VARPTR$(y3)
'========================================================================
  s6$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s6$=s6$+"D="+VARPTR$(y3)+"M-="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s6$=s6$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s6$=s6$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s6$=s6$+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s6$=s6$+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"BD="+VARPTR$(y3)
'===================
  s6$=s6$+"NM-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s6$=s6$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
  s7$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s7$=s7$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s7$=s7$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s7$=s7$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s7$=s7$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s7$=s7$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s7$=s7$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s7$=s7$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
  s8$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s8$=s8$+"D="+VARPTR$(y3)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s8$=s8$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s8$=s8$+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s8$=s8$+"M-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s8$=s8$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s8$=s8$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s8$=s8$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y2)
'========================================================================
  s9$="C1BU="+VARPTR$(y3)+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s9$=s9$+"D="+VARPTR$(y2)+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s9$=s9$+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s9$=s9$+"D="+VARPTR$(y2)+"M-="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s9$=s9$+"M-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"U="+VARPTR$(y3)+"
  s9$=s9$+"M+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"BD="+VARPTR$(y3)
'===================
  s9$=s9$+"NM-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"
  s9$=s9$+"NM+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"ND="+VARPTR$(y3)
'========================================================================
  s10$="C1BU="+VARPTR$(y2)+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s10$=s10$+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"
  s10$=s10$+"D="+VARPTR$(y3)+"M-="+VARPTR$(x2)+",+="+VARPTR$(y2)+"
  s10$=s10$+"M-="+VARPTR$(x2)+",-="+VARPTR$(y2)+"U="+VARPTR$(y2)+"
  s10$=s10$+"M+="+VARPTR$(x1)+",-="+VARPTR$(y1)+"U="+VARPTR$(y2)+"
  s10$=s10$+"M+="+VARPTR$(x1)+",+="+VARPTR$(y1)+"BD="+VARPTR$(y2)
'===================
  s10$=s10$+"NM-="+VARPTR$(x1)+",-="+VARPTR$(y1)+"
  s10$=s10$+"NM+="+VARPTR$(x2)+",-="+VARPTR$(y2)+"ND="+VARPTR$(y3)
'========================================================================
return

acdata:
data 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15