image of READY prompt

Wang2200.org

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"