AppTitle "Snake360"

Const  bb=1024, hh=768, hz=50, sek=90, zahl=20, nr=6, gas#=3.5, ss% = bb/50, bn=bb-200
Global punkte=0, zeit=0, lang=12, takt, pfui, lecker, gross, klein

Type Snake; R Rachen  S Snake  T Tail
 Field x#,y#,xx#[nr],yy#[nr],nr,wi,gas#,big#
End Type

Type Blase
 Field x#,y#,f#
End Type


Graphics bb,hh,16,1
SetBuffer BackBuffer()

SeedRnd MilliSecs()
ms=CreateTimer(hz)

ClsColor 24,32,8

WINDOWS()
START()

While Not KeyHit(1) Or zeit > sek*hz

 takt=WaitTimer(ms)

 Cls

 For i=1 To takt

    FUMMELN()      

 Next

 SCHLANGE()
 BLASEN()
 REST()

 Flip

Wend

ENDE()

End






Function START()

 Local i%,j%,n%

 For i=1 To lang
   S.Snake = New Snake
   Insert S Before First Snake
   S\x     = bn/2
   S\y     = 2*hh/3
   S\gas = gas
   If i=1 Then S\big=1
 Next

 For n=0 To 1
 For i=1 To zahl
   B.Blase = New Blase
   j=1
   While j=1
      j=0
      For S.Snake = Each Snake
         If TREFF(S\x,B\x,S\y,B\y,ss) Then j=1
      Next
      B\x = Rand(ss/2,bn-ss/2)
      B\y = Rand(ss/2,hh-ss/2)
      If n=0 Then B\f=Rand(20,108) Else B\f=Rand(148,235)
   Wend
 Next
 Next

End Function





Function SCHLANGE()

 Local a#

 For S.Snake = Each Snake
   a=ss*S\big
   If S = Last Snake Then Color 248,0,0 Else Color 0,248,0
   If S\x > 0 Then Oval S\x-a/2,S\y-a/2,a,a
 Next

End Function





Function BLASEN()

 Local a#,g%

 For B.Blase = Each Blase

   If B\f < 128 Then g=10 Else g=0
   a=2*ss*B\f/255+g

   If B\f < 128 Then Color 0,B\f  ,248 Else Color B\f,128-B\f/2,0
   Oval B\x  -a/2,B\y  -a/2,a  ,a
   If B\f < 128 Then Color 0,B\f/2,248 Else Color B\f, 32-B\f/8,0
   Oval B\x+4-a/2,B\y+4-a/2,a-8,a-8
   If B\f < 128 Then Color 248,192,128 Else Color 128,  192  ,248
   Oval B\x  -a/2,B\y  -a/2,a  ,a,0

   If B\f > 128 Then Color 248,248,0:   Text B\x,B\y,WERT(B\f/50),1,1

 Next

End Function




Function REST()

 Local r#=4*sek-4*zeit/hz, i%, j%, bm=(bb+bn)/2

 Color 16,16,0
            Rect bn  , 1    ,200   ,hh,1

 SetFont gross

 Color 0,248,0
 For i=-1 To 1
 For j=-1 To 1
            Text bm+i,hh-300-r+j,"Snake",1,0
            Text bm+i,hh-240-r+j,"360"  ,1,0
 Next
 Next

 Color 248,0,0
            Text bm  ,hh-300-r  ,"Snake",1,0
            Text bm  ,hh-240-r  ,"360"  ,1,0

 Color 8,8,0
            Rect bn+2,r         ,196, 130,1

 Color 248,248,0
            Text bm  ,r         ,punkte ,1,0


 SetFont klein   

 Color 128,128,0
            Rect bn  ,0      ,200, hh ,0
            Rect bn+2,r      ,196, 130,0

 Color 248,248,0
            Text bm  ,hh-6*ss,"Steuerung:",1,1
            Text bm  ,hh-4*ss,"Maus",1,1
            Text bm  ,hh-3*ss,"und/oder",1,1
            Text bm  ,hh-2*ss,"Cursor",1,1

 Color 0,0,248
 If r < 4 Then   Text bm  ,2*hh/5 ,"Schnappschuss: F12",1,1
            Text bb-18,hh-12 ,"-jc-",1,1

 Color 248,0,0
            Text bm  ,r+ 80  ,lang + " Segmente",1,0
 If r > 4 Then   Text bm  ,r+100  ,"noch " + Int(r/4) + " Sekunden",1,0

