Sorry your browser is not supported!

file$ = "C:\BlueJ\examples\shapes\README.TXT"
open to read 1, file$

print wordCount(1,1)

close file 1
suspend for key
end


REM nFile = file number to scan
REM r = what data to return from file:
REM 1 = word count
REM 2 = character count with spaces
REM 3 = character count without spaces
function wordCount(nFile, r)
   rem only counts words with more than this many characters
   minChars = 1
   wCount = 0
   charCount = 0
   spaces = 0
   while file end(nFile) = 0
      read string nFile, s$
      charCount = charCount + len(s$)
      start = 1
      for i=1 to len(s$)
         if mid$(s$, i) = " "
            inc spaces
            if i-start > minChars then inc wCount
            start = i
         endif
      next i
      rem end of line word check check
      if i-start > minChars then inc wCount
   endwhile
   charCountNoSpaces = charcount-spaces
   if r = 1 then exitfunction wCount
   if r = 2 then exitfunction charCount
   if r = 3 then exitfunction charCountNoSpaces
endfunction -1

sync on
set display mode 400,300,16

rem If you want you can put window mode on
`set window on

dim wordlenth(1000000)
dim word$(10)

maxfiletypes=2
dim filetypes$(2)
dim file$(1)
filetypes$(1)="txt"
filetypes$(2)="dat"

directory$="C:documents and settingsabcmy documents"

do

   if filename$="" then directory$="C:documents and settingsabcmy documents" else directory$=parentfolder$(filename$)
   filename$=fileaccess(directory$,maxfiletypes)

   words=0
   undim wordlenth(1000000)
   undim word$(10)
   dim wordlenth(1000000)
   dim word$(10)
   word$=""
   bytesscanes=0

   open to read 1,filename$

   while file end(1)=0

      cls

      word$=""
      wordlenth=0

      repeat

         read byte 1,chrASCII

      until letter(chrASCII)=1 or file end(1)=1

      if file end(1)=1 then exit

      repeat

         wordlenth=wordlenth+1
         word$=word$+chr$(chrASCII)
         read byte 1,chrASCII

      until letter(chrASCII)=0 or file end(1)=1

      if file end(1)=1 then exit

      words=words+1

      for i=1 to 9
         word$(i)=word$(i+1)
      next i

      word$(10)=word$

      wordlenth(words)=wordlenth

      maxlenth=0
      minlenth=0
      totallenth=0
      for i=1 to words
         if wordlenth(i)>maxlenth then maxlenth=wordlenth(i)
         totallenth=totallenth+wordlenth(i)
      next i
      minlenth=maxlenth
      for i=1 to words
         if wordlenth(i)<minlenth then minlenth=wordlenth(i)
      next i
      avglenth=totallenth/words

      for i=1 to 10
         ink rgb(i*25,i*25,255),0
         text 300-text width(word$(i)),i*15-15,word$(i)
      next i

      ink rgb(0,0,255),0
      text 0,0,"words so far: "
      text 0,15,"Maximum lenth so far: "
      text 0,30,"Minimum lenth so far: "
      text 0,45,"Average lenth so far: "

      ink rgb(255,255,255),0
      text 180-text width(str$(avglenth)),45,str$(avglenth)
      text 180-text width(str$(minlenth)),30,str$(minlenth)
      text 180-text width(str$(maxlenth)),15,str$(maxlenth)
      text 180-text width(str$(words)),0,str$(words)

      sync

   endwhile

   close file 1

   cls

   maxlenth=0
   minlenth=0
   totallenth=0
   for i=1 to words
      if wordlenth(i)>maxlenth then maxlenth=wordlenth(i)
      totallenth=totallenth+wordlenth(i)
   next i
   minlenth=maxlenth
   for i=1 to words
      if wordlenth(i)<minlenth then minlenth=wordlenth(i)
   next i
   if words>0 then avglenth=totallenth/words

   ink rgb(0,0,255),0
   text 0,0,"words: "
   text 0,15,"Maximum lenth: "
   text 0,30,"Minimum lenth: "
   text 0,45,"Average lenth: "
   text 0,60,"Press space to scan another..."

   ink rgb(255,255,255),0
   text 180-text width(str$(avglenth)),45,str$(avglenth)
   text 180-text width(str$(minlenth)),30,str$(minlenth)
   text 180-text width(str$(maxlenth)),15,str$(maxlenth)
   text 180-text width(str$(words)),0,str$(words)

   suspend for key

loop

function letter(ASCII)
letter=0
if ASCII>=65 and ASCII<=90 or ASCII>=97 and ASCII<=122 or ASCII>=176 and ASCII<=255 then letter=1
endfunction letter

function fileaccess(directory$,maxfiletypes)

   x=90
   y=50

   filename$=""

   while filename$=""

      decision=0

      set dir directory$
      perform checklist for files
      nooffiles=checklist quantity()
      undim file$(1)
      dim file$(nooffiles)
      sort1=1
      for i=1 to nooffiles
         temp$=checklist string$(i)
         if getfiletype$(temp$)=temp$
            file$(sort1)="[+]"+temp$
            sort1=sort1+1
         endif
      next i
      for i=1 to nooffiles
         for j=1 to maxfiletypes
            temp$=checklist string$(i)
            if getfiletype$(temp$)=filetypes$(j)
               file$(sort1)="[T]"+checklist string$(i)
               sort1=sort1+1
            endif
         next i
      next i
      for i=1 to nooffiles
         if (getfiletype$(checklist string$(i))=checklist string$(i))=0
            for j=1 to maxfiletypes
               if getfiletype$(checklist string$(i))=filetypes$(j) then goto Endfilesort
            next i
            file$(sort1)="[X]"+checklist string$(i)
            sort1=sort1+1
         endif
         Endfilesort:
      next i

      file=1
      list=1
      select=1

      while decision=0

         cls

         file=list+select-1

         if upkey()=1 and file>1
            if upK=0
               upK=1
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
               Ucount=40
            endif
            Ucount=Ucount-1
            if Ucount<0
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
               Ucount=2
            endif
         else
            upK=0
         endif

         if downkey()=1 and file<nooffiles
            if dnK=0
               dnK=1
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
               Dcount=40
            endif
            Dcount=Dcount-1
            if Dcount<0
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
               Dcount=2
            endif
         else
            dnK=0
         endif

         if mousemovez()>oldmousemovez and file>1
            file=file-1
            if select=1 and list>1 then list=list-1
            if select>1 then select=select-1
            oldmousemovez=mousemovez()
         endif

         if mousemovez()<oldmousemovez and file<nooffiles
            file=file+1
            if select=10 and list<nooffiles then list=list+1
            if select<10 then select=select+1
            oldmousemovez=mousemovez()
         endif

         if returnkey()=1 and decisionmadetime<1 then decision=2

         if mouseclick()=1
            if mousex()>x-1 and mousey()>y+166 and mousex()<x+108 and mousey()<y+186 and decisionmadetime<1 then decision=1
            if mousex()>x+108 and mousey()>y+166 and mousex()<x+215 and mousey()<y+186 and decisionmadetime<1 then decision=2
            for i=1 to 10
               if mousex()>x and mousey()>i*15+y and mousex()<200+x and mousey()<(i+1)*15+y
                  if doubleclickcount>0 and mouseclick=0 then decision=2
                  doubleclickcount=20
                  file=list+i-1
                  select=i
               endif
            next i
            if mousex()>x+203 and mousey()>y+16+sliderpos# and mousex()<x+213 and mousey()<y+16+sliderpos#+slidersize# and nooffiles>19
               sliderhold=1
            endif
            if mousex()>x+204 and mousey()>y+2 and mousex()<x+212 and mousey()<y+12 and file>1
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
            endif
            if mousex()>x+204 and mousey()>y+153 and mousex()<x+212 and mousey()<y+163 and file<nooffiles
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
            endif
            if mousex()>x+201 and mousey()>y+14 and  mousex()<x+215 and mousey()<y+150 and blankclick<1 and nooffiles>10
               if mousey()<y+16+sliderpos#
                  if list>10
                     file=file-10
                     list=list-10
                     blankclick=10
                  else
                     if list=1
                        select=1
                     endif
                     list=1
                     file=1
                     blankclick=10
                  endif
                  tslider=0
               endif
               if mousey()>y+16+sliderpos#+slidersize#
                  if list<nooffiles-10
                     file=file+10
                     list=list+10
                     if list>nooffiles-9 then list=nooffiles-9
                     blankclick=10
                  else
                     list=nooffiles-9
                     file=nooffiles
                     select=10
                     blankclick=10
                  endif
                  bslider=0
               endif
            endif
         endif
         blankclick=blankclick-1
         doubleclickcount=doubleclickcount-1

         if mouseclick()=1 then mouseclick=1 else mouseclick=0
         if mouseclick()<>1 then sliderhold=0
         if sliderhold=1
               mosy1#=mousey()-(y+16)
               listsize#=(nooffiles-10)
               temp#=mosy1#/122
               listr#=temp#*listsize#
               list=listr#
               if list<1 then list=1
               if list>nooffiles-10 then list=nooffiles-10
         endif

         set text font "system"
         for i=1 to 10
            if select=i
               ink rgb(0,0,255),0
               box x,i*15+y,200+x,(i+1)*15+y
            endif
            ink rgb(255,255,255),0
            if (list+i-1)<=nooffiles then text x,i*15+y,file$(list+i-1)
         next i

         text (x+200)-text width(directory$+""),y,directory$+""

         ink rgb(0,0,255),0
         box x,y+168,x+106,y+184
         box x+110,y+168,x+213,y+184

         ink rgb(255,255,255),0
         center text x+54,y+168,"Parent folder"
         center text x+162,y+168,"OK"

         ink 0,0
         box 200+x,y,399,165+y
         box 0,y,x,y+200

         ink rgb(255,255,255),0
         linebox(x-1,y+14,x+201,y+166)
         linebox(x-1,y-1,x+201,y+14)
         linebox(x+201,y+14,x+215,y+150)
         linebox(x+201,y-1,x+215,y+14)
         linebox(x+201,y+150,x+215,y+166)

         linebox(x-1,y+166,x+108,y+186)
         linebox(x+108,y+166,x+215,y+186)

         linetriangle(x+204,y+12,x+212,y+12,x+208,y+2)
         linetriangle(x+204,y+153,x+212,y+153,x+208,y+163)

         if nooffiles>10
            listr#=list
            checklistquantityr#=nooffiles
            sliderpos#=listr#/(checklistquantityr#-10)
            if nooffiles<20 then sliderpos#=sliderpos#-1
            sliderpos#=sliderpos#*122
            slidersize#=10
            if list=nooffiles-9 then sliderpos#=122
            if sliderpos#>122 then sliderpos#=122
            if sliderpos#<0 then sliderpos#=0
         endif

         if nooffiles>10 then box x+203,y+16+sliderpos#,x+213,y+16+sliderpos#+slidersize# else box x+203,y+16,x+213,y+148

         ink rgb(0,0,255),0
         if nooffiles>10
            if tslider=1 then box x+203,y+16,x+213,y+14+sliderpos#
            if bslider=1 then box x+203,y+18+sliderpos#+slidersize#,x+213,y+148
         endif

         tslider=1
         bslider=1

         decisionmadetime=decisionmadetime-1

         sync

      endwhile

      if decision=1 then directory$=parentfolder$(directory$)
      if decision=2
         filen$=file$(file)
         if left$(filen$,3)="[T]" then filename$=directory$+""+right$(filen$,len(filen$)-3) : goto endfileload
         if left$(filen$,3)="[+]" then directory$=directory$+""+right$(filen$,len(filen$)-3) : goto endfileload
         if left$(filen$,3)="[X]"
            cls
            ink rgb(0,0,255),0
            center text 320,240,"Error - Invalid File type!"
            sleep 2000
            goto endfileload
         endif
      endif
      endfileload:

      decisionmadetime=10

      sync

   endwhile

endfunction filename$

function linebox(x1,y1,x2,y2)

   line x1,y1,x1,y2
   line x1,y2,x2,y2
   line x2,y2,x2,y1
   line x2,y1,x1,y1

endfunction

function linetriangle(x1,y1,x2,y2,x3,y3)

   line x1,y1,x2,y2
   line x2,y2,x3,y3
   line x3,y3,x1,y1

endfunction

function getfiletype$(filename$)

   filetype$=""

   for i=len(filename$) to 1 step -1
      if mid$(filename$,i)="." then goto filetypeend else filetype$=mid$(filename$,i)+filetype$
   next i

   filetypeend:

endfunction filetype$

function parentfolder$(directory$)

   foldernamesize=0

   for i=len(directory$) to 1 step -1
      foldernamesize=foldernamesize+1
      if mid$(directory$,i)="" or mid$(directory$,i)="/" then goto parentfolderend
   next i

   parentfolderend:
   if foldernamesize=len(directory$) then foldernamesize=0
   parentfolder$=left$(directory$,(len(directory$)-foldernamesize))

endfunction parentfolder$

sync on
`set display mode 400,300,16

