'+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
'+       'Oh sack the name...' by Gareth Bailey          +
'+                    September 2002                     +
'+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

open window 640,512
col=3:sprx=6      REM - SETUP VARIABLES AND ARRAYS FOR 
spry=10:fr=4      REM - LEMMINGS
dim sprit(6,10,4),cr(col),cg(col),cb(col)
for c=1 to 4                   
  for b=1 to 10:for a=1 to 6   
   read sprit(a,b,c)  REM - READ LEMMING DATA
  next a:next b
next c

for a=1 to 3              
  read cr(a),cg(a),cb(a)  REM - READ LEMMING COLOURS
next a

for a=1 to 2
 for b=1 to 5
  col=((b/5)*255)     
  setrgb 1,col,col,col 
  text 180+b,255+b,"Jinx (and a lemming) presents..."
  text 150+b,270+b,"...oh sack the name! watch the demo:)"
 next b
gosub db
next a

setrgb 1,0,0,0
for i=1 to 640             REM - WALK THE LEMMING ACCROSS 
fill rect 0,400 to 640,440 REM - THE SCREEN AND CHANGE
   frm=frm+0.2             REM - ANIMATION FRAME
   if frm>5 frm=1
   drawsprite(i,400,3,frm)
 gosub db
setrgb 1,0,0,0
next i
gosub setup

for c=1 to 2
clear window
 for b=1 TO 20 step 2
   for a=1 to tri*3 step 3    REM - PRE-DRAW THE LOGO
    col=((b/10)*100)          REM - TO EACH BUFFER
    setrgb 1,col,col,col
    fill triangle lx(a)+b,ly(a)+b to lx(a+1)+b,ly(a+1)+b to lx(a+2)+b,ly(a+2)+b
   next a
 next b
gosub db
next c

label loop
  setrgb 1,150,150,150:fill rect 0,400 to 640,512
  fill rect 0,0 to 12,12
  gosub drawcube        REM - #MAIN LOOP#
  gosub drawtext        REM - ALL SUB CALLS ARE HERE
  gosub graph
  gosub rotate
  gosub db
goto loop

label drawcube
setrgb 1,75,75,75
fill rect 230,10 to 610,390   REM - THIS ROUTINE DRAWS
for j=1 to 2                  REM - THE CUBE
  for i=1 to 6
    c1=c1(i):c2=c2(i)
    c3=c3(i):c4=c4(i)
    if j=1 if cp(i,xr)>0 goto skip
    if j=2 if cp(i,xr)<0 or i=5 goto skip
    col=(150-dx(c1)+150-dx(c2))/2
    setrgb 1,col*.65,col*.80,col*.90
    fill triangle xx(c1),yy(c1) to xx(c2),yy(c2) to xx(c3),yy(c3)
    fill triangle xx(c1),yy(c1) to xx(c2),yy(c2) to xx(c4),yy(c4)
    if c1=1 and c2=6 and j=1 gosub fillface 
    label skip
  next i
next j
setrgb 1,150-gc,150-gc,150-gc   
REM -  CLEAR THE CUBE AREA AND ADD THE 'START SQUARE'
if sx<380 then:sx=sx+1:fill rect 230,10 to 610-sx,390:fi
rect 230,10 to 610,390
return

label fillface
for b=0 to sprx                REM - THIS FILLS THE FACE
  for a=0 to sprx              REM - USEING PRE-CALCULATED
    if sprite(a,b)>0 then      REM - POINTS
     red=cr(sprite(a,b))*col
     green=cg(sprite(a,b))*col
     blue=cb(sprite(a,b))*col
      setrgb 1,red,green,blue
      fill triangle gx(a,b,xr),gy(a,b,xr) to gx(a+1,b,xr),gy(a+1,b,xr) to gx(a,b+1,xr),gy(a,b+1,xr)
      fill triangle gx(a+1,b+1,xr),gy(a+1,b+1,xr) to gx(a+1,b,xr),gy(a+1,b,xr) to gx(a,b+1,xr),gy(a,b+1,xr)
    fi
  next a
next b
return

label rotate
xr=xr+1:if xr>360 xr=xr-360   REM - INCREASE ANGLE AND
                              REM - CHECK FOR BOUNDRY
for a=1 to points
x1=x(a)
 y1=y(a)
 z1=z(a)                      REM - ROTATE THE CUBE
 xx=x1
 yy=y1*cosi(xr)+z1*sine(xr)
 zz=z1*cosi(xr)-y1*sine(xr)
 y1=yy
 x1=xx*cosi(xr)-zz*sine(xr)
 z1=xx*sine(xr)+zz*cosi(xr)
 zz=z1
 xx=x1*cosi(xr)-y1*sine(xr)
 yy=x1*sine(xr)+y1*cosi(xr)
 dx(a)=xx
 xx(a)=0.8*((xx/((zz/focus)+1)))+420     REM - APPLY 
 yy(a)=0.8*((yy/((zz/focus)+1)))+200     REM - PERSPECTIVE