End Function





Function FUMMELN()

 Local i%, j%, a$

 zeit=zeit+1

 R.Snake = Last Snake

 Select 1
   Case MouseDown(1) And KeyDown(203):   R\wi=R\wi-6: If R\wi> 180 Then R\wi=R\wi-360
   Case MouseDown(1) Or  KeyDown(203):   R\wi=R\wi-4: If R\wi> 180 Then R\wi=R\wi-360
   Case MouseDown(2) And KeyDown(205):   R\wi=R\wi+6: If R\wi> 180 Then R\wi=R\wi+360
   Case MouseDown(2) Or  KeyDown(205):   R\wi=R\wi+4: If R\wi> 180 Then R\wi=R\wi+360
 End Select

 R\x=R\x+R\gas*Sin(R\wi)
 R\y=R\y-R\gas*Cos(R\wi)

 For B.Blase = Each Blase

   If B\f<128 Then
      If B\f>108 Or B\f<  1 Then B\f=108
      B\f=B\f-.1
   Else
      If B\f<148 Or B\f>255 Then B\f=148
      B\f=B\f+.1
   EndIf

   If TREFF(R\x,B\x,R\y,B\y,1.5*ss) Then

      If B\f<128 Then   punkte=punkte-1 Else punkte=punkte+WERT(B\f/50)
;      If B\f<128 Then   a=pfui: punkte=punkte-1 Else a=lecker: punkte=punkte+WERT(B\f/50)
;      SoundVolume a, .2 + B\f/320: PlaySound a

      STRECK()

      j=1
      While j=1
         j=0
         For S.Snake = Each Snake
            If TREFF(S\x,B\x,S\y,B\y,2*ss) Then j=1
         Next
         B\x=Rand(ss,bn-ss)
         B\y=Rand(ss,hh-ss)
         If B\f < 128 Then B\f = 55 Else B\f = 190
      Wend

   End If

 Next

 R\nr=R\nr+1
 j   =R\nr

 For S.Snake = Each Snake

   If S\big < 1 Then S\big = S\big+0.03 Else S\big=1

   If j >= nr Then
      S\nr=0
      T.Snake = After S
      If T<>Null Then
         For i=0 To nr
            S\xx[i]=T\xx[i]
            S\yy[i]=T\yy[i]
         Next
      End If
   End If

   If S = Last Snake Then S\xx[j]=S\x : S\yy[j]=S\y Else S\x=S\xx[j] : S\y=S\yy[j]

   If S<>R If TREFF(S\x,R\x,S\y,R\y,ss-2) Then BUMM()

 Next

 If R\x < -ss Or R\x > bn+ss Or R\y < -ss Or R\y > hh+ss Then BUMM()

End Function





Function STRECK()

 S.Snake = First Snake
 T.Snake = New   Snake
 Insert T Before S
   lang=lang+1
   T\big=0
   For i=0 To nr
      T\xx[i]=S\xx[i]
      T\yy[i]=S\yy[i]
   Next

End Function





Function WERT(a)

 Select Int(a)
   Case 5:   p = 10
   Case 4:   p =  6
   Default:p =  3
 End Select

 Return p

End Function





Function TREFF(a,b,c,d,e)

 Return Sqr( (a-b)^2 + (c-d)^2 ) < e

End Function





Function BUMM()

; SoundVolume pfui,1
; PlaySound pfui
 punkte = punkte-1

End Function




Function ENDE()

 While Not KeyHit(1)
   Cls
   SCHLANGE()
   BLASEN()
   REST()
   Flip
   If KeyDown(88) Then FlushKeys: SaveBuffer(BackBuffer(),"schnapp.bmp")
 Wend

End Function





Function WINDOWS()

 Local win$= SystemProperty$("WINDOWSDIR")

; pfui   = LoadSound(win$ +"\media\IR_BEGIN.WAV")
; lecker= LoadSound(win$ +"\media\IR_END.WAV")

 klein   = LoadFont("arial", 18, 1)
 gross   = LoadFont("arial", 72, 1)

End Function