home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 8 / amigaformatcd08.iso / in_the_mag / emulation / ql / qdos4amiga3.lha / DOC2RTF_bas < prev    next >
Text File  |  1996-03-07  |  19KB  |  726 lines
  1. 10  TURBO_objfil "ram1_DOC2RTF_task"
  2. 11  TURBO_taskn "DOC2RTF"
  3. 12  TURBO_repfil "scr"
  4. 13  TURBO_windo 0
  5. 14  TURBO_diags 'omit'
  6. 15  TURBO_struct "S"
  7. 16  TURBO_model "<"
  8. 17  TURBO_objdat 10
  9. 18  TURBO_optim "R"
  10. 19 :
  11. 1000 REMark ------------------------------
  12. 1010 REMark    DOC2RTF_bas - Mark J Swift
  13. 1020 :
  14. 1052 REMark Thanks go to S N Goodwin for
  15. 1053 REMark obtaining vital information
  16. 1054 REMark about the DOC format, and to
  17. 1055 REMark Chas Dillon for providing it
  18. 1060 REMark ------------------------------
  19. 1070 :
  20. 1160 DIM InFile$(100),OutFile$(100),verstag$(4)
  21. 1170 DIM RTFtbs%(256),RTFtbs$(256),K$(1),extra$(4),RTFo$(4096),t$(256)
  22. 1180 cWdth=11880/98: REMark width of 10pt courier in 1/20 pts (approx)
  23. 1190 verstag$="1.02":REMark this version
  24. 1200 OPEN#3;"Con_456x144a28x12"
  25. 1210 OPEN#4;"Scr_104x12a362x20"
  26. 1220 OPEN#5;"Scr_436x52a38x99"
  27. 1230 REPeat outer_loop
  28. 1235  RETRY_HERE
  29. 1240  IF COMPILED
  30. 1241   WHEN ERRor 
  31. 1242    PRINT #3\\"Error: "
  32. 1243    REPORT #3,ERNUM
  33. 1244    INPUT #3;\" Press ENTER to re-start.";Rplc$
  34. 1245    RETRY
  35. 1246   END WHEN 
  36. 1247  END IF 
  37. 1249  WINDOW#3;456,144,28,12:PAPER#3;0:INK#3;7:CLS#3:BORDER#3;3,2:BORDER#3;2,0:BORDER#3;1,2:WINDOW#3;438,130,36,19:BORDER#5;1,4:INK#5;4:PAPER#5;0
  38. 1250  CSIZE#3;2,1:PRINT#3;"DOC2RTF v";verstag$:CSIZE#3;0,0
  39. 1260  PRINT#3;"DOC file translation utility by MARK J SWIFT";
  40. 1270  CLS#4:BORDER#4;1,7:INK#4;4:CLS#5
  41. 1280  WINDOW#3;438,40,36,59
  42. 1290  INK#5;4
  43. 1300  PRINT#5;" DOC2RTF is a file utility that translates QUILL/XCHANGE doc files into"
  44. 1310  PRINT#5;" rich text format (RTF)."
  45. 1320  PRINT#5;\" RTF files can easily be read into most PC and Apple Macintosh"
  46. 1330  PRINT#5;" word-processors and DTP applications."
  47. 1370  INPUT#3;\"      Input source DOC filename  >";InFile$
  48. 1380  IF InFile$="" THEN EXIT outer_loop
  49. 1390  INPUT#3;" Input destination RTF filename  >";OutFile$
  50. 1400  IF OutFile$="" THEN EXIT outer_loop
  51. 1410  CLS#5
  52. 1419  DOCbeginDocument InFile$
  53. 1420  RTFleading=240
  54. 1421  IF (DOChjust<>0) THEN DOCdoHeader
  55. 1422  IF (DOCfjust<>0) THEN DOCdoFooter
  56. 1423  DOCclearEnhance
  57. 1425  SET_POSITION#6,tblOffs+22+14+14
  58. 1427  RTFleading=240*(1+DOCLineGap)
  59. 1430  REPeat tblLoop
  60. 1440   IF DOCdone% THEN EXIT tblLoop
  61. 1450   DOCdoParagraph
  62. 1460   IF txtOffs>tblOffs THEN 
  63. 1470    BLOCK#4;100,10,0,0,4
  64. 1480   ELSE 
  65. 1490    BLOCK#4;INT((txtOffs/tblOffs)*100),10,0,0,4
  66. 1500   END IF 
  67. 1510  END REPeat tblLoop
  68. 1520  DOCendDocument
  69. 1540 END REPeat outer_loop
  70. 1550 CLOSE#3
  71. 1560 CLOSE#4
  72. 1570 CLOSE#5
  73. 1580 STOP
  74. 1590 :
  75. 1600 DEFine PROCedure DOCbeginDocument(InFile$)
  76. 1610  OPEN_IN#6,InFile$
  77. 1620  SET_POSITION#6,10
  78. 1630  tblOffs=STRINGL(INPUT$(#6,4))
  79. 1641  tblLen=STRING%(INPUT$(#6,2))
  80. 1645  PagOffs=tblOffs+tblLen
  81. 1647  PagLen=STRING%(INPUT$(#6,2))
  82. 1648  GenOffs=PagOffs+PagLen
  83. 1649  GenLen=STRING%(INPUT$(#6,2))
  84. 1650  RulOffs=GenOffs+20
  85. 1651  rulLen=GenLen-20
  86. 1652  GenLen=20
  87. 1659  OPEN_IN#7,InFile$
  88. 1660  DOCclearEnhance
  89. 1670  DOCrulID=0
  90. 1680  SET_POSITION#6,GenOffs
  91. 1681  DOCbotM=CODE(INKEY$(#6,-1))
  92. 1689  K=CODE(INKEY$(#6,-1))
  93. 1690  SELect ON K
  94. 1691  =1:DOCpwid=40
  95. 1692  =2:DOCpwid=64
  96. 1693  =REMAINDER :DOCpwid=80
  97. 1694  END SELect 
  98. 1695  RTFpwid=INT(cWdth*DOCpwid+.5)
  99. 1696  SET_POSITION#6,GenOffs+2
  100. 1697  DOCLineGap=CODE(INKEY$(#6,-1))
  101. 1698  DOCLinePP=CODE(INKEY$(#6,-1))
  102. 1699  DOCStartPag=CODE(INKEY$(#6,-1))
  103. 1700  SET_POSITION#6,GenOffs+6
  104. 1701  DOCtopM=CODE(INKEY$(#6,-1))
  105. 1702  SET_POSITION#6,GenOffs+14
  106. 1703  DOChjust=CODE(INKEY$(#6,-1))
  107. 1704  DOCfjust=CODE(INKEY$(#6,-1))
  108. 1705  DOChGap=CODE(INKEY$(#6,-1))
  109. 1706  DOCfGap=CODE(INKEY$(#6,-1))
  110. 1707  IF DOCLinePP>70 THEN DOCLinePP=70
  111. 1708  RTFextra=240*(70-DOCLinePP)/2
  112. 1709  RTFheadery=240*DOCtopM+RTFextra
  113. 1710  RTFfootery=240*DOCbotM+RTFextra
  114. 1711  RTFmargt=RTFheadery
  115. 1712  IF (DOChjust<>0) THEN RTFmargt=RTFmargt+240*(1+DOChGap)
  116. 1713  RTFmargb=RTFfootery
  117. 1714  IF (DOCfjust<>0) THEN RTFmargb=RTFmargb+240*(DOCfGap+1)
  118. 1717  RTFstartPag=DOCStartPag
  119. 1720  RTFbeginDocument OutFile$
  120. 1730 END DEFine 
  121. 1740 :
  122. 1750 DEFine PROCedure DOCendDocument
  123. 1760  CLOSE#6
  124. 1770  CLOSE#7
  125. 1780  RTFendDocument
  126. 1790 END DEFine 
  127. 1800 :
  128. 1810 DEFine FuNction DOCdone%
  129. 1811  RETurn POSITION(#7)>=tblOffs
  130. 1812 END DEFine 
  131. 1813 :
  132. 1814 DEFine PROCedure DOCdoFooter
  133. 1815  RTFbeginFooter
  134. 1816  SET_POSITION#6,tblOffs+22+14
  135. 1817  txtOffs=STRINGL(INPUT$(#6,4))
  136. 1818  SET_POSITION#6,GenOffs+15
  137. 1819  DOCdoHeaderFooter
  138. 1820  RTFendFooter
  139. 1821 END DEFine 
  140. 1822 :
  141. 1823 DEFine PROCedure DOCdoHeader
  142. 1824  RTFbeginHeader
  143. 1825  SET_POSITION#6,tblOffs+22
  144. 1826  txtOffs=STRINGL(INPUT$(#6,4))
  145. 1827  SET_POSITION#6,GenOffs+14
  146. 1828  DOCdoHeaderFooter
  147. 1829  RTFendHeader
  148. 1830 END DEFine 
  149. 1831 :
  150. 1832 DEFine PROCedure DOCdoHeaderFooter
  151. 1833  DOCclearEnhance
  152. 1834  DOCjFlg=CODE(INKEY$(#6,-1))
  153. 1835  SELect ON DOCjFlg
  154. 1836  =1:RTFleftAlign
  155. 1837  =2:RTFcentreAlign
  156. 1838  =3:RTFrightAlign
  157. 1839  END SELect 
  158. 1840  extra$=INKEY$(#6,-1)
  159. 1841  extra$=INPUT$(#6,2)
  160. 1842  Kk=CODE(INKEY$(#6,-1))
  161. 1843  IF Kk<>0 THEN DOCbold
  162. 1844  SET_POSITION#7,txtOffs
  163. 1845  REPeat txtLoop
  164. 1846   IF EOF(#7) THEN EXIT txtLoop
  165. 1847   K$=INKEY$(#7,-1)
  166. 1848   K=CODE(K$)
  167. 1849   IF K=0 THEN EXIT txtLoop
  168. 1850   RTFoutChar K$
  169. 1851  END REPeat txtLoop
  170. 1852  IF Kk<>0 THEN DOCbold
  171. 1853  REPeat loop
  172. 1854   K="nnn" INSTR RTFo$
  173. 1855   IF K=0 THEN K="aaa" INSTR RTFo$
  174. 1856   IF K=0 THEN EXIT loop
  175. 1857   IF K=(LEN(RTFo$)-2) THEN 
  176. 1858    RTFo$=RTFo$(1 TO K-1)&"\chpgn "
  177. 1859   ELSE 
  178. 1860    RTFo$=RTFo$(1 TO K-1)&"\chpgn "&RTFo$(K+3 TO)
  179. 1861   END IF 
  180. 1862  END REPeat loop
  181. 1865 END DEFine 
  182. 1866 :
  183. 1867 DEFine PROCedure DOCdoParagraph
  184. 1868  DOCclearEnhance
  185. 1869  txtOffs=STRINGL(INPUT$(#6,4))
  186. 1870  IF txtOffs<>0 THEN 
  187. 1890   extra$=INPUT$(#6,2)
  188. 1900   extra$=INKEY$(#6,-1)
  189. 1910   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  190. 1920   RTFleftIndent INT((t+1)*cWdth+.5)
  191. 1930   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  192. 1940   RTFfirstIndent (INT((t+1)*cWdth+.5)-RTFli)
  193. 1950   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  194. 1960   RTFrightIndent INT(RTFpwid-t*cWdth+.5)
  195. 1970   DOCjFlg=CODE(INKEY$(#6,-1))
  196. 1980   SELect ON DOCjFlg
  197. 1990   =0:RTFleftAlign
  198. 2000   =1:RTFcentreAlign
  199. 2010   =2:RTFjustify
  200. 2020   END SELect 
  201. 2021   K=CODE(INKEY$(#6,-1))
  202. 2022   IF K<>DOCrulID THEN 
  203. 2023    DOCrulID=K
  204. 2024    SET_POSITION#7,RulOffs
  205. 2025    REPeat loop
  206. 2026     K=CODE(INKEY$(#7,-1))
  207. 2027     L=CODE(INKEY$(#7,-1))-2
  208. 2028     IF K=DOCrulID THEN EXIT loop
  209. 2029     IF L>0 THEN K$=INPUT$(#7,L)
  210. 2030    END REPeat loop
  211. 2031    RTFnTbs%=0
  212. 2032    FOR i=1 TO L/2
  213. 2033     K=CODE(INKEY$(#7,-1))
  214. 2035     Kk=CODE(INKEY$(#7,-1))
  215. 2036     SELect ON Kk
  216. 2037     =0:RTFtab INT((K+1)*cWdth+.5),"L"
  217. 2038     =1:RTFtab INT((K+1)*cWdth+.5),"C"
  218. 2039     =2:RTFtab INT((K+1)*cWdth+.5),"R"
  219. 2040     =3:RTFtab INT((K+1)*cWdth+.5),"D"
  220. 2041     END SELect 
  221. 2044    END FOR i
  222. 2045    RTFleftIndent RTFli
  223. 2047   END IF 
  224. 2049   extra$=INPUT$(#6,2)
  225. 2050   RTFbeginParagraph
  226. 2055   SET_POSITION#7,txtOffs
  227. 2060   REPeat txtLoop
  228. 2070    IF EOF(#7) THEN EXIT txtLoop
  229. 2080    K$=INKEY$(#7,-1)
  230. 2090    K=CODE(K$)
  231. 2100    IF K=0 THEN EXIT txtLoop
  232. 2110    SELect ON K
  233. 2115    =9:RTFtabout
  234. 2120    =15:DOCbold
  235. 2130    =18:DOCsuperscript
  236. 2140    =17:DOCsubscript
  237. 2150    =16:DOCunderline
  238. 2160    =30:RTFoutChar "-"
  239. 2165    =12:DOCpagFlg%=1
  240. 2170    =REMAINDER : RTFoutChar K$
  241. 2180    END SELect 
  242. 2190   END REPeat txtLoop
  243. 2200   RTFendParagraph
  244. 2210  END IF 
  245. 2220 END DEFine 
  246. 2221 :
  247. 2222 DEFine PROCedure DOCclearEnhance
  248. 2223  DOCbldFlg%=0
  249. 2224  DOCitaFlg%=0
  250. 2225  DOCundFlg%=0
  251. 2226  DOCcndFlg%=0
  252. 2227  DOCsupFlg%=0
  253. 2228  DOCsubFlg%=0
  254. 2229 END DEFine 
  255. 2230 :
  256. 2240 DEFine PROCedure DOCbold
  257. 2250  DOCbldFlg%=1-DOCbldFlg%
  258. 2260  IF DOCbldFlg% THEN 
  259. 2270   RTFboldON
  260. 2280  ELSE 
  261. 2290   RTFboldOFF
  262. 2300  END IF 
  263. 2310 END DEFine 
  264. 2320 :
  265. 2330 DEFine PROCedure DOCsuperscript
  266. 2340  DOCsupFlg%=1-DOCsupFlg%
  267. 2350  IF DOCsupFlg% THEN 
  268. 2360   RTFsuperscriptON
  269. 2370  ELSE 
  270. 2380   RTFsuperscriptOFF
  271. 2390  END IF 
  272. 2400 END DEFine 
  273. 2410 :
  274. 2420 DEFine PROCedure DOCsubscript
  275. 2430  DOCsubFlg%=1-DOCsubFlg%
  276. 2440  IF DOCsubFlg% THEN 
  277. 2450   RTFsubscriptON
  278. 2460  ELSE 
  279. 2470   RTFsubscriptOFF
  280. 2480  END IF 
  281. 2490 END DEFine 
  282. 2500 :
  283. 2510 DEFine PROCedure DOCunderline
  284. 2520  DOCundFlg%=1-DOCundFlg%
  285. 2530  IF DOCundFlg% THEN 
  286. 2540   RTFunderlineON
  287. 2550  ELSE 
  288. 2560   RTFunderlineOFF
  289. 2570  END IF 
  290. 2580 END DEFine 
  291. 2590 :
  292. 2600 DEFine PROCedure RTFbeginDocument(OutFile$)
  293. 2610 :
  294. 2620  RTFclearEnhance
  295. 2690  RTFclearStyle
  296. 2790 :
  297. 2800  rtfparFlg%=0
  298. 2830 :
  299. 2835  DELETE OutFile$
  300. 2840  OPEN_NEW#9,OutFile$
  301. 2850  PRINT#9,"{\rtf1 \mac"
  302. 2860  PRINT#9,""
  303. 2870  PRINT#9,"{\fonttbl"
  304. 2880  PRINT#9,"{\f22 \fmodern Courier;}"
  305. 2890  PRINT#9,"}"
  306. 2900  PRINT#9,""
  307. 2910  PRINT#9,"{\stylesheet"
  308. 2920  PRINT#9,"{\s243 \qc \f22 \fs20 \sbasedon0 \snext243 footer;}"
  309. 2930  PRINT#9,"{\s244 \qc \f22 \fs20 \sbasedon0 \snext244 header;}"
  310. 2940  PRINT#9,"{\f22 \fs20 \sbasedon222 \snext0 Normal;}"
  311. 2950  PRINT#9,"}"
  312. 2960  PRINT#9,""
  313. 2961  RTFmargl=1080
  314. 2962  RTFmargr=11880-RTFpwid-RTFmargl
  315. 2970  PRINT#9,"\paperw11880 \paperh16800 \deftab";INT(cWdth*5)
  316. 2975  PRINT#9,"\margl";RTFmargl;" \margr";RTFmargr;" \margt";-RTFmargt;" \margb";-RTFmargb
  317. 2980  PRINT#9,"\widowctrl \ftnbj \pgnstart";RTFstartPag;" \fracwidth "
  318. 2985  PRINT#9,"\sectd \linemod0 \linex0 \headery";RTFheadery;" \footery";RTFfootery;" \cols1 \endnhere"
  319. 2990  PRINT#9,"\plain \f22 \fs20 "
  320. 3000  PRINT#9,""
  321. 3010  RTFo$=""
  322. 3020 END DEFine 
  323. 3030 :
  324. 3040 DEFine PROCedure RTFendDocument
  325. 3050 :
  326. 3060  IF rtfparFlg% THEN 
  327. 3070    RTFendParagraph
  328. 3080  END IF 
  329. 3090 :
  330. 3100  PRINT#9,"}"
  331. 3110  CLOSE#9
  332. 3120 END DEFine 
  333. 3121 :
  334. 3122 DEFine PROCedure RTFbeginHeader
  335. 3123  PRINT#9;"{\header ":RTFbeginParagraph:RTFo$=RTFo$&"\s244 \f22 \fs20 "
  336. 3124 END DEFine 
  337. 3125 :
  338. 3126 DEFine PROCedure RTFendHeader
  339. 3128  RTFendParagraph:PRINT#9;"}":RTFclearStyle
  340. 3129 END DEFine 
  341. 3130 :
  342. 3132 DEFine PROCedure RTFbeginFooter
  343. 3133  PRINT#9;"{\footer ":RTFbeginParagraph:RTFo$=RTFo$&"\s243 \f22 \fs20 "
  344. 3134 END DEFine 
  345. 3135 :
  346. 3136 DEFine PROCedure RTFendFooter
  347. 3137  RTFendParagraph :PRINT#9;"}":RTFclearStyle
  348. 3138 END DEFine 
  349. 3139 :
  350. 3140 DEFine PROCedure RTFbeginParagraph
  351. 3150  IF rtfparFlg% THEN 
  352. 3160   RTFendParagraph
  353. 3200  END IF 
  354. 3220  rtfparFlg%=1
  355. 3225  RTFclearEnhance
  356. 3227  DOCpagFlg%=0
  357. 3230 END DEFine 
  358. 3240 :
  359. 3250 DEFine PROCedure RTFendParagraph
  360. 3260  IF rtfparFlg% THEN 
  361. 3270    RTFendEnhance
  362. 3280    RTFo$=RTFo$&"\par "
  363. 3285    RTFflushStyle
  364. 3290    PRINT#9,RTFo$
  365. 3295    RTFclearEnhance
  366. 3300    RTFo$=""
  367. 3310    rtfparFlg%=0
  368. 3315    IF DOCpagFlg%<>0 THEN 
  369. 3316     RTFpagebreak
  370. 3317     DOCpagFlg%=0
  371. 3318    END IF 
  372. 3320  END IF 
  373. 3330 END DEFine 
  374. 3331 :
  375. 3332 DEFine PROCedure RTFclearStyle
  376. 3333  RTFdefli=0
  377. 3334  RTFdeffi=0
  378. 3335  RTFdefri=0
  379. 3336  RTFli=RTFdefli
  380. 3337  RTFfi=RTFdeffi
  381. 3338  RTFri=RTFdefri
  382. 3339 :
  383. 3340  RTFalignFlg%=0
  384. 3341 :
  385. 3342  RTFnTbs%=0
  386. 3344 :
  387. 3345  RTFstyleFlg%=0
  388. 3348 END DEFine 
  389. 3349 :
  390. 3350 DEFine PROCedure RTFleftAlign
  391. 3360  IF RTFalignFlg%<>0 THEN 
  392. 3370   RTFalignFlg%=0
  393. 3380   RTFstyleFlg%=1
  394. 3390  END IF 
  395. 3400 END DEFine 
  396. 3410 :
  397. 3420 DEFine PROCedure RTFrightAlign
  398. 3430  IF RTFalignFlg%<>1 THEN 
  399. 3440   RTFalignFlg%=1
  400. 3450   RTFstyleFlg%=1
  401. 3460  END IF 
  402. 3470 END DEFine 
  403. 3480 :
  404. 3490 DEFine PROCedure RTFcentreAlign
  405. 3500  IF RTFalignFlg%<>2 THEN 
  406. 3510   RTFalignFlg%=2
  407. 3520   RTFstyleFlg%=1
  408. 3530  END IF 
  409. 3540 END DEFine 
  410. 3550 :
  411. 3560 DEFine PROCedure RTFjustify
  412. 3570  IF RTFalignFlg%<>3 THEN 
  413. 3580   RTFalignFlg%=3
  414. 3590   RTFstyleFlg%=1
  415. 3600  END IF 
  416. 3610 END DEFine 
  417. 3620 :
  418. 3630 DEFine PROCedure RTFleftIndent(N)
  419. 3640  REMark n - units of pts/20 as measured from the left margin
  420. 3650  IF N<>RTFli THEN 
  421. 3660    RTFli=N
  422. 3670    RTFstyleFlg%=1
  423. 3680  END IF 
  424. 3682  IF RTFstyleFlg%<>0 THEN 
  425. 3685   RTFclearSoftTabs
  426. 3690   RTFtab N,"S"
  427. 3695  END IF 
  428. 3700 END DEFine 
  429. 3710 :
  430. 3720 DEFine PROCedure RTFfirstIndent(N)
  431. 3730  REMark n - units of pts/20 as measured from the left indent
  432. 3740  IF N<>RTFfi THEN 
  433. 3750    RTFfi=N
  434. 3760    RTFstyleFlg%=1
  435. 3770  END IF 
  436. 3780 END DEFine 
  437. 3790 :
  438. 3800 DEFine PROCedure RTFrightIndent(N)
  439. 3810  REMark n - units of pts/20 as measured from the right margin
  440. 3820  IF N<>RTFri THEN 
  441. 3830    RTFri=N
  442. 3840    RTFstyleFlg%=1
  443. 3850  END IF 
  444. 3860 END DEFine 
  445. 3861 :
  446. 3862 DEFine PROCedure RTFclearSoftTabs
  447. 3863  i=1
  448. 3864  REPeat loop
  449. 3865   IF i>RTFnTbs% THEN EXIT loop
  450. 3866   IF RTFtbs$(i)=="S" THEN 
  451. 3867    FOR j=i TO RTFnTbs%-1
  452. 3868     RTFtbs%(j)=RTFtbs%(j+1)
  453. 3869     RTFtbs$(j)=RTFtbs$(j+1)
  454. 3870    END FOR j
  455. 3871    RTFnTbs%=RTFnTbs%-1
  456. 3872    RTFstyleFlg%=1
  457. 3873   END IF 
  458. 3874   i=i+1
  459. 3875   END REPeat loop
  460. 3878  END DEFine 
  461. 3879 :
  462. 3880 DEFine PROCedure RTFtab(N,t$)
  463. 3890  LOCal i,j,loop
  464. 3900  REMark n  - units of pts/20 as measured from the left margin
  465. 3910  REMark t$ - L=left tab, C=centre tab, R=right tab, D=decimal tab, X=remove tab
  466. 3920 :
  467. 3930  i=1
  468. 3940  REPeat loop
  469. 3950    IF ((i>RTFnTbs%) OR (RTFtbs%(i)>=N)) THEN EXIT loop
  470. 3960    i=i+1
  471. 3970  END REPeat loop
  472. 3980 :
  473. 3981  IF t$=="X" THEN 
  474. 3982   IF i<=RTFnTbs% THEN 
  475. 3983    REMark remove old tab
  476. 3984    FOR j=i TO RTFnTbs%-1
  477. 3985     RTFtbs%(j)=RTFtbs%(j+1)
  478. 3986     RTFtbs$(j)=RTFtbs$(j+1)
  479. 3987    END FOR j
  480. 3988    RTFnTbs%=RTFnTbs%-1
  481. 3989    RTFstyleFlg%=1
  482. 3990   END IF 
  483. 3991  ELSE 
  484. 3992   IF i>RTFnTbs% THEN 
  485. 3995    REMark add new tab to end of Q
  486. 4000    RTFnTbs%=RTFnTbs%+1
  487. 4010    RTFtbs%(RTFnTbs%)=N
  488. 4020    RTFtbs$(RTFnTbs%)=t$
  489. 4030    RTFstyleFlg%=1
  490. 4040   ELSE 
  491. 4050    IF N=RTFtbs%(i) THEN 
  492. 4055     REMark replace old tab with new
  493. 4059     IF NOT(t$=="S") THEN 
  494. 4060      IF RTFtbs$(i)<>t$ THEN 
  495. 4070       RTFtbs$(i)=t$
  496. 4080       RTFstyleFlg%=1
  497. 4090      END IF 
  498. 4095     END IF 
  499. 4100    ELSE 
  500. 4105     REMark insert new tab
  501. 4110     RTFnTbs%=RTFnTbs%+1
  502. 4120     FOR j=RTFnTbs%-1 TO i STEP -1
  503. 4130      RTFtbs%(j+1)=RTFtbs%(j)
  504. 4140      RTFtbs$(j+1)=RTFtbs$(j)
  505. 4150     NEXT j
  506. 4160     RTFtbs%(i)=N
  507. 4170     RTFtbs$(i)=t$
  508. 4180     RTFstyleFlg%=1
  509. 4190    END IF 
  510. 4195   END IF 
  511. 4200  END IF 
  512. 4210 :
  513. 4220 END DEFine 
  514. 4230 :
  515. 4240 DEFine PROCedure RTFflushStyle
  516. 4250  LOCal i,t
  517. 4260 :
  518. 4270  IF RTFstyleFlg% THEN 
  519. 4280    t=RTFalignFlg%
  520. 4290    SELect ON t
  521. 4300    =0:t$="\pard "
  522. 4310    =1:t$="\pard \qr "
  523. 4320    =2:t$="\pard \qc "
  524. 4330    =3:t$="\pard \qj "
  525. 4340    END SELect 
  526. 4350 :
  527. 4355    t$=t$&"\sl"&RTFleading&" "
  528. 4357 :
  529. 4360    IF RTFli<>RTFdefli THEN 
  530. 4370     t$=t$&"\li"&RTFli&" "
  531. 4380    END IF 
  532. 4390 :
  533. 4400    IF RTFfi<>RTFdeffi THEN 
  534. 4410     t$=t$&"\fi"&RTFfi&" "
  535. 4420    END IF 
  536. 4430 :
  537. 4440    IF RTFri<>RTFdefri THEN 
  538. 4450     t$=t$&"\ri"&RTFri&" "
  539. 4460    END IF 
  540. 4470 :
  541. 4480    IF RTFnTbs%<>0 THEN 
  542. 4490      FOR i=1 TO RTFnTbs%
  543. 4500        t=CODE(RTFtbs$(i))
  544. 4510        SELect ON t
  545. 4520        =CODE("L"),CODE("S")
  546. 4530          REMark left or soft tab
  547. 4540          t$=t$&"\tx"&RTFtbs%(i)&" "
  548. 4550        =CODE("C")
  549. 4560          REMark centre tab
  550. 4570          t$=t$&"\tqc\tx"&RTFtbs%(i)&"  "
  551. 4580        =CODE("R")
  552. 4590          REMark right tab
  553. 4600          t$=t$&"\tqr\tx"&RTFtbs%(i)&" "
  554. 4610        =CODE("D")
  555. 4620          REMark decimal tab
  556. 4630          t$=t$&"\tqdec\tx"&RTFtbs%(i)&" "
  557. 4640        END SELect 
  558. 4650      NEXT i
  559. 4660    END IF 
  560. 4670 :
  561. 4680    RTFo$=t$&RTFo$
  562. 4690 :
  563. 4700    RTFstyleFlg%=0
  564. 4710  END IF 
  565. 4720 END DEFine 
  566. 4730 :
  567. 4740 DEFine PROCedure RTFboldON
  568. 4750  IF RTFbldFlg%=0 THEN 
  569. 4760   RTFendEnhance
  570. 4770   RTFbldFlg%=1
  571. 4775   RTFenhFlg%=1
  572. 4780  END IF 
  573. 4790 END DEFine 
  574. 4800 :
  575. 4810 DEFine PROCedure RTFboldOFF
  576. 4820  IF RTFbldFlg%<>0 THEN 
  577. 4830   RTFendEnhance
  578. 4840   RTFbldFlg%=0
  579. 4845   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  580. 4850  END IF 
  581. 4860 END DEFine 
  582. 4870 :
  583. 4880 DEFine PROCedure RTFitalicON
  584. 4890  IF RTFitaFlg%=0 THEN 
  585. 4900   RTFendEnhance
  586. 4910   RTFitaFlg%=1
  587. 4915   RTFenhFlg%=1
  588. 4920  END IF 
  589. 4930 END DEFine 
  590. 4940 :
  591. 4950 DEFine PROCedure RTFitalicOFF
  592. 4960  IF RTFitaFlg%<>0 THEN 
  593. 4970   RTFendEnhance
  594. 4980   RTFitaFlg%=0
  595. 4985   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  596. 4990  END IF 
  597. 5000 END DEFine 
  598. 5010 :
  599. 5020 DEFine PROCedure RTFunderlineON
  600. 5030  IF RTFundFlg%=0 THEN 
  601. 5040   RTFendEnhance
  602. 5050   RTFundFlg%=1
  603. 5055   RTFenhFlg%=1
  604. 5060  END IF 
  605. 5070 END DEFine 
  606. 5080 :
  607. 5090 DEFine PROCedure RTFunderlineOFF
  608. 5100  IF RTFundFlg%<>0 THEN 
  609. 5110   RTFendEnhance
  610. 5120   RTFundFlg%=0
  611. 5125   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  612. 5130  END IF 
  613. 5140 END DEFine 
  614. 5150 :
  615. 5160 DEFine PROCedure RTFcondensedON
  616. 5170  IF RTFcndFlg%=0 THEN 
  617. 5180   RTFendEnhance
  618. 5190   RTFcndFlg%=1
  619. 5195   RTFenhFlg%=1
  620. 5200  END IF 
  621. 5210 END DEFine 
  622. 5220 :
  623. 5230 DEFine PROCedure RTFcondensedOFF
  624. 5240  IF RTFcndFlg%<>0 THEN 
  625. 5250   RTFendEnhance
  626. 5260   RTFcndFlg%=0
  627. 5265   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  628. 5270  END IF 
  629. 5280 END DEFine 
  630. 5290 :
  631. 5300 DEFine PROCedure RTFsuperscriptON
  632. 5310  IF RTFsupFlg%=0 THEN 
  633. 5320   RTFendEnhance
  634. 5330   RTFsupFlg%=1
  635. 5335   RTFenhFlg%=1
  636. 5340  END IF 
  637. 5350 END DEFine 
  638. 5360 :
  639. 5370 DEFine PROCedure RTFsuperscriptOFF
  640. 5380  IF RTFsupFlg%<>0 THEN 
  641. 5390   RTFendEnhance
  642. 5400   RTFsupFlg%=0
  643. 5405   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  644. 5410  END IF 
  645. 5420 END DEFine 
  646. 5430 :
  647. 5440 DEFine PROCedure RTFsubscriptON
  648. 5450  IF RTFsubFlg%=0 THEN 
  649. 5460   RTFendEnhance
  650. 5470   RTFsubFlg%=1
  651. 5475   RTFenhFlg%=1
  652. 5480  END IF 
  653. 5490 END DEFine 
  654. 5500 :
  655. 5510 DEFine PROCedure RTFsubscriptOFF
  656. 5520  IF RTFsubFlg%<>0 THEN 
  657. 5530   RTFendEnhance
  658. 5540   RTFsubFlg%=0
  659. 5545   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  660. 5550  END IF 
  661. 5560 END DEFine 
  662. 5570 :
  663. 5580 DEFine PROCedure RTFendEnhance
  664. 5590  IF RTFenhFlg%=0 THEN 
  665. 5595   IF (RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%) THEN 
  666. 5600    RTFo$=RTFo$&"}"
  667. 5605   END IF 
  668. 5606  END IF 
  669. 5607 END DEFine 
  670. 5608 :
  671. 5609 DEFine PROCedure RTFclearEnhance
  672. 5610  RTFbldFlg%=0
  673. 5620  RTFitaFlg%=0
  674. 5630  RTFundFlg%=0
  675. 5640  RTFcndFlg%=0
  676. 5650  RTFsupFlg%=0
  677. 5660  RTFsubFlg%=0
  678. 5670  RTFenhFlg%=0
  679. 5690 END DEFine 
  680. 5700 :
  681. 5710 DEFine PROCedure RTFflushEnhance
  682. 5720  IF RTFenhFlg% THEN 
  683. 5730   RTFo$=RTFo$&"{"
  684. 5740   IF RTFbldFlg% THEN 
  685. 5750    RTFo$=RTFo$&"\b "
  686. 5760   END IF 
  687. 5770   IF RTFitaFlg% THEN 
  688. 5780    RTFo$=RTFo$&"\i "
  689. 5790   END IF 
  690. 5800   IF RTFundFlg% THEN 
  691. 5810    RTFo$=RTFo$&"\ul "
  692. 5820   END IF 
  693. 5830   IF RTFcndFlg% THEN 
  694. 5840    RTFo$=RTFo$&"\expnd58 "
  695. 5850   END IF 
  696. 5860   IF RTFsupFlg% THEN 
  697. 5870    RTFo$=RTFo$&"\up6 "
  698. 5880   END IF 
  699. 5890   IF RTFsubFlg% THEN 
  700. 5900    RTFo$=RTFo$&"\dn4 "
  701. 5910   END IF 
  702. 5920  END IF 
  703. 5930  RTFenhFlg%=0
  704. 5940 END DEFine 
  705. 5950 :
  706. 5951 DEFine PROCedure RTFtabout
  707. 5952  IF RTFenhFlg% THEN RTFflushEnhance
  708. 5953  RTFo$=RTFo$&"\tab "
  709. 5954 END DEFine 
  710. 5955 :
  711. 5956 DEFine PROCedure RTFpagebreak
  712. 5957  PRINT#9;"\page "
  713. 5958 END DEFine 
  714. 5959 :
  715. 5960 DEFine PROCedure RTFoutChar(t$)
  716. 5965  LOCal K
  717. 5970  IF RTFenhFlg% THEN RTFflushEnhance
  718. 5992  K=CODE(t$)
  719. 5993  SELect ON K
  720. 5995  =CODE("{"),CODE("}"),CODE("\"):RTFo$=RTFo$&"\"&t$
  721. 5996  =32 TO 255:RTFo$=RTFo$&t$
  722. 5998  =REMAINDER :PRINT#5;"<";CODE(t$);"> ";
  723. 6000  END SELect 
  724. 6010 END DEFine 
  725. 6020 :
  726.