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