Herramientas de usuario
es:basic:gwbasic:graficos.bas_y_edipant.bas
Graficos.bas y Edipant.bas
Una de mis primeras intenciones cuando me pasé al PC fue crear juegos arcade con gwbasic. Sin embargo, gwbasic era bastante limitado al respecto, ya que no se podían crear caracteres personalizados como en el ZX-Spectrum. Graficos.bas y Edipant.bas son un intento de crear un sistema de sprites para gwbasic, empleando la ineficiente instrucción “PSET”.
Edipant.bas
Es el programa con el que se crean las pantallas.
10 REM PROGRAMA CREADOR DE PANTALLAS 20 DIM P%(40,10):DIM A%(50,16,16) 30 REM MENU 40 CLS:SCREEN 0:PRINT "MENU" 50 PRINT "1- OPERACIONES CON ARCHIVOS" 60 PRINT "2- EDITAR PANTALLA" 70 INPUT R 80 IF R=1 THEN GOSUB 1000 90 IF R=2 THEN GOSUB 5000 100 GOTO 40 1000 REM OPERACIONES CON ARCHIVOS 1010 CLS:PRINT "OPERACIONES CON ARCHIVOS" 1020 PRINT "1- CARGAR NUEVOS CARACTERES GRAFICOS" 1030 PRINT "2- CARGAR PANTALLA" 1040 PRINT "3- GRABAR PANTALLA" 1050 PRINT "4- NUEVA PANTALLA" 1060 PRINT "5- SALIR A D.O.S." 1070 PRINT "6- VOLVER AL MENU" 1080 INPUT R 1090 IF R>6 THEN 1010 1095 IF R=6 THEN RETURN 1100 ON R GOTO 1500,2000,2500,3000,3500 1110 GOTO 1010 1500 REM CARGAR CARACTERES GRAFICOS 1510 REM HAN DE ESTAR CREADOS CON EL PROGRAMA 'GRAFICO' 1520 INPUT "NOMBRE DEL ARCHIVO";N$ 1530 IF LEN (N$)>8 THEN N$=MID$(N$,1,8) 1540 OPEN (N$+".OBJ") FOR INPUT AS #1 1550 FOR F=1 TO 50 1560 FOR G=1 TO 16 1570 INPUT #1,A$:IF A$=STRING$(16,"0") THEN GOTO 1600 1580 FOR H=1 TO 16 1590 A%(F,H,G)=VAL(MID$(A$,H,1)):NEXT 1600 NEXT :INPUT #1,C,D,A$:NEXT 1610 CLOSE #1:GOTO 1110 2000 REM CARGAR PANTALLA 2010 INPUT "¨SEGURO?";S$ 2020 IF MID$(S$,1,1)="N" OR MID$(S$,1,1)="n" THEN 1110 2030 IF MID$(S$,1,1)<>"S" AND MID$(S$,1,1)<>"s" THEN 2010 2040 INPUT "NOMBRE DEL ARCHIVO";N$ 2050 IF LEN (N$)>8 THEN N$=MID$(N$,1,8) 2060 OPEN (N$+".PAN") FOR INPUT AS #1 2070 FOR F=1 TO 10:INPUT #1,A$ 2080 FOR G=1 TO 40:P%(G,F)=(ASC(MID$(A$,G,1))-ASC("A")) 2090 NEXT :NEXT :CLOSE #1 2100 GOTO 1110 2500 REM GRABAR PANTALLA 2510 INPUT "NOMBRE DEL ARCHIVO";N$ 2520 IF LEN (N$)>8 THEN N$=MID$(N$,1,8) 2525 SHELL"IF EXIST "+N$+".PAN COPY "+N$+".PAN "+N$+".BAK" 2530 OPEN (N$+".PAN") FOR OUTPUT AS #1 2540 FOR F=1 TO 10:A$="" 2550 FOR G=1 TO 40:A$=A$+(CHR$(P%(G,F)+ASC("A"))) 2560 NEXT :WRITE #1,A$:NEXT :CLOSE #1 2570 GOTO 1110 3000 REM NUEVA PANTALLA 3010 INPUT "¨SEGURO?";S$ 3020 IF MID$(S$,1,1)="N" OR MID$(S$,1,1)="n" THEN 1110 3030 IF MID$(S$,1,1)<>"S" AND MID$(S$,1,1)<>"s" THEN 3010 3040 FOR F=1 TO 10:FOR G=1 TO 40:P%(F,G)=0 3050 GOTO 1110 3500 REM SALIR A DOS 3510 INPUT "¨SEGURO?";S$ 3520 IF MID$(S$,1,1)="N" OR MID$(S$,1,1)="n" THEN 1110 3530 IF MID$(S$,1,1)<>"S" AND MID$(S$,1,1)<>"s" THEN 5010 3540 SYSTEM 5000 REM EDITAR PANTALLA 5005 CLS:SCREEN 2 5010 FOR X=1 TO 40:FOR Y=1 TO 10 5020 N=P%(X,Y) 5030 IF N>0 THEN GOSUB 6000 5040 NEXT :NEXT 5050 X=1:Y=1:PLA=0 5060 IN$=INKEY$:IF IN$="" THEN GOTO 5130 5070 IF IN$="+" AND P%(X,Y)<50 THEN P%(X,Y)=P%(X,Y)+1:PLA=P%(X,Y) 5080 IF IN$="-" AND P%(X,Y)>0 THEN P%(X,Y)=P%(X,Y)-1:PLA=P%(X,Y) 5090 IF IN$="4" AND X>1 THEN X=X-1 5100 IF IN$="6" AND X<40 THEN X=X+1 5110 IF IN$="2" AND Y<10 THEN Y=Y+1 5120 IF IN$="8" AND Y>1 THEN Y=Y-1 5125 IF IN$=CHR$(13) THEN P%(X,Y)=PLA 5130 LINE(X*16+8,Y*16)-(X*16+8,Y*16+16) 5140 LINE(X*16,Y*16+8)-(X*16+16,Y*16+8) 5150 N=P%(X,Y) 5160 IF N>0 THEN GOSUB 6000 ELSE LINE (X*16,Y*16)-(X*16+16,Y*16+16),0,BF 5170 IF IN$=CHR$(27) THEN RETURN 5180 GOTO 5060 6000 FOR F=1 TO 16 6010 FOR G=1 TO 16 6020 PSET (F+(16*X),G+(16*Y)),A%(N,F,G):NEXT :NEXT 6030 RETURN
Graficos.bas
Es el programa con que se diseñan los sprites. La idea era poder almacenar propiedades a la vez que el gráfico del sprite.
10 REM programa creador de iconos gr ficos 20 REM creado para ser utilizado con el creador de juegos 30 DIM A%(50,16,16):REM iconos 40 DIM P%(50):REM puntos 50 DIM D%(50):REM da¤o 60 DIM V$(50) 70 REM nucleo de control 80 REM men£ 90 CLS:LOCATE 1,35:PRINT "Men£" 100 LOCATE 3,10:PRINT "1.- Editar un icono" 110 LOCATE 4,10:PRINT "2.- Propiedades del icono" 120 LOCATE 5,10:PRINT "3.- Operaciones con archivos" 130 IN$=INKEY$:IF IN$="" THEN GOTO 130 140 IF IN$="" THEN GOTO 130 150 IF IN$="1" THEN GOSUB 1000 160 IF IN$="2" THEN GOSUB 2000 170 IF IN$="3" THEN GOSUB 3000 180 GOTO 90 1000 REM editar grafico 1010 CLS:LOCATE 1,30:PRINT "Edici¢n del gr fico" 1020 NUM=1 1030 FOR B=1 TO 16:FOR C=1 TO 16 1040 LOCATE C+1,B 1050 IF A%(NUM,B,C)=1 THEN PRINT CHR$(219) ELSE PRINT " " 1060 NEXT:NEXT:X=1:Y=1 1070 LOCATE 2,20:PRINT "2,4,6,8 : mover" 1080 LOCATE 3,20:PRINT "Intro : cambiar" 1090 LOCATE 4,20:PRINT "+/- : avanzar/retroceder icono" 1100 LOCATE 5,20:PRINT "Esc : salir" 1105 LOCATE 20,1:PRINT "N§ del icono: ";NUM 1110 REM teclado 1120 IN$=INKEY$ 1130 IF IN$="8" THEN Y=Y-1:IF Y<1 THEN Y=16 1140 IF IN$="2" THEN Y=Y+1:IF Y>16 THEN Y=1 1150 IF IN$="6" THEN X=X+1:IF X>16 THEN X=1 1160 IF IN$="4" THEN X=X-1:IF X<1 THEN X=16 1170 IF IN$=CHR$(13) THEN A%(NUM,X,Y)=ABS(1-(A%(NUM,X,Y))):BEEP 1180 IF IN$="+" THEN NUM=(NUM+1 AND NUM<50):GOTO 1030 1190 IF IN$="-" THEN NUM=(NUM-1 AND NUM>0):GOTO 1030 1200 LOCATE Y+1,X:PRINT "*" 1210 LOCATE Y+1,X:IF A%(NUM,X,Y)=1 THEN PRINT CHR$(219) ELSE PRINT " " 1220 IF IN$=CHR$(27) THEN CLS:RETURN 1230 GOTO 1120 2000 REM propiedades del icono 2010 SCREEN 2:CLS:N=1 2020 LOCATE 1,1:PRINT "N£mero del icono:";N 2030 LOCATE 2,1:PRINT "Puntos otorgados:";P%(N) 2040 LOCATE 3,1:PRINT "Da¤o que causa:";D%(N) 2050 LOCATE 4,1:PRINT "Otros:";V$(N) 2060 FOR X=1 TO 16:FOR Y=1 TO 16 2070 PSET(X,Y+40),A%(N,X,Y) 2080 NEXT:NEXT 2090 LOCATE 5,1:PRINT "Dibujo" 2100 LOCATE 9,1:PRINT "+/-: cambio de icono" 2110 LOCATE 10,1:PRINT "P: cambio de puntos" 2120 LOCATE 11,1:PRINT "D: cambio de da¤o" 2130 LOCATE 12,1:PRINT "O: entorno programador" 2140 IN$=INKEY$:IF IN$="" THEN GOTO 2140 2150 IF IN$=CHR$(27) THEN SCREEN 0:RETURN 2160 IF IN$="P" THEN INPUT "¨Puntos?";PU:P%(N)=PU:CLS:GOTO 2020 2170 IF IN$="D" THEN INPUT "¨Da¤o?";DA:D%(N)=DA:CLS:GOTO 2020 2180 IF IN$="O" THEN GOSUB 5000:CLS:GOTO 2020 2190 IF IN$="+" AND N<50 THEN N=N+1:CLS:GOTO 2020 2200 IF IN$="-" AND N>0 THEN N=N-1:CLS:GOTO 2020 2210 GOTO 2140 3000 REM operaciones con archivos 3005 CLS 3010 LOCATE 1,35:PRINT "OPERACIONES CON ARCHIVOS" 3020 LOCATE 2,1:PRINT "1.- Grabar" 3030 LOCATE 3,1:PRINT "2.- Cargar" 3040 LOCATE 4,1:PRINT "3.- Salir a D.O.S." 3050 LOCATE 5,1:PRINT "4.- Men£" 3060 IN$=INKEY$:IF IN$="" THEN GOTO 3060 3070 IF IN$="1" THEN GOSUB 3500 3080 IF IN$="2" THEN GOSUB 4000 3090 IF IN$="3" THEN GOSUB 4500 3100 IF IN$="4" XOR IN$=CHR$(27) THEN RETURN 3110 BEEP:CLS:GOTO 3010 3500 REM grabar 3510 INPUT "Grabar archivo. Introduzca su nombre (max. 8 car cteres)";N$ 3520 IF LEN(N$)>8 THEN N$=MID$(N$,1,8) 3530 SE$=N$:N$=N$+".obj" 3540 SHELL"if exist "+N$+" copy "+N$+" "+SE$+".bak" 3550 OPEN N$ FOR OUTPUT AS #1 3560 FOR N=1 TO 50:LOCATE 20,1:PRINT USING "##";N 3570 FOR T=1 TO 16:A$="":FOR U=1 TO 16 3580 IF A%(N,U,T)=1 THEN A$=A$+"1" ELSE A$=A$+"0" 3590 NEXT 3600 WRITE #1,A$:NEXT 3610 WRITE #1,P%(N) 3620 WRITE #1,D%(N) 3630 WRITE #1,V$(N) 3640 NEXT 3650 CLOSE #1 3660 LOCATE 20,1:PRINT " ":RETURN 4000 REM cargar archivo 4010 INPUT "Cargar archivo.¨Seguro?";S$ 4020 IF MID$(S$,1,1)="N" OR MID$(S$,1,1)="n" THEN RETURN 4030 IF MID$(S$,1,1)<>"S" AND MID$(S$,1,1)<>"s" THEN GOTO 4010 4040 INPUT "Cargar archivo. Introduzca su nombre (max. 8 car cteres)";N$ 4050 IF LEN(N$)>8 THEN N$=MID$(N$,1,8) 4060 SE$=N$:N$=N$+".obj" 4070 OPEN N$ FOR INPUT AS #1 4090 FOR N=1 TO 50 :LOCATE 20,1:PRINT USING"##";N 4100 FOR T=1 TO 16:INPUT #1,A$:FOR U=1 TO 16 4110 A%(N,U,T)=(1 AND(MID$(A$,U,1)="1"))+0 4120 NEXT 4130 NEXT 4140 INPUT #1,P%(N) 4150 INPUT #1,D%(N) 4160 INPUT #1,V$(N) 4170 NEXT 4180 CLOSE #1:LOCATE 20,1:PRINT " " 4190 RETURN 4500 REM Salir a D.O.S. 4510 INPUT "Salir a D.O.S.¨Seguro?";S$ 4520 IF MID$(S$,1,1)="N" OR MID$(S$,1,1)="n" THEN RETURN 4530 IF MID$(S$,1,1)<>"S" AND MID$(S$,1,1)<>"s" THEN GOTO 4010 4540 SYSTEM 5000 REM entorno programador 5010 CLS 5020 LOCATE 1,1:PRINT "Entorno Programador" 5030 PRINT "1-Cambiar el nombre del icono" 5040 PRINT "2-Cambiar la caracter¡stica fondo/solido" 5050 PRINT "ESC-Salir" 5100 IN$=INKEY$:IF IN$="" THEN GOTO 5100 5110 IF IN$="1" THEN GOSUB 5500 5120 IF IN$="2" THEN GOSUB 6000 5130 IF IN$=CHR$(27) THEN RETURN 5200 GOTO 5010 5500 REM nombre 5510 M1=INSTR(V$(N),"<") 5520 M2=INSTR(V$(N),">") 5530 IF M1=0 OR M2=0 THEN GOTO 5700 5540 PRINT "El nombre actual es";MID$(V$(N),M1+1,M2-M1-1) 5550 INPUT "¨Desea cambiar el nombre?";R$ 5560 IF MID$(R$,1,1)="N" OR MID$(R$,1,1)="n" THEN RETURN 5570 IF MID$(R$,1,1)<>"S" AND MID$(R$,1,1)<>"s" THEN GOTO 5550 5580 INPUT "Introduzca el nuevo nombre";NN$ 5590 MID$(V$(N),M1,M2-M1)=STRING$(M2-M1," ") 5600 NV$="":FOR F=1 TO LEN(A$) 5610 IF MID$(V$(N),1,1)<>" " THEN NV$=NV$+MID$(V$(N),1,1) 5620 NEXT :V$(N)=NV$ 5630 NV$=NV$+"<"+NN$+">" 5640 RETURN 5700 INPUT "Introduzca el nuevo nombre";NN$ 5710 V$(N)=V$(N)+"<"+NN$+">" 5720 RETURN 6000 FON=INSTR(V$(N),"fondo_") 6010 SOL=INSTR(V$(N),"solido"):LOCATE 10,1 6020 IF SOL<>0 AND FON<>0 THEN PRINT "Error:fondo s¢lido. Valor por defecto:solido":MID$(V$(N),FON,6)=" ":MID$(V$(N),SOL,6)=" ":RETURN 6030 IF SOL>0 THEN PRINT "Elegido: s¢lido" 6040 IF FON>0 THEN PRINT "Elegido: fondo " 6045 IF FON=0 AND SOL=0 THEN GOTO 6120 6050 PRINT "1-cambiar; 2-salir" 6070 IN$=INKEY$:IF IN$="" THEN GOTO 6070 6080 IF IN$="1" AND FON>0 THEN MID$(V$(N),FON,6)="solido":SOL=FON:FON=0 6090 IF IN$="1" AND SOL>0 THEN MID$(V$(N),FON,6)="fondo_":FON=SOL:SOL=0 6100 IF IN$="2" THEN RETURN 6110 LOCATE 10,1:GOTO 6030 6120 PRINT "No se ha especificado ni fondo ni s¢lido. Valor por defecto:solido." 6130 INPUT "Introduzca el nuevo valor (1-fondo, 2-s¢lido)";NV 6140 IF NV=1 THEN V$(N)=V$(N)+"fondo_":RETURN 6150 IF NV=2 THEN V$(N)=V$(N)+"solido":RETURN 6160 PRINT "No se ha especificado ni fondo ni s¢lido. Valor por defecto:solido." 6170 INPUT "Pulse <INTRO>";NV$:RETURN
es/basic/gwbasic/graficos.bas_y_edipant.bas.txt · Última modificación: 2016/01/11 17:33 por nepenthes
Herramientas de la página
Excepto donde se indique lo contrario, el contenido de este wiki esta bajo la siguiente licencia: CC Attribution-Noncommercial-Share Alike 4.0 International
