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