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(' [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
|