10 files changed, 416 insertions, 0 deletions

diff --git a/BIC.FOR b/BIC.FOR
new file mode 100644
index 0000000..5d0d202
--- /dev/null
+++ b/BIC.FOR
@@ -0,0 +1,12 @@
+	SUBROUTINE BIC(CH,IV,IP)
+	CHARACTER CH(10)*40
+	IPP=IP
+	DO 10 I=1,40
+	IF(CH(IV)(I:I).EQ.'*') THEN
+	CH(IV)(I:I)=' '
+	IPP=IPP-1
+	IF(IPP.EQ.0) RETURN
+	ENDIF
+10	CONTINUE
+	RETURN
+	END
diff --git a/BRI.FOR b/BRI.FOR
new file mode 100644
index 0000000..1506efb
--- /dev/null
+++ b/BRI.FOR
@@ -0,0 +1,9 @@
+	SUBROUTINE BRI
+	DO 10 I=1,23
+	CALL PKURZ(I,1,IND)
+	WRITE(*,5)
+5	FORMAT('                           ')
+10	CONTINUE
+	RETURN
+	END
+
diff --git a/ICH.FOR b/ICH.FOR
new file mode 100644
index 0000000..da6ccfe
--- /dev/null
+++ b/ICH.FOR
@@ -0,0 +1,15 @@
+	SUBROUTINE ICH(CH,IZV,N)
+	CHARACTER CH(10)*40
+	DIMENSION IZV(1)
+	CALL PKURZ(3,32,IND)
+	WRITE(*,1)
+1	FORMAT('Vr  Zv')
+	DO 10 I=1,N
+	II=2*I+3
+	CALL PKURZ(II,22,IND)
+	WRITE(*,5)I,IZV(I),CH(I)
+5	FORMAT(10X,I2,'. ',I2,1X,A40)
+10	CONTINUE
+	RETURN
+	END
+
diff --git a/KRI.FOR b/KRI.FOR
new file mode 100644
index 0000000..319d329
--- /dev/null
+++ b/KRI.FOR
@@ -0,0 +1,8 @@
+	SUBROUTINE KRI
+	WRITE(*,10)
+10	FORMAT(1X,'To ni nobena zmaga! S tako majhnim stevilom'/,
+     *  1x,'zvezdic se ne igra.')
+	PAUSE '<ENTER>'
+	RETURN
+	END
+
diff --git a/PALICE.FOR b/PALICE.FOR
new file mode 100644
index 0000000..61e19ee
--- /dev/null
+++ b/PALICE.FOR
@@ -0,0 +1,80 @@
+	SUBROUTINE PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON)
+	DIMENSION IZV(1),IPA(100)
+	IZMA=0
+	IMAK=0
+	KON=0
+	ISOTIC=0
+	DO 10 I=1,N
+	IF(IZV(I).GE.IMAK) THEN
+	IVMAK=I
+	IMAK=IZV(I)
+	ENDIF
+	ISOTIC=ISOTIC+IZV(I)
+10	IPA(I)=IZV(I)
+	IF(IMAK.EQ.0) THEN
+	IZMA=1
+	KON=1
+	RETURN
+	ENDIF
+	IF(ISOTIC.EQ.0) KON=1
+	J=0
+	KODA=0
+	DO 20 I=1,N
+20	IF(IZV(I).GE.2) J=J+1
+	IF(J.EQ.1) KODA=1
+	IF(J.EQ.0) KODA=2
+	LL=0
+	DO 21 L=1,N
+	IF(IPA(L).GT.0) LL=LL+1
+21	CONTINUE
+	ICC=MOD(LL,2)
+	IF((KODA.EQ.1).AND.(IMAK.GT.1)) THEN
+	IF(ICC.EQ.0) THEN
+	IVRSTA=IVMAK
+	IPALIC=IMAK
+	IZMA=1
+	RETURN
+	ELSE
+	IVRSTA=IVMAK
+	IPALIC=IMAK-1
+	IZMA=1
+	RETURN
+	ENDIF
+	ENDIF
+	DO 30 I=1,N
+	IF(IPA(I).EQ.0) GO TO 30
+	DO 25 J=1,IMAK
+	IPA(I)=IPA(I)-J
+	IF(IPA(I).EQ.-1) THEN
+	IPA(I)=IPA(I)+J
+	GO TO 30
+	ENDIF
+	CALL SRC(IPA,N,IND)
+	IF((KODA.EQ.0).AND.(IND.EQ.0)) THEN
+	IVRSTA=I
+	IPALIC=J
+	IZMA=1
+	RETURN
+	ENDIF
+25	IPA(I)=IPA(I)+J
+30	CONTINUE
+	IF((KODA.EQ.2).AND.(ICC.EQ.0)) IZMA=1
+C	IVRSTA=IVMAK
+C	IPALIC=1
+	CALL GETTIM(LU,LM,LS,L)
+	IZN=1
+	J=MOD(L,N)+1
+40	IF(IPA(J).EQ.0) J=J+IZN
+	IF(J.GT.N) THEN
+	IZN=-1
+	J=J-1
+	GO TO 40
+	ENDIF
+	IF(IPA(J).NE.0) GO TO 50
+	GO TO 40
+50	IVRSTA=J
+	IPALIC=1
+	RETURN
+	END
+
+
diff --git a/PKURZ.FOR b/PKURZ.FOR
new file mode 100644
index 0000000..5bec267
--- /dev/null
+++ b/PKURZ.FOR
@@ -0,0 +1,41 @@
+	SUBROUTINE PKURZ(IVR,IST,IND)
+C
+C Lenasi,maj 1990
+C
+C**********************************************************************
+C* Postavi kurzor na IVR vrstico in IST stolpec. IND je normalno 0,   *
+C* 1 je, ce prekoracimo stevilo 25 vrstic in 2, ce je stevilo stolpcev*
+C* vecje kot 80. Na tem mestu v glavnem programu napisemo ali ustrezno*
+C* delujemo. Po tem se kurzor prestavi na zacetek nove vrstice.       *
+C* IVR, IST, IND so INTEGER tipa.                                     *
+C**********************************************************************
+C
+C
+	J=4
+ 	IND=0
+	IF((IVR.LT.10).AND.(IST.LT.10)) J=1
+	IF((IVR.LT.10).AND.(IST.GE.10)) J=2
+	IF((IVR.GE.10).AND.(IST.LT.10)) J=3
+	IF(IVR.GT.25) THEN
+	IND=1
+	RETURN
+	ENDIF
+	IF(IST.GT.80) THEN
+	IND=2
+	RETURN
+	ENDIF
+	GO TO (10,20,30,40),J
+10	WRITE(*,15)IVR,IST
+15	FORMAT(' [',I1,';',I1,'H',$)
+	RETURN
+20	WRITE(*,25)IVR,IST
+25	FORMAT(' [',I1,';',I2,'H',$)
+	RETURN
+30	WRITE(*,35)IVR,IST
+35	FORMAT(' [',I2,';',I1,'H',$)
+	RETURN
+40	WRITE(*,45)IVR,IST
+45	FORMAT(' [',I2,';',I2,'H',$)
+	RETURN
+	END
+
diff --git a/POH.FOR b/POH.FOR
new file mode 100644
index 0000000..22347e9
--- /dev/null
+++ b/POH.FOR
@@ -0,0 +1,10 @@
+	SUBROUTINE POH
+	WRITE(*,10)
+10	FORMAT(1X,'Odlicno! Postajas mojster. Ko bos dobil na'/,
+     *  1x,'eno mojo zmago eno svojo, obvladas igro in za tebe'/,
+     *  1x,'ni vec zanimiva. Seveda pri primernem stevilu'/,1x,
+     *  'vrstic in zvezdic ter nivoju 4.')
+	PAUSE '<ENTER>'
+	RETURN
+	END
+
diff --git a/SPACE.FOR b/SPACE.FOR
new file mode 100644
index 0000000..d1713c7
--- /dev/null
+++ b/SPACE.FOR
@@ -0,0 +1,8 @@
+	SUBROUTINE SPACE
+	write(*,*)'ENTER'
+	READ(*,*)
+	DO  I=1,27
+	  WRITE(*,*)
+	ENDDO
+	RETURN
+	END
diff --git a/ZMA.FOR b/ZMA.FOR
new file mode 100644
index 0000000..e6ead50
--- /dev/null
+++ b/ZMA.FOR
@@ -0,0 +1,47 @@
+C	* subroutine dodal jaz da bi popravil gettime *
+	subroutine GetTim(ihr,imin,isec,i100th) 
+	integer(4), intent(out):: ihr, imin, isec, i100th 
+	character(8):: sdate 
+	character(10):: stime 
+	call date_and_time(sdate,stime)
+	read(sTime,"(I2,I2,I2,1x,I3)") ihr, imin, isec, i100th 
+	end subroutine GetTim 
+	SUBROUTINE ZMA
+	CALL GETTIM(LU,LM,LS,L)
+	I=INT(L/10)+1
+	GO TO (10,20,30,40,50,60,70,80,90,100),I
+10	WRITE(*,11)
+11	FORMAT(1X,'Smola - ne obupaj!')
+	GO TO 200
+20	WRITE(*,21)
+21	FORMAT(1X,'Vec treniraj!')
+	GO TO 200
+30	WRITE(*,31)
+31	FORMAT(1X,'Se vec treniraj!')
+	GO TO 200
+40	WRITE(*,41)
+41	FORMAT(1X,'Vprasanje je, ce vaja res dela mojstra.')
+	GO TO 200
+50	WRITE(*,51)
+51	FORMAT(1X,'Nisi samo ti slab. Tudi Janez je izgubljal.')
+	GO TO 200
+60	WRITE(*,61)
+61	FORMAT(1X,'Drugic bo bolje!')
+	GO TO 200
+70	WRITE(*,71)
+71	FORMAT(1X,'Ne gre ti dobro. Vec misli!')
+	GO TO 200
+80	WRITE(*,81)
+81	FORMAT(1X,'Predvsem pa brez panike! Casa za uk je dovolj.')
+	GO TO 200
+90	WRITE(*,91)
+91	FORMAT(1X,'Verjetno si politik. Po stilu sem te spoznal.')
+	GO TO 200
+100	WRITE(*,101)
+101	FORMAT(1X,'Izgubljas, toda tu in tam bos tudi dobil, ce'/
+     *  1x,'bos vadil.')
+200	CONTINUE
+	PAUSE '<ENTER>'
+	RETURN
+	END
+
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(' ')
+	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=',$)
+	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
+	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!','      ',' ')
+	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!','       ',' ',$)
+	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')
+	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) =',$)
+	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
+