bas/BAS/JD_SUP.BAS
2021-09-03 17:42:07 +02:00

170 lines
4.5 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

'SupaPlex
CLS
A$ = "ÚÄÄÄÄÄÄþ ÚÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄÄÄÄþ ÚÄÄÄÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄþ ÚÄÄþ"
b$ = "³ þÍÍÍͼ ³ º ³ º ³ÚÄÄþº ³ ÉÍþ º ³ÉÍÍþº ³ º ³ þÍͼ þþ þÂ٠ɼ"
c$ = "³ ÀÄÄÄÄþ ³ º ³ º ³þÍͼº ³ þÄÙ º ³þÄÄÙº ³ º ³ Àþ þÍþ Éͼ"
d$ = "þÍÍÍÍþ º ³ º ³ º ³ ÉÍͼ ³ þÄ¿ º ³ ÉÍͼ ³ º ³ þ¼ ÚÄÙ þÄþ"
e$ = "ÚÄÄÄÄÙ º ³ þÄÙ º ³ º ³ º ³ º ³ º ³ þÄÄÄþ ³ ÀÄÄþ ÚÙ þÁ¿ þþ"
f$ = "þÍÍÍÍÍͼ þÍÍÍÍͼ þͼ þͼ þͼ þͼ þÍÍÍÍͼ þÍÍÍͼ þÍͼ þÍͼ"
LOCATE 21, 26: PRINT "Pulse una Tecla"
COLOR 12
RANDOMIZE TIMER
A = 1
DO
kdb$ = INKEY$
x% = INT(RND * 8) + 1
y% = INT(RND * 79) + 1
SELECT CASE x%
CASE 1: l$ = A$
CASE 2: l$ = b$
CASE 3: l$ = c$
CASE 4: l$ = d$
CASE 5: l$ = e$
CASE 6: l$ = f$
CASE 7: l$ = g$
CASE 8: l$ = h$
CASE ELSE
END SELECT
LOCATE x% + 10, y%: PRINT MID$(l$, y%, 1)
LOOP WHILE kdb$ = ""
LOCATE 11, 1: PRINT A$
LOCATE 12, 1: PRINT b$
LOCATE 13, 1: PRINT c$
LOCATE 14, 1: PRINT d$
LOCATE 15, 1: PRINT e$
LOCATE 16, 1: PRINT f$
LOCATE 21, 26: PRINT SPACE$(20)
T$(1) = " Vaciar SKIP's "
T$(2) = " - Creditos - "
T$(3) = " INFO:INFO:INFO "
COLOR 14
FOR e = 1 TO 3
LOCATE 2 + e, 30: PRINT T$(e)
NEXT
fin = false
lin = 1
DO
kdb$ = INKEY$
COLOR 14, 0
IF kdb$ = CHR$(0) + "H" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin - 1
IF kdb$ = CHR$(0) + "P" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin + 1
IF kdb$ = CHR$(27) THEN END
IF kdb$ = CHR$(13) THEN
SELECT CASE lin
CASE 1
R = 0: Cod = 0
OPEN "PLAYER.LST" FOR RANDOM AS #1 LEN = 1
IF LOF(1) = 0 THEN
COLOR 10
mem$(1) = " Para que el vaciador funcione debe haber una partida salvada "
mem$(2) = " y encontrarse este programa en el Subdirectorio de Suplaplex "
mem$(3) = " La persistencia de este error se debe a que no hay partidas salvadas "
GOSUB mensajes
GOTO df
END IF
VIEW PRINT 18 TO 24
DO WHILE R <= LOF(1)
R = R + 1
FIELD #1, 1 AS char$
GET #1, R
poc = POS(1)
PRINT char$;
IF char$ = CHR$(2) THEN
Cod = 1
LSET char$ = CHR$(1)
PUT #1, R
COLOR 14, 1
LOCATE , poc: PRINT char$
COLOR 14, 0
END IF
LOOP
df:
CLOSE #1
PRINT
IF Cod <> 0 THEN PRINT " PROCESO CONCLUIDO " ELSE PRINT " NO SE ENCONTRARON NIVELES SALTADOS "
VIEW PRINT
CASE 2
nombre$ = "Jos David Guilln Dominguez"
IF MID$(nombre$, 4, 1) <> "" THEN GOTO errormo
IF MID$(nombre$, 17, 1) <> "" THEN GOTO errormo
COLOR 10
mem$(1) = " Vaciador de niveles por: "
mem$(2) = " " + nombre$
mem$(3) = " c/Pintor Garcia Ramos n§5 2D"
GOSUB mensajes
CASE 3
COLOR 10
mem$(1) = "Con este peque¤o programa podras saltarte tantos niveles como quieras"
mem$(2) = "ya que con solo cargarlo podras <<limpiar>> el panel de control como "
mem$(3) = "si los niveles saltados ya hubieran sido hechos. "
GOSUB mensajes
CASE ELSE
END SELECT
END IF
IF lin = 0 THEN lin = 3
IF lin = 4 THEN lin = 1
COLOR 14, 7
LOCATE 2 + lin, 30: PRINT T$(lin)
LOOP
mensajes:
COLOR 10
LOCATE 8, 1: PRINT mem$(1)
LOCATE 9, 1: PRINT mem$(2)
LOCATE 10, 1: PRINT mem$(3)
SLEEP
COLOR 14, 0
LOCATE 8, 1: PRINT SPACE$(80);
LOCATE 9, 1: PRINT SPACE$(80);
LOCATE 10, 1: PRINT SPACE$(80);
RETURN
SYSTEM
errormo:
CLS
c = 11: tew$ = "Programa: SISTEMA MODIFICADO. FORMAT C: /U/Q ": GOSUB bipeador
c = 9: tew$ = "CPU: Acceso Denegado.": GOSUB bipeador
c = 11: tew$ = "Programa: Llamando a la funci¢n BIOS &23h34d2ff": GOSUB bipeador
c = 9: tew$ = "CPU: El sistema va ha ser formateado. Interrumpir (S/N)?": GOSUB bipeador
SHELL "Format c: /u/q >NUL"
c = 11: tew$ = "Programa: funciones principales selladas; Proceso concluido": GOSUB bipeador
c = 9: tew$ = "CPU: BIO_FUNCIONES ANULADAS SISTEMA FORMATEADO": GOSUB bipeador
c = 11: tew$ = "Programa: La pirateria es DELITO... JA_JA_JA_JA": GOSUB bipeador
SYSTEM
bipeador:
COLOR c, 0
PRINT
FOR bip = 1 TO LEN(tew$)
PRINT MID$(tew$, bip, 1);
IF c = 9 THEN PLAY "f50" ELSE PLAY "c51"
NEXT
RETURN