summaryrefslogtreecommitdiffstats
path: root/ZVEZDE.FOR
blob: ce9e5798f523ea7a9f24903bab6b9cc1a7e226b7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
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