10MODE7
20DEFT3 (C)NOV90 BY KEITH JOHNSON
30L$=""
40DIM N$(20)
50DIM proc$(20)
60tw=0
70def=1
80num=0:nextline=20:M$="" :condition=
0:p=0
90REM translation prog part 1 DEFT
100PRINT''"THIS PROGRAM DEFT PULLS IN
A NAMED *SPOOL FILE READS ITS LINE
NUMBERS AND WRITES TO A SECOND NAME
D FILE"
110PRINT"BEFORE IT WRITES TO THE SECON
D FILE IT ALTERS DEFPROCS ENDPROCS
AND PROCS ONLY , GETTING THE PR
OGRAM READY FOR THE SECOND STAGE
TRANSLATION"
120PRINT"PROCEDURE-LOAD-RENUMBER-NOTE
LAST LINE NUMBER-*SPOOL-LIST- *
SPOOL -RUN THIS PROGRAM- *EXEC-SECOND PR
OG-LIST SAVE"
130REM DATA TO COMPUTER
140INPUT'"ENTER NAME OF FIRST FILE TO
BE ALTERED "file1$
150INPUT'"ENTER last line number "last
num
160INPUT'"ENTER NAME OF FIRST TRANSLAT
ION " file2$
170INPUT'"ENTER NAME OF SECOND TRANSLA
TION " file3$
180run=1
190CLS
200IF run=2 THEN tw=0:def=1:num=0:next
line=10:M$=""
210IF run=1 THEN Y=OPENIN(file1$)
220IF run=1 THEN X=OPENOUT(file2$)
230IF run=2 THEN Y=OPENIN(file2$)
240IF run=2 THEN X=OPENOUT(file3$)
250PRINT'''"LAST LINE NUMBER IS ";last
num
260IF run=1 THEN PRINTTAB(0,11)"OUTPUT
TO FILE "file2$
270IF run=2 THEN PRINTTAB(0,11)"OUTPUT
TO FILE "file3$
280REPEAT
290CHST=0
300D=BGET#Y
310L$=L$+CHR$(D)
320A$=L$
330B$=CHR$(10)
340m=LEN(B$)
350FOR K=1 TO LEN(L$):A=K
360IF MID$(A$,A,m)=B$ THEN GOTO 380
370GOTO 410
380IF MID$(A$,A-5,4)="GOTO" THEN GOTO
410
390IF MID$(A$,A-4,4)="GOTO" THEN GOTO
410
400line$=LEFT$(L$,A):L$=MID$(L$,A+1):C
HST=1:nextline=nextline+10
410NEXT
420IF CHST=1 THEN A$=line$ :GOSUB 520
430IF LEN(L$)=240 THEN L$=""
440UNTIL EOF#Y
450A$=L$:line$=L$:GOSUB 520
460CLOSE#X
470CLOSE#Y
480REM now to have run 2
490run=run+1
500IF run=2 THEN GOTO 190
510END
520IF run=1 THEN GOTO 530 ELSE GOTO 83
0
530PROCrepeat
540IF CHST=1 THEN GOTO 560
550GOTO 570
560PROCwritetline
570PROCamp
580IF CHST=1 THEN GOTO 600
590GOTO 610
600PROCwritetline
610PROCuntil
620IF CHST=1 THEN GOTO 640
630GOTO 650
640PROCwritetline
650PROCvdu
660IF CHST=1 THEN GOTO 680
670GOTO 690
680PROCwritetline
690REM REPEAT UNTILS DONE ON FIRST RUN
700PROCdef
710IF CHST=1 THEN GOTO 730
720GOTO 732
730PROCwritetline
732PROCdef`P
733IF CHST=1 THEN GOTO 736
735GOTO 740
736PROCwritetline
740PROCendproc
750IF CHST=1 THEN GOTO 770
760GOTO 780
770PROCwritetline
780IF tw=1 THEN GOTO 800
790PROCwrite
800tw=0:REM on run 1 defprocs endprocs
sorted and line nums remembered
810RETURN
820m=LEN(STR$(nextline))
830tw=0:REM comes here on run 2 to sor
t out procs into gosubs
840A$=line$
850PROCproc
860IF CHST=1 THEN GOTO 880
870GOTO890
880PROCwritetline
890IF tw=1 THEN GOTO 910
900PROCwrite
910RETURN
920PRINTTAB(0,12)" inputting line numb
er ";nextline
930PRINTTAB(0,15)" outputting line num
ber ";nextline ;TAB(33,15)"----"
940CHST=0
950DEFPROCparse
960CHST=0
970FOR K=1 TO LEN(A$):A=K
980IF MID$(A$,A,num)=B$ THEN M$=LEFT$(
A$,A-1):R$=MID$(A$,A+num):CHST=1:tw=1
990NEXT
1000ENDPROC
1010DEFPROCamp
1020CHST=0
1030B$="@%"
1040num=LEN(B$)
1050PROCparse
1060IF CHST=1 THEN GOTO 1070 ELSE GOTO
1080
1070tline$=M$+"REM @%"+R$
1080ENDPROC
1090DEFPROCdraw
1100B$="DRAW":num=LEN(B$)
1110PROCparse
1120 IF CHST=1 THEN GOTO 1130 ELSE GOT
O 1230
1130CHST=0
1140B$=",":num=1
1150FOR K=1 TO LEN(R$):A=K
1160IF MID$(R$,A,num)=B$ THEN X%=VAL(LE
FT$(R$,A-num)):Y%=VAL(MID$(R$,A+num):r=L
EN(STR$(Y%)):remain$=MID$(R$,A+num+r):CH
ST=1
1170NEXT
1180REM TRAN FOR SCREEN 2
1190LET x%=X%/2
1200LET y%=(1024-Y%)/5.12
1210insert$="LINE-("+STR$(x%)+","+STR$(
y%)+")"
1220tline$=M$+insert$+remain$
1230ENDPROC
1240DEFPROCvdu
1250CHST=0
1260B$="VDU"
1270num=LEN(B$)
1280PROCparse
1290 IF CHST=1 THEN tline$=M$+"REM VDU"
+R$
1300ENDPROC
1310DEFPROCdef
1320B$="DEFPROC"
1330num=LEN(B$)
1340PROCparse
1350IF CHST=1 THEN N$(def)=M$:proc$(def
)=R$:def=def+1:tline$=M$+"REM P"+R$
1360ENDPROC
1361DEFPROCdef`P
1362B$="DEF PROC"
1363num=LEN(B$)
1364PROCparse
1365IF CHST=1 THEN N$(def)=M$:proc$(def
)=R$:def=def+1:tline$=M$+"REM P"+R$
1366ENDPROC
1370DEFPROCendproc
1380B$="ENDPROC"
1390num=LEN(B$)
1400PROCparse
1410IF CHST=1 THEN tline$=M$+"RETURN"
1420ENDPROC
1430DEFPROCproc
1440B$="PROC"
1450num=LEN(B$)
1460PROCparse
1470IF CHST=1 THEN GOTO 1480 ELSE GOTO
1520
1480FOR K=1 TO 20
1490d%=LEN(proc$(K))
1500IF proc$(K)=LEFT$(R$,d%) AND d%>0
THEN tline$=M$+"GOSUB"+MID$(N$(K),3)
1510NEXT
1520ENDPROC
1530DEFPROCwrite
1540A$=line$
1550PRINTTAB(0,18)"
"
1560PRINTTAB(0,18)A$
1570BPUT#X ,&0D
1580FOR K=1 TO LEN(A$):A=K
1590BPUT#X ,ASC(MID$(A$,A,1))
1600NEXT
1610ENDPROC
1620DEFPROCwritetline
1630tw=1
1640A$=tline$
1650PRINTTAB(0,18)"
"
1660PRINTTAB(0,18)tline$
1670BPUT#X ,&0D
1680FOR K=1 TO LEN(A$):A=K
1690BPUT#X ,ASC(MID$(A$,A,1))
1700NEXT
1710ENDPROC
1720DEFPROCrepeat
1730B$="REPEAT"
1740num=LEN(B$)
1750PROCparse
1760IF CHST=1 THEN rline$=MID$(M$,2):tl
ine$=M$+"REM REPEAT"
1770ENDPROC
1780DEFPROCuntil
1790B$="UNTIL"
1800num=LEN(B$)
1810PROCparse
1820PROCnrt
1830B$="UNTIL"
1840num=LEN(B$)
1850PROCparse
1860IF CHST=1 THEN n=VAL(MID$(M$,2))+10
:next$=STR$(n):tline$=M$+"IF"+R$+"THEN G
OTO "+next$+"ELSE GOTO "+rline$
1870ENDPROC
1880DEFPROCnrt
1890IF CHST=1 THEN B$=CHR$(10):num=LEN(
B$)
1900PROCparse
1910IF CHST=1 THEN A$=M$
1920ENDPROC