PROGRAM C20141
C     TEXT VIDEOGAME: GUESS A SENTENCE
C     VIDEOGIOCO TESTUALE: INDOVINARE UNA FRASE
      CHARACTER SINPU1*5,SINPUX*2,SINPU2*5,SINPUT*14,COUTP1*78,
     * COUTP2*78,CRISP*1
      CHARACTER*14 V(70)
      LOGICAL LYES1,LYES2,DEBUG
      COMMON /VECTOR/V
      DEBUG=.FALSE.
      NMAX=70
      CALL SRAND(TIME())
      WRITE(*,*)
     * '******************************************************'
      WRITE(*,*)
     * '*                                                    *'
      WRITE(*,*)
     * '*             Castello 2014  (vers. 1)               *'
      WRITE(*,*)
     * '*                                                    *'
      WRITE(*,*)
     * '* Open source public domain software - Alexor (2014) *'
      WRITE(*,*)
     * '*                                                    *'
      WRITE(*,*)
     * '*                videogioco testuale                 *'
      WRITE(*,*)
     * '*                                                    *'
      WRITE(*,*)
     * '******************************************************'
4     CONTINUE
      WRITE(*,*)
      WRITE(*,*)'Siamo nella stanza del bibliotecario del castello.'
      WRITE(*,*)'scrivi g per giocare col bibliotecario'
      WRITE(*,*)'scrivi f per finire'
      READ(*,100)CRISP
      IF(CRISP.EQ.'g'.OR.CRISP.EQ.'G')GOTO 3
      WRITE(*,*)'Fine.'
      STOP
3     CONTINUE
      NPHRASE=1+INT(NMAX*RAND())
                IF(DEBUG)WRITE(*,*)'NMAX=',NMAX,' NPHRASE=',NPHRASE
      CALL XHELP
2     CONTINUE   
      WRITE(*,*)
      WRITE(*,*)'Scrivi quale potrebbe essere la frase:'
100   FORMAT(A)
      READ(*,100)SINPUT
      WRITE(*,*)'......................................'
      IF(SINPUT(1:4).EQ.'help'.OR.SINPUT(1:5).EQ.'aiuto')THEN
        CALL XHELP
        GOTO 2
      ENDIF
               IF(DEBUG)WRITE(*,*)'SINPUT=',SINPUT
      IF(SINPUT(1:4).EQ.'quit'.OR.SINPUT(1:4).EQ.'exit'.OR.
     * SINPUT(1:1).EQ.' ')STOP
      SINPU1=SINPUT(1:5)
               IF(DEBUG)WRITE(*,*)'SINPU1=',SINPU1,'<'
      SINPUX=SINPUT(7:8)
      SINPU2=SINPUT(10:14)
               IF(DEBUG)WRITE(*,*)'SINPU2=',SINPU2,'<'
      CALL XCOMM(NPHRASE,1,SINPU1,COUTP1,LYES1)
               IF(DEBUG)WRITE(*,*)'***uscito da XCOMM***'
      WRITE(*,*)COUTP1
      CALL XCOMM(NPHRASE,2,SINPU2,COUTP2,LYES2)
      WRITE(*,*)COUTP2
      IF(LYES1.AND.LYES2)THEN
        IF(SINPUX.EQ.V(NPHRASE)(7:8))THEN
          WRITE(*,*)
          WRITE(*,*)V(NPHRASE)
          WRITE(*,*)
          WRITE(*,*)'HAI INDOVINATO LA FRASE!'
          WRITE(*,*)
          GOTO 4
        ELSE
          WRITE(*,*)'ma ancora non ci siamo...'
        ENDIF
      ENDIF
      GOTO 2
      END

      SUBROUTINE XCOMM(N,I,SINPU5,COUTPU,LYES)
