image of READY prompt

Wang2200.org

Listing of file='BSC-KEYH' on disk='vmedia/tbo_81.wvd.zip'

# Sector 381, program filename = 'BSC-KEYH'
0010 REM BSC-KEYH 04/28/78  GENERATE T.C. DISKETTES FROM KEYBOARD
   : COM F$
0012 SELECT #5 005
0015 DIM K0$1,K1$1,K2$1, P$(150)4, H$(16,16)2, M$(1)2, K$(1)30
0018 REM %0 P$( Position display,  H$( Hex values
0020 DIM B$(4)62,R1$(255)1,X$(2,255)1,F1$2,F3$2,F4$2
   : F6=64
0025 DIM S$1,K$1,Q8$17,Q9$64,R$(255)1,V$64
0026 GOSUB 1800
   : REM /INITIALIZE ARRAY
0030 GOTO 1520
   : REM %DESCRIPTION
0040 REM %REQUIRES
   : REM %0 OP2 I/O ROM, OP5 SORT ROM, MEM. 12K
   : REM %PERIPHERALS
   : REM %0 #2 DISK, /001 KEYBOARD, #5   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 .7 .8 .9 .0 .1 .2 .3 .4 .5 .6 .7 .8 .9 .0"
0235 SELECT PRINT 005(80)
   : PRINT TAB(60);"01-20"
   : PRINT TAB(60);"21-40"
   : PRINT TAB(60);"41-60"
   : PRINT TAB(60);"61-80"
0240 V9=V2+L1-1
   : IF V9>255THEN 570
   : V=L1
0245 FOR I=V2TO V9
   : V=VAL(R$(I))+1
0246 MAT COPY H$()<(2*V)-1,2>TO P$()<(4*I)-3,2>
0247 NEXT I
0250 V=1
   : Q=Q1
   : V1=V2
   : GOSUB 290
0260 SELECT PRINT 005(64)
   : PRINT STR(Q8$,1,Q);STR(Q9$,1,(V*3)-2);
0270 KEYIN K$,302,440
   : GOTO 270
0280 Q=Q1
0290 PRINT STR(Q8$,1,Q1);
   : $GIO#5(A000,P2$)P$()<1,4*80>
0295 RETURN
0300 PRINT STR(Q8$,1,Q);STR(Q9$,1,X);
   : RETURN
0301 REM ..1ST of pair
0302 MAT SEARCHK$(),=K$ TO M$()
   : IF M$(1)=HEX(0000)THEN 270
0304 ON VAL(STR(M$(1),2))GOTO 540,307,340
0305 REM ......................BS, SP, CR
0306 STR(P$(V1),1,1)=K$
   : PRINT K$;
   : GOTO 310
0307 PRINT HEX(09);
0308 REM ..2nd of pair
0310 KEYIN K$,312,440
   : GOTO 310
0312 MAT SEARCHK$(),=K$ TO M$()
   : IF M$(1)=HEX(0000)THEN 310
0314 ON VAL(STR(M$(1),2))GOTO 334,500,340
0315 REM ......................BS, SP, CR
0316 STR(P$(V1),2,1)=K$
   : PRINT K$;HEX(09);
0320 V1=V1+1
   : V=V+1
   : IF V<21THEN 330
   : PRINT
   : V=1
   : Q=Q+1
0330 IF V1<=V9THEN 270
   : V=V-1
   : V1=V9
   : GOTO 260
0334 PRINT HEX(08);
   : GOTO 270
0338 E=1
   : REM /'16 END OF FILE
0339 REM .CR
0340 FOR I=V2 TO V9
   : MAT SEARCHH$(),=STR(P$(I),1,2) TO M$()STEP 2
0341 K$=STR(M$(1),2)
   : AND (K$,FE)
   : ROTATE(K$,7)
   : IF M$(1)<HEX(0100)THEN 342
   : OR (K$,80)
0342 R$(I)=K$
   : NEXT I
0344 ON E9GOTO 640
   : RETURN
0345 REM %^INSERT
0350 X=V1
0360 FOR I=80 TO X+1STEP -1
   : STR(P$(I),1,2)=STR(P$(I-1),1,2)
   : NEXT I
0365 IF X=1THEN 370
   : STR(P$(X),1,2)=STR(P$(X-1),1,2)
0370 STR(P$(X),1,2)=HEX(3030)
   : GOSUB 290
   : GOTO 260
0375 REM %DELETE
0380 X=V1
0390 FOR I=X TO 80
   : STR(P$(I),1,2)=STR(P$(I+1),1,2)
   : NEXT I
   : STR(P$(80),1,2)=HEX(3030)
0400 GOSUB 290
   : GOTO 260
0405 REM %LINE ERASE
0410 FOR I=1 TO 80
   : STR(P$(I),1,2)=HEX(3030)
   : NEXT I
   : 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(10)THEN 338
   : GOTO 260
0475 REM % ERASE
0480 FOR I=V1TO 80
   : STR(P$(I),1,2)=HEX(3030)
   : NEXT I
   : GOSUB 290
   : GOTO 260
0485 REM % CURSOR RIGHT
0490 V=V+4
   : V1=V1+4
0500 V1=V1+1
   : V=V+1
   : IF V<21THEN 510
   : PRINT
   : V=V-20
   : Q=Q+1
0510 IF V1<V9THEN 260
   : V1=V9
0515 STOP #
0520 Q=1+INT(L1/20)
   : V=L1-(Q*20)+20
   : Q=Q+Q1-1
   : GOTO 260
0525 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)-(20*(Q-Q1))+1
0560 IF Q<Q1THEN 250
   : GOTO 260
0570 STOP "550  IMPROPER REQUEST"
0590 REM %RECALL DATA
0600 MAT COPY 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 PRINT STR(Q8$,1,8);"LENGTH = ";L;
   : INPUT " OR ",L
0650 BIN(X$(1,B))=L
   : B=B+1
0660 MAT COPY R$()<1,L>TO X$()<B,L>
   : B1=B
   : INIT(00)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 MAT COPY 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 GOSUB 780
0750 RETURN
0770 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
   : MAT COPY B$()TO X$()
0990 B=3+(81*(B-1))
   : B1=B+1
   : MAT COPY 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(00)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)
   : MAT COPY B$()TO X$()
   : 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
   : MAT COPY 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 %^
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
   : INIT(00)R$()
