home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 2 #1 / Commodore_Disk_User_Vol.2_1_1988_-.d64 / texted (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  20KB  |  273 lines
  1. 5 rem*******************************
  2. 10 rem set up machine code and sprites
  3. 15 rem*******************************
  4. 20 sys57812"texteds",8,1:sys62631:sys57812"control",8,1:sys62631
  5. 25 poke2040,225:poke2041,226:poke2042,227:poke2043,230:poke2044,229
  6. 30 poke2045,228:poke2046,231:poke2047,232:v=53248:fort=v+39tov+46:poket,7:next
  7. 35 fory=3to15step2:pokev+y,230:next:forx=2to14step2:g=g+30:pokev+x,g:next:pokev+39,5:pokev,30:pokev+1,23
  8. 40 poke49153,5:pokev+21,255:sys49152
  9. 42 open15,8,15,"i":close15:open14,8,15
  10. 45 rem********************************
  11. 50 rem initialise
  12. 55 rem******************************
  13. 60 vo=15:poke54296,15:poke53280,0:poke53281,0:printchr$(14),chr$(8):poke646,i
  14. 65 print"[147]";:dimtext$(500):ll=1:pl=1
  15. 70 text$(0)="[158][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178][178]"
  16. 75 text$(1)="[158][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][177][146]"
  17. 80 deffna(p)=1024+20*40+p:deffnb(p2)=1024+40*p2:poke54277,25:poke54278,00
  18. 81 gosub260
  19. 90 rem******************************
  20. 95 rem edit line
  21. 100 rem******************************
  22. 105 a$=" ":sys49152
  23. 110 p=0:print"";a$
  24. 115 ch=peek(fna(p)):poke54272+fna(p),5:pokefna(p),111
  25. 120 print"column:";p;"[157] word count:";wc;"[157] ";
  26. 125 print"length:";ll:pokefna(p),ch:ifpeek(56320)=111thengosub690
  27. 130 gett$:ift$=""thengoto115
  28. 135 poke54276,17:poke54273,100:poke54272,255
  29. 136 poke54276,16
  30. 140 ift$=chr$(13)orlen(a$)=81thengosub210:wc=wc+1:goto115
  31. 145 ift$="^"thengosub285:pokefnb(pl-ss),62:goto110
  32. 150 ift$=""thengosub560
  33. 155 ift$=""thengosub260:goto90
  34. 160 ift$="_"thenp=len(a$)-1:goto195
  35. 165 ift$=chr$(32)thenwc=wc+1
  36. 170 ifpeek(56320)=111thengosub690
  37. 175 ift$="."thenwc=wc+1
  38. 180 ift$="[147]"ort$=""ort$="[145]"thengoto195
  39. 185 ifp>0andt$=chr$(20)thena$=left$(a$,p-1)+mid$(a$,p+1):p=p-1:goto195
  40. 190 ift$<>""andt$<>"[157]"andt$<>""thena$=left$(a$,p)+t$+mid$(a$,p+1):p=p+1
  41. 195 print"";a$:ift$="[157]"andp>0thenp=p-1
  42. 200 ift$=""andp<len(a$)-1thenp=p+1
  43. 205 goto115
  44. 210 rem******************************
  45. 215 rem insert line
  46. 220 rem******************************
  47. 225 x=0
  48. 230 iflen(a$)<41thentt$(x)=left$(a$,len(a$)-1):a$="":goto245
  49. 235 fori=41to1step-1:ifmid$(a$,i,1)<>" "thennexti:i=41
  50. 240 tt$(x)=left$(a$,i-1):a$=mid$(a$,i+1)
  51. 245 x=x+1:ifa$<>""anda$<>" "thengoto230
  52. 250 fori=ll+xtopl+xstep-1:text$(i)=text$(i-x):nexti:fori=0tox-1:text$(pl+i)=tt$(i):next
  53. 255 a$=" ":p=0:print"[147]";:ll=ll+x:pl=pl+x
  54. 260 ss=pl-7:ifll-pl<8thenss=ll-15
  55. 265 print"[147][154]";a$;"";:ifss<0thenss=0
  56. 270 fori=sstoss+15:print"[158]";text$(i);:iflen(text$(i))<40thenprint
  57. 275 ifi=pl-1thenprintchr$(62)
  58. 280 nexti:print"                                        ":return
  59. 285 rem******************************
  60. 290 rem move edit line
  61. 295 rem******************************
  62. 300 p2=pl-ss
  63. 305 gett1$:ift1$<>""then320
  64. 310 poke54272+fnb(p2),1:pokefnb(p2),62:forit=1to20:next:ifpeek(56320)=111thengosub690
  65. 315 pokefnb(p2),32:goto305
  66. 320 pl=pl+(t1$="[145]")+10*(t1$="u"):ifpl<1thenpl=1
  67. 325 pl=pl-(t1$="")-10*(t1$="d"):ifpl>llthenpl=ll
  68. 330 ift1$=chr$(13)thenreturn
  69. 335 ifpl=>llort1$<>chr$(20)then345
  70. 340 ll=ll-1:fori=pltoll:text$(i)=text$(i+1):next:text$(ll+1)=""
  71. 345 ifpl<llandt1$="c"thena$=text$(pl)+" ":return
  72. 350 ift1$="p"thengosub435
  73. 355 ift1$="d"thengosub490
  74. 360 ift1$="f"thengosub370
  75. 361 ift1$="s"thengosub2000
  76. 365 gosub260:goto300
  77. 370 rem******************************
  78. 375 rem format line
  79. 380 rem******************************
  80. 385 fori=1toll-2:iftext$(i)=""ortext$(i+1)=""then430
  81. 387 ifleft$(text$(i),1)="*"thengoto430
  82. 388 ifleft$(text$(i+1),1)="*"thengoto430
  83. 390 sp=40-len(text$(i)):forj=1tolen(text$(i+1))
  84. 395 ifmid$(text$(i+1),j,1)<>" "thennextj:j=j-1
  85. 400 ifsp<jorj=len(text$(i+1))then415
  86. 405 text$(i)=text$(i)+" "+left$(text$(i+1),j-1)
  87. 410 text$(i+1)=mid$(text$(i+1),j+1):goto387
  88. 415 iflen(text$(i+1))=>spthen430
  89. 420 text$(i)=text$(i)+" "+text$(i+1)
  90. 425 forj=i+1toll:text$(j)=text$(j+1):nextj:ll=ll-1:pl=pl-1:goto387
  91. 430 nexti:gosub260:return
  92. 435 rem******************************
  93. 440 rem output to printer
  94. 445 rem******************************
  95. 450 open1,4,7:x=1:print#1,chr$(27);chr$(93);chr$(48);chr$(17);
  96. 455 ifx=llthen485
  97. 460 ifleft$(text$(x),1)="*"thengosub1075
  98. 461 ifleft$(text$(x),1)="*"thenx=x+1:goto455
  99. 465 iftext$(x)=""thenprint#1,"":x=x+1:goto455
  100. 470 print#1,text$(x);" ";:ifx+1=llthen485
  101. 471 ifleft$(text$(x+1),1)="*"thengosub1075
  102. 472 ifleft$(text$(x+1),1)="*"thenx=x+1:goto455
  103. 475 print#1,text$(x+1):iftext$(x+1)=""thenprint#1,""
  104. 480 x=x+2:goto455
  105. 485 print#1,"":close1:return
  106. 490 rem******************************
  107. 495 rem disk operations
  108. 500 rem******************************
  109. 502 poke56334,0:poke788,49:poke789,234:pokev+21,0:poke56334,1
  110. 505 gosub750:print"[147][196]ata handling."
  111. 510 print"[208]osition correct disk,then return[146]--":wait197,1
  112. 515 print"[195]ommands available:":print"1)[211]ave data":print"2)[204]oad data"
  113. 516 print"3)[205]erge files":poke198,0
  114. 520 input"[150]which do you require:";q:onqgoto525,535,552:gosub260:return
  115. 525 input"[198]ilename";f$:open1,8,2,f$+",s,w":print#1,pl:print#1,ll
  116. 530 fori=0toll:ff$=text$(i)+"@":print#1,ff$:nexti:close1
  117. 531 sys49152:pokev+21,255:gosub260:return
  118. 535 input"[198]ilename";f$:open1,8,0,f$+",s,r":input#1,pl,ll
  119. 540 fori=0toll:input#1,text$(i):next:close1:fori=0toll
  120. 545 iftext$(i)<>"@"thentext$(i)=left$(text$(i),len(text$(i))-1)
  121. 550 iftext$(i)="@"thentext$(i)=""
  122. 551 nexti:gosub260:sys49152:pokev+21,255:return
  123. 552 input"[198]ilename";f$:open1,8,0,f$+",s,r":cl=ll:input#1,pl,ll
  124. 553 fori=cltoll+cl:input#1,text$(i):next:close1:fori=cltoll+cl
  125. 554 iftext$(i)<>"@"thentext$(i)=left$(text$(i),len(text$(i))-1)
  126. 555 iftext$(i)="@"thentext$(i)=""
  127. 556 nexti:text$(cl)=" "
  128. 557 pl=pl+cl:ll=ll+cl:print"[145]";:gosub260:sys49152:pokev+21,255:return
  129. 560 rem******************************
  130. 565 rem help screens
  131. 570 rem******************************
  132. 575 print"[147]          [200][197][204][208]          ":print"                        "
  133. 580 print"[212]ext entry mode:        ":print"[210][197][212][213][210][206] places in text   "
  134. 585 print"_ moves cursor to end   ":print"^ calls up edit module  "
  135. 590 print"[195][210][211][210] keys move over text":print"                        "
  136. 595 getw$:ifpeek(56320)<>111andw$=""then595
  137. 600 print"[158]        [200][197][204][208] 2           "
  138. 605 printtab(10)"                         ":printtab(10)"[205]ain edit mode:          "
  139. 610 printtab(10)"[210][197][212][213][210][206] exits edit module ":printtab(10)"[196][197][204][197][212][197] removes line      "
  140. 615 printtab(10)"[195] copies line            ":printtab(10)"[208] prints text on printer "
  141. 620 printtab(10)"[196] saves and loads text   "
  142. 622 printtab(10)"[198] compacts text          "
  143. 625 printtab(10)"[195][210][211][210] keys move over text ":printtab(10)"                         "
  144. 630 getw$:ifpeek(56320)<>111andw$=""then630
  145. 635 print"";:print"       [200][197][204][208] 3      "
  146. 640 print"disk status:       ":print"                   ":input#14,rr$,tr$
  147. 645 print"[145]";tr$:print"                   ":print"";
  148. 650 getw$:ifpeek(56320)<>111andw$=""then650
  149. 655 printtab(16)"[145][158]      [200][197][204][208] 4      ":printtab(16)"[195][204][210] restarts prog "
  150. 660 printtab(16)"[210][213][206]/[211][212][207][208] for help ":printtab(16)"                  "
  151. 665 getw$:ifpeek(56320)<>111andw$=""then665
  152. 666 sys49152:pokev+21,255
  153. 670 gosub260:return
  154. 675 rem*******************************
  155. 680 rem icon recognition
  156. 685 rem*******************************
  157. 690 xp=peek(v):v=53248:ifxp>25andxp<55thenpokev+40,1:fort=0to500:next:pokev+40,7:gosub440:return
  158. 695 ifxp>55andxp<85thenpokev+41,1:fort=0to500:next:pokev+41,7:gosub570:return
  159. 700 ifxp>85andxp<115thenpokev+42,1:fort=0to500:next:pokev+42,7:gosub385:return
  160. 705 ifxp>115andxp<145thenpokev+43,1:fort=0to500:next:pokev+43,7:gosub730:return
  161. 710 ifxp>145andxp<175thenpokev+44,1:fort=0to500:next:pokev+44,7:gosub490:return
  162. 715 ifxp>175andxp<205thenpokev+45,1:fort=0to500:next:pokev+45,7:gosub285:return
  163. 720 ifxp>205andxp<235thenpokev+46,1:fort=0to500:next:pokev+46,7:goto110
  164. 725 return:return
  165. 730 ifvo=15thenpoke54296,0:vo=0:return
  166. 735 ifvo=0thenpoke54296,15:vo=15:return
  167. 740 return
  168. 745 rem*******************************
  169. 750 rem disk operations
  170. 755 rem*******************************
  171. 760 open15,8,15,"i":close15
  172. 765 print"[147][196][201][211][203][160][207][208][197][210][193][212][201][207][206][211].":print"1) [198]ormat [196]isk"
  173. 770 print"2) [210]ead [197]rror [195]hannel":print"3) [201]nitialize [196]rive"
  174. 775 print"4) [214]alidate [196]isk":print"5) [210]ead [196]irectory"
  175. 780 print"6) [210]ename [198]ile":print"7) [211]ave or [204]oad [196]ata":poke198,0
  176. 781 print"8) [210]eturn to [212]ext [197]ntry [205]ode"
  177. 785 input"[215]hich do you require";sk:ifsk<1orsk>8then765
  178. 790 onskgoto815,850,875,910,945,975,795,796:goto765
  179. 795 return
  180. 796 sys49152:pokev+21,255:gosub260:goto90
  181. 800 rem*******************************
  182. 805 rem format disk
  183. 810 rem*******************************
  184. 815 print"[147][156][198]ormat ([206]ew)[146]"
  185. 820 print"give required name and id":inputname$:inputid$
  186. 825 open1,8,15:print#1,"m-w"chr$(81)chr$(0)chr$(1)chr$(255):close1
  187. 830 open15,8,15:print#15,"new:"+name$+","+id$:goto765
  188. 835 rem*******************************
  189. 840 rem read error channel
  190. 845 rem*******************************
  191. 850 print"[147][197]rrors";:print"";:input#14,a$,b$,c$,d$:printa$,b$,c$,d$
  192. 855 poke198,0:wait198,1:goto765
  193. 860 rem*******************************
  194. 865 rem initialize disk
  195. 870 rem*******************************
  196. 875 print"[147][156][201]nitialize disk[146]"
  197. 880 print"[155][208]lace a disk in drive and close the door"
  198. 885 poke198,0:wait198,1:open15,8,15,"initialize":close15
  199. 890 print"[144][196]one":forx=0to1500:next:goto765
  200. 895 rem*******************************
  201. 900 rem validate disk
  202. 905 rem*******************************
  203. 910 print"[147][156][214]alidate [196]isk[146]":close15
  204. 915 print"[144][208]lace disk in drive and close door.":poke198,0:wait198,1
  205. 920 open15,8,15,"validate":print"[196]o not remove disk till light is out"
  206. 925 rem*******************************
  207. 930 rem read directory
  208. 935 rem*******************************
  209. 940 close15:print"[144][196]one":fort=0to1500:next:goto765
  210. 945 print"[147][156][210]ead [196]irectory.[146]"
  211. 950 print"place disk to be read in drive and closedoor"
  212. 955 poke198,0:wait198,1:print"[147][196][201][211][203] [196][201][210][197][195][212][207][210][217].[146]":goto1010
  213. 960 rem*******************************
  214. 965 rem rename file
  215. 970 rem*******************************
  216. 975 print"[147][156][210]ename [198]ile[146]"
  217. 980 input"[206]ame of file to be renamed";pr$:input"[206]ame to call new file";pp$
  218. 985 print"[207][203]?":geta$:ifa$="n"thengoto975
  219. 990 open1,8,15,"rename:"+pp$+"="+pr$:close1:print"[144][196]one":poke198,0:wait198,1:goto765
  220. 995 rem*******************************
  221. 1000 rem directory read subroutine
  222. 1005 rem*******************************
  223. 1010 open1,8,0,"$0":get#1,aw$,bw$
  224. 1015 get#1,aw$,bw$:get#1,aw$,bw$:c=0:ifaw$<>""thenc=asc(aw$)
  225. 1020 ifbw$<>""thenc=c+asc(bw$)*256
  226. 1025 print""mid$(str$(c),2);tab(2);"[146]";
  227. 1030 get#1,bw$:ifst<>0then1070
  228. 1035 ifbw$<>chr$(34)then1030
  229. 1040 get#1,bw$:ifbw$<>chr$(34)thenprintbw$;:goto1040
  230. 1045 get#1,bw$:ifbw$=chr$(32)then1045
  231. 1050 printtab(18);:c$=""
  232. 1055 c$=c$+bw$:get#1,bw$:ifbw$<>""then1055
  233. 1060 print""left$(c$,3):ifpeek(1024)<>32thenpoke198,0:wait198,1
  234. 1065 ifst=0then1015
  235. 1070 print" blocks free":close1:poke198,0:wait198,1:goto765
  236. 1075 rem*******************************
  237. 1080 rem output printer control codes
  238. 1085 rem*******************************
  239. 1087 cm$=text$(x)
  240. 1090 ifleft$(cm$,7)="*colour"thenprint#1,chr$(27);chr$(114);chr$((right$(cm$,2))
  241. 1095 ifleft$(cm$,4)="*nlq"thenprint#1,chr$(27);chr$(120);chr$(49);
  242. 1100 ifleft$(cm$,6)="*draft"thenprint#1,chr$(27);chr$(120);chr$(48);
  243. 1105 ifleft$(cm$,7)="*italic"thenprint#1,chr$(27);chr$(52);
  244. 1110 ifleft$(cm$,11)="*italic off"thenprint#1,chr$(27);chr$(53);
  245. 1115 ifleft$(cm$,11)="*emphasized"thenprint#1,chr$(27);chr$(69);
  246. 1120 ifleft$(cm$,15)="*emphasized off"thenprint#1,chr$(27);chr$(70);
  247. 1125 ifleft$(cm$,13)="*doublestrike"thenprint#1,chr$(27);chr$(71);
  248. 1130 ifleft$(cm$,17)="*doublestrike off"thenprint#1,chr$(27);chr$(72);
  249. 1135 ifleft$(cm$,8)="*reverse"thenprint#1,chr$(18);
  250. 1140 ifleft$(cm$,12)="*reverse off"thenprint#1,chr$(146);
  251. 1145 ifleft$(cm$,10)="*underline"thenprint#1,chr$(27);chr$(45);chr$(49);
  252. 1150 ifleft$(cm$,14)="*underline off"thenprint#1,chr$(27);chr$(45);chr$(48);
  253. 1155 ifleft$(cm$,12)="*superscript"thenprint#1,chr$(27);chr$(83);chr$(48);
  254. 1160 ifleft$(cm$,10)="*subscript"thenprint#1,chr$(27);chr$(83);chr$(49);
  255. 1165 ifleft$(cm$,11)="*script off"thenprint#1,chr$(27);chr$(84);
  256. 1170 ifleft$(cm$,9)="*expanded"thenprint#1,chr$(14);
  257. 1175 ifleft$(cm$,13)="*expanded off"thenprint#1,chr$(15);
  258. 1180 ifleft$(cm$,5)="*pica"thenprint#1,chr$(27);chr$(80);
  259. 1185 ifleft$(cm$,6)="*elite"thenprint#1,chr$(27);chr$(77);
  260. 1190 ifleft$(cm$,13)="*proportional"thenprint#1,chr$(27);chr$(112);chr$(49);
  261. 1195 ifleft$(cm$,14)="*proportional off"thenprint#1,chr$(27);chr$(112);chr$(48);
  262. 1200 ifleft$(cm$,8)="*double "thenprint#1,chr$(27);chr$(119);chr$(49);
  263. 1205 ifleft$(cm$,7)="*normal"thenprint#1,chr$(27);chr$(119);chr$(48);
  264. 1210 ifleft$(cm$,14)="*bottom margin"thenprint#1,chr$(147);
  265. 1215 ifleft$(cm$,10)="*form feed"thenprint#1,chr$(12);
  266. 1220 ifleft$(cm$,12)="*left margin"thenprint#1,chr$(27);chr$(108);chr$(right$(cm$,2));
  267. 1225 ifleft$(cm$,13)="*right margin"thenprint#1,chr$(27);chr$(81);chr$(right$(cm$,1));
  268. 1230 ifleft$(cm$,13)="*left justify"thenprint#1,chr$(27);chr$(97);chr$(0);
  269. 1235 ifleft$(cm$,14)="*right justify"thenprint#1,chr$(27);chr$(97);chr$(2);
  270. 1240 ifleft$(cm$,7)="*center"thenprint#1,chr$(27);chr$(97);chr$(1);
  271. 1245 ifleft$(cm$,6)="*reset"thenprint#1,chr$(27);chr$(64);
  272. 1250 return
  273.