Lingo

[geecee]

Hi there!

Here's a little programme I found in the August 1985 issue of the Sinclair Programs magazine and which I have converted to run in PB ...... Not that it needed much conversion.

It's called LINGO and it is as much a joke as it is a programme.

Each time you press the spacebar (or any key really ...... the spacebar just happens to be my personal preference), it will produce a gramatically correct but ludicrous sentence.

Vocabulary of your own can be added to the listing, making it easy to construct computerised greetings or insults.

PlayBASIC Code: [Select]

rem Declare array/s
dim message$(4)

rem Load the "Arial" font as font 2, size 20, in the normal style
LoadFont "Arial",2,20,0
 
rem Set Font 2 as the current font.
SetFont 2 

rem Get height of text
height=gettextheight("Arial")

rem Write text to screen
message$(1)="LINGO is a joke as much as it is a programme.  Each time you press the spacebar LINGO will"
message$(2)="produce a gramatically correct but ludicrous sentence.  Vocabulary of your own can be added"
message$(3)="to the listing, making it easy to construct computerised greetings or insults."

rem Determine width of longest text line
tw=gettextwidth("produce a gramatically correct but ludicrous sentence.  Vocabulary of your own can be added")

rem Set down coordinate
down=0

rem Write text to screen
for n=1 to 3
  down=down+(height*2)
  text 400-tw/2,down,message$(n)
next

centertext 400,300,"Press any key to start"

rem Display the screen and wait for key press
sync  
waitkey
waitnokey

rem Draw box to hide previous text at location 
boxc 2,300,798,320,1,rgb(0,0,0)

start:
rem Determine random variables
q=rnd(4)+1:w=rnd(4)+1:e=rnd(4)+1:r=rnd(4)+1:t=rnd(4)+1:y=rnd(4)+1:u=rnd(4)+1

   select q
     case 1
        q$="Greedy "
     case 2
        q$="Moronic "
     case 3
        q$="Hairy "
     case 4
        q$="Dirty "
     case 5 
        q$="Ugly "
   endselect
   select w
     case 1
        w$="Gorilla "
     case 2
        w$="Bus Conductress "
     case 3
        w$="Warthog "
     case 4
        w$="Grave Digger "
     case 5
        w$="Hippy "
   endselect
   select e
     case 1
        e$="Burps "
     case 2
        e$="Eats "
     case 3
        e$="Perches "
     case 4
        e$="Rasps "
     case 5
        e$="Slavers "
   endselect
   select r
     case 1
        r$="Incessantly "
     case 2
        r$="Noisily "
     case 3
        r$="Hungrily "
     case 4
        r$="Violently "
     case 5
        r$="Skilfully "
   endselect
   select t
     case 1
        t$="In "
     case 2
        t$="Inside "
     case 3
        t$="Above "
     case 4
        t$="Through "
     case 5
        t$="Outside "
   endselect
   select y
     case 1
        y$="Slimy "
     case 2
        y$="Mouldy "
     case 3
        y$="Smelly "
     case 4
        y$="Ricketty "
     case 5
        y$="Ancient "
   endselect
   select u
     case 1
        u$="Bridge"
     case 2
        u$="Toilet"
     case 3
        u$="Chip Shop"
     case 4
        u$="Mansion"
     case 5
        u$="Subway"
   endselect

rem Go to subroutine to print message
gosub printmessage

rem Write text to screen
centertext 400,560,"Press spacebar to rerun"

rem Display the screen and wait for key press
sync  
waitkey
waitnokey

rem Draw box to hide previous text at location 
boxc 2,300,798,320,1,rgb(0,0,0)

rem Return to start
goto start
end
rem ---------------------------------------------------
rem Subroutine to get part message to write to screen
rem ---------------------------------------------------

Login required to view complete source code

:)
enjoy
geecee

Some of my other contributions
My first programme in PB - Magic Square

[kevin]

 Here's a version that a little more expandable.

PlayBASIC Code: [Select]

   rem Load the "Arial" font as font 2, size 20, in the normal style
   LoadFont "Arial",2,20,0
 
   rem Set Font 2 as the current font.
   SetFont 2 

   rem Get height of text
   height=gettextheight("Arial")


   rem Declare array/s
   dim message$(4)

   rem Write text to screen

   message$(1)="LINGO is a joke as much as it is a programme.  Each time you press the spacebar LINGO will"
   message$(2)="produce a gramatically correct but ludicrous sentence.  Vocabulary of your own can be added"
   message$(3)="to the listing, making it easy to construct computerised greetings or insults."

   rem Determine width of longest text line
   tw=gettextwidth("produce a gramatically correct but ludicrous sentence.  Vocabulary of your own can be added")

   rem Set down coordinate
   down=0

   rem Write text to screen
   for n=1 to 3
     down=down+(height*2)
     Centertext 400,down,message$(n)
   next

   centertext 400,300,"Press any key to start"

   rem Display the screen and wait for key press
   sync  
   waitkey
   waitnokey

   rem Draw box to hide previous text at location 
   boxc 2,300,798,320,1,rgb(0,0,0)



   // Hold the 7 lists of the words in ann array, so we can loop through to solve them all 
   Dim WordLists$(7)

   WordLists$(1) = "Greedy,Moronic,Hairy,Dirty,Ugly"
   WordLists$(2) = "Gorilla,Bus Conductress,Warthog,Grave Digger,Hippy"
   WordLists$(3) = "Burps,Eats,Perches,Rasps,Slavers"
   WordLists$(4) = "Incessantly,Noisily,Hungrily,Violently,Skilfully"
   WordLists$(5) = "In,Inside,Above,Through,Outside"
   WordLists$(6) = "Slimy,Mouldy,Smelly,Ricketty,Ancient"
   WordLists$(7) = "Bridge,Toilet,Chip Shop,Mansion,Subway"


   // temp array, used to seperate a word list into indivual words
   Dim Splitwords$(100)

   // The ranomdaly selected words from each of the word lists 
   Dim Sentence$(7)


Do

   For Wordlp = 1 to 7
      WordCount =SplitToArray(WordLists$(WordLp),",",Splitwords$(),1)
      WordIndex = rndrange(1,WordCount)
      Sentence$(Wordlp) =SplitWords$(WordIndex)
   next

   rem Go to subroutine to print message
   gosub printmessage

   rem Write text to screen
   centertext 400,560,"Press spacebar to rerun"

   rem Display the screen and wait for key press
   sync  
   waitkey
   waitnokey

   rem Draw box to hide previous text at location 
   boxc 2,300,798,320,1,rgb(0,0,0)

   rem Return to start
loop





rem ---------------------------------------------------
rem Subroutine to get part message to write to screen
rem ---------------------------------------------------
printmessage:

      s$="The "
      for lp=1 to 7
         s$=s$+Sentence$(lp)+" "
         if lp=5
            s$=s$+"the "
         endif
      next
   
     rem Write text to screen   
     CenterText 400,300,s$
    
   return 

[geecee]

Thanks for your reply kevin.

As usual, most helpful ...... Much appreciated

:)
geecee