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