gosub initialise
gosub main
exit

label main
 repeat
  gosub flipscreen
  clear window
  gosub demopart
  gosub showmessage
 until (1=2)
return

label drawsky
 setrgb 1,0,0,0
 setrgb 2,0,0,255-world
 setrgb 3,0,0,255-world
 gtriangle -320,50 to -320,-260 to 320,-260
 setrgb 3,0,0,0
 gtriangle -320,50 to 320,-260 to 320,50
return

label rotdemo
 gosub drawsky
 gosub drawfloor
 gosub calcobjxy
 gosub drawobj
 gosub processscript
 timepos=timepos+1
return

label linedemo
 gosub drawsky
 gosub drawfloor
 gosub drawlines
return

label ribbondemo
 gosub drawsky
 gosub drawfloor
 gosub drawribbon
return

label balldemo
 gosub drawsky
 gosub drawfloor
 gosub drawballs
return

label demopart
 world=world+worldchange

 if world=255 then
  demopart=demopart+1
  if demopart>maxdemos demopart=1
  worldchange=-1
  demowait=demodelay
 fi

 if world=0 then
  worldchange=0
  if demowait>0 then
   demowait=demowait-1
  else
   worldchange=1
  fi
 fi

 on demopart gosub linedemo,ribbondemo,balldemo,rotdemo
return

label drawfloor
 y=20+offset
 repeat
  setrgb 1,0,y-20-world,0
  size=y/5
  fill rect -320,y to 320,y-size
  y=y+size
 until (y>320)
 offset=offset+0.3
 if offset>8.5 offset=0
return

label drawlines
 for lin=1 to numlines
  setrgb 1,lin-world,0,0
  pos=linepos(lin)
  x=linex(pos):y=liney(pos)
  ppos=pos+60
  if ppos>360 ppos=ppos-360
  xx=linex(ppos):yy=liney(ppos)
  line x,y to xx,yy
  pos=pos+3:if pos>360 pos=pos-360
  linepos(lin)=pos
 next lin
return

label drawribbon
 for rib=1 to numribs
  setrgb 1,rib-world,0,0
  pos=ribpos(rib)
  x=ribx(pos):y=riby(pos)
  fill rect x,y to x+10,y+10
  pos=pos+3:if pos>360 pos=pos-360
  ribpos(rib)=pos
 next rib
return

label drawballs
 setrgb 2,0,0,0
 setrgb 3,0,0,0
 r=20
 for ball=1 to numballs
  setrgb 1,255-world,0,0
  pos=ballpos(ball)
  x=ballx(pos):y=bally(pos)
  gosub drawball
  pos=pos+3:if pos>360 pos=pos-360
  ballpos(ball)=pos
 next ball
return

label drawball
 ang=0
 repeat
  xo1=cosines(ang)*r:yo1=sines(ang)*r
  xo2=cosines(ang+20)*r:yo2=sines(ang+20)*r
  gtriangle x,y to x+xo1,y+yo1 to x+xo2,y+yo2
  gtriangle x,y to x-xo1,y+yo1 to x-xo2,y+yo2
  gtriangle x,y to x-xo1,y-yo1 to x-xo2,y-yo2
  gtriangle x,y to x+xo1,y-yo1 to x+xo2,y-yo2
  ang=ang+20
 until (ang>90)
return

label flipscreen
 setdrawbuf cb
 cb=1-cb
 setdispbuf cb
return

label setup_message
 mx=10:mpos=0:m$=""
 for a=1 to 65:m$=m$+" ":next a
 m$=m$+"Hello, Xalthorn here, welcome to my latest "
 m$=m$+"demo titled 'Crammed'.  It's name comes from "
 m$=m$+"the fact that I've tried to cram in as many "
 m$=m$+"things as possible to maintain interest. "
 m$=m$+"The code size versus speed problem struck again "
 m$=m$+"though, so it's limited in what it can do. "
 m$=m$+"I was going to have multiple scrollers, "
 m$=m$+"one for each demo, but I figured saving text "
 m$=m$+"space for code was more important. "
 m$=m$+"Having said that, I hope you enjoy some of the "
 m$=m$+"graphical effects that exist in this demo. "
 m$=m$+"This demo, along with many others by myself and "
 m$=m$+"other Yabasic coders, can be found on the site "
 m$=m$+"www.ps2-yabasic.co.uk.    "
 m$=m$+"Finally some hello's to the bunch at the Yabasic "
 m$=m$+"forums, especially Doctor and Shockwave. "
