Apagada docs

Aprendiendo a programar el pasado

Herramientas de usuario

Herramientas del sitio


es:basic:gwbasic:logcomp1

LOGCOMP1

Logcomp1 es un “compilador” de logo a basic, es decir, crea un programa de logo y crea un programa basic. El problema es que, realmente, mi conocimiento de logo era muy superficial (sólo conocía las instrucciones de dibujo y la creación de diccionarios, lo que hoy llamaríamos “funciones” o “subs”). Pero sirve para crear pequeños dibujos.

Antes de escribirlo había hecho (en papel!) otro programa similar para Spectrum, que no llegué a probar.

A partir de este programa creé otro para Qbasic; sin embargo, las características de Qbasic hicieron que lo enfocase de manera diferente.

NOTA: Hay una línea errónea entre la 560 y la 580, debido a la degradación del disquete. Creo que sólo está mal el número de línea (que debería ser 570), pero por si acaso lo he dejado igual.

10 REM COMPILADOR DE JLOGO A BASIC
20 CLS:PRINT "TRADUCTOR DE JOSELOGO A GWBASIC. VERSIàN 0.1."
30 DIM P$(10):DIM PR$(100):LI=10
40 LET BUCLE=0
50 LINE INPUT "¨Archivo? ";F$
60 GOSUB 390
70 LINE INPUT "¨àrden? ";A$
80 REM Separando ¢rdenes y par metros-------------------------------------
90 P=1
100 FOR A=1 TO 10:P$(A)="":NEXT
110 ORD$="":FOR N=1 TO LEN(A$)
120 IF MID$(A$,N,1)=" " AND P=1 THEN ORD$=MID$(A$,1,N-1):P=2:GOTO 150
130 IF MID$(A$,N,1)=" " AND MID$(A$,N+1,1)<>" " AND P>2 THEN P=P+1:GOTO 150
140 IF P>1 THEN P$(P)=P$(P)+MID$(A$,N,1)
150 NEXT
160 IF P=1 AND ORD$="" THEN ORD$=A$
170 REM Int‚rprete---------------------------------------------------------
180 TRA$=""
190 IF ORD$="TO" THEN F$=P$(2):GOSUB 560
200 IF ORD$="FILE" THEN F$=P$(2):GOSUB 390
210 IF ORD$="DO" THEN BUCLE=BUCLE+1
220 BUCL$=STR$(BUCLE):IF MID$(BUCL$,1,1)=" " THEN BUCL$=MID$(BUCL$,2)
230 IF ORD$="SET" THEN TRA="LET "+P$(2)
240 IF ORD$="PD" THEN TRA$="PU=1"
250 IF ORD$="PU" THEN TRA$="PU=0"
260 IF ORD$="FD" THEN TRA$="X=X+SIN(DIR)*"+P$(2)+":Y=Y+COS(DIR)*"+P$(2)
270 IF ORD$="BK" THEN TRA$="X=X-SIN(DIR)*"+P$(2)+":Y=Y-COS(DIR)*"+P$(2)
280 IF ORD$="LT" THEN TRA$="DIR=DIR+("+ P$(2)+ "/180) *3.141592"
290 IF ORD$="RT" THEN TRA$="DIR=DIR-("+ P$(2)+ "/180) *3.141592"
300 IF ORD$="DO" OR ORD$="{" THEN TRA$="FOR A"+ BUCL$+ "=1 TO "+P$(2)
310 IF ORD$="}" THEN TRA$="NEXT A"+BUCL$
320 IF ORD$="END" THEN TRA$="END"
330 IF ORD$="PROCEDURE" THEN GOSUB 680
340 IF ORD$="ENDPROC" THEN GOSUB 630
350 IF ORD$="HOME" THEN TRA$="X=160:Y=100"
360 IF ORD$="CS" THEN TRA$="CLS: X=160:Y=100"
370 GOSUB 480
380 GOTO 70
390 REM ------------------ARCHIVO-------------------------------
400 ON ERROR GOTO 430
410 OPEN F$ FOR APPEND AS #1
420 RETURN
430 RESUME
440 OPEN F$ FOR OUTPUT AS #1
450 PRINT #1, 5:" SCREEN 2"
460 ON ERROR GOTO
470 RETURN
480 REM *******************GRABANDO******************************
490 IF TRA$="" THEN PRINT "ERROR SINTµCTICO":RETURN
500 TRA$=TRA$+":LINE (AX,AY)-(X,Y),PU:AX=X:AY=Y
510 PRINT #1, LI;" ";TRA$
520 PRINT LI, TRA$
530 IF ORD$="}" THEN BUCLE=BUCLE-1
540 LI=LI+5
550 RETURN
560 REM ---------------------PROCESO------------------------------
14880 IF ALIN<>LI AND ALIN<>0 THEN GOSUB 630:PRINT "CERRANDO EL PROCESO ANTERIOR"
580 ALIN=0:FOR A=1 TO 100
590 IF PR$(A)="" AND ALIN=0 THEN PR$(A)=F$:ALIN=LI:LI=A*1000:ABU=BUCLE:BUCLE=A*20
600 NEXT :IF LI=ALIN THEN PRINT "NO HAY ESPACIO PARA EL PROCESO EN MEMORIA"
610 TRA$="REM *TO "+F$+"*"
620 RETURN
630 REM ----------------------ENDPROC----------------------------
640 IF LI=ALIN THEN PRINT "NO HAY PROCESO EN DEFINICIàN":RETURN
650 TRA$="RETURN":GOSUB 480:TRA$=""
660 LI=ALIN:BUCLE=ABU
670 RETURN
680 REM LLAMADA A UN PROCESO
690 CLIN=0:FOR A=1 TO 100
700 IF CLIN=0 AND PR$(A)=P$(2) THEN CLIN=A*1000
710 NEXT
720 IF CLIN=0 THEN PRINT "EL PROCESO NO SE ENCUENTRA":RETURN
730 TRA$="GOSUB "+STR$(CLIN)
740 RETURN

EJEMPLO:



Este sitio web utiliza cookies. Al utilizar el sitio web, usted acepta almacenar cookies en su computadora. También reconoce que ha leído y entendido nuestra Política de privacidad. Si no está de acuerdo abandone el sitio web.Más información
es/basic/gwbasic/logcomp1.txt · Última modificación: 2014/03/10 14:52 por nepenthes