next a
return

label drawtext              REM - DRAW THE SCROL TEXT
tm=tm+1
if tm=7 then
  t=t+1
  tm=0
fi
if t>txtlen t=0: setrgb 1,150,150,150
setrgb 1,150-gc,150-gc,150-gc
text txtx,txty,textdraw$(t)
rect txtx-4,txty-15 to txtx+205,txty+5
orbit=orbit+3:IF orbit>360 orbit=1
orbitx(5,1)=(sine(orbit)*150)+txtx+100
orbity(5,1)=(cosi(orbit)*40)+txty-5
orbitx(5,2)=(cosi(orbit)*150)+txtx+100
orbity(5,2)=(sine(orbit)*40)+txty-5
for a=1 to 2
for b=1 to 4
col=150+((b/4)*150): setrgb 1,col,col/1.5,0
fill rectangle orbitx(b,a),orbity(b,a) to orbitx(b,a)+10,orbity(b,a)+10
orbitx(b,a)=orbitx(b+1,a)
orbity(b,a)=orbity(b+1,a)
next b:next a
return

label graph                 REM - DRAW THE SINE CURVE
gc=gc+.5
for a=1 to 30
next a
setrgb 1,150-gc,150-gc,150-gc
 new curve
  for a=0 to pts
    line to sgx(a),sgy(a)
     ang(a)=ang(a)-5
     if ang(a)<0 ang(a)=ang(a)+360
     sgy(a)=(sine(ang(a))*amp)+450
   next a
 line 50,450 to 50+wvln,450
 line 50,450-amp to 50,450+amp
 line 50+wvln,450-amp to 50+wvln,450+amp
return

sub drawsprite(x,y,size,c)       REM - LEMMING SPRITE 
for b=1 to spry:for a=1 to sprx  REM - ROUTINE
x1=(a*size):y1=(b*size)
if sprit(a,b,c)>0 then
setrgb 1,cr(sprit(a,b,c)),cg(sprit(a,b,c)),cb(sprit(a,b,c))
fill rect x+x1,y+y1 to x+x1+size,y+y1+size
fi
next a:next b
end sub

label db                    REM - DOUBLE BUFFERING
setdispbuf draw             REM - FOR SMOOTH ANIMATION
draw =1-draw
setdrawbuf draw
return

label setup REM -==============STARTUP===================-
setrgb 0,150,150,150
col    =2   :sprx  =8         REM - SET UP ALL VARIABLES
tri    =12  :points=8         REM - AND GIVE INITIAL 
focus  =500 :pts   =10        REM - VALUES
amp    =30  :wvln  =150
txtshow=20  :txtlen=0
txtx   =320 :txty=450
spc=wvln/pts
REM - SET UP ARRAYS FOR USE
dim gx(sprx,sprx,361),gy(sprx,sprx,361),sprite(sprx,sprx)
dim cr(col),cg(col),cb(col),lx(tri*3),ly(tri*3)
dim x(points),y(points),z(points),xx(points),yy(points)
dim dx(points),cp(6,361),sine(361),cosi(361)
dim c1(6),c2(6),c3(6),c4(6),sgx(pts),sgy(pts),ang(pts)
dim orbitx(5,2),orbity(5,2)

for a=0 to 361
  cosi(a)=cos(a*(pi/180))        REM - PRECALCULATE 
  sine(a)=sin(a*(pi/180))        REM - SINE/COSINE
next

for a=1 to points                REM - READ POINTS FOR 
  read x(a)                      REM - THE CUBE
  read y(a)
  read z(a)
next a

for a=1 to 6                     REM - READ VERTEX 
  read c1(a),c2(a),c3(a),c4(a)   REM - CONECTION DATA
next a

for b=0 to sprx-1
  for a=0 to sprx-1              REM - READ DATA FOR 
    read sprite(a,b)             REM - THE FACE
  next a
next b

for a=1 to 2                     REM - READ FACE COLOURS
  read cr(a),cg(a),cb(a)        
next a

