Listing of file='BSC-KEY' on disk='vmedia/tbo_81.wvd.zip'
# Sector 531, program filename = 'BSC-KEY' 0010 REM BSC-KEY 12/11/75 GENERATE BISYNC CASSETTE TAPES FROM KEYBOARD : COM F$ 0020 DIM B$(4)62,R1$(255)1,X$(2,255)1,F1$2,F3$2,F4$2 : F6=64 : DIM S$1,K$1,Q8$17,Q9$64,R$(255)1,V$64 0030 SELECT #2 10A : GOTO 1520 : REM %DESCRIPTION 0040 REM %REQUIRES : REM %0 OP2 I/O ROM, OP5 SORT ROM, MEM. 12K : REM %PERIPHERALS : REM %0 #2 CASSETTE/DISK, /001 KEYBOARD, /005 CRT : REM %SPECIAL FUNCTIONS 0050 REM %0 '11 REOPEN DISK, '12 OPEN DISK FILE 0060 REM %0 '13 MAKE TAPE FILE, '15 KEY PICTURE 0070 REM %0 '31 RECORD FORMAT, '201 KEYBOARD INPUT 0090 REM %VARIABLES 0100 REM %0 A DESIRED CARD, F$ FILE NAME, B1 RECALL PTR, K$ K$1 0110 REM %0 B BUFFER PTR, D DEVICE FLAG, E END FLAG, E9 EDIT FLAG 0120 REM %0 F1$ (A001), F3$ (A03E), F4$ (A040), F6 VAL=64 0130 REM %0 B$( I/O BUFFER, P2$ CRT ARG2, R$( R$(255)1, R9 MAX.IMG # 0140 REM %0 R CARD IMAGE #, R1 BL0CKS USED, R2 CURR.BLOCK, R1$( R1$(4)64 0150 REM %0 Q CUR.CRT LINE, V CUR.CRT CHAR, Q1 1ST CRT LINE 0160 REM %0 V1 CUR.BYTE IN BUFFER, L1 # BYTES IN FLD, L LENGTH 0170 REM %0 V2 START BYTE IN BUF., S$ PAD(SPACES), V9 BUFFER END 0180 REM %0 Q8$ CURSOR DOWN, Q9$ CURSOR RIGHT, S9 #BLOCKS FREE 0190 REM %0 S8 # BLOCKS USED, V$ V$64, X$( X$(2-255)1, X X, Z Z 0200 REM %^EDIT ARRAY R$() 0210 DEFFN'201(Q1,V2,L1) 0220 PRINT STR(Q8$,1,11);"CURR.BLOCK=";R2+1;TAB(25);"CARD NUMBER=";R+1;TAB(43) ;"LAST CARD OUT=";R9 0230 PRINT "....!....1....!....2....!....3....!....4....!....5....!....6...." : PRINT ,,,,,,,,"!....7....!....8";HEX(0C5F) 0240 V9=V2+L1-1 : IF V9>255THEN 570 : V=L1 0250 V=1 : Q=Q1 : V1=V2 : GOSUB 290 0260 SELECT PRINT 005(64) : PRINT STR(Q8$,1,Q);STR(Q9$,1,V); 0270 KEYIN K$,310,440 : GOTO 270 0280 Q=Q1 0290 PRINT STR(Q8$,1,Q1); : X=64 : FOR Z=V2TO V9-2STEP 64 : IF V9-Z>64THEN 300 : X=V9-Z+1 0300 $GIO/005(A000,P2$)R$()<Z,X> : PRINT : NEXT Z : PRINT STR(Q8$,1,Q);STR(Q9$,1,X); : RETURN 0310 IF K$=HEX(08)THEN 540 : IF K$=HEX(E5)THEN 410 : PRINT K$; : IF K$=HEX(0D)THEN 340 : R$(V1)=K$ : SELECT PRINT 005 0320 V1=V1+1 : V=V+1 : IF V<65THEN 330 : PRINT : V=1 : Q=Q+1 0330 IF V1<=V9THEN 270 : V=V-1 : V1=V9 : GOTO 260 0340 ON E9GOTO 640 : RETURN : REM %^INSERT 0350 X=V1 : $UNPACK(F=F1$)R$()TO R1$() 0360 $UNPACK(F=F4$)R1$()<X,F6>TO V$ : $PACK(F=F4$)R$()<X+1,F6>FROM V$ : X=X+F6 : IF X<LTHEN 360 0370 R$(V1)=" " : GOSUB 290 : GOTO 260 : REM %DELETE 0380 X=V1 : $UNPACK(F=F1$)R$()TO R1$() 0390 $UNPACK(F=F4$)R1$()<X+1,F6>TO V$ : $PACK(F=F4$)R$()<X,F6>FROM V$ : X=X+F6 : IF X<LTHEN 390 : $TRAN(R$()<V9>,S$)00 0400 GOSUB 290 : GOTO 260 0410 $TRAN(R$()<V2,L1>,S$)00 : GOSUB 280 : GOTO 250 0420 REM .............HOM.ERA.DEL.INS.5>..1>..<1..<5..RECALL 0430 REM .............'7..'8..'9..'10.'11.'12.'13.'14.'15 0440 ON VAL(K$)-6GOTO 250,480,380,350,490,500,540,530,600 0450 REM .............EDT. 0460 ON VAL(K$)+1GOTO 860 0470 IF K$=HEX(1B)THEN 580 : IF K$=HEX(10)THEN 590 : GOTO 260 0480 $TRAN(R$()<V1,V9-V1+1>,S$)00 : GOSUB 290 : GOTO 260 : REM %^CURSOR RIGHT 0490 V=V+4 : V1=V1+4 0500 V1=V1+1 : V=V+1 : IF V<65THEN 510 : PRINT : V=V-64 : Q=Q+1 0510 IF V1<V9THEN 260 : V1=V9 0520 Q=1+INT(L1/64) : V=L1-(Q*64)+64 : Q=Q+Q1-1 : GOTO 260 : REM %CURSOR LEFT 0530 V=V-4 : V1=V1-4 0540 V=V-1 : V1=V1-1 0550 IF V>0THEN 260 : Q=Q-1 : V=(V1-V2)-(64*(Q-Q1))+1 0560 IF Q<Q1THEN 250 : GOTO 260 0570 STOP "550 IMPROPER REQUEST" 0580 IF V<>1THEN 260 : REM ESC CAN ONLY OCCUR IN POSITION 1 : GOTO 310 0590 E=1 : REM /SF '16 WRITE END OF FILE : ON E9GOTO 640 : RETURN : REM %RECALL DATA 0600 $UNPACK(F=F1$)X$()<B1,255> TO R$() : GOTO 240 : REM %^ 0610 REM %MAKE DATA BLOCKS : PRINT HEX(01) 0620 GOSUB 1050 0630 GOSUB '201(13,1,80) 0640 L=80 : REM /MAKE 80 BYTE L.RECS ONLY 0650 BIN(X$(1,B))=L : B=B+1 0660 MAT COPY R$()<1,L>TO X$()<B,L> : B1=B : INIT(20)R$() 0670 B=B+L : R=R+1 : IF E=1THEN 680 : IF E9=1THEN 700 : IF B+L+2<256THEN 620 0680 REM %WRITE DATA BLOCK : R2,R1=R1+1 : S9=S9-1 0690 BIN(X$(1,2))=B 0700 X$(1,1)=HEX(00) : B=3 0710 $UNPACK(F=F3$)X$()TO B$() 0720 PRINT HEX(01); : PRINTUSING 1030,S9,R1 : IF E>0THEN 730 : IF S9>2THEN 740 : E=2 0730 STR(B$(1),1,1)=HEX(F0) 0740 ON D+1GOSUB 760,780 0750 RETURN : REM %CASSETTE 0760 REM DATA SAVE #2,B$() : REM .^ERR 50 PROTECTED TAPE 0770 IF E=0THEN 840 : REM DATA SAVE #2,END : GOTO 800 : REM %DISK 0780 DATA SAVE DC #2,B$() : IF E=0THEN 830 0790 DATA SAVE DC #2,END 0800 PRINT STR(Q8$,1,2);" FILE CREATED"; : IF E<2THEN 810 : PRINT " END OF FILE FORCED" 0810 PRINT STR(Q8$,1,11);STR(Q9$,1,43);"LAST CARD OUT=";R 0820 PRINT STR(Q8$,1,3) : IF E=2THEN 1550 : GOSUB 1560 : PRINT TAB(64) : RETURN 0830 ON E9GOTO 850 0840 R9=R : GOTO 620 : REM %^EDIT 0850 DBACKSPACE #2,1 : CONVERT R+1 TO Z$,(####) : IF R>=R9THEN 910 : GOTO 880 0860 IF D=0THEN 260 : ON E9GOTO 870 : GOSUB 680 0870 E9=1 : Z$=" " 0880 PRINT STR(Q8$,1,11);TAB(20);"EDIT CARD NUMBER";TAB(64);STR(Q8$,1,11);STR( Q9$,1,38);Z$; 0890 INPUT Z$ : IF Z$="END"THEN 910 : IF Z$="LAST"THEN 920 : IF NUM(Z$)<>16THEN 870 : K$=Z$ : CONVERT Z$TO Z : IF K$<>"+"THEN 900 : A=R+Z+1 : GOTO 940 0900 IF K$<>"-"THEN 930 : A=R+Z+1 : GOTO 940 0910 E9=2 : REM /END 0920 Z=R9 0930 A=Z 0940 A=INT(A) : IF A<1THEN 610 : IF A>R9THEN 610 : Z=INT((A+2)/3) : B=A+3-(3*Z) : Z=Z-1 : IF Z<R2THEN 950 : IF Z=R2THEN 960 : DSKIP #2,Z-R2 : GOTO 960 0950 DBACKSPACE #2,R2-Z 0960 DATA LOAD DC #2,B$() : REM .ERR 58 EXPECTED DATA RECORD 0970 IF END THEN 980 : DBACKSPACE #2,1 0980 R2=Z : R=A-1 : $PACK(F=F3$)X$()FROM B$() 0990 B=3+(81*(B-1)) : B1=B+1 : $UNPACK(F=F1$)X$()<B+1,255>TO R$() 1000 ON E9GOTO 1010,1020 : INIT(20)B$(),R$() : R9=R9-1 : GOTO 620 1010 Q1=13 : V2=1 : L1=80 : GOTO 210 1020 E9=0 : STR(B$(1),1,1)=HEX(00) : DATA SAVE DC #2,B$() : DBACKSPACE #2,1 : R9=R9+1 : GOTO 920 : REM %^ 1030 %#### BLOCKS FREE #### BLOCKS USED 1040 % ################### ################# ##################### 1050 PRINT STR(Q8$,1,3);"USE SPECIAL FUNCTION KEY TO SELECT OPERATION:" 1060 PRINTUSING 1040,"'16 END-OF-FILE"," '7 CURSOR HOME","'11 CURSOR----->" 1070 PRINTUSING 1040," '0 EDIT CARD"," '8 ERASE RIGHT","'12 CURSOR->" 1080 PRINTUSING 1040," "," '9 CHAR DELETE","'13 CURSOR<-" 1090 PRINTUSING 1040," ","'10 CHAR INSERT","'14 CURSOR<-----" 1100 PRINTUSING 1040," "," ","'15 RECALL DATA" 1110 PRINTUSING 1040," " : RETURN 1120 DEFFN'11 : REM %'11 OPEN OLD : PRINT HEX(03);"'11 OPEN AN EXISTING DISK FILE" : GOSUB 1220 1130 DATA LOAD DC OPEN T#2,F$ : REM ...^ERR 80 SHOWS NO FILE WITH THIS NAME...KEY S.F.'11 REOPEN FILE '12 OPEN NEW FILE 1140 GOSUB 1290 : E9=1 1150 DATA LOAD DC #2,B$() : REM .ERR 58 NOT A BISYNC DATA FILE 1160 GOTO 1340 1170 DEFFN'12 : REM %'12 OPEN NEW : PRINT HEX(03);"'12 OPEN A NEW DISK FILE" : E9=0 : GOSUB 1220 1180 INPUT "# OF SECTORS TO SAVE=",S9 : S9=S9+2 : IF S9<3THEN 1180 1190 DATA SAVE DC OPEN T$#2,S9,F$ : REM ...^ERR 79=A FILE ALREADY EXISTS WITH THIS NAME... S.F.'11 REOPEN FIL E '12 OPEN NEW FILE 1200 INIT(20)B$() : STR(B$(1),1,3)=HEX(F05450) : FOR Z=1 TO S9-1 : DATA SAVE DC #2,B$() : PRINT "CLEARING BLOCK=";Z;HEX(0C) : NEXT Z 1210 GOSUB 1290 : E9=0 : GOTO 620 : REM %ASSIGN DISK 1220 INPUT "DISK OUTPUT 1=(F)310 2=(R)B10 3=(F)320 4=(R)B20",Z 1230 ON Z GOTO 1240,1250,1260,1270 : GOTO 1220 1240 SELECT #2 310 : GOTO 1280 1250 SELECT #2 B10 : GOTO 1280 1260 SELECT #2 320 : GOTO 1280 1270 SELECT #2 B20 1280 PRINT "FILE NAME IS ";F$;" OR"; : INPUT F$ : IF F$=" "THEN 1280 : RETURN 1290 PRINT "FILE--";F$;"--OPENED" : FOR Z=1 TO 100 : NEXT Z : D=1 1300 PRINT HEX(03);TAB(42);"DISK FILE--";F$ 1310 LIMITS T#2,F$,X,Z,S8 : S9=Z-X 1320 DATA LOAD DC OPEN T #2,F$ : REM .^ERR 47 SAYS FILE NOT OPENED...S.F.'11 REOPEN FILE '12 OPEN NEW FI LE 1330 E,R,R1=0 : PRINT HEX(01); : PRINTUSING 1030,S9,R1 : RETURN : REM %POSITION TO LAST RECORD 1340 K$=STR(B$(1),1) : R2,R1=R1+1 : S9=S9-1 : PRINT HEX(01); : PRINTUSING 1030,S9,R1 1350 IF S9<1THEN 1430 1360 IF K$<>HEX(00)THEN 1400 : R=R+3 1370 DATA LOAD DC #2,B$() : REM .ERR 58 BISYNC FILE NOT PROPERLY ENDED 1380 IF END THEN 1430 1390 GOTO 1340 1400 R2=R2-1 : IF K$<>HEX(F0)THEN 1430 : STR(B$(1),1,1)=HEX(00) : $PACK(F=F3$)X$()FROM B$() : Z=VAL(STR(B$(1),2)) : B=0 1410 R=R+1 : B=B+1 : Z=Z-81 : IF Z>3THEN 1410 : R9=R : R=R-1 1420 B=3+(81*(B-1)) : B1=B+1 : $UNPACK(F=F1$)X$()<B+1,255>TO R$() : DBACKSPACE #2,1 : GOTO 610 1430 R9=R : STOP "FILE NOT ENDED-KEY (CONTINUE)TO EDIT " : GOTO 870 : REM %^ 1440 DEFFN'13 : REM %'13 TO TAPE : D=0 : PRINT HEX(03);TAB(42);"CASSETTE FILE" : SELECT #2 10A : S9=300 : GOSUB 1330 : GOTO 620 1450 REM "2200 RECORD FORMAT" 1460 REM "BYTE 1 CTRL 00=NO END FILE F0=END FILE" 1470 REM "BYTE 2 BLOK BLOCK SIZE" 1480 REM "BYTE 3 LREC LOGICAL RECORD LENGTH (#TEXT BYTES)" 1490 REM "BYTES 4-N=TEXT MATERIAL" 1500 REM "REPEAT OF BYTES 3-N FOR EACH LOGICAL RECORD" 1510 REM %SET-UP 1520 F1$=HEX(A001) : F3$=HEX(A03E) : F4$=HEX(A040) : INIT(0A)Q8$ : INIT(09)Q9$ : STR(Q8$,1,1)=HEX(01) : STR(Q9$,1,1)=HEX(00) : S$=" " : B=3 1530 DEFFN'15 : REM %'15 MENU : SELECT PRINT 005(64) : PRINT HEX(03),,"BSC-KEY CARD IMAGE EDITOR" 1540 PRINT : PRINT "USE SPECIAL FUNCTION KEY TO SELECT OPERATION";TAB(64) : PRINT 1550 GOSUB 1560 : STOP " KEY APPROPRIATE SPECIAL FUNCTION" 1560 PRINT ,"'11 OPEN AN EXISTING DISK FILE";TAB(64) 1570 PRINT ,"'12 OPEN A NEW DISK FILE";TAB(64) 1580 PRINT ,"'13 GENERATE CASSETTE FILE";TAB(64) 1590 PRINT ,"'15 DISPLAY MENU";TAB(64) : PRINT TAB(64) : RETURN 1600 STOP "END OF FILE ON POSITION---LINE 1425"