path: root/ZVEZDE.FOR

	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 <ENTER>'//)
	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 '<ENTER>'
	WRITE(*,*)'<ENTER>'
	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 '<ENTER> '
C	CALL BRI
C	CALL PKURZ(1,1,IND)
C	PAUSE '<ENTER> '
	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 '<ENTER>'
	write(*,*)'<ENTER>'
	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 '<ENTER>'
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 '<ENTER> '
	write(*,*)'<ENTER>'
	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 '<ENTER> '
	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