for ang=1 to 361                 REM - PRE-CACULATION
  gosub rotate
  for i=1 to 6 
    c1=c1(i):c2=c2(i)            REM - CALCULATE CROSS-
    c3=c3(i):c4=c4(i)            REM - PRODUCT
    cp(i,ang)=(xx(c1)-xx(c2))*(yy(c3)-yy(c2))-(xx(c3)-xx(c2))*(yy(c1)-yy(c2))
  next i
  
  c1=c1(6):c2=c2(6)
  c3=c3(6):c4=c4(6)
  ax2=(xx(c2)-xx(c3))/sprx       REM - CALCULATE THE GRID 
  ay2=(yy(c2)-yy(c3))/sprx       REM - TO PLACE THE FACE
  ax3=(xx(c4)-xx(c1))/sprx       REM - ONTO
  ay3=(yy(c4)-yy(c1))/sprx
  for a=0 to sprx
    ta3=(ax3*a)+xx(c1)
    tb3=(ay3*a)+yy(c1)
    ta2=(ax2*a)+xx(c3)
    tb2=(ay2*a)+yy(c3)
    tx=(ta3-ta2)/sprx
    ty=(tb3-tb2)/sprx
      for b=0 to sprx
        gx(a,b,ang)=(tx*b)+ta2   REM - STORE THE GRID
        gy(a,b,ang)=(ty*b)+tb2   REM - IN ARRAY
      next b
   next a
next ang

for a=1 to txtshow+5             REM - SCROL MSG
msg$=msg$+" "
next a
msg$=msg$+"Ok, here's the scroly message :o). First of "
msg$=msg$+"all thanks to shockwave for the competition, "
msg$=msg$+"great stuff! Hello's go to: Shockwave, "
msg$=msg$+"Parabellum, Xalthorn, Jimshaw (emulator is "
msg$=msg$+"great!),Jomorrow, rafryer, Demoneye, Snakedog"
msg$=msg$+", Tappi, Kyata, stel and every1 else on the "
msg$=msg$+"yabasic forums! looking forward to seeing all "
msg$=msg$+"of your demos!.---Sat @ a computer in college "
msg$=msg$+"now realised I have 4 lines to fill so here "
msg$=msg$+"they are! Big thanks again to shockwave and "
msg$=msg$+"the other helpfull people @ yabasic.co.uk :o) "
msg$=msg$+"300 lines exactly, better go and do some work!"
txtlen=len(msg$)

dim textdraw$(txtlen)                
for a=1 to txtlen                     REM - CALCULATE AND
  textdraw$(a)=mid$(msg$,a,txtshow)   REM - STORE STRINGS
next a

for a=0 to pts
  sgx(a)=(a*spc)+50                   REM - SETUP GRAPH
  ang(a)=a*(360/pts)
  if ang(a)>360 ang(a)=ang(a)-360
next a

for a=1 to tri*3                      REM - SETUP LOGO
  read lx(a),ly(a) 
next a
return

data 0,0,0,0,0,0,0,2,2,2,2,0,0,2,2,3,0,0,0,2,3,3,3,0,0,0,3
data 1,0,0,0,0,1,3,0,0,0,0,3,1,0,0,0,0,1,1,0,0,0,3,1,1,0,0
data 0,0,3,3,0,0,0,0,2,0,2,0,0,2,2,2,0,0,0,2,2,3,0,0,0,0,3
data 3,3,0,0,0,3,1,0,0,0,0,1,3,0,0,0,0,1,3,0,3,0,0,1,1,0,3
data 0,1,1,0,3,0,0,3,3,0,0,0,0,0,0,0,0,0,0,2,0,2,0,0,0,2,2
data 2,0,0,0,2,2,3,0,0,0,0,3,3,3,0,0,0,1,3,0,0,0,0,1,3,0,0
data 0,0,1,1,3,0,0,1,1,1,1,0,3,3,0,0,3,3,0,0,0,0,0,0,0,0,2
data 2,0,0,0,2,2,3,2,0,0,2,3,3,3,0,0,0,3,1,0,0,0,0,3,1,0,0
data 0,3,1,1,0,0,0,0,1,1,0,0,3,1,1,1,1,0,3,0,0,3,3,0
data 064,064,244,000,160,000,224,192,192
data 100, 100, 100,-100, 100, 100,-100, 100,-100
data 100, 100,-100, 100,-100, 100,-100,-100, 100
data -100,-100,-100, 100,-100,-100, 1,3,2,4,1,8,4,5
data 8,6,7,5,6,3,7,2,3,8,7,4,1,6,5,2,0,0,1,1,1,1,0,0
data 0,1,2,2,2,2,1,0,1,2,1,2,2,1,2,1,1,2,2,2,2,2,2,1
data 1,2,1,2,2,1,2,1,1,2,2,1,1,2,2,1,0,1,2,2,2,2,1,0
data 0,0,1,1,1,1,0,0,0.00,0.00,0.00,1.50,1.50,0.00
data 50,25,150,25,100,40,150,30,150,100,130,35
data 150,100,60,80,60,100,50,105,150,105,100,120
data 90,122,110,122,100,170,50,185,150,185,100,170
data 50,190,50,270,75,210,50,190,150,270,125,230
data 150,190,150,270,125,230,50,275,150,350,100,275
data 150,275,150,300,50,350,0,0,0,0,0,000