Screen Title

geecee · March 27, 2009, 11:08:23 PM

Hi there!

This short programme writes a screen title in random colour, one word at a time in random order.

PlayBASIC Code: [Select]

` Pre-load required fonts
global arial20 = loadnewfont("arial bold",20,0)
global arial25 = loadnewfont("arial bold",25,0) 
  
` Set text style and size
setfont arial25

` Get text height
height=gettextheight("X")

` Begin do/loop
do
  
  ` Choosing a random color
  ink rgb(rnd(255),rnd(255),rnd(255))

  ` Write message/s to screen
  centertext 400,100,"This programme writes a screen title in random colour,"
  centertext 400,100+height*1,"one word at a time in random order"
    
  ` A short wait before proceeding
  sync
  wait 1000

  ` Declare array/s
  dim randomseries(8)

  ` This command will turn the mouse pointer off
  mouse off

  ` Go to subroutine to get 8 numbers in random order
  gosub eightrandomnumbers
  
  ` Set text style and size
  setfont arial20
  
  th=gettextheight("arial")

    ` Display words of screen title in random order
    for order=1 to 8
      if randomseries(order)>=1 and randomseries(order)<=2
        a$="Underware Design"
        down=290
      else
        a$="The Home of Play Basic"
        down=310
      endif      
          
      if randomseries(order)=1
        pos=1:length=10
        across=400-gettextwidth("Underware Design")/2
        gosub getsubstring
      endif
      if randomseries(order)=2
        pos=11:length=16
        across=419
        gosub getsubstring
      endif
      if randomseries(order)=3
        pos=1:length=4
        across=400-gettextwidth("The Home of Play Basic")/2
        gosub getsubstring
      endif
      if randomseries(order)=4
        pos=5:length=9
        across=342 
        gosub getsubstring
      endif
      if randomseries(order)=5
        pos=10:length=12
        across=392
        gosub getsubstring
      endif
      if randomseries(order)=6
        pos=13:length=17
        across=412
        gosub getsubstring
      endif
      if randomseries(order)=7
        pos=18:length=22
        across=450
        gosub getsubstring
      endif
    next order
    
  ` A short wait before proceeding
  sync
  wait 1000
  wait 1000
  
  ` Draw a box to hide previous text at location
  boxc 0,0,799,599,1,rgb(0,0,0)
  
  ` A short wait before proceeding  
  sync
  wait 1000
  
loop

` ---------------------------------------------------
` Subroutine to get part message to write to screen
` ---------------------------------------------------
getsubstring:

  sub$=""
  sub$=mid$(a$,pos,length)
  setcursor across,down+(th/2)
  wait 100
  text across,down,sub$
    
  sync

return
` -----------------------------------------------------------
` Subroutine to generate numbers from 1 to 8 in random order
` -----------------------------------------------------------
eightrandomnumbers:

  for nextnumber = 1 to 7

    repeat
      x=rnd(6)+1
        alreadyfound=0
          for j=1 to nextnumber
            if randomseries(j)=x
              alreadyfound=1
              exit
            endif
          next j
    until alreadyfound=0

    randomseries(nextnumber)=x

  next nextnumber
return

:)
Enjoy
geecee

kevin · March 28, 2009, 07:36:02 AM

The for next loop in the get Sub string sub routine is basically doing what the MID$() function does, so why not use it.

Sub$=mid$(a$,Pos,Length)

Also,. it's UnderWARE ;)

geecee · March 28, 2009, 05:21:35 PM

Thanks for your reply kevin.

I'm always learning, though some things should be obvious.

QuoteAlso,. it's UnderWARE

What a bloomer eh ...... Sorry about that.

:)
geecee

geecee · March 28, 2009, 07:49:35 PM

Hi kevin

QuoteThe for next loop in the get Sub string sub routine is basically doing what the MID$() function does, so why not use it.

Sub$=mid$(a$,Pos,Length)

I changed the subroutine to

PlayBASIC Code: [Select]

` ---------------------------------------------------
` Subroutine to get part message to write to screen
` ---------------------------------------------------
getsubstring:

  sub$=""
  sub$=mid$(a$,pos,length)
  setcursor across,down+(th/2)
  wait 100
  text across,down,sub$
    
  sync

return

Is this what you meant or have I got it wrong?

If I change the wait to 1000, it clearly does not work properly.

???
geecee

kevin · March 28, 2009, 09:43:29 PM

Why are you waiting 'before' it's drawn ? Surely you want to draw the fragment, then wait. So there's a pause at the end of each word.

Code Select


getsubstring:

  setcursor across,down+(th/2)
  text across,down,mid$(a$,pos,length)
  sync
  wait 1000

return

geecee · March 30, 2009, 07:30:50 PM

Just checked my programme again and found out why it wasn't working properly, I had all my lengths wrong ...... Instead of the number of characters, I had the position of the last character.

For example in