rem If you want you can put window mode on
`set window on

dim wordlenth(1000000)
dim word$(10)

maxfiletypes=2
dim filetypes$(2)
dim file$(1)
filetypes$(1)="txt"
filetypes$(2)="dat"

do

   `if filename$="" then directory$="C:\documents and settings\abc\my documents" else directory$=parentfolder$(filename$)
   `filename$=fileaccess(directory$,maxfiletypes)
   input "Directory: >";filename$

   words=0
   undim wordlenth(1000000)
   undim word$(10)
   dim wordlenth(1000000)
   dim word$(10)
   word$=""
   bytesscanes=0

   open to read 1,filename$

   while file end(1)=0

      cls

      word$=""
      wordlenth=0

      repeat

         read byte 1,chrASCII

      until letter(chrASCII)=1 or file end(1)=1

      if file end(1)=1 then exit

      repeat

         wordlenth=wordlenth+1
         word$=word$+chr$(chrASCII)
         read byte 1,chrASCII

      until letter(chrASCII)=0 or file end(1)=1

      if file end(1)=1 then exit

      words=words+1

      for i=1 to 9
         word$(i)=word$(i+1)
      next i

      word$(10)=word$

      wordlenth(words)=wordlenth

      maxlenth=0
      minlenth=0
      totallenth=0
      for i=1 to words
         if wordlenth(i)>maxlenth then maxlenth=wordlenth(i)
         totallenth=totallenth+wordlenth(i)
      next i
      minlenth=maxlenth
      for i=1 to words
         if wordlenth(i)<minlenth then minlenth=wordlenth(i)
      next i
      avglenth=totallenth/words

      for i=1 to 10
         ink rgb(i*25,i*25,255),0
         text 300-text width(word$(i)),i*15-15,word$(i)
      next i

      ink rgb(0,0,255),0
      text 0,0,"words so far: "
      text 0,15,"Maximum lenth so far: "
      text 0,30,"Minimum lenth so far: "
      text 0,45,"Average lenth so far: "

      ink rgb(255,255,255),0
      text 180-text width(str$(avglenth)),45,str$(avglenth)
      text 180-text width(str$(minlenth)),30,str$(minlenth)
      text 180-text width(str$(maxlenth)),15,str$(maxlenth)
      text 180-text width(str$(words)),0,str$(words)

      sync

   endwhile

   close file 1

   cls

   maxlenth=0
   minlenth=0
   totallenth=0
   for i=1 to words
      if wordlenth(i)>maxlenth then maxlenth=wordlenth(i)
      totallenth=totallenth+wordlenth(i)
   next i
   minlenth=maxlenth
   for i=1 to words
      if wordlenth(i)<minlenth then minlenth=wordlenth(i)
   next i
   if words>0 then avglenth=totallenth/words

   ink rgb(0,0,255),0
   text 0,0,"words: "
   text 0,15,"Maximum lenth: "
   text 0,30,"Minimum lenth: "
   text 0,45,"Average lenth: "
   text 0,60,"Press space to scan another..."

   ink rgb(255,255,255),0
   text 180-text width(str$(avglenth)),45,str$(avglenth)
   text 180-text width(str$(minlenth)),30,str$(minlenth)
   text 180-text width(str$(maxlenth)),15,str$(maxlenth)
   text 180-text width(str$(words)),0,str$(words)

   suspend for key

loop

function letter(ASCII)
letter=0
if ASCII>=65 and ASCII<=90 or ASCII>=97 and ASCII<=122 or ASCII>=176 and ASCII<=255 then letter=1
endfunction letter

function fileaccess(directory$,maxfiletypes)

   x=90
   y=50

   filename$=""

   while filename$=""

      decision=0

      set dir directory$
      perform checklist for files
      nooffiles=checklist quantity()
      undim file$(1)
      dim file$(nooffiles)
      sort1=1
      for i=1 to nooffiles
         temp$=checklist string$(i)
         if getfiletype$(temp$)=temp$
            file$(sort1)="[+]"+temp$
            sort1=sort1+1
         endif
      next i
      for i=1 to nooffiles
         for j=1 to maxfiletypes
            temp$=checklist string$(i)
            if getfiletype$(temp$)=filetypes$(j)
               file$(sort1)="[T]"+checklist string$(i)
               sort1=sort1+1
            endif
         next i
      next i
      for i=1 to nooffiles
         if (getfiletype$(checklist string$(i))=checklist string$(i))=0
            for j=1 to maxfiletypes
               if getfiletype$(checklist string$(i))=filetypes$(j) then goto Endfilesort
            next i
            file$(sort1)="[X]"+checklist string$(i)
            sort1=sort1+1
         endif
         Endfilesort:
      next i

      file=1
      list=1
      select=1

      while decision=0

         cls

         file=list+select-1

         if upkey()=1 and file>1
            if upK=0
               upK=1
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
               Ucount=40
            endif
            Ucount=Ucount-1
            if Ucount<0
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
               Ucount=2
            endif
         else
            upK=0
         endif

         if downkey()=1 and file<nooffiles
            if dnK=0
               dnK=1
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
               Dcount=40
            endif
            Dcount=Dcount-1
            if Dcount<0
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
               Dcount=2
            endif
         else
            dnK=0
         endif

         if mousemovez()>oldmousemovez and file>1
            file=file-1
            if select=1 and list>1 then list=list-1
            if select>1 then select=select-1
            oldmousemovez=mousemovez()
         endif

         if mousemovez()<oldmousemovez and file<nooffiles
            file=file+1
            if select=10 and list<nooffiles then list=list+1
            if select<10 then select=select+1
            oldmousemovez=mousemovez()
         endif

         if returnkey()=1 and decisionmadetime<1 then decision=2

         if mouseclick()=1
            if mousex()>x-1 and mousey()>y+166 and mousex()<x+108 and mousey()<y+186 and decisionmadetime<1 then decision=1
            if mousex()>x+108 and mousey()>y+166 and mousex()<x+215 and mousey()<y+186 and decisionmadetime<1 then decision=2
            for i=1 to 10
               if mousex()>x and mousey()>i*15+y and mousex()<200+x and mousey()<(i+1)*15+y
                  if doubleclickcount>0 and mouseclick=0 then decision=2
                  doubleclickcount=20
                  file=list+i-1
                  select=i
               endif
            next i
            if mousex()>x+203 and mousey()>y+16+sliderpos# and mousex()<x+213 and mousey()<y+16+sliderpos#+slidersize# and nooffiles>19
               sliderhold=1
            endif
            if mousex()>x+204 and mousey()>y+2 and mousex()<x+212 and mousey()<y+12 and file>1
               file=file-1
               if select=1 and list>1 then list=list-1
               if select>1 then select=select-1
            endif
            if mousex()>x+204 and mousey()>y+153 and mousex()<x+212 and mousey()<y+163 and file<nooffiles
               file=file+1
               if select=10 and list<nooffiles then list=list+1
               if select<10 then select=select+1
            endif
            if mousex()>x+201 and mousey()>y+14 and  mousex()<x+215 and mousey()<y+150 and blankclick<1 and nooffiles>10
               if mousey()<y+16+sliderpos#
                  if list>10
                     file=file-10
                     list=list-10
                     blankclick=10
                  else
                     if list=1
                        select=1
                     endif
                     list=1
                     file=1
                     blankclick=10
                  endif
                  tslider=0
               endif
               if mousey()>y+16+sliderpos#+slidersize#
                  if list<nooffiles-10
                     file=file+10
                     list=list+10
                     if list>nooffiles-9 then list=nooffiles-9
                     blankclick=10
                  else
                     list=nooffiles-9
                     file=nooffiles
                     select=10
                     blankclick=10
                  endif
                  bslider=0
               endif
            endif
         endif
         blankclick=blankclick-1
         doubleclickcount=doubleclickcount-1

         if mouseclick()=1 then mouseclick=1 else mouseclick=0
         if mouseclick()<>1 then sliderhold=0
         if sliderhold=1
               mosy1#=mousey()-(y+16)
               listsize#=(nooffiles-10)
               temp#=mosy1#/122
               listr#=temp#*listsize#
               list=listr#
               if list<1 then list=1
               if list>nooffiles-10 then list=nooffiles-10
         endif

         set text font "system"
         for i=1 to 10
            if select=i
               ink rgb(0,0,255),0
               box x,i*15+y,200+x,(i+1)*15+y
            endif
            ink rgb(255,255,255),0
            if (list+i-1)<=nooffiles then text x,i*15+y,file$(list+i-1)
         next i

         text (x+200)-text width(directory$+"\"),y,directory$+"\"

         ink rgb(0,0,255),0
         box x,y+168,x+106,y+184
         box x+110,y+168,x+213,y+184

         ink rgb(255,255,255),0
         center text x+54,y+168,"Parent folder"
         center text x+162,y+168,"OK"

         ink 0,0
         box 200+x,y,399,165+y
         box 0,y,x,y+200

         ink rgb(255,255,255),0
         linebox(x-1,y+14,x+201,y+166)
         linebox(x-1,y-1,x+201,y+14)
         linebox(x+201,y+14,x+215,y+150)
         linebox(x+201,y-1,x+215,y+14)
         linebox(x+201,y+150,x+215,y+166)

         linebox(x-1,y+166,x+108,y+186)
         linebox(x+108,y+166,x+215,y+186)

         linetriangle(x+204,y+12,x+212,y+12,x+208,y+2)
         linetriangle(x+204,y+153,x+212,y+153,x+208,y+163)

         if nooffiles>10
            listr#=list
            checklistquantityr#=nooffiles
            sliderpos#=listr#/(checklistquantityr#-10)
            if nooffiles<20 then sliderpos#=sliderpos#-1
            sliderpos#=sliderpos#*122
            slidersize#=10
            if list=nooffiles-9 then sliderpos#=122
            if sliderpos#>122 then sliderpos#=122
            if sliderpos#<0 then sliderpos#=0
         endif

         if nooffiles>10 then box x+203,y+16+sliderpos#,x+213,y+16+sliderpos#+slidersize# else box x+203,y+16,x+213,y+148

         ink rgb(0,0,255),0
         if nooffiles>10
            if tslider=1 then box x+203,y+16,x+213,y+14+sliderpos#
            if bslider=1 then box x+203,y+18+sliderpos#+slidersize#,x+213,y+148
         endif

         tslider=1
         bslider=1

         decisionmadetime=decisionmadetime-1

         sync

      endwhile

      if decision=1 then directory$=parentfolder$(directory$)
      if decision=2
         filen$=file$(file)
         if left$(filen$,3)="[T]" then filename$=directory$+"\"+right$(filen$,len(filen$)-3) : goto endfileload
         if left$(filen$,3)="[+]" then directory$=directory$+"\"+right$(filen$,len(filen$)-3) : goto endfileload
         if left$(filen$,3)="[X]"
            cls
            ink rgb(0,0,255),0
            center text 320,240,"Error - Invalid File type!"
            sleep 2000
            goto endfileload
         endif
      endif
      endfileload:

      decisionmadetime=10

      sync

   endwhile

endfunction filename$

function linebox(x1,y1,x2,y2)

   line x1,y1,x1,y2
   line x1,y2,x2,y2
   line x2,y2,x2,y1
   line x2,y1,x1,y1

endfunction

function linetriangle(x1,y1,x2,y2,x3,y3)

   line x1,y1,x2,y2
   line x2,y2,x3,y3
   line x3,y3,x1,y1

endfunction

function getfiletype$(filename$)

   filetype$=""

   for i=len(filename$) to 1 step -1
      if mid$(filename$,i)="." then goto filetypeend else filetype$=mid$(filename$,i)+filetype$
   next i

   filetypeend:

endfunction filetype$

function parentfolder$(directory$)

   foldernamesize=0

   for i=len(directory$) to 1 step -1
      foldernamesize=foldernamesize+1
      if mid$(directory$,i)="\" or mid$(directory$,i)="/" then goto parentfolderend
   next i

   parentfolderend:
   if foldernamesize=len(directory$) then foldernamesize=0
   parentfolder$=left$(directory$,(len(directory$)-foldernamesize))

endfunction parentfolder$

dim oldFfileToLoad$(4)
dim fileToLoad$(1)
dim fileCount(1)
dim driveCount(1)
dim files$(1,2)
dim fileData$(256)
DRIVE$ = ""
perform checklist for drives
driveCount(1) = checklist quantity()
dim drives$(checklist quantity())


for d = 1 to driveCount(1)
   drives$(d) = checklist string$(d)
next d
empty checklist

clickDelay = 500
clickCount = 0
timestamp = timer()
mousestamp = 0
offset = 0

loaderPath$ = ""


sync on

repeat
   cls


   gosub drawFileLoader

   if upkey()=1 then dec offset
   if downkey()=1 then inc offset
   if offset < 0 then offset = 0
   if offset > 256 then offset = 256

   ink rgb(255,255,255),0
   center text 320,230, "File Preview"
   displayFileData(fileToLoad$(0))
   displayFile(offset)


   sync
until spacekey()
end



REM Sort the files
_Sort_Load_Files:
   flag=0
   repeat
      flag=0
      for x = 1 to fileCount(1)-1
         a$ = lower$(getExtension$(files$(x,1)))
         b$ = lower$(getExtension$(files$(x+1,1)))
         if len(a$) = len(files$(x,1)) then files$(x,2) = "1"
         if len(b$) = len(files$(x+1,1)) then files$(x+1,2) = "1"
         if a$ > b$
            t$ = files$(x,2)
            temp$=files$(x,1)
            files$(x,1) = files$(x+1,1)
            files$(x,2) = files$(x+1,2)
            files$(x+1,1) = temp$
            files$(x+1,2) = t$
            flag=1
         endif
      next x
   until flag = 0
RETURN

REM
REM
drawFileLoader:
   x = 220
   y = 75
   counter = 0
   displayCount = 10
   charWidth = text width("X")
   tHeight = text height("X")
   width = 200
   height = displayCount*tHeight
   maxChars = (width-12) / charWidth
   if mouseclick() = 0 then mouseFlag = 0
   ink rgb(192,192,192),0
   box x,y,x+width,y+height

   ink rgb(128,128,128),0
   box x+width,y,x+width+10,y+height
   drawUpArrow(x+width,y)
   drawDownArrow(x+width,y+height-11)

   if mouseWithin(x+width,y,x+width+10,y+11) and mouseclick() = 1 and mouseflag = 0
      mouseFlag = 1
      if fileOffset > 0 then dec fileOffset
   endif
   if mouseWithin(x+width,y+height-11,x+width+10,y+height) and mouseclick() = 1 and mouseflag = 0
      mouseFlag = 1
      if fileOffset < fileCount(0)-displayCount then inc fileOffset
   endif

   if mousemovex() = 0 and mousemovey() = 0
      if oldmousex = mousex() and oldmousey = mousey()
         if mousestamp+1000 < timer() then showToolTip = 0
      else
         oldmousex = mousex()
         oldmousey = mousey()
         mousestamp = timer()
         showToolTip = -1
      endif
   else
      showToolTip = -1
   endif

   if timestamp+clickDelay < timer() then clickCount = 0
   if loaderPath$ = ""
      for i = 1 to driveCount(1)
         ly = y+counter*tHeight
         oy = abs(tHeight-10)/2 + 1
         if mouseWithin(x,ly+1,x+width,ly+tHeight-1)
            ink rgb(220,220,240),0
            box x,ly+1,x+width,ly+tHeight-1
            if mouseclick() = 1 and mouseFlag = 0
               mouseFlag = 1
               inc clickCount
               if clickCount = 1 then timestamp = timer()
               if clickCount = 2 and timestamp+clickDelay >= timer()
                  fileOffset = 0
                  loaderPath$ = drives$(i)
                  DRIVE$ = drives$(i)
                  loadFiles(loaderPath$)
                  gosub _Sort_Load_Files
                  clickCount = 0
               endif
            endif
         endif
         drawFolder(x+1, ly+oy)
         ink 0,0
         text x+12, ly, drives$(i)
         line x,ly+tHeight,x+width,ly+tHeight
         inc counter
      next i
   else
      for i = 1+fileOffset to displayCount+fileOffset
         if i <= fileCount(1)
            ly = y+counter*tHeight
            oy = abs(tHeight-10)/2 + 1
            if mouseWithin(x,ly+1,x+width,ly+tHeight-1)
               if showToolTip = 0 then showToolTip = i
               ink rgb(220,220,240),0
               box x,ly+1,x+width,ly+tHeight-1
               if mouseclick() = 1 and mouseFlag = 0
                  mouseFlag = 1
                  inc clickCount
                  if clickCount = 1 then timestamp = timer()
                  if clickCount = 2 and timestamp+clickDelay >= timer()
                     if files$(i,2) = "1"
                        fileOffset = 0
                        loaderPath$ = files$(i,1)
                        loadFiles(loaderPath$)
                        gosub _Sort_Load_Files
                        clickCount = 0
                     else
                        fileToLoad$(0) = DRIVE$+loaderPath$+"\"+files$(i,1)
                     endif
                  endif
               endif
            endif
            if files$(i,2) = "1"
               drawFolder(x+1, ly+oy)
            else
               drawFile(x+1, ly+oy)
            endif

            display$ = files$(i,1)
            if showToolTip = i
               w = text width(display$)+12
               ink rgb(220,220,240),0
               box x+12,ly+1,x+w,ly+tHeight-1
               ink 0,0
               text x+12, ly, display$
            else
               if len(files$(i,1)) > maxChars then display$ = left$(display$, maxChars-3)+"..."
               ink 0,0
               text x+12, ly, display$
            endif
            line x,ly+tHeight,x+width,ly+tHeight
            inc counter
         endif
      next i
   endif
RETURN


REM
function drawFolder(x, y)
   ink rgb(243,235,133),0
   box x,y,x+4,y+2
   box x,y+2,x+10,y+9
endfunction

REM
function drawFile(x,y)
   ink rgb(243,235,233),0
   box x,y,x+7,y+10
endfunction

REM
function drawUpArrow(x,y)
   ink rgb(255,255,255),0
   box x,y,x+10,y+11
   ink 0,0
   line x+5,y+1,x+1,y+9
   line x+5,y+1,x+9,y+9
   line x+1,y+9,x+9,y+9
endfunction

REM
function drawDownArrow(x,y)
   ink rgb(255,255,255),0
   box x,y,x+10,y+11
   ink 0,0
   line x+5,y+9,x+1,y+1
   line x+5,y+9,x+9,y+1
   line x+1,y+1,x+9,y+1
endfunction





REM
function loadFiles(path$)
   undim files$()
   empty checklist
   cd path$
   perform checklist for files
   fileCount(0) = checklist quantity()
   dim files$(checklist quantity(),2)
   r = 0
   for f = 1 to fileCount(0)
      ext$ = getExtension$(checklist string$(f))
      if lower$(ext$) = "txt" or len(ext$) = len(checklist string$(f))
         inc r
         files$(r,1) = checklist string$(f)
      endif
   next f
   fileCount(1) = r
endfunction




REM
function getExtension$(name$)
   if name$ = "." or name$ = ".." then exitfunction name$
   length = len(name$)
   for i = length to 1 step -1
      if mid$(name$,i) = "." then exitfunction right$(name$,length-i)
   next i
endfunction name$

REM boolean, true if mouse within specified co-ordinates
function mouseWithin(x1,y1,x2,y2)
  if mousex() >= x1 and mousex() <= x2 and mousey() >= y1 and mousey() <= y2 then exitfunction 1
endfunction 0



REM
REM
REM
function displayFileData(filename$)
   if filename$ <> oldFfileToLoad$(1)
      oldFfileToLoad$(1) = filename$
      open to read 1, filename$
      wordCount(1)
      close file 1
   else
      text 1,1,"Filename: "+filename$
      text 1,20,"Word count: "+oldFfileToLoad$(2)
      text 1,36,"Character count w/ spaces: "+oldFfileToLoad$(3)
      text 1,52,"Character count no spaces: "+oldFfileToLoad$(4)
   endif
endfunction


REM nFile = file number to scan
function wordCount(nFile)
   undim fileData$()
   dim fileData$(256)
   c = 1
   rem only counts words with more than this many characters
   minChars = 1
   wCount = 0
   charCount = 0
   spaces = 0
   while file end(nFile) = 0
      read string nFile, s$
      fileData$(c) = s$
      inc c
      charCount = charCount + len(s$)
      start = 1
      for i=1 to len(s$)
         if mid$(s$, i) = " "
            inc spaces
            if i-start > minChars then inc wCount
            start = i
         endif
      next i
      rem end of line word check check
      if i-start > minChars then inc wCount
   endwhile
   charCountNoSpaces = charcount-spaces

   oldFfileToLoad$(2) = str$(wCount)
   oldFfileToLoad$(3) = str$(charCount)
   oldFfileToLoad$(4) = str$(charCountNoSpaces)
endfunction


REM
function displayFile(offset)
   ink rgb(210,232,236),0
   box 1,250,screen width(),480
   ink 0,0
   h = text height("X")
   lines = 230/h
   if offset+lines > 256 then offset = 256-lines
   y = 0
   for i = offset to offset+h
      text 10,250+y*h,fileData$(i)
      inc y
   next i

endfunction

This simple text file has got a total of twentythree words in it.

The file also has three lines (including the blank one).

Latch

Nanogames Guy - Entry 2

Set Display Mode 800,600,16
Sync On: CLS 0: Sync
Dim TextLines$(5000)

Do
  CLS: Input "Name Of Text File (Enter To Quit): ";FName$
  CLS
  If FName$ = "" Then Print "Goodbye!": End
  LineCounter = 0: WordCount = 0
  If File Exist(FName$)
    Open To Read 1,FName$
      Repeat
        Read String 1,T$: TextLines$(LineCounter) = T$
        Inc LineCounter
      Until File End(1)
    Close File 1
    Gosub ProcessFile
    Print "This Text file Contains ";WordCount;" Words."
    Print: Print "Press Any Key"
    Wait Key
  Else
    CLS
    Print "The File ";FName$;" Does Not Exist! Any Key To Try Again..."
    Wait Key
    CLS
  Endif
  Sync
Loop

ProcessFile:
  For N = 0 To LineCounter
    ThisLine$ = TextLines$(N)
    For N2 = 1 To Len(ThisLine$)
      TCA = ASC(Mid$(ThisLine$,N2))
      If (TCA>47 And TCA<58) Or (TCA>96 And TCA<123) Or (TCA>64 And TCA<91)
        W$=W$+Chr$(TCA)
      Else
        If W$<>"" Then Inc WordCount: W$=""
      Endif
    Next N2
  Next N
Return

Gosub Setup

Repeat
  MMx=MouseMoveX(): MMy=MouseMoveY(): Key=ScanCode()
  Gosub This
  Gosub That
  Gosub TheOther
  Sync
  If MMx<>0 Or MMy<>0 Or Key<>0 Then ExitProg = True
Until ExitProg = True
End

This:
  Rem Subroutine For Example Only - Use Your Own
Return

That: 
  Rem Subroutine For Example Only - Use Your Own
Return

TheOther:
  Rem Subroutine For Example Only - Use Your Own
Return

Setup:
  True=1: False=0
  Rem Rest of your setup here
Return

REM ==========================
REM DBC Challenge: Screensaver
REM Author: Phaelax
REM ==========================

randomize timer()
REM VARIABLES
depth#=400
screenwidth#=800
screenheight#=600

`color as dword
color = rgb(205,255,255)

