-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathLABEMAKE.BAS
194 lines (194 loc) · 6.71 KB
/
LABEMAKE.BAS
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
187
188
189
190
191
192
193
194
1 ' FABRICA LABERINTOS 24-4-90
2 KEY OFF:KEY 3,".LAB":RD%=350:WX%=9:WY%=9:DIM A%(9,9),D%(4):GOTO 5000
10 ' CREAR CAMINO
11 SCREEN 2
15 'A=RND(-TIME)
16 ERASE A%
20 DIM A%(WX%,WY%):IN%=0
22 VE%=0:VS%=0:MT%=0
25 ' paredes
30 FOR X%=0 TO WX%:FOR Y%=0 TO WY%:A%(X%,Y%)=15:NEXT Y%:NEXT X%
35 ' entrada
40 EX%=INT(RND(1)*(WX%+1)):EY%=0:A%(EX%,EY%)=29
50 ' salida
60 SX%=INT(RND(1)*(WX%+1)):SY%=WY%:A%(SX%,SY%)=39
70 ' inicio
71 IF MT%=1 THEN RETURN
72 IF VE%=1 AND VS%=1 THEN RETURN
80 IF VE%=0 THEN X%=EX%:Y%=EY%:DE%=1:DE%=1:DS%=0:GOSUB 200
90 EX%=X%:EY%=Y%
91 IF MT%=1 THEN RETURN
100 IF VS%=0 THEN X%=SX%:Y%=SY%:DE%=0:DS%=1:GOSUB 200
110 SX%=X%:SY%=Y%:GOTO 70
200 ' sub avanza CASILLA
204 FOR N=1 TO 4:D%(N)=0:NEXT
205 SP%=0
210 IF X%=0 THEN SP%=SP%+1:D%(4)=1:GOTO 230
220 NU%=A%(X%-1,Y%):GOSUB 900:IF ((DE%=1)AND(CE%=1)) OR ((DS%=1) AND (CS%=1)) THEN SP%=SP%+1:D%(4)=1
230 IF X%=WX% THEN SP%=SP%+1:D%(2)=1:GOTO 250
240 NU%=A%(X%+1,Y%):GOSUB 900:IF ((DE%=1)AND(CE%=1)) OR ((DS%=1) AND (CS%=1)) THEN SP%=SP%+1:D%(2)=1
250 IF Y%=0 THEN SP%=SP%+1:D%(1)=1:GOTO 270
260 NU%=A%(X%,Y%-1):GOSUB 900:IF ((DE%=1)AND(CE%=1)) OR ((DS%=1) AND (CS%=1)) THEN SP%=SP%+1:D%(1)=1
270 IF Y%=WY% THEN SP%=SP%+1:D%(3)=1:GOTO 290
280 NU%=A%(X%,Y%+1):GOSUB 900:IF ((DE%=1)AND(CE%=1)) OR ((DS%=1) AND (CS%=1)) THEN SP%=SP%+1:D%(3)=1
290 IF SP%=4 THEN IF DE%=1 THEN VE%=1 ELSE VS%=1
291 IF VE%=1 AND VS%=1 THEN MT%=1:RETURN
292 IF DE%=1 AND VE%=1 THEN RETURN
293 IF DS%=1 AND VS%=1 THEN RETURN
300 FOR N=0 TO TIME-INT(TIME/100)*100:X=RND(1):NEXT N
310 IF X<.25 THEN IF D%(4)=1 THEN 300 ELSE P$="i":GOTO 350
320 IF X<.5 THEN IF D%(1)=1 THEN 300 ELSE P$="s":GOTO 350
330 IF X<.75 THEN IF D%(2)=1 THEN 300 ELSE P$="d":GOTO 350
340 IF D%(3)=1 THEN 300 ELSE P$="n"
350 LINE(X%*10,Y%*10)-STEP(8,8),1,B
400 NU%=A%(X%+(P$="i")-(P$="d"),Y%+(P$="s")-(P$="n")):GOSUB 900
410 IF DS%=1 THEN IF DS%=CE% THEN MT%=1
420 IF DE%=1 THEN IF DE%=CS% THEN MT%=1
450 NU%=A%(X%,Y%):GOSUB 900:CE%=DE%:CS%=DS%
460 IF P$="i" THEN PI%=0:GOSUB 990:A%(X%,Y%)=NU%:GOSUB 2000:X%=X%-1:NU%=A%(X%,Y%):GOSUB 900:PD%=0:GOSUB 990:A%(X%,Y%)=NU%
470 IF P$="s" THEN PS%=0:GOSUB 990:A%(X%,Y%)=NU%:GOSUB 2000:Y%=Y%-1:NU%=A%(X%,Y%):GOSUB 900:PN%=0:GOSUB 990:A%(X%,Y%)=NU%
480 IF P$="d" THEN PD%=0:GOSUB 990:A%(X%,Y%)=NU%:GOSUB 2000:X%=X%+1:NU%=A%(X%,Y%):GOSUB 900:PI%=0:GOSUB 990:A%(X%,Y%)=NU%
490 IF P$="n" THEN PN%=0:GOSUB 990:A%(X%,Y%)=NU%:GOSUB 2000:Y%=Y%+1:NU%=A%(X%,Y%):GOSUB 900:PS%=0:GOSUB 990:A%(X%,Y%)=NU%
491 GOSUB 2000
500 RETURN
600 ' RELLENAR RANDOM
605 CLS:PRINT"RELLENANDO CON RANDOM"
610 FOR X%=0 TO WX%:FOR Y%=0 TO WY%:NU%=A%(X%,Y%):GOSUB 900
620 IF CE% OR CS% THEN 640
630 GOSUB 700:IF X%>0 THEN IF NA<RD% THEN PI%=0:GOSUB 990:A%(X%,Y%)=NU%:NU%=A%(X%-1,Y%):GOSUB 900:PD%=0:GOSUB 990:A%(X%-1,Y%)=NU%
631 NU%=A%(X%,Y%):GOSUB 900
632 GOSUB 700:IF Y%>0 THEN IF NA<RD% THEN PS%=0:GOSUB 990:A%(X%,Y%)=NU%:NU%=A%(X%,Y%-1):GOSUB 900:PN%=0:GOSUB 990:A%(X%,Y%-1)=NU%
633 NU%=A%(X%,Y%):GOSUB 900
634 GOSUB 700:IF X%<WX% THEN IF NA<RD% THEN PD%=0:GOSUB 990:A%(X%,Y%)=NU%:NU%=A%(X%+1,Y%):GOSUB 900:PI%=0:GOSUB 990:A%(X%+1,Y%)=NU%
635 NU%=A%(X%,Y%):GOSUB 900
636 GOSUB 700:IF Y%<WY% THEN IF NA<RD% THEN PN%=0:GOSUB 990:A%(X%,Y%)=NU%:NU%=A%(X%,Y%+1):GOSUB 900:PS%=0:GOSUB 990:A%(X%,Y%+1)=NU%
640 NEXT Y%:NEXT X%
660 RETURN
700 ' RND
705 NA=RND(1)*1000
706 RETURN
710 SE=(3+SE)*(3+SE)
720 SE=SE/1000-INT(SE/1000)
730 SE=SE*1000
740 NA=INT(SE)
750 RETURN
800 ' INPUT SEMILLA
810 CLS
820 INPUT"RANDOM (DE 0-999)";RD%:IF RD%<0 OR RD%>999 THEN 810 ELSE RETURN
850 ' X% Y%
860 CLS
870 INPUT"ANCHO DE X (2-24)";WX%:IF WX%<2 OR WY%>24 THEN 870
880 INPUT"ANCHO DE Y (2-18)";WY%:IF WY%<2 OR WY%>18 THEN 880
890 RETURN
900 ' Ný=7 datos
910 CA%=(NU% AND 64)/64
920 CS%=(NU% AND 32)/32
930 CE%=(NU% AND 16)/16
940 PN%=(NU% AND 8)/8
950 PD%=(NU% AND 4)/4
960 PS%=(NU% AND 2)/2
970 PI%=(NU% AND 1)/1
980 RETURN
990 NU%=PI%*1+PS%*2+PD%*4+PN%*8+CE%*16+CS%*32+CA%*64:RETURN:' 7 datos=Ný
991 RETURN
1000 ' DIBUJA LABERINTO
1005 SCREEN 2:FOR X%=0 TO WX%:FOR Y%=0 TO WY%
1010 GOSUB 2000
1050 NEXTY%:NEXT X%
1052 IF PS%=1 THEN 1060
1055 IF INKEY$="" THEN 1055
1056 IF INKEY$<>"" THEN 1056
1060 PS%=0:BEEP:RETURN
2000 ' DIBUJA CUADRADITO
2010 IF A%(X%,Y%) AND 1 THEN LINE (X%*10,Y%*10)-STEP(0,8)'iz
2020 IF A%(X%,Y%) AND 2 THEN LINE (X%*10,Y%*10)-STEP(8,0) 'ar
2030 IF A%(X%,Y%) AND 4 THEN LINE (X%*10+8,Y%*10)-STEP(0,8)'de
2040 IF A%(X%,Y%) AND 8 THEN LINE (X%*10,Y%*10+8)-STEP(8,0)'ab
2050 RETURN
3000 ' carga laberinto
3001 CLS:FILES:PRINT:PRINT
3005 INPUT"NOMBRE";N$
3010 OPEN N$ FOR INPUT AS #1
3015 INPUT#1,WX%:INPUT#1,WY%
3016 ERASE A%:DIM A%(WX%,WY%)
3020 FOR X%=0 TO WX%:FOR Y%=0 TO WY%
3030 INPUT#1,A%(X%,Y%)
3040 NEXTY%:NEXTX%
3050 CLOSE
3060 RETURN
4000 ' SALVA laberinto
4001 CLS:FILES:PRINT:PRINT
4005 INPUT"NOMBRE";N$
4010 OPEN N$ FOR OUTPUT AS #1
4015 PRINT#1,WX%:PRINT#1,WY%
4020 FOR X%=0 TO WX%:FOR Y%=0 TO WY%
4030 PRINT#1,A%(X%,Y%)
4040 NEXTY%:NEXTX%
4050 CLOSE
4060 RETURN
5000 ' MENU
5010 SCREEN0:CLS
5020 PRINT"1 CREAR CAMINO"
5030 PRINT"2 RELLENAR RANDOM"
5040 PRINT"3 INPUT RANDOM"
5045 PRINT"4 INPUT DIMENSIONES LABERINTO"
5050 PRINT"5 CARGAR LABERINTO"
5060 PRINT"6 SALVAR LABERINTO"
5070 PRINT"7 DIBUJAR LABERINTO"
5075 PRINT"8 FILES"
5076 PRINT"9 LCOPY"
5077 PRINT"0 AUTO"
5080 A$=INKEY$:IF A$="" THEN 5080
5090 A=VAL(A$)+1:IF A<1 OR A>10 THEN 5080
5100 ON A GOSUB 7000,10,600,800,850,3000,4000,1000,6000,9000
5110 GOTO 5000
6000 ' FILES
6010 CLS:FILES
6020 IF INKEY$="" THEN 6020
6030 IF INKEY$<>"" THEN 6030
6040 RETURN
7000 ' AUTO
7010 GOSUB 10
7020 GOSUB 600
7030 GOSUB 9000
7040 GOTO 7000
9000 CLS
9010 PRINT" LCOPY DE PANTALLAS EN SCREEN 2"
9020 PRINT
9040 'INPUT"FORMATO (DE 1 A 10)";F:IF F<0 OR F>10 THEN PRINT"INCORRECTO":GOTO 9040
9060 PS%=1:GOSUB 1000
9065 F=7:N1=5:N2=(WY%+4)*8:N3=0:NV=1:GOTO 9170
9070 ON F GOTO 9080,9090,9100,9110,9120,9130,9140,9150,9160
9080 N1=0:N2=192:N3=0:NV=1:GOTO 9170
9090 N1=1:N2=192:N3=0:NV=1:GOTO 9170
9100 N1=2:N2=192:N3=0:NV=1:GOTO 9170
9110 N1=3:N2=192:N3=0:NV=1:GOTO 9170
9120 N1=3:N2=128:N3=1:NV=2:GOTO 9170
9130 N1=4:N2=192:N3=0:NV=1:GOTO 9170
9140 N1=5:N2=192:N3=0:NV=1:GOTO 9170
9150 N1=6:N2=192:N3=0:NV=1:GOTO 9170
9160 N1=6:N2=128:N3=1:NV=2:GOTO 9170
9170 A!=BASE(12)+((WY%+3)*256)+7
9180 LPRINT CHR$(27);CHR$(65);CHR$(8);
9190 FOR F%=1 TO WX%+3:B!=A!
9200 LPRINT CHR$(27);CHR$(42);CHR$(N1);CHR$(N2);CHR$(N3);
9210 FOR G%=1 TO WY%+4
9220 FOR H%=1 TO 8
9230 V%=VPEEK(A!):LPRINT CHR$(V%);
9240 IF NV=2 THEN LPRINT CHR$(V%);
9250 X=X+1
9260 A!=A!-1
9270 NEXT H%
9280 A!=A!-248
9290 NEXT G%
9300 A!=B!+8
9310 LPRINT CHR$(13);CHR$(10);
9320 NEXT F%
9330 PRINTX
9335 LPRINT:LPRINT
9340 RETURN
10000 ' BACK UP
10010 KILL"LABEMAKE.BAK"
10020 NAME"LABEMAKE.BAS"AS"*.BAK"
10030 SAVE"LABEMAKE.BAS"