From 37fc0b25d852dba0ce7a329678c5c30a028be00f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Anton=20=C5=A0ijanec?= Date: Mon, 30 Mar 2020 15:24:15 +0200 Subject: initial commit --- BIC.FOR | 12 ++++ BRI.FOR | 9 +++ ICH.FOR | 15 +++++ KRI.FOR | 8 +++ PALICE.FOR | 80 ++++++++++++++++++++++++++ PKURZ.FOR | 41 ++++++++++++++ POH.FOR | 10 ++++ SPACE.FOR | 8 +++ ZMA.FOR | 47 ++++++++++++++++ ZVEZDE.FOR | 186 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 416 insertions(+) create mode 100644 BIC.FOR create mode 100644 BRI.FOR create mode 100644 ICH.FOR create mode 100644 KRI.FOR create mode 100644 PALICE.FOR create mode 100644 PKURZ.FOR create mode 100644 POH.FOR create mode 100644 SPACE.FOR create mode 100644 ZMA.FOR create mode 100644 ZVEZDE.FOR 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 '' + 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 '' + 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 '' + 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 '//) + 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 '' + 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') + PAUSE '' + 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') + PAUSE ' ' + 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 + -- cgit v1.2.3