newColorDelayAmount = 3000
newColorDelay = 0


total2=40
dim x2#(total2)
dim y2#(total2)
dim a2#(total2)
x2#=rnd(screenwidth#)
y2#=rnd(screenheight#)
f3=rnd(1)
f4=rnd(1)

total3=total2
dim x3#(total3)
dim y3#(total3)
dim a3#(total3)
x3#=rnd(screenwidth#)
y3#=rnd(screenheight#)
f5=rnd(1)
f6=rnd(1)

REM VARIABLES CALCULATIONS
width#=(depth#/10)*16
height#=(depth#/10)*12
even#=screenwidth#/1.6
prop#=depth#/even#

REM SETUP
set display mode screenwidth#,screenheight#,32
position camera width#/2,height#/-2,0
sync on
autocam off
hide mouse
backdrop on
`color backdrop 0

REM OBJECTS


for t=1 to total2
	make object plain t+100,100,20
	color object t+100,rgb(0,0,(total-t)*6)
	ghost object on t+100
next t


for t=1 to total3
	make object plain t+200,100,20
	color object t+200,rgb(0,(total-t)*6,0)
	ghost object on t+200
next t

sync rate 40


REPEAT

	a2#(1)=wrapvalue(a2#(1)-4)
	a3#(1)=wrapvalue(a3#(1)+6)


	if newColorDelay + newColorDelayAmount < timer()
	tr = rnd(255)
	tg = rnd(255)
	tb = rnd(255)
	newColorDelay = timer()
	endif
	
	color = getFadedValue(cr,cg,cb,tr,tg,tb)
	ink color,0
	cr = rgbr(color)
	cg = rgbg(color)
	cb = rgbb(color)
	
	
	gosub get_new_positions_blue
	gosub get_new_positions_green
	
	
	for t=1 to total2
		position object t+100,x2#(t),y2#(t),depth#
			
		ttr=cr-(t-1)*6
		ttg=cg-(t-1)*6
		ttb=cb-(t-1)*6
		if ttr<0 then ttr=0
		if ttg<0 then ttg=0
		if ttb<0 then ttb=0
			
		color object t+100, rgb(ttr,ttg,ttb)
		zrotate object t+100, a2#(t)
			
			
		position object t+200,x3#(t),y3#(t),depth#
		color object t+200, rgb(ttr,ttg,ttb)
		zrotate object t+200, a3#(t)
	next t


sync
until mousemovex() <> 0 or mousemovey() <> 0
end



get_new_positions_blue:
  for t=total2 to 2 step -1
    x2#(t)=x2#(t-1)
  next t

  for t=total2 to 2 step -1
    y2#(t)=y2#(t-1)
  next t

  for t=total2 to 2 step -1
    a2#(t)=a2#(t-1)
  next t

  if f3=1 then inc x2#,9
  if f3=0 then dec x2#,9
  if x2#>800 then f3=0
  if x2#<0 then f3=1

  if f4=1 then inc y2#,9
  if f4=0 then dec y2#,9
  if y2#>600 then f4=0
  if y2#<0 then f4=1

  x2#(1)=x2#*prop#
  y2#(1)=y2#*prop#*-1
RETURN

get_new_positions_green:
  for t=total3 to 2 step -1
    x3#(t)=x3#(t-1)
  next t

  for t=total3 to 2 step -1
    y3#(t)=y3#(t-1)
  next t

  for t=total3 to 2 step -1
    a3#(t)=a3#(t-1)
  next t

  if f5=1 then inc x3#,6
  if f5=0 then dec x3#,6
  if x3#>800 then f5=0
  if x3#<0 then f5=1

  if f6=1 then inc y3#,6
  if f6=0 then dec y3#,6
  if y3#>600 then f6=0
  if y3#<0 then f6=1

  x3#(1)=x3#*prop#
  y3#(1)=y3#*prop#*-1
RETURN




function getFadedValue(currentR,currentG,currentB,targetR, targetG, targetB) as dword

  if currentR > targetR then dec currentR,1
  if currentR < targetR then inc currentR,1

  if currentG > targetG then dec currentG,1
  if currentG < targetG then inc currentG,1

  if currentB > targetB then dec currentB,1
  if currentB < targetB then inc currentB,1

  color = rgb(currentR, currentB, currentB)

endfunction color

remstart
   ==============================================================
   =  Title  : Reflective Cube Screen Saver
   =  Author : Latch
   =  Date   : 04/27/2007
   =  Update : 04/28/2007
   =  Version: .01
   ==============================================================
   Comments    Improved my mirror code with an idea
               presented by Rigo - Thanks Rigo!
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 640,480,16
   sync on
   sync rate 0
   hide mouse

rem =============================================================
rem = MAIN
rem =============================================================
_main:
   gosub _init

   repeat
      gosub _face_cube
      gosub _reflect

      cls
      text 0,0,str$(screen fps())
      `text 0,20,str$(angy1#)
      `text 0,40,str$(cangy#)
      `text 0,60,str$(abs(angy1#-cangy#))
      sync
   until break_silence()=1
   delete sprite 1
   delete sprite 2
   delete sprite 101
   delete matrix 1
   delete image 1
   delete image 2
   delete image 3
   delete image 100
   delete image 101
   for obj=1 to 13
      delete object obj
   next obj
   set camera view 0,0,screen width(),screen height()
   backdrop off
   cls 0
   sync

   end

   _init:
      x1=100
      y1=50
      x2=440
      y2=330
      xdir=1
      sx=-1
      ydir=1
      sy=-1
      randomize timer()
      gosub _texture
      gosub _floor
      gosub _reflective_cube
      gosub _objects
      set camera view x1,y1,x2,y2
      position camera 500,0,500
   return
   _floor:
      make matrix 1,1000,1000,10,10
      position matrix 1,0,-30,0
      prepare matrix texture 1,100,1,1
      `randomize matrix 1,20
   return
   _texture:
      rem checkerboard
      create bitmap 1,65,65
      cls RGB(128,128,128)
      ink 0,0
      box 0,0,32,32
      box 33,33,64,64
      get image 100,0,0,65,65
      ink rgb(0,255,0),0
      delete bitmap 1

      create bitmap 1,screen width(),screen height()
      cls 0
      get image 101,x1,y1,x2+1,y2+1
      delete bitmap 1

      set current bitmap 0
      sprite 101,x1,y1,101
      set sprite 101,0,0
      sprite 1,-900,-900,100
      sprite 2,-900,-900,100
      set sprite 1,0,0
      set sprite 2,0,0
      mirror sprite 1
   return
   _reflective_cube:
      make object plain 1,80,80
      make object plain 2,80,80
      yrotate object 2,90
      position object 1,500,40,660
      position object 2,460,40,700
   return
   _objects:
      rem objects to reflect
         rem left side
         objects(3,4,150,0,1000,0)
         rem right side
         objects(5,7,200,800,1000,0)
         rem bottom
         objects(8,10,1000,0,150,0)
         rem top
         objects(11,13,1000,0,100,900)
   return
   _rotate_camera:
      yang#=wrapvalue(yang#+.5)
      camx#=camera position x()
      camz#=camera position z()
      centerx#=500
      centerz#=700
      dist#=sqrt((centerx#-camx#)^2+(centerz#-camz#)^2)
      newcamx#=dist#*cos(yang#+90)+centerx#
      newcamz#=-1*dist#*sin(yang#+90)+centerz#
      position camera newcamx#,camera position y(),newcamz#
      point camera centerx#,0,centerz#
      sync
   return
   _face_cube:
      yrotate camera camy#
      gosub _rotate_camera
      if sx+x2 >= screen width() then xdir=-1
      if sx+x1 <=0 then xdir=1
      sx=sx+1*xdir
      if sy+y2 >= screen height() then ydir=-1
      if sy+y1 <= 0 then ydir=1
      sy=sy+1*ydir
      get image 1,x1,y1,x2,y2
      sprite 2,x1+sx,y1+sy,1
      sprite 1,x1+sx*-1,y1+sy*-1,1
      sync
   return
   _reflect:
      cangy#=camera angle y()
      camx#=camera position x()
      camy#=camera position y()
      camz#=camera position z()
      angy1#=object angle y(1)
      angy2#=object angle y(2)
      if abs(angy1#-cangy#)>90 and abs(angy1#-cangy#)< 180
         move object 1,80
         yrotate object 1,(angy1#+180)
      endif
      if abs(angy2#-wrapvalue(cangy#))>90
         move object 2,80
         yrotate object 2,wrapvalue(angy2#+180)
      endif
      position camera object position x(1),object position y(1),object position z(1)
      cangy2#=360-cangy#
      yrotate camera wrapvalue(cangy2#+180)
      get image 2,x1,y1,x2,y2
      texture object 1,2
      sync
      position camera object position x(2),object position y(2),object position z(2)
      yrotate camera wrapvalue(cangy2#)
      get image 3,x1,y1,x2,y2
      texture object 2,3
      position camera camx#,camy#,camz#
   return
   function objects(obstart,obend,x,xlimit,z,zlimit)
      for obj=obstart to obend
         choice=rnd(3)+1
         select choice
            case 1
               make object cube obj,rnd(100)+25
               position object obj,rnd(x)+xlimit,31,rnd(z)+zlimit
               color object obj,rgb(rnd(255),rnd(255),rnd(255))
            endcase
            case 2
               make object sphere obj,rnd(100)+25
               position object obj,rnd(x)+xlimit,31,rnd(z)+zlimit
               color object obj,rgb(rnd(255),rnd(255),rnd(255))
            endcase
            case 3
               make object cylinder obj,rnd(100)+25
               position object obj,rnd(x)+xlimit,31,rnd(z)+zlimit
               color object obj,rgb(rnd(255),rnd(255),rnd(255))
            endcase
            case 4
               make object cone obj,rnd(100)+25
               position object obj,rnd(x)+xlimit,31,rnd(z)+zlimit
               color object obj,rgb(rnd(255),rnd(255),rnd(255))
            endcase
         endselect
      next obj
   endfunction
   function break_silence()
      result=0
      if mousemovex() <> 0 or mousemovey() <> 0 or mousemovez() <>0 then result=1
      if scancode()<>0 then result=1
   endfunction result

Gosub Setup

Repeat
  MMx=MouseMoveX(): MMy=MouseMoveY(): [b]Mc=MouseClick():[/b] Key=ScanCode()
  Gosub This
  Gosub That
  Gosub TheOther
  Sync
  If MMx<>0 Or MMy<>0 Or Key<>0 [b]Or Mc<>0[/b] Then ExitProg = True
Until ExitProg = True
End

This:
  Rem Subroutine For Example Only - Use Your Own
Return

That: 
  Rem Subroutine For Example Only - Use Your Own
Return

TheOther:
  Rem Subroutine For Example Only - Use Your Own
Return

Setup:
  True=1: False=0
  Rem Rest of your setup here
Return

rem very boring screen saver
rem by latch
set display mode 640,480,16
sync on:sync rate 0:cls 0
randomize timer() : a=timer()
hide mouse

ink rgb(0,255,0),0
cls 0
box 0,0,100,100
get image 1,0,0,101,101
cls 0
sprite 1,0,0,1
set sprite 1,1,0
repeat
   inc s,1
   scale sprite 1,s
   if s >= 640 then s=0
   sync
until break_silence()=1

end
   function break_silence()
      result=0
      if mousemovex() <> 0 or mousemovey() <> 0 or mousemovez() <>0 then result=1
      if mouseclick() <> 0 then result=1
      if scancode()<>0 then result=1
   endfunction result

rem dot screen saver
rem by latch
set display mode 640,480,16
sync on:sync rate 0:cls 0
randomize timer() : a=timer()
hide mouse

repeat
   if timer()-a >= 10000
      cls 0
      a=timer()
   endif
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   dot rnd(screen width()),rnd(screen height())
   sync
until break_silence()=1

end
   function break_silence()
      result=0
      if mousemovex() <> 0 or mousemovey() <> 0 or mousemovez() <>0 then result=1
      if mouseclick() <> 0 then result=1
      if scancode()<>0 then result=1
   endfunction result

rem words screen saver
rem by latch
set display mode 640,480,16
sync on:sync rate 0:cls 0
randomize timer() : a=timer()
hide mouse

dim talk(6,8)
dim talk$(6)
for n=1 to 6
   read talk$(n)
next n

for n=1 to 6
   for s=1 to 8
      read talk(n,s)
   next s
next n

repeat
   cls
   for n=1 to 6
      orbit(n)
      sync
   next n
   `sync
   wait 20
until break_silence()=1


end

function orbit(index)
   rad1=talk(index,1)
   rad2=talk(index,2)
   cx=talk(index,3)
   cy=talk(index,4)
   x=talk(index,5)
   y=talk(index,6)
   speed=talk(index,7)
   angle=talk(index,8)

   text x,y,talk$(index)

   newangle=wrapvalue(angle+speed)
   newx=rad1*cos(newangle)+cx
   newy=rad2*sin(newangle)+cy

   talk(index,5)=newx
   talk(index,6)=newy
   talk(index,8)=newangle
endfunction

   function break_silence()
      result=0
      if mousemovex() <> 0 or mousemovey() <> 0 or mousemovez() <>0 then result=1
      if mouseclick() <> 0 then result=1
      if scancode()<>0 then result=1
   endfunction result




data "Hello","What's new?","Screen savers don't have to be complicated"
data "Do you like DarkBASIC?","Drinks on the house for everyone","Blah blah blah..."

data 10,10,220,200,320,190,5,90
data 50,10,220,200,320,150,1,90
data 90,240,200,200,320,110,-3,90
data 130,90,220,200,320,290,2,270
data 50,180,220,200,320,20,4,90
data 300,200,220,200,320,0,1,90

 Rem Screensaver Attempt
           sync on
            do

ink rgb(244,214,210),0

for t=1 to 100

   ink rgb(rnd(255),rnd(255),rnd(255)),1

   left=rnd(640)
   top=rnd(480)
   right=(left+50)
   bottom=(top+50)


   box left,top,right,bottom
next t

ink rgb(244,214,210),1

text 200,240,"kooky"

for background=1 to 1000
   dot rnd(640),rnd(480)
next background

 ink rgb(rnd(255), rnd(255), rnd(255)),1

   left=rnd(640)
   top=rnd(480)
   right=(left+50)
   bottom=(top+50)




    sync
loop

  sync on:cls
            sync rate 30

            do
for background=1 to 1000
   dot rnd(640),rnd(480)
next background

 ink rgb(rnd(255), rnd(255), rnd(255)),1

   left=rnd(640)
   top=rnd(480)
   right=(left+50)
   bottom=(top+50)




    sync
loop

Rem Dark Basic Classic Project:
Rem Created: 5/4/2007 2:59:47 AM
Rem Title: starfield
Rem Author: Phaelax


total = 400
rem x,y,angle,speed
dim stars#(total, 4)
for i = 1 to total
   stars#(i,1) = screen width()/2 + rnd(20)-10
   stars#(i,2) = screen height()/2 + rnd(20)-10
   stars#(i,3) = rnd(360)
   stars#(i,4) = (rnd(60)+10)/10.0
next i

width2 = screen width()/2
height2 = screen height()/2

hide mouse
sync on

ink rgb(255,255,255),0

repeat
   cls

   for i = 1 to total
      if stars#(i,1) < 0 or stars#(i,1) > screen width() or stars#(i,2) < 0 or stars#(i,2) > screen height()
         stars#(i,1) = width2
         stars#(i,2) = height2
         stars#(i,3) = rnd(360)
         stars#(i,4) = rnd(5)+1
      else
         stars#(i,1) = stars#(i,1)+sin(stars#(i,3))*stars#(i,4)
         stars#(i,2) = stars#(i,2)+cos(stars#(i,3))*stars#(i,4)
      endif
      dot stars#(i,1),stars#(i,2)
   next i

   sync
until breaker() = 1
end


function breaker()
   if mousemovex() <> 0 then exitfunction 1
   if mousemovey() <> 0 then exitfunction 1
   if mousemovez() <> 0 then exitfunction 1
   if mouseclick() <> 0 then exitfunction 1
   if scancode() <> 0 then exitfunction 1
endfunction 0

Rem Dark Basic Classic Project:
Rem Created: 5/4/2007 4:24 AM
Rem Title: starfield
Rem Author: Phaelax
sync on
sync rate 60
hide mouse

randomize timer()
dim stars(1000,9)
for i=0 to 1000
   stars(i,0)=rnd(4000)-2000
   stars(i,1)=rnd(4000)-2000
   stars(i,2)=rnd(4000)+1000
   stars(i,7)=25+rnd(100)
next i


ink rgb(255,255,255),0

repeat
   cls
   for i=0 to 1000
      stars(i,2)=stars(i,2)-stars(i,7):rem speed
      if stars(i,2)<=0
         stars(i,0)=rnd(4000)-2000
         stars(i,1)=rnd(4000)-2000
         stars(i,2)=rnd(4000)+1000
         stars(i,7)=25+rnd(50)
      endif
         stars(i,3)=(stars(i,0)*100)/stars(i,2)
         stars(i,4)=(stars(i,1)*100)/stars(i,2)
         stars(i,5)=(stars(i,0)*100)/stars(i,2)+(stars(i,7)*4):rem (speed*4)
         stars(i,6)=(stars(i,1)*100)/stars(i,2)+(stars(i,7)*4):rem (speed*4)
         dot 320+stars(i,3),240+stars(i,4)
   next i
   sync
until breaker() = 1


function breaker()
   if mousemovex() <> 0 then exitfunction 1
   if mousemovey() <> 0 then exitfunction 1
   if mousemovez() <> 0 then exitfunction 1
   if mouseclick() <> 0 then exitfunction 1
   if scancode() <> 0 then exitfunction 1
endfunction 0

Rem Dark Basic Classic Project:
Rem Created: 5/4/2007 3:42 AM
Rem Title: fern fractal
Rem Author: Phaelax

set display mode 1024,768,32


ink rgb(0,255,0),0


startAngle# = 90
bendAngle# = 7
branchAngle# = 50
height# = 150

repeat
   cls

   fern(512.0, 668.0, 7, startAngle#, bendAngle#, branchAngle#, height#)

   timestamp = timer()
   while timestamp+5000 > timer()
      rem display final image for 5 seconds
   endwhile

   rem create new random(somewhat) fern
   startAngle# = 65 + rnd(50)
   bendAngle# = -8 + rnd(20)
   branchAngle# = 30 + rnd(40)
   height# = 100 + rnd(100)

until breaker() = 1
end

function breaker()
   if mousemovex() <> 0 then exitfunction 1
   if mousemovey() <> 0 then exitfunction 1
   if mousemovez() <> 0 then exitfunction 1
   if mouseclick() <> 0 then exitfunction 1
   if scancode() <> 0 then exitfunction 1
endfunction 0


REM ====== FERN FRACTAL =======
REM X,Y         - starting position for fern, root of first stem
REM passes      - number of iterations
REM startAngle  - angle to start drawing on this pass
REM bendAngle   - overall bending angle of the whole leaf
REM branchAngle - angle to branch off each stem at
REM height      - starting height
function fern(x#, y#, passes, startAngle#, bendAngle#, branchAngle#, height#)
   spKey = spacekey()
   if spKey = 1 then passes = 0

   rootAngle# = wrapvalue(startAngle# - bendAngle#)

   x2# = x# + cos(rootAngle#)*height#
   y2# = y# - sin(rootAngle#)*height#
   line x#,y#,x2#,y2#

   height# = height#*0.5

   x3# = x# + cos(wrapvalue(rootAngle#+branchAngle#))*height#
   y3# = y# - sin(wrapvalue(rootAngle#+branchAngle#))*height#
   line x#,y#,x3#,y3#

   x4# = x# + cos(wrapvalue(rootAngle#-branchAngle#))*height#
   y4# = y# - sin(wrapvalue(rootAngle#-branchAngle#))*height#
   line x#,y#,x4#,y4#

   if passes > 1 and spKey = 0
      fern(x2#,y2#,passes-1, rootAngle#, bendAngle#, branchAngle#, height#)
      fern(x3#,y3#,passes-1, wrapvalue(rootAngle#+branchAngle#), bendAngle#, branchAngle#, height#)
      fern(x4#,y4#,passes-1, wrapvalue(rootAngle#-branchAngle#), bendAngle#, branchAngle#, height#)
   endif

endfunction