© serviceprofessionalgmbh

The aim of the game is to guess a word of a certain length by guessing its individual letters. At the beginning the word in question will be drawn up symbolically and a list of all possible characters is displayed.

The player can either select a letter or try to solve the riddle. If a letter is chosen every occurance of this letter in the word will be disclosed. At the same time the letter gets removed from the list of remaining character selection list.

/* REXX
*/
"alloc fi(worte) da(dataset-name) shr reuse"
"execio * diskr worte (stem wort. finis"
do forever
   x=1
   abc='A B C D E F G H I J K L M N O P Q R S T U V W X Y Z'
   if wort.0=0 then leave
   i=random(1,wort.0)
   wort1=space(translate(wort.i),0)
   wort2=copies('.',length(wort1))
   do until wort2 = wort1
      say center("< Heinzi's lustiges Worteraten >",79,'-')
      say
      say center(wort2,79)
      say
      say 'Geben Sie einen Buchstaben, oder die Loesung ein (*=Ende)'
      say abc
      say;say
      say x'. Versuch';say
      pull ant
      select
         when ant='*' then do
            say "Das gesuchte Wort war" wort1
            say "Schaem Dich..."
            exit
         end
         when ant < 'A' ! ant > 'Z' then do
            say 'Nur ein Buchstabe oder die Loesung'
            say 'weiter mit '
            pull
            iterate
         end
         when x > 1 & length(ant) = 1 & ,
            index(abc,ant) = 0 then do
            say 'Buchstabe nicht mehr moeglich'
            say 'weiter mit '
            pull
            iterate
         end
         otherwise if length(ant) = 1 then call check
      end
      if ant=wort1 ! wort2=wort1 then do
         say 'Gut!'
         say 'Loesung im' x'. Versuch'
         loesung=''
         do x=1 to length(wort1)
            loesung=loesung!!substr(wort1,x,1)' '
         end
         say;say 'Loesung:' loesung;say;say
         say 'weiter mit '
         pull
         leave
      end
      x=x+1
   end /* until wort1 = wort2 */
   max=wort.0
   wort.i=wort.max
   wort.0=wort.0-1
end
say 'Bye, bye...'
exit

/* Beginn SUBROUTINE CHECK **************************/
check:
   do y=1 to length(wort1)
      if substr(wort1,y,1) = ant then
      wort2 = overlay(ant,wort2,y,1)
   end
   if index(abc,ant) > 0 then
      abc= overlay('-',abc,index(abc,ant),1)
return
/* Ende SUBROUTINE CHECK ****************************/
back to Fun & More