home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / basicaid.zip / TRS2PC.BAS < prev    next >
BASIC Source File  |  1983-11-27  |  10KB  |  210 lines
  1. 100 'TRS TO IBM PC CONVERSION AID        12/31/82 REV. 1/23/83
  2. 120 'DAVE MCCOY 70040,1131
  3. 130 CLS:PRINT "TRS-80 to IBM-PC Conversion Program":PRINT"Version 2.0 - Dave McCoy - 70040,1131":PRINT
  4. 140 GOTO 510  
  5. 200 '*******************************************************
  6. 210 '*          ADDSPACE SUBROUTINES                       *
  7. 220 '*******************************************************
  8. 230 IF P=N THEN 3250 ELSE X$=MID$(B$,P+1,1)     'LOOK AT NEXT CHAR.
  9. 240 IF X$=" " OR X$=":" THEN 3250 ELSE N$=N$+" ":GOTO 3250      'ADD SPACE
  10. 250 X$=MID$(B$,P+1,1)
  11. 260 IF X$="@" OR X$=CHR$(34) OR X$=":" OR X$=" "THEN 3250 ELSE N$=N$+" ":GOTO 3250 
  12. 270 X$=MID$(N$,LEN(N$)-L,1)
  13. 280 IF X$=" " OR X$=":" THEN 230  ELSE T2$=LEFT$(N$,LEN(N$)-L):T3$=RIGHT$(N$,L)
  14. 290 N$=T2$+" "+T3$:GOTO 230  
  15. 300 X$=MID$(B$,P+1,3)
  16. 310 IF X$="INT" OR X$="SGN" OR X$="DBL" OR X$="STR" THEN 3250 ELSE 230  
  17. 320 X$=MID$(B$,P-2,3)
  18. 330 IF X$="XOR" THEN L=3:GOTO 270  ELSE GOTO 270  
  19. 340 X$=MID$(B$,P-3,4)
  20. 350 IF X$="GOTO" THEN L=4:GOTO 270  ELSE GOTO 270  'CHECK FOR SPACE
  21. 360 X$=MID$(B$,P+1,1)
  22. 370 IF X$="C" OR X$="$" THEN 3250 ELSE 270  
  23. 380 X$=MID$(N$,LEN(N$)-L,1)
  24. 390 IF X$=" " OR X$=":" THEN 3250 ELSE T2$=LEFT$(N$,LEN(N$)-L):T3$=RIGHT$(N$,L)
  25. 400 N$=T2$+" "+T3$:GOTO 3250 
  26. 410 '          LOCATE ABORT SUBROUTINE
  27. 420 IF LEN(B$)=>245 THEN LPRINT "Line";VAL(B$);"Locate aborted ..potential line too long":LPRINT B$:GOTO 3030
  28. 430 RETURN
  29. 500 '*******************************************************
  30. 510 '*                   INITIALIZE                        *
  31. 520 '*******************************************************
  32. 530 CLEAR 28000
  33. 540 DEFINT A-Z
  34. 550 ON ERROR GOTO 7010 
  35. 560 DEF FNRW%(A1$,A2$,A3%)=(INSTR(A1$,LEFT$(A2$+STRING$(A3%," "),A3%))-1)/A3%+1
  36. 570 R6$="RETURN RESUME DEFINT DEFSNG DEFDBL DEFSTR "
  37. 580 R5$="PRINT INPUT GOSUB FIELD CLOSE ERROR CLEAR USING "
  38. 590 R4$="THEN ELSE READ DATA RSET LSET SWAP NEXT STEP KILL OPEN POKE LINE "
  39. 600 R3$="FOR AND NOT PUT GET DIM DEF LET "
  40. 610 R2$="IF OR TO ON AS "
  41. 620 DIM B1$(20)        'CONVERSION REPORT EXCEPTIONS
  42. 630 I=1
  43. 640 READ B1$(I):IF B1$(I)<>"*END*" THEN I=I+1:GOTO 640  
  44. 650 MAX=I-1
  45. 660 DATA TIME$,PEEK,"POKE","CLEAR",USR,MEM,FRE(,"RANDOM"," %",CMD,"ERR/2+1","S TO P",CHR$(,ASC(,"RES TO RE",*END*
  46. 665 '------------------------------------------------------
  47. 670 C1$="N"    '*** CHANGE TO Y FOR BATCH FILE PROCESSING
  48. 675 '------------------------------------------------------
  49. 680 IF C1$="Y" THEN 930  
  50. 690 INPUT"Print@ converted to LOCATE r,c - IBM only (Y/N)";C2$
  51. 700 IF C2$<>"Y" AND C2$<>"N" THEN 690  
  52. 710 INPUT"ADD SPACE between keywords                (Y/N)";C3$
  53. 720 IF C3$<>"Y" AND C3$<>"N" THEN 710  
  54. 730 INPUT"REPLACE commands for PC        - IBM only (Y/N)";C4$
  55. 740 IF C4$<>"Y" AND C4$<>"N" THEN 730  
  56. 750 INPUT"UPPER CASE converted to LOWER CASE        (Y/N)";C5$
  57. 760 IF C5$<>"Y" AND C5$<>"N" THEN 750  
  58. 770 INPUT"Conversion REPORT to printer   - IBM only (Y/N)";C6$
  59. 780 IF C6$<>"Y" AND C6$<>"N" THEN 770  
  60. 790 PRINT:INPUT"Edited lines to SCREEN                    (Y/N)";C7$
  61. 800 IF C7$<>"Y" AND C7$<>"N" THEN 790  
  62. 810 GOTO 1730 
  63. 900 '*******************************************************
  64. 910 '*                BATCH PROCESSING                     *
  65. 920 '*******************************************************
  66. 930 PRINT"Batch file processing..":ON ERROR GOTO 950  
  67. 940 OPEN"I",1,"COUNTER/DAT":INPUT#1,YF:CLOSE:GOTO 960  
  68. 950 YF=1:OPEN"O",1,"COUNTER/DAT":PRINT#1,YF:CLOSE:GOTO 940  
  69. 960 ON ERROR GOTO 7010 
  70. 970 DIM FF$(20)       'BATCH PROCESSING FILENAME ARRAY
  71. 980 '------------------------------------------------------
  72. 990 'C1$=BATCH FLAG  C2$=PRINT@-LOCATE  C3$=ADDSPACE TO KEY
  73. 1000 'WORDS  C4$=REPLACE COMMANDS  C5$=UPPER TO LOWER CASE
  74. 1010 'C6$=REPORT EXCEPTIONS  C7$=NEW FILE TO SCREEN
  75. 1020 '------------------------------------------------------
  76. 1030 J=1:C2$="Y":C3$="Y":C4$="Y":C5$="Y":C6$="Y":C7$="Y"
  77. 1040 READ FF$(J):IF FF$(J)="END" THEN 1100 ELSE J=J+1:GOTO 1040 
  78. 1050 'ENTER 8 CHARACTER FILESPECS IN DATA STATEMENT BELOW
  79. 1060 'EXTENSION OF /ASC ASSUMED ON BATCH FILES - END DATA WITH        WORD END
  80. 1070 '================= BATCH FILES =========================
  81. 1080 DATA DIRDUPS,DIRDUMP,END
  82. 1090 '======================================================
  83. 1100 IF FF$(YF)="END" THEN 1550 
  84. 1110 FS$=FF$(YF)       'CURRENT FILE TO PROCESS
  85. 1120 F1$=FS$+"/ASC"    'ASSUMES /ASC INPUT FILE EXTENSION
  86. 1130 F2$=FS$+"/IBM"    'ASSIGNS /IBM OUTPUT FILE EXTENSION
  87. 1140 GOTO 1760 
  88. 1500 '******************************************************
  89. 1510 '*                END                                 *
  90. 1520 '******************************************************
  91. 1530 PRINT:IF C6$="Y" THEN LPRINT STRING$(79,"="):LPRINT:LPRINT
  92. 1540 PRINT "Close ";F1$;" and ";F2$
  93. 1550 CLOSE:IF FF$(YF)="END" THEN PRINT "Done":KILL"COUNTER/DAT":CLEAR 50:END
  94. 1560 IF C1$="Y" THEN OPEN"O",1,"COUNTER/DAT":PRINT#1,YF+1:CLOSE
  95. 1570 RUN
  96. 1580 END
  97. 1700 '******************************************************
  98. 1710 '*             KEYBOARD ENTRY OF FILESPEC             *
  99. 1720 '******************************************************
  100. 1730 PRINT:LINE INPUT "Enter source ASCII filespec : ";F1$
  101. 1740 LINE INPUT "Enter output ASCII filespec : ";F2$
  102. 1750 '******************************************************
  103. 1760 OPEN "I",1,F1$
  104. 1770 OPEN "O",2,F2$
  105. 1780 CLS:PRINT"Source "F1$;" --> Target "F2$
  106. 1790 IF C6$="Y" THEN LPRINT "TRS-80 ";F1$;" CONVERSION TO IBM/PC ";F2$;"    ";TIME$:LPRINT
  107. 1800 IF EOF(1) THEN 1530 
  108. 1810 LINE INPUT #1,B$: IF B$="" THEN 1800 
  109. 1820 PRINT:PRINT "Line";VAL(B$),
  110. 2000 '******************************************************
  111. 2010 '*         CHANGE PRINT@ TO LOCATE R,C                *
  112. 2020 '******************************************************
  113. 2030 IF C2$<>"Y" THEN 3030 
  114. 2040 PRINT "Locate..";
  115. 2050 D=INSTR(B$,"PRINT@")
  116. 2060 IF D=0 THEN 2120 
  117. 2070 PL=6
  118. 2080 C=INSTR(D,B$,",")
  119. 2090 IF C=0 THEN 2120 
  120. 2100 A=VAL(MID$(B$,D+PL,(C-D+PL-1)))
  121. 2110 L=INT(A/64):B=A-(L*64):GOTO 2140 
  122. 2120 D=INSTR(B$,"PRINT @")
  123. 2130 IF D=0 THEN 3030 ELSE PL=7:GOTO 2080 
  124. 2140 C$=LEFT$(B$,D-1)
  125. 2150 GOSUB 410  :C$=C$+"LOCATE "+RIGHT$(STR$(L),LEN(STR$(L))-1)+","+RIGHT$(STR$(B),LEN(STR$(B))-1)
  126. 2160 C$=C$+":PRINT"+RIGHT$(B$,LEN(B$)-C)
  127. 2170 B$=C$
  128. 2180 GOTO 2050 
  129. 3000 '******************************************************
  130. 3010 '*                ADDSPACE TO KEY WORDS               *
  131. 3020 '******************************************************
  132. 3030 IF C3$<>"Y" THEN N$=B$:GOTO 4030 
  133. 3040 PRINT "Add Space..";
  134. 3050 D=INSTR(B$,"DATA"):IF D THEN 4030 'DON'T ADD SPACE TO DATA
  135. 3060 N=LEN(B$):N$="":F4=0:F1=0
  136. 3070 FOR P=1 TO N       'STRIP B$
  137. 3080   IF LEN(N$)=>255 THEN LPRINT "ADDSPACE ABORTED LINE TOO LONG":LPRINT N$:GOTO 4030 
  138. 3090   D$=MID$(B$,P,1)
  139. 3100   N$=N$+D$
  140. 3110   IF D$=CHR$(34) AND F4=1 THEN F4=0: GOTO 3130 
  141. 3120   IF D$=CHR$(34) AND F4=0 THEN F4=1
  142. 3130   IF D$="'" AND F4=0 THEN F1=1     'REMARK
  143. 3140   IF F4=1 OR F1=1 THEN 3250 
  144. 3150   L=6: R%=FNRW%(R6$,RIGHT$(N$,L),L+1)
  145. 3160   ON R% GOTO 230  ,230  ,230  ,230  ,230  ,230  ,230  
  146. 3170   L=L-1: R%=FNRW%(R5$,RIGHT$(N$,L),L+1)
  147. 3180   ON R% GOTO 250  ,250  ,270  ,230  ,230  ,230  ,230  ,250  
  148. 3190   L=L-1: R%=FNRW%(R4$,RIGHT$(N$,L),L+1)
  149. 3200   ON R% GOTO 270  ,270  ,230  ,250  ,230  ,230  ,230  ,270  ,270  ,250  ,250  ,230  ,230  
  150. 3210   L=L-1: R%=FNRW%(R3$,RIGHT$(N$,L),L+1)
  151. 3220   ON R% GOTO 230  ,270  ,270  ,230  ,230  ,230  ,300  ,230  
  152. 3230   L=L-1: R%=FNRW%(R2$,RIGHT$(N$,L),L+1)
  153. 3240   ON R% GOTO 230  ,320  ,340  ,230  ,360  
  154. 3250 NEXT
  155. 4000 '******************************************************
  156. 4010 '*        REPLACEMENT COMMANDS                        *
  157. 4020 '******************************************************
  158. 4030 IF C4$<>"Y" THEN 5030 
  159. 4040 PRINT "Replace..";
  160. 4050 D=INSTR(N$,"ERR/2+1")
  161. 4060 IF D=0 THEN 4080 
  162. 4070 MID$(N$,D,7)=" ERR   "
  163. 4080 D=INSTR(N$,"[")
  164. 4090 IF D=0 THEN 4110 
  165. 4100 MID$(N$,D,1)=CHR$(94):GOTO 4080 
  166. 4110 D=INSTR(N$,"STRING$(64,")
  167. 4120 IF D=0 THEN 4140 
  168. 4130 MID$(N$,D+8,2)="80"
  169. 4140 D=INSTR(N$,"STRING$(63,")
  170. 4150 IF D=0 THEN 5030 
  171. 4160 MID$(N$,D+8,2)="79"
  172. 5000 '******************************************************
  173. 5010 '*           CONVERT UPPER TO LOWER CASE              *
  174. 5020 '******************************************************
  175. 5030 IF C5$<>"Y" THEN 6030 
  176. 5040 W=1:PRINT"UC to LC..";
  177. 5050 Y=INSTR(W,N$,CHR$(34)):IF Y<1 THEN 6030 
  178. 5060 Z=INSTR(Y+1,N$,CHR$(34)):IF Z<1 THEN Z=LEN(N$)
  179. 5070 FOR I=Y+2 TO Z
  180. 5080   X$=MID$(N$,I,1):IF X$="" THEN 5120 
  181. 5090   IF ASC(X$)<65 OR ASC(X$)>90 THEN 5120 
  182. 5100   X$=CHR$(ASC(X$)+32)
  183. 5110   MID$(N$,I,1)=X$
  184. 5120 NEXTI
  185. 5130 W=I:GOTO 5050 
  186. 6000 '******************************************************
  187. 6010 '*         CONVERT AID REPORTER                       *
  188. 6020 '******************************************************
  189. 6030 IF C6$<>"Y" THEN 6140 
  190. 6040 PRINT"Report..";
  191. 6050 FOR I=1 TO MAX
  192. 6060   C%=INSTR(N$,B1$(I)):CM=INSTR(N$,"'"):RM=INSTR(N$,"REM")
  193. 6070   IF C%=0 THEN 6120 
  194. 6080   IF CM THEN IF CM<=C% THEN 6120 
  195. 6090   IF RM THEN IF RM<=C% THEN 6120 
  196. 6100   LPRINT N$
  197. 6110   LPRINT TAB(C%-1)"*"
  198. 6120 NEXT
  199. 6130 '******************************************************
  200. 6140 PRINT#2,N$:IF C7$="Y" THEN PRINT:PRINT N$   'WRITE FILE
  201. 6150 '******************************************************
  202. 6160 GOTO 1800 
  203. 7000 '******************************************************
  204. 7010 '*                 ERROR ROUTINE                      *
  205. 7020 '******************************************************
  206. 7030 PRINT "Error"ERR/2+1"in line"ERL
  207. 7040 CLOSE:STOP
  208. 7050 END
  209. 9000 '**************** SAVE PROGRAM ************************
  210.