return

label showmessage
 setrgb 1,0,0,0
 fill rect -320,230 to 320,260
 setrgb 1,255,255,255
 mx=mx-2
 if mx<=0 then 
  mx=mx+10:mpos=mpos+1
  if mpos>len(m$) then
   mpos=0
  fi
 fi
 text mx-330,250,mid$(m$,mpos,65)
return

label calcobjxy
for obj=1 to maxobj
 objx(obj)=objx(obj)+cosines(obj*objstep)*objradr(obj)
 objy(obj)=objy(obj)+sines(obj*objstep)*objradr(obj)
 x=objx(obj)*cosines(sang)+objy(obj)*sines(sang)
 y=objy(obj)*cosines(sang)-objx(obj)*sines(sang)
 objx(obj)=x:objy(obj)=y
next obj
return

label drawobj
 for obj=1 to maxobj
 tx(0)=objx(obj)+cx
 ty(0)=objy(obj)+cy
 objang=objr(obj)
 for a=1 to 3
  rx=px(a)-px(rotpnt)
  ry=py(a)-py(rotpnt)
  tx(a)=rx*cosines(objang)-ry*sines(objang)
  ty(a)=ry*cosines(objang)+rx*sines(objang)
  tx(a)=tx(a)+tx(0)
  ty(a)=ty(a)+ty(0)
 next a

 objr(obj)=objr(obj)+objrr(obj)
 if objr(obj)>360 objr(obj)=objr(obj)-360
 if objr(obj)<0 objr(obj)=objr(obj)+360

 setrgb 1,255-world,0,0
 setrgb 2,255-world,255-world,255-world
 setrgb 3,255-world,0,0
 gtriangle tx(1),ty(1) to tx(2),ty(2) to tx(3),ty(3)
next obj
return

label reset
 scriptpos=1:timepos=0
 cx=0:cy=0:sang=0:spinspeed=4
 movespeed=4:turnspeed=1:rotpnt=0
 for obj=1 to maxobj
  objrad(obj)=40:objradr(obj)=0
  objx(obj)=cosines(obj*objstep)*objrad(obj)
  objy(obj)=sines(obj*objstep)*objrad(obj)
  objr(obj)=obj*objstep+90
  objrr(obj)=0
  if objr(obj)>360 objr(obj)=objr(obj)-360
 next obj
return

label pointdata
data -20,-20,0,20,20,-20

label processscript
 repeat
 done=1
 if timepos=scriptt(scriptpos) then
  done=0
  obj=scripto(scriptpos)
  action=scripta(scriptpos)
  if obj<11 then
   if action=1 objrr(obj)=1
   if action=2 objrr(obj)=-1
   if action=3 objrr(obj)=0
   if action=4 objradr(obj)=1
   if action=5 objradr(obj)=-1
   if action=6 objradr(obj)=0
  else
   if action=1 sang=1
   if action=2 sang=359
   if action=3 sang=0
  fi
  scriptpos=scriptpos+1
 fi
 until (done=1)
 if scriptt(scriptpos)=-1 then
  gosub reset
 fi
return

label setupscript
 restore scriptdata
 read scriptlines
 dim scriptt(scriptlines)
 dim scripto(scriptlines)
 dim scripta(scriptlines)
 for a=1 to scriptlines
  read scriptt(a),scripto(a),scripta(a)
 next a
return

