PROGRAM ZVEZDE DIMENSION IZV(100) CHARACTER CH(10)*40,CR*2 IO=0 WRITE(*,10) 10 FORMAT(' ') WRITE(*,20) 20 FORMAT(' P O Z D R A V L J E N Z V E Z D N I I G R A L E C', * 2X,'!'///) WRITE(*,30) 30 FORMAT(1X,'Pravila - Midva bova igrala. Izberi do 10 vrstic', * 1x,'in v vsaki vrstici do 20'/1x,'zvezd. Ko bos na potezi,', * 1x,'poberi iz poljubne vrstice vsaj eno zvezdo ali vec.'/, * 1x,'Zaradi mene lahko poberes tudi celo vrstico zvezd. Sve', * 'tujem vsaj 4'/,1x,'zacetne vrstice, sicer si neresen igral', * 'ec.'/,1x,'Kdor pobere zadnjo zvezdo, je izgubil!'//) WRITE(*,40) 40 FORMAT(1X,'Posebno navodilo - Ce kupujes transformatorje,', * 1x,'kupuj le v Tovarni transforma-'/1x,'torjev Ljubljana,', * 1x,'ce pa so zelo majhni, pri ELMI v Ljubljani. Naj te pri', * 1x,'nakupu'/1x,'ne moti morebiten neuspeh pri zvezdicah!'//) WRITE(*,45) 45 FORMAT(1X,'Ce si jezen, koncaj z Ctrl C'//) WRITE(*,50) 50 FORMAT(1X,'Za nadaljevanje pritisni '//) WRITE(*,51) 51 FORMAT(1X,'(c) Lenasi 1990') C PAUSE ' ' read(*,*) 54 WRITE(*,10) WRITE(*,31) 31 FORMAT(1X,'N I V O J I Z N A N J A '///) 33 WRITE(*,32) 32 FORMAT(1X,'Nivo 1 .... Zacetnik'//1x,' 2 .... Kar gre'//1x, * ' 3 .... Zdi se, da znam'//1x,' 4 .... Mojster'///1x, * 'Izberem nivo stevilka=',$) read(*,*,ERR=35,IOSTAT=IO)NIVO 35 IF((NIVO.LT.1.OR.NIVO.GT.4).OR.(IO.NE.0)) THEN IO=0 WRITE(*,*)'Popravi!',' ',' ' GO TO 33 ENDIF C PAUSE '' WRITE(*,*)'' read(*,*) WRITE(*,10) 55 WRITE(*,60) 60 FORMAT(1X,'Stevilo'/1x,'vrstic =',$) READ(*,*,ERR=65,IOSTAT=IO)N 65 IF((N.GT.10.OR.N.LT.1).OR.(IO.NE.0)) THEN IO=0 WRITE(*,70) 70 FORMAT(1X,'Popravi!',' ',' ') GO TO 55 ENDIF DO 90 I=1,N 79 WRITE(*,80)I 80 FORMAT(' Stevilo zvezd'/1x,'v ',I2,'. vrstici =',$) READ(*,*,ERR=85,IOSTAT=IO)IZV(I) 85 IF((IZV(I).GT.20.OR.IZV(I).LT.1).OR.(IO.NE.0)) THEN IO=0 II=2*I+3 WRITE(*,81) 81 FORMAT(1X,'Popravi!') CALL PKURZ(II,16,IND) WRITE(*,82) 82 FORMAT(' ') II=II-2 CALL PKURZ(II,1,IND) WRITE(*,83) 83 FORMAT('v') GO TO 79 ENDIF 90 CONTINUE IVVS=0 DO 100 I=1,N IVVS=IVVS+IZV(I) KA=0 IPRA=INT((40-IZV(I)*2)/2)+1 DO 100 J=1,40 IF((J.LE.IPRA).OR.(J.GT.(IPRA+IZV(I)*2))) THEN CH(I)(J:J)=' ' ELSE IF(KA.EQ.0) THEN CH(I)(J:J)='*' KA=1 ELSE CH(I)(J:J)=' ' KA=0 ENDIF ENDIF 100 CONTINUE CALL ICH(CH,IZV,N) CALL PKURZ(1,1,IND) C PAUSE ' ' C CALL BRI C CALL PKURZ(1,1,IND) C PAUSE ' ' CALL PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON) CALL GETTIM(L,M,I,K) IF(NIVO.EQ.1) KI=20 IF(NIVO.EQ.2) KI=30 IF(NIVO.EQ.3) KI=40 IF(NIVO.EQ.4) KI=50 IZA=0 IF((IZMA.EQ.1).AND.(K.LE.KI)) IZA=1 IF((IZMA.EQ.0).AND.(K.LT.(100-KI))) IZA=1 IF(IZA-1)135,110,110 110 IF(KON.EQ.1) GO TO 1000 CALL BRI CALL PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON) IF(KON.EQ.1) GO TO 1000 CALL PKURZ(4,1,IND) WRITE(*,120)IVRSTA,IPALIC 120 FORMAT(1X,'Moja poteza'/1x,'Iz vrste =',I3/ * 1x,'vzamem zvezd =',I3//1x,'Na sliki je'/1x,'staro stanje') C PAUSE '' write(*,*)'' read(*,*) CALL BRI CALL BIC(CH,IVRSTA,IPALIC) IZV(IVRSTA)=IZV(IVRSTA)-IPALIC CALL ICH(CH,IZV,N) C CALL PKURZ(4,1,IND) C WRITE(*,130) C130 FORMAT(1X,'Novo stanje,'/1x,'tvoja poteza') C PAUSE '' 135 IF(KON.EQ.1) GO TO 1000 CALL PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON) IF(IZMA.EQ.0) IZMA=1 IF(IZMA.EQ.1) IZMA=0 IF(KON.EQ.1) GO TO 1000 CALL BRI CALL PKURZ(4,1,IND) 139 WRITE(*,140) 140 FORMAT(1X,'Tvoja poteza'/1x,'Iz vrste =',$) READ(*,*,ERR=145,IOSTAT=IO)IVRSTA M=IVRSTA 145 IF((IZV(M).EQ.0.OR.(M.LT.1.OR.M.GT.N)).OR.(IO.NE.0)) THEN IO=0 WRITE(*,150) 150 FORMAT(1X,'Popravi!',' ',' ',$) GO TO 139 ENDIF 159 WRITE(*,160) 160 FORMAT(1X,'vzamem zvezd =',$) READ(*,*,ERR=165,IOSTAT=IO)IPALIC 165 IF((IPALIC.LT.1.OR.IPALIC.GT.IZV(IVRSTA)).OR.(IO.NE.0)) THEN IO=0 WRITE(*,170) 170 FORMAT(1X,'Popravi!',' ',' ') GO TO 159 ENDIF WRITE(*,180) 180 FORMAT(//1X,'Na sliki je'/1x,'staro stanje') C PAUSE ' ' write(*,*)'' read(*,*) CALL BRI CALL BIC(CH,IVRSTA,IPALIC) IZV(IVRSTA)=IZV(IVRSTA)-IPALIC CALL ICH(CH,IZV,N) C CALL PKURZ(4,1,IND) C WRITE(*,190) C190 FORMAT(1X,'Novo stanje,'/1x,'moja poteza') C PAUSE ' ' GO TO 110 1000 WRITE(*,10) INDEK=0 IF(N.LE.3.OR.IVVS.LE.8) INDEK=1 IF(IZMA.EQ.1) THEN CALL ZMA GO TO 1010 ELSE IF(INDEK.EQ.1) THEN CALL KRI GO TO 1010 ELSE CALL POH GO TO 1010 ENDIF ENDIF 1010 WRITE(*,1020) 1020 FORMAT(1X,'Zelis nadaljevati? (DA/NE) =',$) READ(*,1)CR 1 FORMAT(A2) IF(CR(1:1).EQ.'D'.OR.CR(1:1).EQ.'d') GO TO 54 IF(CR(1:1).EQ.'N'.OR.CR(1:1).EQ.'n') GO TO 1030 WRITE(*,*)' ',' ',' ' GO TO 1010 1030 CONTINUE END