1 files changed, 186 insertions, 0 deletions
diff --git a/ZVEZDE.FOR b/ZVEZDE.FOR
new file mode 100644
index 0000000..ce9e579
--- /dev/null
+++ b/ZVEZDE.FOR
@@ -0,0 +1,186 @@
+	PROGRAM ZVEZDE
+	DIMENSION IZV(100)
+	CHARACTER CH(10)*40,CR*2
+	IO=0
+	WRITE(*,10)
+10	FORMAT(' [2J')
+	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')
+	PAUSE '  '
+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=[s',$)
+	read(*,*,ERR=35,IOSTAT=IO)NIVO
+35	IF((NIVO.LT.1.OR.NIVO.GT.4).OR.(IO.NE.0)) THEN
+	IO=0
+	WRITE(*,*)'Popravi![u','           ',' [10A'
+	GO TO 33
+	ENDIF
+	PAUSE '<ENTER>'
+	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![3;9H','      ',' [1;1H')
+	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')
+	PAUSE '<ENTER>'
+	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![5;11H','       ',' [4;1H',$)
+	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![6;15H','      ',' [5;1H')
+	GO TO 159
+	ENDIF
+	WRITE(*,180)
+180	FORMAT(//1X,'Na sliki je'/1x,'staro stanje')
+	PAUSE '<ENTER> '
+	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) =[s',$)
+	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(*,*)' [u','                      ',' [1A'
+	GO TO 1010
+1030	CONTINUE
+	END
+