C     COMMENTS SIMILARITY OF I-TH WORD OF V(N) WITH SINPUT
      COMMON /VECTOR/V
      CHARACTER*14 V(70)*14,SINPU5*5,COUTP*52,C1*16,C2*32,
     * c3*16,c4*32,CCOMP*5,COUTPU*78
      LOGICAL LC2YES,LYES,DEBUG
      DEBUG=.FALSE.
               IF(DEBUG)WRITE(*,*)'entrato in XCOMM. N=',N
      COUTPU=''
      I1=1+(I-1)*9
               IF(DEBUG)WRITE(*,*)'I1=',I1
      I2=I1+4
               IF(DEBUG)WRITE(*,*)'I2=',I2
      CCOMP=V(N)(I1:I2)
         if(.FALSE.)write(*,*)'n=',N,' i=',i,' SINPU5=',SINPU5,' ',
     *    'CCOMP=',CCOMP,'*'
               IF(DEBUG)WRITE(*,*)'CCOMP=',CCOMP
      C1=''
      C2=''
      C3=''
      C4=''
      LC2YES=.FALSE.
      LYES=.FALSE.
      IF(SINPU5.EQ.CCOMP)THEN
        C2=' esatto!'
        LC2YES=.TRUE.
        LYES=.TRUE.
      ELSE
        IF(SINPU5(1:1).EQ.CCOMP(1:1))THEN
          LC2YES=.TRUE.
          C1=' inizia bene... '
          IF(SINPU5(2:2).EQ.CCOMP(2:2))THEN
            C2=C1//' si'' davvero... '
          ELSE
            C2=C1
          ENDIF
        ENDIF
        IF(SINPU5(5:5).EQ.CCOMP(5:5))THEN
          C3='finisce bene... '
          IF(SINPU5(4:4).EQ.CCOMP(4:4))THEN
            C4=C3//' si'' davvero... '
          ELSE
            C4=C3
          ENDIF
        ENDIF
      ENDIF
      IF(LC2YES)THEN
        COUTPU=SINPU5//'... '//C2//C4
      ELSE
        COUTPU=SINPU5//'... '//C4
      ENDIF
      IF(COUTPU.EQ.SINPU5//'...')COUTPU=SINPU5//'... non ci siamo'
      RETURN
      END

      SUBROUTINE XHELP
      WRITE(*,*)
      WRITE(*,*)'Bisogna indovinare una frase di 3 parole.'
      WRITE(*,*)'Inizia con una parola di 5 lettere, segue la',
     * 'parola ''di'', e poi un''altra parola di 5 lettere.'
      WRITE(*,*)'Il bibliotecario risponde con indicazioni sulle'
      WRITE(*,*)'prime e sulle ultime lettere delle parole.'
      WRITE(*,*)'Non scrivere lettere maiuscole e neanche accentate.'
      WRITE(*,*)'Il bibliotecario gioca con 70 frasi diverse.'
      RETURN
      END


      BLOCK DATA 
      integer nmax
      parameter (nmax=70)
      CHARACTER*14 v(nmax)
      common /vector/v
      data v/
     * 'carta di cuori',
     * 'scala di legno',
     * 'gatto di creta',
     * 'monte di fango',
     * 'ballo di festa',
     * 'regni di fiaba',
     * 'forza di agire',
     * 'balla di notte',
     * 'ballo di gioia',
     * 'tappo di ferro',

     * 'parte di legno',
     * 'porta di ferro',
     * 'toppa di porta',
     * 'parte di torta',
     * 'torta di festa',
     * 'festa di ballo',
     * 'bolla di spuma',
     * 'cerca di stare',
     * 'cerco di darti',
     * 'corpo di ballo',

     * 'parto di notte',
     * 'fiore di campo',
     * 'fiori di carta',
     * 'pesci di fiume',
     * 'forza di agire',
     * 'sfera di gomma',
     * 'sfera di legno',
     * 'sfera di vetro',
     * 'sfera di ferro',
     * 'palla di gomma',

     * 'palla di carta',
     * 'palla di legno',
     * 'palla di ferro',
     * 'fibra di vetro',
     * 'fibra di kapok',
     * 'suono di gioia',
     * 'gioia di udire',
     * 'fungo di bosco',
     * 'fungo di prato',
     * 'luogo di gioia',

     * 'suono di tuoni',
     * 'grida di gioia',
     * 'fango di bosco',
     * 'suono di corvi',
     * 'ballo di festa',
     * 'villa di ricco',
     * 'prato di valle',
     * 'borsa di cuoio',
     * 'cinta di cuoio',
     * 'cinta di gomma',

     * 'pasta di grano',
     * 'pasta di farro',
     * 'lacci di gomma',
     * 'odore di zolfo',
     * 'gusto di acido',
     * 'odore di pesce',
     * 'odore di carne',
     * 'gusto di pesce',
     * 'gusto di carne',
     * 'odore di carne',

     * 'fonte di soldi',
     * 'fonte di gioia',
     * 'grumo di terra',
     * 'cespo di verza',
     * 'punta di ferro',
     * 'punta di legno',
     * 'ponte di legno',
     * 'ponti di legno',
     * 'ponte fi ferro',
     * 'ponti di ferro'/
C    * 'baffo di gatto',
C    * 'baffi di gatta',
C    * 'sorte di donna',
C    * 'sorta di baffo',
C    * 'sorta di ponte',
C    * 'sorta di monte',
C    * 'gioco di bimbi',
C    * 'sedia di canne',
C    * 'panca di legno',
C    * 'panca di ferro',
C amore di bimbi mogli donna
C luogo di amori donne
C odore di pesca pesce fiori fango
C (fuori di testa)
C terna di frati
C pesce di costa
C pesca di frodo tonni
C pelle di leone/daino/serpe/tigre
C pasto di carne/pesce/leone/tigre
      end