Code Select


      if randomseries(order)=1
        pos=1:length=10
        across=400-gettextwidth("Underware Design")/2
        gosub getsubstring
      endif
      if randomseries(order)=2
        pos=11:length=16
        across=419
        gosub getsubstring
      endif

Code Select

pos=11:length=16

should read

Code Select

pos=11:length=6

You probably by now have the gist of what I intended the programme to do, but here it is ...... this time in working order ...... I think.

PlayBASIC Code: [Select]

; PROJECT : Screen Title
; AUTHOR  : geecee
; CREATED : 28/03/2009
; EDITED  : 8/04/2009
; ---------------------------------------------------------------------

` Pre-load required fonts
global arial20 = loadnewfont("arial bold",20,0)
  
` Set text style and size
setfont arial20

` Determine text height
height=gettextheight("X")

` Declare array/s
dim randomseries(7)

` Determine number of times title will be shown
shows=rnd(9)+1

` Begin loop
repeat 
   
  ` Increment times counter
  inc times 
     
  `Set the ink colour to to a random colour
  Ink RndRGB()

  ` Write text to screen
  centertext 400,100,"This programme writes a screen title in random colour,"
  centertext 400,100+height*1,"one word at a time in random order"
    
  ` A short wait before proceeding
  sync
  wait 1000

  ` This command will turn the mouse pointer off
  mouse off

  ` Go to subroutine to get 7 numbers in random order
  gosub sevenrandomnumbers

    ` Display words of screen title in random order
    for order=1 to 7
       
      if randomseries(order)>=1 and randomseries(order)<=2
        a$="Underware Design"
        down=290
      else
        a$="The Home of Play Basic"
        down=310 
      endif
      
      Select randomseries(order)
        case 1
          pos=1:length=10
          across=400-gettextwidth("Underware Design")/2
          gosub getsubstring
        case 2
          pos=11:length=6
          across=419
          gosub getsubstring
        case 3
          pos=1:length=4
          across=400-gettextwidth("The Home of Play Basic")/2
          gosub getsubstring
        case 4
          pos=5:length=5
          across=342 
          gosub getsubstring    
        case 5
          pos=10:length=2
          across=392
          gosub getsubstring    
        case 6
          pos=13:length=5
          across=412
          gosub getsubstring    
        case 7
          pos=18:length=6
          across=450
          gosub getsubstring
      EndSelect
      
    next order
    
  ` A short wait before proceeding
  sync
  wait 1000
  
    if times<shows 
      ` Draw a box to hide previous text at location
      boxc 0,0,799,599,1,rgb(0,0,0)  
    endif
    
    sync
  
` End loop
until times=shows

` Begin loop
repeat

  ` Increment flashes counter   
  inc flashes
  
  ` Draw box to hide previous text at location
  boxc 2,290,798,340,1,rgb(0,0,0)
  
     ` Flash the text on and off every 1/10 of a second.
     if textTime <= timer()
       textToggle = Not textToggle
       textTime = timer()+100
     endif
     if textToggle <> 0
       centertext 400,290,"Underware Design"
       centertext 400,310,"The Home of Play Basic"
     endif

  sync
  
` End loop
until flashes=1000

` Write text to screen
centertext 400,500,"Press any key to exit"
sync

` Wait for a key press
waitkey

` End programme
end

` ---------------------------------------------------
` Subroutine to get part message to write to screen
` ---------------------------------------------------
getsubstring:

  setcursor across,down+(th/2)
  text across,down,mid$(a$,pos,length)
  sync
  wait 100

return

` -----------------------------------------------------------

Login required to view complete source code

:)
geecee

geecee · April 07, 2009, 04:12:00 AM

Hi there!

Just enhanced the posting « Reply #5 on: March 31, 2009, 12:30:50 PM »

:)
geecee

kevin · April 07, 2009, 07:44:56 AM

Rather than falling through the 7 if/endif statements. Check out how Select/Case/EndSelect statements work.

Code Select


  Select randomseries(order)
	case 1
             do stuff
	case 2
             do stuff
	case 3
             do stuff

  etc

EndSelect

geecee · April 07, 2009, 07:29:34 PM

Thanks for your reply kevin.

Looks better ...... Have modified the post « Reply #5 on: March 31, 2009, 12:30:50 PM »

:)
geecee

kevin · April 07, 2009, 10:44:43 PM

The gosub can be removed from each case and performed after the endselect. So the select seeds the values for this word, then we call the gosub to draw it.

eg.

PlayBASIC Code: [Select]

      Select randomseries(order)
        case 1
          pos=1:length=10
          across=400-gettextwidth("Underware Design")/2
        case 2
          pos=11:length=6
          across=419
        case 3
          pos=1:length=4
          across=400-gettextwidth("The Home of Play Basic")/2
        case 4
          pos=5:length=5
          across=342 
        case 5
          pos=10:length=2
          across=392
        case 6
          pos=13:length=5
          across=412
        case 7
          pos=18:length=6
          across=450
      EndSelect
     gosub getsubstring

News:

Screen Title