5 ! CS80 driver for HP-75 <=>HP-IB<=>HP9121 drives
10 DIM T$[256],R$[512]
20 DIM A$[256]
30 DIM C$[96]
40 ASSIGN IO
50 INPUT 'name of interface?';N$
60 N$=':'&N$
70 INPUT "name of disk drive";D$
80 D$=':'&D$
90 INPUT 'name of display?';P$
100 PRINTER IS ':P1'
110 CLEAR LOOP
120 WAIT 3
130 SENDIO N$,'LAD#','SE'
140 DIM S1$[300]
150 DIM A1$[256]
160 INPUT 'copy,setup,ok?,seek,read,write? ';A$
170 IF UPRC$(A$)='OK?' THEN 260
180 IF UPRC$(A$)='SEEK' THEN 330
190 IF UPRC$(A$)='READ' THEN 390
200 IF UPRC$(A$)='WRITE' THEN 450
210 IF UPRC$(A$)='SETUP' THEN 610
220 IF UPRC$(A$)='COPY' THEN 660
230 IF UPRC$(A$)='COPYIN' THEN 1530
240 DISP "sorry, don't know that"
250 GOTO 160
260 S1$=ENTIO$(D$,'TAD#,SAD16,SDA')
270 DISP 'LEN(S1$)=';LEN(S1$)
280 FOR I=1 TO LEN(S1$)
290 DISP NUM(S1$[I])
300 NEXT I
310 GOTO 160
320 WAIT 5
330 ! seek
340 INPUT 'sector?';A
350 SENDIO D$,'LAD#,SAD8',CHR$(2)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(A)
360 WAIT 3
370 DISP 'got there'
380 GOTO 160
390 ! read
400 SENDIO D$,'LAD#,SAD10',CHR$(5)&CHR$(0)
410 WAIT 3
420 S1$=ENTIO$(D$,'LAD2,TAD#,SAD0,SDA')
430 ! DISP 'LEN(S1$)=';LEN(S1$) @ DISP S1$
440 GOTO 160
450 ! write
460 SENDIO D$,'LAD#,SAD9',CHR$(8)&CHR$(0)
470 S1$=''
480 INPUT 'string?';C$
490 S1$=S1$&C$
500 DISP LEN(S1$)
510 IF LEN(S1$)<256 THEN 480
520 IF LEN(S1$)=256 THEN A1$=S1$ @ GOTO 560
530 A1$=S1$[1,256]
540 S1$=S1$[257,LEN(S1$)]
550 DISP LEN(S1$);' leftover chars: ';S1$
560 SENDIO D$,'LAD#,SAD0',A1$
570 WAIT 3
580 INPUT 'more? ';Y$
590 IF UPRC$(Y$)='YES' THEN 470
600 DISP 'done' @ GOTO 160
610 CLEAR LOOP
620 WAIT 3
630 SENDIO N$,'LAD#','SEE2'
640 DISP 'setup done'
650 GOTO 160
660 ! to write to directory
670 DIM Q$[40]
680 ! first get name
690 INPUT 'file? ';E$
700 DISP 'transforming '&E$&' into text'
710 EDIT E$
720 RENUMBER 1,1
730 TRANSFORM E$ INTO TEXT
740 ASSIGN # 1 TO E$
750 EDIT CAT$(-1)
760 FOR I=1 TO 20
770 Q$=CAT$(I)
780 IF LEN(Q$)=0 THEN 660
790 IF UPRC$(E$)=Q$[1,LEN(E$)] AND Q$[LEN(E$)+1,LEN(E$)+1]=' ' THEN DISP Q @ GOTO 830
800 NEXT I
810 DISP "couldn't find "&E$
820 GOTO 660
830 W$=Q$[14,17] ! ascii file size
840 B$=CHR$(VAL(W$)\256)&CHR$(MOD(VAL(W$),256))
850 T1=CEIL(VAL(W$)/256)
860 T1$=CHR$(T1)
870 DISP ' ascii size: '&W$
880 FOR I=LEN(T1$)+1 TO 4 @ T1$=CHR$(0)&T1$ @ NEXT I
890 DISP ' internal size: ';B$;T1$
900 L$=Q$[31,32]&Q$[28,29]&Q$[25,26]
910 DISP 'time=';L$
920 INPUT 'sector? ';S1
930 A1$[1,10]='          '
940 A1$[1,LEN(E$)]=Q$[1,LEN(E$)]
950 A1$[11,12]=CHR$(0)&CHR$(1)
960 A1$[16,16]=CHR$(MOD(S1,256))
970 A1$[15,15]=CHR$(S1\256*256)
980 A1$[14,14]=CHR$(S1\256*256*256)
990 A1$[13,13]=CHR$(S1\256*256*256*256)
1000 DISP 'sector: ';A1$[13,16]
1010 DISP 'ascii sector: ';NUM(A1$[13,13]);NUM(A1$[14,14]);NUM(A1$[15,15]);NUM(A1$[16,16])
1020 A1$[17,20]=T1$
1030 A1$[21,26]=L$
1040 A1$[27,28]=CHR$(64)&CHR$(1)
1050 A1$[29,32]=CHR$(0)&CHR$(0)&CHR$(0)&CHR$(0)
1060 ! actual writing of record
1070 ! (make a subroutine later)
1080 DISP 'seeking'
1090 SENDIO D$,'LAD#,SAD8',CHR$(2)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(2)
1100 WAIT 5
1110 SENDIO D$,'LAD#,SAD9',CHR$(8)&CHR$(0)
1120 FOR I=33 TO 256 @ A1$[I,I]=' ' @ NEXT I
1130 WAIT 5
1140 DISP 'sending directory'
1150 SENDIO D$,'LAD#,SAD0',A1$
1160 WAIT 3
1170 SENDIO D$,'LAD#,SAD8',CHR$(2)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(S1)
1180 WAIT 3
1190 DISP 'sending file'
1200 X=1
1210 ON ERROR GOTO 1440
1220 READ # 1 ; A$
1230 A$=CHR$(LEN(A$))&A$
1240 ! DISP 'new len=';LEN(A$);'old len=';L1;'x=';X;'y=';Y
1250 L1=LEN(A$)
1260 IF L1+X>256 THEN A1$[X,256]=A$[1,256-X] @ GOTO 1310
1270 A1$[X,X+LEN(A$)]=A$
1280 IF X+LEN(A$)=256 THEN 1310
1290 X=X+LEN(A$)+1
1300 GOTO 1220
1310 ! send 256 byte chunk
1320 SENDIO D$,'LAD#,SAD9',CHR$(8)&CHR$(0)
1330 WAIT 3
1340 SENDIO D$,'LAD#,SAD0',A1$
1350 DISP 'record sent' @ WAIT 3
1360 DISP 'last chars sent: '&A1$[249,256]
1370 DISP 'leftover chars: '&A$[257-X,L1]
1380 Y=LEN(A$)-(256-X)
1390 IF Y=0 THEN 1420
1400 A1$[1,Y]=A$[257-X,L1]
1410 DISP 'first';Y;' chars to be sent: '&A1$[1,Y]
1420 X=Y+1
1430 GOTO 1220
1440 IF ERRN=34 THEN DISP 'end of file reached' ELSE DISP ERRN;'on';ERRL;'(bad ending)' @ STOP
1450 ! pad a1$ with blanks
1460 FOR I=X TO 256
1470 A1$[I,I]=' '
1480 NEXT I
1490 SENDIO D$,'LAD2,LAD#,SAD9',CHR$(8)&CHR$(0)
1500 WAIT 3
1510 SENDIO D$,'LAD2,LAD#,SAD0',A1$
1520 DISP 'done!' @ GOTO 160
1530 ! now let's read it back in
1540 ! get directory
1550 INPUT 'name of disc file?';O$
1560 ASSIGN # 1 TO O$
1570 Z=1 @ T$=''
1580 SENDIO D$,'LAD#,SAD8',CHR$(2)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(0)&CHR$(2)
1590 WAIT 2
1600 SENDIO D$,'LAD#,SAD10',CHR$(5)&CHR$(0)
1610 WAIT 3
1620 S1$=ENTIO$(D$,'TAD#,SAD0,SDA')
1630 IF UPRC$(O$)=S1$[1,LEN(O$)] THEN DISP 'found '&O$ ELSE DISP O$&'not there' @ GOTO 160
1640 S5$=S1$[13,16] @ DISP 'sector:'&S5$
1650 N1$=S1$[17,20] @ DISP 'length:'&N1$
1660 ! seek to sector
1670 SENDIO D$,'LAD#,SAD8',CHR$(2)&CHR$(0)&S5$
1680 WAIT 3
1690 DISP NUM(N1$[1,1])*256^3+NUM(N1$[2,2])*256^2+NUM(N1$[3,3])*256+NUM(N1$[4,4])
1700 FOR I=1 TO NUM(N1$[1,1])*256^3+NUM(N1$[2,2])*256^2+NUM(N1$[3,3])*256+NUM(N1$[4,4])
1710 DISP 'i=';I
1720 SENDIO D$,'LAD#,SAD10',CHR$(5)&CHR$(0)
1730 WAIT 3
1740 A1$=ENTIO$(D$,'TAD#,SAD0,SDA')
1750 GOSUB 1780
1760 NEXT I
1770 GOTO 160
1780 IF T$='' THEN 1810
1790 R$=T$&A1$[1,NUM(T$[1,1])+1-LEN(T$)] @ Z=NUM(T$[1,1])+1-LEN(T$)
1800 GOTO 1870
1810 IF NUM(A1$[Z,Z])>LEN(A1$[Z+1,256]) THEN 1900
1820 DISPLAY IS ':TV'
1830 DISP 'z=';Z;
1840 R$=A1$[Z+1,Z+NUM(A1$[Z,Z])]
1850 DISP 'r$(';LEN(R$);')='&R$
1860 Z=Z+LEN(R$)+2
1870 IF Z=268 THEN LIST O$ @ RETURN
1880 PRINT # 1 ; R$
1890 GOTO 1780
1900 ! record overflow
1910 T$=A1$[Z,256]
1920 LIST O$
1930 RETURN