label scriptdata
data 125
data 100,100,1,100,1,2,100,2,2,100,3,2,100,4,2
data 100,5,2,100,6,2,100,7,2,100,8,2,100,9,2
data 100,10,2,200,100,2,200,1,1,200,2,1,200,3,1
data 200,4,1,200,5,1,200,6,1,200,7,1,200,8,1
data 200,9,1,200,10,1,300,100,3,300,1,3,300,2,3
data 300,3,3,300,4,3,300,5,3,300,6,3,300,7,3
data 300,8,3,300,9,3,300,10,3,400,1,4,410,2,4
data 420,3,4,430,4,4,440,5,4,450,6,4,460,7,4
data 470,8,4,480,9,4,490,10,4,500,1,6,510,2,6
data 520,3,6,530,4,6,540,5,6,550,6,6,560,7,6
data 570,8,6,580,9,6,590,10,6,600,1,1,610,2,1
data 620,3,1,630,4,1,640,5,1,650,6,1,660,7,1
data 670,8,1,680,9,1,690,10,1,800,1,2,810,2,2
data 820,3,2,830,4,2,840,5,2,850,6,2,860,7,2
data 870,8,2,880,9,2,890,10,2,1000,1,3,1010,2,3
data 1020,3,3,1030,4,3,1040,5,3,1050,6,3,1060,7,3
data 1070,8,3,1080,9,3,1090,10,3,1200,1,5,1210,2,5
data 1220,3,5,1230,4,5,1240,5,5,1250,6,5,1260,7,5
data 1270,8,5,1280,9,5,1290,10,5,1400,1,6,1410,2,6
data 1420,3,6,1430,4,6,1440,5,6,1450,6,6,1460,7,6
data 1470,8,6,1480,9,6,1490,10,6,1500,1,4,1510,2,4
data 1520,3,4,1530,4,4,1540,5,4,1550,6,4,1560,7,4
data 1570,8,4,1580,9,4,1590,10,4,1600,1,6,1610,2,6
data 1620,3,6,1630,4,6,1640,5,6,1650,6,6,1660,7,6
data 1670,8,6,1680,9,6,1690,10,6,1790,0,0,-1,0,0

label initialise
 open window 640,512
 window origin "cc"

 dim cosines(360),sines(360)
 for ang=0 to 360
  cosines(ang)=cos(ang*(pi/180))
  sines(ang)=sin(ang*(pi/180))
 next ang

 numballs=10
 dim ballx(360),bally(360),ballpos(numballs)
 for a=1 to numballs:ballpos(a)=a*10:next a

 numribs=150
 dim ribx(360),riby(360),ribpos(numribs)
 for a=1 to numribs:ribpos(a)=a:next a

 numlines=150
 dim linex(360),liney(360),linepos(numlines)
 for a=1 to numlines:linepos(a)=a:next a

 xa=0:ya=0
 for a=1 to 360
  linex(a)=cosines(xa)*100
  liney(a)=sines(ya)*100
  xa=xa+1:if xa>360 xa=xa-360
  ya=ya+2:if ya>360 ya=ya-360
 next a

 xa=0:ya=0
 for a=1 to 360
  ribx(a)=cosines(xa)*100
  riby(a)=sines(ya)*100
  xa=xa+3:if xa>360 xa=xa-360
  ya=ya+1:if ya>360 ya=ya-360
 next a

 xa=0:ya=0
 for a=1 to 360
  ballx(a)=cosines(xa)*100
  bally(a)=sines(ya)*100
  xa=xa+1:if xa>360 xa=xa-360
  ya=ya+2:if ya>360 ya=ya-360
 next a

 gosub setup_message

 demodelay=2000:demowait=demodelay
 demopart=1:maxdemos=4
 world=255:worldchange=-1

 dim px(3),py(3),tx(3),ty(3)
 restore pointdata
 for a=1 to 3:read px(a),py(a):next a

 maxobj=10
 objstep=360/maxobj
 dim objx(maxobj),objy(maxobj),objr(maxobj),objrr(maxobj)
 dim objrad(maxobj),objradr(maxobj)

 gosub setupscript
 gosub reset
return
