' Fanatix Demonstration.
' Programmed in Yabasic august 2001.
' By Nick Simpson. (E-Mail- Nicksimpson007@aol.com)
' If you rip stuff without crediting me then you are
' truly lame.... Enjoy the demo.. Nuff zed..
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'## Open graphics screen + Set variables.

    open window 400,400
    dr=0 : Rem used for double buffering.
    xx=0 : Rem flag for (X) button.
     p=0 : Rem scroll text pointer.
   scx=0 : Rem left of scroll position for scrolling. 
lxo=340
lyo=60
   poll=18

   dim logx(poll*3)
   dim logy(poll*3)
for a=1 to poll*3
   read logx(a),logy(a)
logx(a)=logx(a)*2
next a


  t$=""  : Rem Scroll Text.
  t$=t$+"                                                                      "
'*********************************************************
  t$=t$+"This little Fanatix intro is called seeing "
  t$=t$+"stars.... Can you guess why?!?!?   It was  "
  t$=t$+"designed and programmed by Nick Simpson AkA "
  t$=t$+"Shockwave of Fanatix...   Check out some of my "
  t$=t$+"other programs at www.yabasic.co.uk, and also "
  t$=t$+"in the forums section.... If you want to "
  t$=t$+"contact me (legal only) to chat about Yabasic "
  t$=t$+"programming my Email address is : "
  t$=t$+"NICKSIMPSON007@aol.com    If you know of a way "
  t$=t$+"to change the dimensions of this GFX font I "
  t$=t$+"will be especially interested in hearing from "
  t$=t$+"you......  Also as a final note to SONY.... "
  t$=t$+"Cheers for a great machine. How about expanding "
  t$=t$+"Yabasic into something more powerfull??? "
  t$=t$+"Cheers for reading... Bye bye...       "
dp=0
qz=255
a$=""
a$=a$+" FANATIX PROUDLY PRESENT A NEW INTRO "
a$=a$+"      S E E I N G    S T A R S !     "
a$=a$+"        PROGRAMMED  IN YABASIC       "
a$=a$+"   DESIGN AND CODE BY NICK SIMPSON   "
a$=a$+"    EMAIL: NICKSIMPSON007@AOL.COM    "


nstar=24
zm=0
xm=1
ym=1
dim os(nstar)
dim x(nstar)
dim y(nstar)
dim z(nstar)
dw=1

'##
'## Set Star positions..
'##
mmm=1
for a=1 to nstar
  x(a)=-25+ran(50)
  y(a)=-25+ran(50)
  z(a)=mmm
mmm=mmm+100/nstar
next a

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'       Main Loop..  Call Subroutines one by one.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
for loop=1 to 2
setdrawbuf 1-dr
clear window
  gosub funkycolours

setrgb 1,30,30,130
zzz=4+1*cos(ainc/100)
a=1

for b=1 to 18
 fill triangle zzz*logx(a)+lxo,zzz*logy(a)+lyo to zzz*logx(a+1)+lxo,zzz*logy(a+1)+lyo to zzz*logx(a+2)+lxo,zzz*logy(a+2)+lyo
 a=a+3
next b

  gosub dispstars
  gosub scroll
setrgb 1,rdsin+20,50,50
text 215,505,"A FANATIX DEMO (C) 2001"

  loop=1
  isx()
  if xx=1 loop=2
setdispbuf dr
dr=1-dr
next loop


'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                        Subroutines.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'*********************************************************
'## Draw stars

label dispstars
mm=mm+.1
sx=.8*sin(mm/15)
sy=.8*sin(mm/19)
sz=1.2*sin(mm/13)
for a=1 to nstar
qt=200-z(a)*2
setrgb 1,qt+30,qt+30,qt+30
xx=x(a)*25
yy=y(a)*25
xx=xx/z(a)*25
yy=yy/z(a)*25
   xx=xx+320
   yy=yy+250
zz=9-z(a)/14
os(a)=zz+4
     fill rectangle xx,yy to xx+zz,yy+zz
z(a)=z(a)+sz

x(a)=x(a)+sx
y(a)=y(a)+sy
if y(a)<-25 y(a)=y(a)+50
if y(a)>25 y(a)=y(a)-50
if x(a)<-25 x(a)=x(a)+50
if x(a)>25 x(a)=x(a)-50
if z(a)<1 z(a)=z(a)+100
if z(a)>100 z(a)=z(a)-100
next a

qz=qz-1
if qz<=20 dp=dp+37 : if dp>len(a$) dp=0
if qz<=20 qz=255
setrgb 1,qz,qz,qz
text 139,254,MID$(a$,dp+1,37)
return


'*********************************************************
'## Scrolltext routine.
'
label scroll
setrgb 1,0,0,100
fill triangle 0,466 to 650,466 to 650,486
fill triangle 0,466 to 0,486 to 650,486

 setrgb 1,0,0,0
 text scx+2,482,mid$(t$,p,66)
setrgb 1,255,255,255
 text scx,480,mid$(t$,p,66)
 scx=scx-2
 if scx<-9 p=p+1
 if p>len(t$) p=0
 if scx<-9 scx=0
return

'*********************************************************
'## Nice Cycling background colours.
'##
label funkycolours
  ainc=ainc+3
  xstrch=160+160*sin(ainc/142)
  rdsin=60+30*sin(ainc/40)
  grsin=60+30*sin(ainc/60)
  blsin=60+30*sin(ainc/90)
   setrgb 1,0,0,blsin
   setrgb 2,0,grsin,0
   setrgb 3,rdsin,0,0
  gtriangle 0-xstrch,0 to 660+xstrch,0 to 0-xstrch,540
  gtriangle 660+xstrch,540 to 660+xstrch,0 to 0-xstrch,540
return


'*********************************************************
'## Is X Being Pressed?  ##
'## True Returns 1 in xx ##
sub isx() 
     xx=0
     if and(peek("port1"), 16384) <>0 then xx=1
     fi
end sub
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Fanatix Logo... Designed By Nick!!

data -39,-9,-25,-15,-24,-8
data -31,-15,-35,15,-28,15
data -38,0,-27,-4,-26,5
data -25,15,-20,-15,-21,18
data -21,-15,-15,15,-18,15
data -25,3,-18,-4,-16,4
data -15,14,-13,-14,-13,17
data -16,-14,-9,15,-5,18
data -11,-7,-8,-10,-6,19
data -3,-12,-5,15,-3,18
data -6,-13,5,15,2,16
data -6,3,-5,-2,4,4
data -2,-10,0,-6,15,-12
data 6,17,10,15,3,-13
data 12,15,20,15,15,-4
data 15,-4,17,-7,10,-8
data 15,-11,35,15,27,13
data 35,-15,29,-13,21,19