1530 DEFFN'15
   : REM %'15 MENU
   : SELECT PRINT 005(64)
   : PRINT HEX(03),,"BSCHKEY CARD IMAGE EDITOR"
1535 PRINT  ," ALLOWING HEX DIGIT ENTRY ONLY"
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)
1590 PRINT ,"'15 DISPLAY MENU";TAB(64)
   : PRINT TAB(64)
   : RETURN
1600 STOP "END OF FILE ON POSITION---LINE 1425"
1790 REM %INITIALIZATION FOR HEX ENTRY DISPLAYS
1800 FOR B=0TO 100STEP 20
1810 FOR A=1TO 19
   : P$(B+A)=HEX(30302E00)
   : NEXT A
   : P$(B+A+1)=HEX(30300D0A)
1820 NEXT B
1830 H$="0123456789ABCDEF"
1835 K$(1)=HEX(08200D)
   : STR(K$(1),4)=H$
1840 FOR A=1 TO 16
   : K$=STR(H$,A,1)
1850 FOR B=1 TO 16
   : STR(H$(A,B),1,1)=K$
   : STR(H$(A,B),2,1)=STR(H$,B,1)
1860 NEXT B
   : NEXT A
1870 RETURN
1880 DEFFN'0
1890 $GIO#5( 4001 A000, Z$) P$()
1895 PRINT
1900 PRINT ".1 .2 .3 .4 .5 .6 .7 .8 .9 10 11 12 13 14 15 16 17 18 19 20"
1910 PRINT
1920 FOR A=1 TO 16
   : FOR B=1 TO 16
   : PRINT H$(A,B);" ";
   : NEXT B
   : PRINT
   : NEXT A