'
'      Merry Christmas Coded By Shockwave (C) 2002.
'      ============================================
'       A Festive Demo To Celebrate Christmas 2002
'=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

gosub set
repeat
gosub buf
gosub blizzard
gosub scrl
gosub front
ro=ro+1
if ro>360 ro=0
go=go+1
if go>360 go=0
bo=bo+1
if bo>360 bo=0

until (1=2)

label scrl
yp=256+(rt(ro)/2)
setrgb 1,0,0,0
text scx,yp,mid$(s$,p,67)
setrgb 1,255,255,255
text scx+2,yp+2,mid$(s$,p,67)

scx=scx-1
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$) p=0
fi
return


label buf
setdrawbuf dw
dw=1-dw
setdispbuf dw
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
'                   Night Sky Background
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
   setrgb 1,10,0,25
   setrgb 2,10,0,25
   setrgb 3,40,40,155
   gtriangle 0,0 to 640,0 to 640,512
   setrgb 2,100,100,255
   gtriangle 0,0 to 0,512 to 640,512

'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
'                      Snowdrifts;
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
res=40
rx=200
ry=140
cy=450
setrgb 1,150,150,150
setrgb 2,90,90,250
setrgb 3,90,90,250

for l=0 to 640 step 150
 cx=l
 cy=cy+50
 rx=rx+30
 ry=ry+30

 gosub fillsphere 
next l

res=40
rx=200
ry=140
cy=700
setrgb 1,250,250,250
setrgb 2,130,130,250
setrgb 3,130,130,250

for l=0 to 640 step 150
 cx=l
 cy=cy-10
 rx=rx+30
 ry=ry+30

 gosub fillsphere 
next l
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
'                          Snowman;
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
setrgb 1,250,250,250
setrgb 2,170,170,250
setrgb 3,170,170,250

cx=450
cy=410
rx=50
ry=80
gosub fillsphere
cy=300
rx=30
ry=40
gosub fillsphere
setrgb 1,0,0,0
fill rect 430,280 to 435,285
fill rect 455,285 to 460,290
fill triangle 405,380 to 370,380 to 370,385
fill triangle 470,380 to 520,370 to 530,375
setrgb 1,255,100,0
fill triangle 440,300 to 445,310 to 400,315

return

label front
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO
'                    Window Foreground;
'oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOooO

setrgb 1,0,0,0
fill rect 316,0 to 324,512
fill rect 0,252 to 640,260

setrgb 1,70,70,70
fill rect 318,0 to 322,512
fill rect 0,254 to 640,258
setrgb 1,85,85,80
fill rect 0,0 to 30,512
fill rect 640,0 to 610,512
fill rect 0,0 to 640,30
fill rect 0,512 to 640,482
setrgb 1,0,0,0
rect 30,30 to 610,482

return

label blizzard
 setrgb 1,255,255,255
 for a=1 to snow
  fill rect snx(a),sny(a) to snx(a)+sns(a),sny(a)+sns(a)
  sny(a)=sny(a)+sns(a)
  snx(a)=snx(a)-1+ran(2)
  if sny(a)>640 then
    snx(a)=ran(640)
    sny(a)=-10
  fi
 next a
return

label set
p=0
scx=0
s$="                                                                   "
s$=s$+"NADOLEG LLAWEN AS WE SAY IN WALES... OR HAVE A "
s$=s$+"HAPPY CHRISTMAS.   THIS IS JUST A LITTLE ONE TO "
s$=s$+"SAY SEASONS GREETINGS TO ALL THE FRIENDS I HAVE "
s$=s$+"MADE ON THE YABASIC FORUMS AND TO WISH YOU ALL "
s$=s$+"A HAPPY AND PROSPEROUS NEW YEAR!!!   YOU KNOW "
s$=s$+"WHO YOU ALL ARE, BUT ESPECIALLY THESE PEOPLE; "
s$=s$+"    JIM, PARABELLUM, XALTHORN, DEMONEYE, DOCTOR, "
s$=s$+"JO, SNAKEDOGG, TRICKY, FRYER, KYATA, CK0, TAPPI, "
s$=s$+"JINX, ZINGY, PYRO, LOOPY, JACOB, AZ, CONSIDER "
s$=s$+"YOURSELVES ON MY CHRISTMAS CARD LIST :O)   "
s$=s$+"HAVE A GREAT TIME....    BYE!!!  "


open window 640,512
snow=80
dim snx(snow),sny(snow),sns(snow)
dim rt(720),bt(720),gt(720)
for a=1 to 720
 rt(a)=255*sin(a*pi/180)
 gt(a)=255*sin((a*2)*pi/180)
 bt(a)=255*sin((a*3)*pi/180)
next a

for a=1 to snow
 snx(a)=ran(640)
 sny(a)=ran(512)
 sns(a)=ran(4)
next a
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                    Circles Setup Code;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 dim sn(720),cs(720):rem                     Lookup tables
 for a=1 to 720
  sn(a)=sin(a*pi/180):rem                   Calculate Sine
  cs(a)=cos(a*pi/180):rem                 Calculate Cosine
 next a
return

label fillsphere
 for ca=1 to 360 step res
 gtriangle cx,cy to cx+rx*sn(ca),cy+ry*cs(ca) to cx+rx*sn(ca+res),cy+ry*cs(ca+res)
 next ca
return



