start tok64 d64-CG9jhj
0 REM"@0:vr"
1 OPEN15,8,15:np=-1:DIMpo$(100,6):GOTO10
2 INPUT#15,q1$,q2$,q3$,q4$
3 IFVAL(q1$)<20THENRETURN
4 PRINT"{cyan} disk error has occured:
5 PRINT" {green}"q1$" "CHR$(34)q2$CHR$(34)" "q3$","q4$
6 IFw9=.THENCLOSE2:CLOSE15:END
7 PRINT"{down}{cyan} shall i try to save the file with the{space*3}backup?
8 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"ANDa$<>"n"THEN8
9 GOTO900
10 POKE53280,.:POKE53281,.:PRINT"{gray}{clear}{142}{ct h}
20 PRINT"{down}{right}{white}video tape register
30 PRINT"{down}{right*25}{dark gray}(c) 1991 mr.p.
40 PRINT"{yellow}{cm @}{green}main menu{yellow}{cm @}{dark gray}{right*17}for sys pd.
50 PRINT"{yellow}{cm t}{cm y}E{D*5}E{cm y}{cm t}
60 PRINT"{down}{156}(1) {cyan}load register from disk
70 PRINT"{156}(2) {cyan}save register to disk
80 PRINT"{156}(3) {cyan}create a new register
90 PRINT"{156}(4) {cyan}update register file
91 PRINT"{156}(5) {cyan}edit register post(s)
92 PRINT"{156}(6) {cyan}delete register post(s)
93 PRINT"{156}(7) {cyan}view register to screen
94 PRINT"{156}(8) {cyan}print register
95 REM print"{156}(9) {cyan}
98 PRINT"{down}{156}(0) {cyan}quit program
99 PRINT"{home}{down*20}{cyan}filename:"CHR$(34)fl$CHR$(34)" date:"dt$
100 PRINT"{home}{down*21}{green}enter your choice :";:gg=1:GOSUB10000
101 ch=ASC(gg$)-48
102 IFch<0ORch>8ORch<>INT(ch)THEN100
103 IFnp=-1AND(ch=2ORch>3)THEN100
200 PRINT"{cyan}{clear}{down}{right}"ch"{left}: ";:ONchGOTO1000,2000,3000,4000,5000,6000,7000,8000,9000
210 PRINT"{clear}{green}{down}{right}are you sure that you want to quit?
220 PRINT"{down}{right}if you haven't saved the datas since
230 PRINT"{right}the last update, those datas will be
240 PRINT"{right}lost!
250 PRINT"{down}{right}press {reverse on}{arrow left}{reverse off} to quit, any other key to
260 PRINT"{right}return to main menu.
270 POKE198,.:WAIT198,1:GETa$:IFa$<>"{arrow left}"THEN10
280 POKE53280,14:POKE53281,6:PRINT"{light blue}{clear}{down}{right}suit yourself!{down*4}":END
900 IFa$="n"THENEND
910 PRINT"{down}{cyan} just to be sure the disk works:
920 PRINT"{right}please remove disk, turn off drive,
930 PRINT"{right}turn it on again, and insert disk.
940 PRINT"{right}press a key when ready:":CLOSE15:POKE198,.:WAIT198,1
950 OPEN15,8,15,"m-w{ct g}{red}{ct a}{ct o}":PRINT#15,"v0:"
951 PRINT"{green}please wait{.*3} validating disk{.*3}
952 INPUT#15,q,a$,z,z:IFq<>.THENPRINT"can't continue: "a$:CLOSE15:END
960 PRINT"{green}please wait{.*3} copying backup{.*3}
970 PRINT#15,"c0:"fl$"=backup copy"
971 INPUT#15,q,a$,z,z:IFq<>.THENPRINT"can't continue: "a$:CLOSE15:END
980 PRINT"{green}please wait{.*3} scratching bachup{.*3}
990 PRINT#15,"s0:backup copy"
999 CLOSE15:END
1000 REM(1) load register from disk
1010 PRINT"load register from disk
1020 PRINT"{down*2}{right}{green}please input the name of the register:
1030 PRINT"{down*2}{right}{cm y*16}
1040 PRINT"{up*2}:";:gg=16:GOSUB10000:IFLEN(gg$)=.THEN1020
1050 OPEN2,8,2,gg$+",s,r"
1060 GOSUB2
1070 INPUT#2,fl$,dt$,np
1080 GOSUB2
1090 FORp=1TOnp
1100  FORl=1TO6
1110   INPUT#2,po$(p,l):PRINTpo$(p,l)
1120  NEXT
1130  GOSUB2
1140 NEXT
1150 CLOSE2
1160 d$=dt$:f$=fl$:s=.:PRINT"{right}{down}{green}this file is dated "dt$
1170 PRINT"{right}do you want to change this?
1171 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THEN1190
1180 gg=6:PRINT"{down}{right}yymmdd":PRINT"{up*2}:";:GOSUB10000:dt$=gg$:s=-1
1190 PRINT"{right}{down}{green}the filename is "fl$
1200 PRINT"{right}do you want to change this?
1210 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THEN1230
1220 gg=16:PRINT"{down}{right}{cm y*16}":PRINT"{up*2}:";:GOSUB10000:fl$=gg$:s=-1
1221 IFLEN(fl$)=.THENfl$=f$:GOTO1220
1230 IFs=.THEN1999
1240 s=.:PRINT"{right}{down}{green}is this correct?
1250 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THENdt$=d$:fl$=f$:GOTO1160
1999 GOTO10
2000 REM(2) save register to disk
2005 PRINT"save register to disk
2010 PRINT#15,"r0:backup copy="fl$
2020 INPUT#15,a,a$,b,b:IFa=62THEN2100
2030 IFa=63THENPRINT#15,"s0:backup copy":GOSUB2:GOTO2010
2040 IFa<20THEN2100
2050 PRINT"{green}"aCHR$(34)a$CHR$(34):CLOSE15:END
2100 w9=-1:OPEN2,8,2,fl$+",s,w":GOSUB2
2110 PRINT#2,fl$CHR$(13)dt$CHR$(13)np
2120 FORp=1TOnp
2130  FORl=1TO6
2140   PRINT#2,po$(p,l):PRINTpo$(p,l)
2150  NEXT
2160  GOSUB2
2170 NEXT
2180 CLOSE2:GOSUB2:w9=.
2999 GOTO10
3000 REM(3) create a new register
3010 PRINT"create a new register
3020 PRINT"{green}{down}{right}please input the name of the register
3030 PRINT"{down*2}{right}{cm y*16}
3040 PRINT"{up*2}:";:gg=16:GOSUB10000:fl$=gg$:IFLEN(fl$)=.THEN3020
3050 PRINT"{green}{down}{right}please input today's date
3060 PRINT"{down*2}{right}yymmdd
3070 PRINT"{up*2}:";:gg=6:GOSUB10000:dt$=gg$
3080 PRINT"{down}{right}{green}is this correct?
3090 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THEN3020
3999 np=.:GOTO10
4000 REM(4) update register file
4010 PRINT"update register file
4015 IFnp=100THENGOTO4999
4020 PRINT"{down}{right}{green}please input post #"np+1"{left}:
4030 PRINT"{down}{right}{green}tape title:
4040 gg=30:GOSUB4900:po$(np+1,1)=gg$
4050 PRINT"{down}{right}{green}category:
4060 gg=15:GOSUB4900:po$(np+1,2)=gg$
4070 PRINT"{green}{down}{right}main contens:
4080 gg=30:GOSUB4900:po$(np+1,3)=gg$
4090 PRINT"{down}{green}{right}tape length:
4100 gg=10:GOSUB4900:po$(np+1,4)=gg$
4110 PRINT"{down}{right}{green}remark line 1:
4120 gg=30:GOSUB4900:po$(np+1,5)=gg$
4130 PRINT"{down}{green}{right}line 2:
4140 gg=30:GOSUB4900:po$(np+1,6)=gg$
4150 PRINT"{down}{right}{green}is this correct?
4160 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THEN4020
4170 np=np+1
4180 PRINT"{down}{right}{green}input more?
4190 POKE198,.:WAIT198,1:GETa$:IFa$<>"y"THEN4999
4200 GOTO4015
4900 PRINT"{down*2}{right}"LEFT$("{cm y*29}",gg)
4910 PRINT"{up*2}:";:GOSUB10000:RETURN
4999 GOTO10
5000 REM(5) edit register post(s)
5010 PRINT"edit register post(s)
5011 IFnp=.THEN5999
5020 PRINT"{down}{green}which post do you want to change?
5030 PRINT"{down*2}{right}{cm y*3}
5040 PRINT"{up*2}:";:gg=3:GOSUB10000
5050 IFVAL(gg$)<1ORVAL(gg$)>100THEN5020
5060 s=VAL(gg$):IFs>npTHEN5020
5070 PRINT"{green}line:{cyan}title:{156}contens:":RESTORE
5080 FORi=1TO6
5085  READp$:PRINT"{green}"i"{space*3}{cyan}"p$":
5090  PRINT"{space*9}{156}"po$(s,i)
5100 NEXT
5110 PRINT"{right}{down}{green}change what post? 0=ready:";
5120 gg=1:GOSUB10000
5130 p=ASC(gg$)-48:IFp<.ORp>6THEN5110
5131 IFp=.THEN5999
5140 PRINT"{green} from:
5150 PRINT":{156}"po$(s,p)
5160 PRINT" {green}to:
5170 gg=30+15*(p=2)+20*(p=4)
5180 GOSUB4900
5190 po$(s,p)=gg$:GOTO5070
5200 DATAtape title,category,main contens,tape length,remark line 1,line 2
5999 GOTO10
6000 REM(6) delete register post(s)
6010 PRINT"delete register post(s)
6011 IFnp=.THEN5999
6020 PRINT"{down}{green}which post do you want to delete?
6030 PRINT"{down*2}{right}{cm y*3}
6040 PRINT"{up*2}:";:gg=3:GOSUB10000
6050 IFVAL(gg$)<1ORVAL(gg$)>100THEN5020
6060 s=VAL(gg$):IFs>npTHEN5020
6070 PRINT"{green}line:{cyan}title:{156}contens:":RESTORE
6080 FORi=1TO6
6085  READp$:PRINT"{green}"i"{space*3}{cyan}"p$":
6090  PRINT"{space*9}{156}"po$(s,i)
6100 NEXT
6120 PRINT"{down}{right}{green}press {reverse on}{arrow left}{reverse off} to delete. any other key for
6130 PRINT"{right}menu.
6140 POKE198,.:WAIT198,1:GETa$:IFa$<>"{arrow left}"THEN6999
6150 FORp=sTOnp-1:FORl=1TO6:po$(p,l)=po$(p+1,l):NEXT:NEXT:np=np-1
6999 GOTO10
7000 REM(7) view register to screen
7010 PRINT"view register to screen
7011 IFnp=.THEN7999
7020 PRINT"{down}{green}press shift to pause
7030 FORs=1TOnp
7040 PRINT"{green}line:{cyan}title:{156}contens:",s:RESTORE
7050 FORi=1TO6
7060 READp$:PRINT"{green}"i"{space*3}{cyan}"p$":
7070 PRINT"{space*9}{156}"po$(s,i)
7080 NEXT
7090 IFPEEK(653)=1THEN7090
7100 NEXT
7110 PRINT"{green}commodore:":WAIT653,2
7999 GOTO10
8000 REM(8) print register
8010 PRINT"print register
8020 IFnp=.THEN8999
8030 PRINT"{down}{right}{green}press {reverse on}{arrow left}{reverse off} to print. any other key to
8040 PRINT"{right}quit.
8050 OPEN4,4:CMD4
8060 PRINTCHR$(34)fl$CHR$(34)TAB(20)dt$
8070 FORs=1TOnp
8080 PRINT"post:"TAB(20)s:RESTORE
8090 FORi=1TO6
8100 READp$:PRINTp$TAB(20)po$(s,p)
8110 NEXT
8120 NEXT
8130 PRINT#4
8140 CLOSE4
8999 GOTO10
9000 REM(9)
9999 GOTO10
10000 gg$=""
10010 PRINT"{yellow}*{left}";:POKE198,.:WAIT198,1:GETa$:PRINT" {left}";
10020 IFa$=CHR$(13)THENPRINT"{down}":RETURN
10030 IFa$<>CHR$(20)ORLEN(gg$)=.THEN10040
10031 gg$=LEFT$(gg$,LEN(gg$)-1):PRINT"{left}";:GOTO10010
10040 IFASC(a$)<32OR(ASC(a$)>127ANDASC(a$)<160)THEN10010
10050 IFLEN(gg$)=ggTHEN10010
10060 PRINT"{156}"a$;:gg$=gg$+a$:GOTO10010
stop tok64
(bastext 1.0)