home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / trs2pc / trstopc.bas next >
Encoding:
BASIC Source File  |  1994-05-24  |  10.4 KB  |  224 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 C1$ = "Y"
  50. 685 IF C1$ = "Y" THEN 930
  51. 690 INPUT "PRINT@ CONVERTED TO LOCATE R,C - IBM ONLY (Y/N)"; C2$
  52. 695 IF C2$ = "y" THEN C2$ = "Y"
  53. 698 IF C2$ = "n" THEN C2$ = "N"
  54. 700 IF C2$ <> "Y" AND C2$ <> "N" THEN 690
  55. 710 INPUT "ADD SPACE BETWEEN KEYWORDS                (Y/N)"; C3$
  56. 711 IF C3$ = "y" THEN C3$ = "Y"
  57. 712 IF C3$ = "n" THEN C3$ = "N"
  58. 720 IF C3$ <> "Y" AND C3$ <> "N" THEN 710
  59. 730 INPUT "REPLACE COMMANDS FOR PC        - IBM ONLY (Y/N)"; C4$
  60. 741 IF C4$ = "y" THEN C4$ = "Y"
  61. 742 IF C4$ = "n" THEN C4$ = "N"
  62. 740 IF C4$ <> "Y" AND C4$ <> "N" THEN 730
  63. 750 INPUT "UPPER CASE CONVERTED TO LOWER CASE        (Y/N)"; C5$
  64. 751 IF C5$ = "y" THEN C5$ = "Y"
  65. 752 IF C5$ = "n" THEN C5$ = "N"
  66. 760 IF C5$ <> "Y" AND C5$ <> "N" THEN 750
  67. 770 INPUT "CONVERSION REPORT TO PRINTER   - IBM ONLY (Y/N)"; C6$
  68. 771 IF C6$ = "y" THEN C6$ = "Y"
  69. 772 IF C6$ = "n" THEN C6$ = "N"
  70. 780 IF C6$ <> "Y" AND C6$ <> "N" THEN 770
  71. 790 PRINT : INPUT "EDITED LINES TO SCREEN                    (Y/N)"; C7$
  72. 791 IF C7$ = "y" THEN C7$ = "Y"
  73. 792 IF C7$ = "n" THEN C7$ = "N"
  74. 800 IF C7$ <> "Y" AND C7$ <> "N" THEN 790
  75. 810 GOTO 1730
  76. 900 '*******************************************************
  77. 910 '*                BATCH PROCESSING                     *
  78. 920 '*******************************************************
  79. 930 PRINT "BATCH FILE PROCESSING..": ON ERROR GOTO 950
  80. 940 OPEN "I", 1, "COUNTER/DAT": INPUT #1, YF: CLOSE : GOTO 960
  81. 950 YF = 1: OPEN "O", 1, "COUNTER/DAT": PRINT #1, YF: CLOSE : GOTO 940
  82. 960 ON ERROR GOTO 7010
  83. 970 DIM FF$(20)       'BATCH PROCESSING FILENAME ARRAY
  84. 980 '------------------------------------------------------
  85. 990 'C1$=BATCH FLAG  C2$=PRINT@-LOCATE  C3$=ADDSPACE TO KEY
  86. 1000 'WORDS  C4$=REPLACE COMMANDS  C5$=UPPER TO LOWER CASE
  87. 1010 'C6$=REPORT EXCEPTIONS  C7$=NEW FILE TO SCREEN
  88. 1020 '------------------------------------------------------
  89. 1030 J = 1: C2$ = "Y": C3$ = "Y": C4$ = "Y": C5$ = "Y": C6$ = "Y": C7$ = "Y"
  90. 1040 READ FF$(J): IF FF$(J) = "END" THEN 1100 ELSE J = J + 1: GOTO 1040
  91. 1050 'ENTER 8 CHARACTER FILESPECS IN DATA STATEMENT BELOW
  92. 1060 'EXTENSION OF /ASC ASSUMED ON BATCH FILES - END DATA WITH        WORD END
  93. 1070 '================= BATCH FILES =========================
  94. 1080 DATA DIRDUPS,DIRDUMP,END
  95. 1090 '======================================================
  96. 1100 IF FF$(YF) = "END" THEN 1550
  97. 1110 FS$ = FF$(YF)     'CURRENT FILE TO PROCESS
  98. 1120 F1$ = FS$ + "/ASC"'ASSUMES /ASC INPUT FILE EXTENSION
  99. 1130 F2$ = FS$ + "/IBM"'ASSIGNS /IBM OUTPUT FILE EXTENSION
  100. 1140 GOTO 1760
  101. 1500 '******************************************************
  102. 1510 '*                END                                 *
  103. 1520 '******************************************************
  104. 1530 PRINT : IF C6$ = "Y" THEN LPRINT STRING$(79, "="): LPRINT : LPRINT
  105. 1540 PRINT "CLOSE "; F1$; " AND "; F2$
  106. 1550 CLOSE : IF FF$(YF) = "END" THEN PRINT "DONE": KILL "COUNTER/DAT": CLEAR 50: END
  107. 1560 IF C1$ = "Y" THEN OPEN "O", 1, "COUNTER/DAT": PRINT #1, YF + 1: CLOSE
  108. 1570 RUN
  109. 1580 END
  110. 1700 '******************************************************
  111. 1710 '*             KEYBOARD ENTRY OF FILESPEC             *
  112. 1720 '******************************************************
  113. 1730 PRINT : LINE INPUT "ENTER SOURCE ASCII FILESPEC : "; F1$
  114. 1740 LINE INPUT "ENTER OUTPUT ASCII FILESPEC : "; F2$
  115. 1750 '******************************************************
  116. 1760 OPEN "I", 1, F1$
  117. 1770 OPEN "O", 2, F2$
  118. 1780 CLS : PRINT "SOURCE "; F1$; " --> TARGET "; F2$
  119. 1790 IF C6$ = "Y" THEN LPRINT "TRS-80 "; F1$; " CONVERSION TO IBM/PC "; F2$; "    "; TIME$: LPRINT
  120. 1800 IF EOF(1) THEN 1530
  121. 1810 LINE INPUT #1, B$: IF B$ = "" THEN 1800
  122. 1820 PRINT : PRINT "LINE"; VAL(B$),
  123. 2000 '******************************************************
  124. 2010 '*         CHANGE PRINT@ TO LOCATE R,C                *
  125. 2020 '******************************************************
  126. 2030 IF C2$ <> "Y" THEN 3030
  127. 2040 PRINT "LOCATE..";
  128. 2050 D = INSTR(B$, "PRINT@")
  129. 2060 IF D = 0 THEN 2120
  130. 2070 PL = 6
  131. 2080 C = INSTR(D, B$, ",")
  132. 2090 IF C = 0 THEN 2120
  133. 2100 A = VAL(MID$(B$, D + PL, (C - D + PL - 1)))
  134. 2110 L = INT(A / 64): B = A - (L * 64): GOTO 2140
  135. 2120 D = INSTR(B$, "PRINT @")
  136. 2130 IF D = 0 THEN 3030 ELSE PL = 7: GOTO 2080
  137. 2140 C$ = LEFT$(B$, D - 1)
  138. 2150 GOSUB 410: C$ = C$ + "LOCATE " + RIGHT$(STR$(L), LEN(STR$(L)) - 1) + "," + RIGHT$(STR$(B), LEN(STR$(B)) - 1)
  139. 2160 C$ = C$ + ":PRINT" + RIGHT$(B$, LEN(B$) - C)
  140. 2170 B$ = C$
  141. 2180 GOTO 2050
  142. 3000 '******************************************************
  143. 3010 '*                ADDSPACE TO KEY WORDS               *
  144. 3020 '******************************************************
  145. 3030 IF C3$ <> "Y" THEN N$ = B$: GOTO 4030
  146. 3040 PRINT "ADD SPACE..";
  147. 3050 D = INSTR(B$, "DATA"): IF D THEN 4030'DON'T ADD SPACE TO DATA
  148. 3060 N = LEN(B$): N$ = "": F4 = 0: F1 = 0
  149. 3070 FOR P = 1 TO N'STRIP B$
  150. 3080   IF LEN(N$) >= 255 THEN LPRINT "ADDSPACE ABORTED LINE TOO LONG": LPRINT N$: GOTO 4030
  151. 3090   D$ = MID$(B$, P, 1)
  152. 3100   N$ = N$ + D$
  153. 3110   IF D$ = CHR$(34) AND F4 = 1 THEN F4 = 0: GOTO 3130
  154. 3120   IF D$ = CHR$(34) AND F4 = 0 THEN F4 = 1
  155. 3130   IF D$ = "'" AND F4 = 0 THEN F1 = 1'REMARK
  156. 3140   IF F4 = 1 OR F1 = 1 THEN 3250
  157. 3150   L = 6: R% = FNRW%(R6$, RIGHT$(N$, L), L + 1)
  158. 3160   ON R% GOTO 230, 230, 230, 230, 230, 230, 230
  159. 3170   L = L - 1: R% = FNRW%(R5$, RIGHT$(N$, L), L + 1)
  160. 3180   ON R% GOTO 250, 250, 270, 230, 230, 230, 230, 250
  161. 3190   L = L - 1: R% = FNRW%(R4$, RIGHT$(N$, L), L + 1)
  162. 3200   ON R% GOTO 270, 270, 230, 250, 230, 230, 230, 270, 270, 250, 250, 230, 230
  163. 3210   L = L - 1: R% = FNRW%(R3$, RIGHT$(N$, L), L + 1)
  164. 3220   ON R% GOTO 230, 270, 270, 230, 230, 230, 300, 230
  165. 3230   L = L - 1: R% = FNRW%(R2$, RIGHT$(N$, L), L + 1)
  166. 3240   ON R% GOTO 230, 320, 340, 230, 360
  167. 3250 NEXT
  168. 4000 '******************************************************
  169. 4010 '*        REPLACEMENT COMMANDS                        *
  170. 4020 '******************************************************
  171. 4030 IF C4$ <> "Y" THEN 5030
  172. 4040 PRINT "REPLACE..";
  173. 4050 D = INSTR(N$, "ERR/2+1")
  174. 4060 IF D = 0 THEN 4080
  175. 4070 MID$(N$, D, 7) = " ERR   "
  176. 4080 D = INSTR(N$, "[")
  177. 4090 IF D = 0 THEN 4110
  178. 4100 MID$(N$, D, 1) = CHR$(94): GOTO 4080
  179. 4110 D = INSTR(N$, "STRING$(64,")
  180. 4120 IF D = 0 THEN 4140
  181. 4130 MID$(N$, D + 8, 2) = "80"
  182. 4140 D = INSTR(N$, "STRING$(63,")
  183. 4150 IF D = 0 THEN 5030
  184. 4160 MID$(N$, D + 8, 2) = "79"
  185. 5000 '******************************************************
  186. 5010 '*           CONVERT UPPER TO LOWER CASE              *
  187. 5020 '******************************************************
  188. 5030 IF C5$ <> "Y" THEN 6030
  189. 5040 W = 1: PRINT "UC TO LC..";
  190. 5050 Y = INSTR(W, N$, CHR$(34)): IF Y < 1 THEN 6030
  191. 5060 Z = INSTR(Y + 1, N$, CHR$(34)): IF Z < 1 THEN Z = LEN(N$)
  192. 5070 FOR I = Y + 2 TO Z
  193. 5080   X$ = MID$(N$, I, 1): IF X$ = "" THEN 5120
  194. 5090   IF ASC(X$) < 65 OR ASC(X$) > 90 THEN 5120
  195. 5100   X$ = CHR$(ASC(X$) + 32)
  196. 5110   MID$(N$, I, 1) = X$
  197. 5120 NEXT I
  198. 5130 W = I: GOTO 5050
  199. 6000 '******************************************************
  200. 6010 '*         CONVERT AID REPORTER                       *
  201. 6020 '******************************************************
  202. 6030 IF C6$ <> "Y" THEN 6140
  203. 6040 PRINT "REPORT..";
  204. 6050 FOR I = 1 TO MAX
  205. 6060   C% = INSTR(N$, B1$(I)): CM = INSTR(N$, "'"): RM = INSTR(N$, "REM")
  206. 6070   IF C% = 0 THEN 6120
  207. 6080   IF CM THEN IF CM <= C% THEN 6120
  208. 6090   IF RM THEN IF RM <= C% THEN 6120
  209. 6100   LPRINT N$
  210. 6110   LPRINT TAB(C% - 1); "*"
  211. 6120 NEXT
  212. 6130 '******************************************************
  213. 6140 PRINT #2, N$: IF C7$ = "Y" THEN PRINT : PRINT N$'WRITE FILE
  214. 6150 '******************************************************
  215. 6160 GOTO 1800
  216. 7000 '******************************************************
  217. 7010 '*                 ERROR ROUTINE                      *
  218. 7020 '******************************************************
  219. 7030 PRINT "ERROR"; ERR / 2 + 1; "IN LINE"; ERL
  220. 7040 CLOSE : STOP
  221. 7050 END
  222. 9000 '**************** SAVE PROGRAM ************************
  223.  
  224.