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"