Back to Main page.
Back to Main tapes page.
10 COM A$[255],B$[255],A[80],B[32],C$[200]
20 REM: PIP - PERIPHERAL INTERCHANGE PROGRAM
30 REM: BY STEVE SPEAR. ALL RIGHTS RESERVED.
40 DIM D$[255],E$[200],I$[255],J$[255],O$[255],C[15],D[15],E[32]
50 FILES *,*,*,*
60 DEF FNA(B)=A>B+L
70 DEF FNB(X)=X+500* NOT X
80 DEF FNC(X)=(TIM(1)*100+TIM(BRK( NOT X)<0))*100+TIM(4)
90 DEF FND(X)=TIM(1)*60+TIM(0)
100 IF ERROR THEN 440
110 SYSTEM C$[1,4],"TIM"
120 A[2]=POS(C$[3,4],"00")
130 ENTER #A[1]
140 A[1]=A[1]+32* NOT A[1]
150 O=O1=0
160 B= NOT POS(A$,"/SL")-1
170 GOTO (LEN(A$)>0) MAX (LEN(C$)>20)*2 OF 250,360
180 ENTER 1,B,I$
190 O$="PIP - V01.????, HP 2000/Access system. KB:00"
200 O$[11,14]=C$
210 IF NOTA[2] THEN 230
220 O$[LEN(O$)+1]=" Privileged User."
230 CONVERT A[1] TO O$[44+(A[1]<10),45]
240 PRINT O$
250 MAT D=ZER
260 READ A[3],A[4],A[5],A[6]
270 DATA 1,9,60,70
280 FOR A=1 TO 32
290 B[A]=(FNC(1)-300)*-1
300 NEXT A
310 B[A[1]]=-999999.
320 C$[5,81]="SYSDIR.B999BUFFER.B970SYSTST.????PIPINT.B999PIPCCL"
330 GOSUB 2990
340 C$[101,135]="11111111111111111111111111111111"
350 GOSUB B<0 OF 1470
360 A=0
370 ASSIGN C$[38,48],3,O1, NR
380 GOTO NOT O1 MAX (A#0 OR LEN(A$)>0)*2 OF 5130,480
390 CREATE A,C$[38,48],40
400 I$="MWA-"
410 I$[5]=C$[38,48]
420 SYSTEM B,I$
430 GOTO 370
440 CONVERT SYS(0) TO A$
450 CONVERT SYS(1) TO B$
460 PRINT "?SYE["A$","B$"] System error. Please report."
470 GOTO 490
480 GOSUB NOT O1 OF 5990
490 PRINT CHR$((SYS(3)<2)+34);
500 IF ERROR THEN 440
510 LINPUT A$
520 IF SYS(3) AND FNC(0) THEN 6260
530 C$[134,135]=" "
540 CHAIN A,A$
550 GOSUB FNC(1)>0 OF 2990
560 REM: CCL NAME ::= OPTIONS
570 A=POS(A$,"::=")
580 IF NOT A THEN 750
590 CREATE B,C$[49,59],1
600 ASSIGN C$[49,59],1,B
610 IF NOT B THEN 640
620 PRINT "?CFM CCL file missing or read-only."
630 GOTO 490
640 A$=UPS$(A$)
650 IF END #1 THEN 720
660 READ #1;I$
670 IF I$[1,POS(I$,"::=")-1 MAX 1]#A$[1,A-1] THEN 660
680 PRINT "?DNE duplicate name exists."
690 GOTO 490
700 PRINT "?CFF CCL file full."
710 GOTO 490
720 IF END #1 THEN 700
730 PRINT #1;A$, END
740 GOTO 490
750 GOSUB 800
760 GOSUB NOT O1 AND LEN(A$) OF 4620
770 GOSUB NOT O1 AND NUM(A$[LEN(A$) MAX 1])#27 OF 5990
780 GOTO 1030
790 REM: CASE SETTING & SHIFT
800 B$=A$
810 FOR A=1 TO LEN(B$)
820 IF B$[A,A]#"'" THEN 900
830 FOR B=1 TO 3
840 CONVERT B$[A+1,4+A-B MIN LEN(B$)] TO C,890
850 IF C<0 OR C>255 THEN 890
860 B$[A,A]=CHR$(C)
870 B$[A+1]=B$[5+A-B MIN LEN(B$)+1]
880 GOTO 900
890 NEXT B
900 NEXT A
910 FOR A=1 TO LEN(B$)
920 B=POS("^^//",B$[A,A+1])
930 GOTO NOT B MAX (B>LEN(B$))*2 OF 980,1000
940 L=B#1
950 B$[A]=B$[A+2]
960 A=A-1
970 GOTO 990
980 B$[A,A]=CHR$(NUM(B$[A])+32*(L AND NUM(B$[A])>64 AND NUM(B$[A])<91))
990 NEXT A
1000 A$=UPS$(A$)
1010 RETURN
1020 REM: COMMANDS
1030 RESTORE 1040
1040 DATA "NEW","DETACH","ATTACH","LIST","EXIT","MAIL","SYS","WIDTH"
1050 DATA "ENABLE","DISABLE","RECEIVE","MONITOR",0
1060 A=0
1070 IF TYP(0)#2 THEN 1220
1080 A=A+1
1090 READ I$
1100 IF I$#A$[1,LEN(I$)] THEN 1070
1110 GOTO A OF 3170,3240,3240,3310,6270,3630,5660,3210,1400,1400,5130
1120 REM: MONITOR
1130 GOSUB NOT O1 OF 5990
1140 C$[134,135]="**"
1150 B$=""
1160 GOSUB NOT O1 OF 4620
1170 IF NOT SYS(3) THEN 1130
1180 C$[134,135]=" "
1190 GOSUB NOT O1 OF 4620
1200 GOTO 490
1210 REM: LOAD SWITCHES?
1220 I$="*ACFM *LPU"
1230 O$="/"
1240 FOR A=1 TO 6
1250 O$[2]=I$[A,A]
1260 IF NOT POS(A$,O$) THEN 1310
1270 FOR B=7 TO 11
1280 O$[3]=I$[B,B]
1290 IF POS(A$,O$) THEN 1370
1300 NEXT B
1310 NEXT A
1320 GOSUB POS(A$,"/ZE") OR POS(A$,"/RO") OR POS(A$,"/CD") OF 1470
1330 IF POS(B$,"/")+POS(B$,"=")+POS(B$,"<")<1 THEN 490
1340 CHAIN A,"PIPU.B900"
1350 PRINT "?PUP PIP utility program missing."
1360 GOTO 490
1370 GOSUB 1470
1380 GOTO 1330
1390 REM: ENABLE / DISABLE
1400 FOR B=1 TO 32
1410 CONVERT A$[LEN(I$)+1] TO C,1430
1420 IF C#B THEN 1440
1430 C$[100+B,100+B]=CHR$(48+(A=9))
1440 NEXT B
1450 GOTO 490
1460 REM: GET CATALOG
1470 A=0
1480 ASSIGN C$[5,15],1,B
1490 GOTO (A AND B) MAX NOT B*2 OF 1570,1520
1500 CREATE A,C$[5,15],1
1510 GOTO 1480
1520 A=0
1530 ASSIGN C$[16,26],2,B
1540 GOTO (A AND B) MAX NOT B*2 OF 1590,1610
1550 CREATE A,C$[16,26],10
1560 GOTO 1530
1570 PRINT "?SDU System Directory Unavailable."
1580 RETURN
1590 PRINT "?CAB can't access buffer."
1600 RETURN
1610 SYSTEM I$,"TIM"
1620 I$[5,9]=I$[34]
1630 I$[10]=I$[52]
1640 SYSTEM O$,"LEN"
1650 I$[15]=O$[28]
1660 I$[20]=O$[50]
1670 I$[25,35]=" "
1680 I$[36,54]=C$[82,100]
1690 C$[34,37]=C$
1700 J$=C$[1,4]
1710 T=TIM(2)
1720 CONVERT T TO J$[5,7]
1730 IF TYP(1)#3 THEN 1750
1740 PRINT #1;"A000001"
1750 READ #1,1
1760 A=2
1770 IF END #1 THEN 1840
1780 IF END #2 THEN 2040
1790 READ #1;O$
1800 IF O$[1,4]54 THEN 1860
1840 PRINT "Who uses "C$[1,4]"? ";
1850 LINPUT I$[55,85]
1860 PRINT #2;J$, END
1870 IF END #1 THEN 1960
1880 PRINT #2;O$, END
1890 READ #1;O$
1900 GOTO 1880
1910 PRINT #2;O$, END
1920 GOTO 1790
1930 PRINT "?SDF system directory full."
1940 GOTO 2970
1950 A=1
1960 READ #1,1
1970 READ #2,1
1980 IF END #1 THEN 2040
1990 IF END #2 THEN 2200
2000 READ #2;O$
2010 PRINT #1;O$, END
2020 GOTO 2000
2030 REM: EXPAND FILES
2040 O$=C$[5+11*(A>1),5+10*(A>1)]
2050 C$[34,37]=C$[12,15]
2060 ASSIGN *,1+(A>1)
2070 CREATE B,C$[27,37],2
2080 IF B THEN 1930
2090 PURGE B,C$[27,37]
2100 CREATE B,O$,REC(1+(A>1))+1
2110 ASSIGN O$,1+(A>1),B
2120 IF B THEN 2960
2130 READ #1,1
2140 READ #2,1
2150 GOTO A OF 1950,1760,2740
2160 B=ITM(1)
2170 READ #1,REC(1)
2180 ADVANCE #1;B-1,C
2190 UPDATE #1;J$
2200 D$="*ACFM *LPU"
2210 O$="/"
2220 E$=""
2230 FOR A=1 TO 6
2240 O$[2]=D$[A,A]
2250 IF NOT POS(A$,O$) THEN 2320
2260 FOR B=7 TO 11
2270 O$[3]=D$[B,B]
2280 IF NOT POS(A$,O$) THEN 2310
2290 E$[LEN(E$)+1]=O$[2]
2300 E$[LEN(E$)+1]=","
2310 NEXT B
2320 NEXT A
2330 IF NOT POS(A$,"/RO") THEN 2350
2340 E$[LEN(E$)+1]=",RO"
2350 IF NOT LEN(E$) THEN 2370
2360 E$[LEN(E$)]=""
2370 IF T+1031)+FNA(59)+FNA(90)+FNA(120)+FNA(151)+FNA(181)+FNA(212)+FNA(243)+FNA(273)+FNA(304)+FNA(334)+1
3030 D=A-(30*((M>4)+(M>6)+(M>9)+(M>11))+31*((M>1)+(M>3)+(M>5)+(M>7)+(M>8)+(M>10))+28*(M>2)+(A>60)*L)
3040 D$="JanFebMarAprMayJunJulAugSepOctNovDec"
3050 C$[82,100]="00-???-0000:00:00am"
3060 C$[85,87]=D$[M*3-2,M*3]
3070 CONVERT D TO C$[82+(D<10),83]
3080 CONVERT Y TO C$[89+(Y<10),90]
3090 IF TIM(1)<12 THEN 3110
3100 C$[99,100]="pm"
3110 A=TIM(1)-12*(TIM(1)>12)+12* NOT TIM(1)
3120 CONVERT A TO C$[91+(A<10),92]
3130 CONVERT TIM(0) TO C$[94+(TIM(0)<10),95]
3140 CONVERT TIM(4) TO C$[97+(TIM(4)<10),98]
3150 RETURN
3160 REM: NEW NAME
3170 PRINT "New name: ";
3180 LINPUT C$[136]
3190 GOTO 490
3200 REM: Width x
3210 CONVERT A$[LEN(I$)+1] TO A[6],490
3220 GOTO 490
3230 REM: ATTACH / DETACH
3240 FOR B=1 TO 32
3250 CONVERT A$[LEN(I$)+1] TO C,3270
3260 IF B#C THEN 3280
3270 B[B]=(FNC(1)+999999.*(A=2))*SGN(B[B])
3280 NEXT B
3290 GOTO 490
3300 REM: LIST MAIL
3310 A=0
3320 IF END #3 THEN 3570
3330 READ #3,34
3340 READ #3;I$
3350 IF SYS(3) THEN 490
3360 IF I$[1,5]=" " THEN 3340
3370 ASSIGN I$[51,61],4,B
3380 IF B>2 AND NOT A[2] THEN 3340
3390 IF A THEN 3450
3400 O$="FOR PROT DATE STATUS FROM WHO"
3410 IF NOT A[2] OR A[6]<75 THEN 3430
3420 O$[LEN(O$)+1]=" STORED IN"
3430 PRINT O$
3440 A=1
3450 O$=I$
3460 O$[16,17]=" "
3470 O$[18,23]=I$[16,19]
3480 O$[24,35]=I$[20,28]
3490 A$="R/WR/OR/ON/AERRERRN/AERRN/A"
3500 O$[36,42]=A$[(B+1)*3-2,(B+1)*3]
3510 O$[43,48]=I$[29,32]
3520 O$[49,65]=I$[33,47]
3530 IF NOT A[2] OR A[6]<75 THEN 3550
3540 O$[66]=I$[51]
3550 PRINT O$
3560 GOTO 3340
3570 IF A THEN 490
3580 PRINT "NO MAIL AVAILABLE"
3590 GOTO 490
3600 PRINT "NOT AVAILABLE NOW"
3610 GOTO 490
3620 REM: MAIL
3630 IF O1 THEN 3600
3640 PRINT "Type Control A to Abort."
3650 IF LEN(C$)>135 THEN 3690
3660 PRINT "This message is from: ";
3670 LINPUT C$[136]
3680 IF POS(C$,'1) THEN 4560
3690 PRINT "This will go to: ";
3700 LINPUT I$[1,15]
3710 IF POS(I$,'1) THEN 4560
3720 GOSUB 2990
3730 PRINT "Account to protect to (CR if none): ";
3740 LINPUT D$
3750 IF POS(D$,'1) THEN 4560
3760 D$=UPS$(D$)
3770 I$[16,19]="????"
3780 IF NOT LEN(D$) THEN 3860
3790 IF LEN(D$)=4 AND NUM(D$)>64 AND NUM(D$)<91 THEN 3820
3800 PRINT '34D$'34" ILLEGAL PROTECTION CODE."
3810 GOTO 3730
3820 FOR B=2 TO 4
3830 IF NOT POS("?0123456789",D$[B,B]) THEN 3800
3840 NEXT B
3850 I$[16,19]=D$
3860 I$[20,28]=C$[82,90]
3870 I$[29,32]=C$[1,4]
3880 I$[33,47]=C$[136]
3890 CONVERT TIM(2) TO I$[48,50]
3900 PRINT "Alternate file (CR if none): ";
3910 LINPUT D$
3930 I$[51,61]=D$
3940 CONVERT TIM(2) TO I$[48,50]
3950 GOTO (POS(D$,'1)#0)*2 MAX LEN(D$)=0 OF 4180,4560
3960 ASSIGN I$[51,61],1,Z
3970 IF Z>2 THEN 3900
3980 IF END #3 THEN 4130
3990 READ #3,34
4000 READ #3;O$
4010 IF O$[48,50]=" " THEN 4040
4020 CONVERT O$[48,50] TO A,4000
4030 IF A <= TIM(2) AND A+10>TIM(2) THEN 4000
4040 A=ITM(3)
4050 LOCK #3
4060 PURGE Z,O$[51,61]
4070 IF Z=1 THEN 4000
4080 READ #3,REC(3)
4090 ADVANCE #3;A-1,Z
4100 UPDATE #3;I$
4110 UNLOCK #3
4120 GOTO 490
4130 IF END #3 THEN 4160
4140 PRINT #3;I$
4150 GOTO 490
4160 PRINT "?INE index needs expansion."
4170 GOTO 490
4180 SYSTEM E$,"LEN"
4190 CONVERT E$[50,54] TO K
4200 CREATE Z,"Piptmp",K MIN 32767
4210 ASSIGN "PIPTMP",1,Z
4220 IF NOT Z THEN 4250
4230 ASSIGN C$[16,26],1,Z
4240 IF Z THEN 3600
4250 PRINT "Type a control Z to end."
4260 IF END #1 THEN 4360
4270 LINPUT A$
4280 IF POS(A$,'1) THEN 4560
4290 GOSUB 800
4300 IF B$='26 THEN 4340
4310 PRINT #1;B$, END
4320 IF B$[LEN(B$) MAX 1]='26 THEN 4340
4330 GOTO 4270
4340 PRINT "^Z"'13'10"Control Z --- Loading"
4350 GOTO 4370
4360 PRINT "END OF DEVICE"
4370 A$="PIP000"
4380 READ #1,1
4390 A$[7]=C$[11,15]
4400 FOR X=0 TO 999
4410 CONVERT X TO B$
4420 A$[7-LEN(B$),6]=B$
4430 CREATE Z,A$,REC(1)
4440 GOTO Z+1 OF 4480,4450,4460,4460,4460
4450 NEXT X
4460 PRINT "NO SPACE LEFT"
4470 GOTO 490
4480 ASSIGN A$,2,Z
4490 IF Z THEN 4450
4500 PRINT "Mail stored in "'34A$'34
4510 I$[51,61]=A$
4520 IF END #1 THEN 4570
4530 READ #1;O$
4540 PRINT #2;O$, END
4550 GOTO 4530
4560 PRINT "^A"'13'10"Control A -- Mail Aborted"
4565 GOTO 490
4570 ASSIGN *,1
4580 GOTO 3980
4600 REM: SEND MESSAGE
4610 REM: OPEN CHANNEL A(1)
4620 IF END #3 THEN 5080
4630 READ #3,33
4640 ADVANCE #3;A[1]-1,A
4650 IF A THEN 5080
4660 UPDATE #3;FND(1)
4670 READ #3,A[1]
4680 IF TYP(3)#2 THEN 5030
4690 READ #3;I$,O$
4700 MAT READ #3;C,D
4710 IF NOT LEN(B$) THEN 4860
4720 IF NOT C[1] THEN 4740
4730 O$=O$[D[1]+1]
4740 Z=0
4750 FOR X=1 TO 14
4760 C[X]=C[X+1]
4770 D[X]=D[X+1]
4780 NEXT X
4790 C[15]=D[15]=0
4800 FOR X=1 TO 15
4810 Z=Z+D[X]
4820 NEXT X
4830 IF Z+LEN(B$)>255 THEN 4730
4840 D[15]=LEN(B$)
4850 O$[Z+1]=B$
4860 I$[5]="0"
4870 C[15]=FNC(1)
4880 CONVERT A[1] TO I$[5+(A[1]<10),6]
4890 I$[7]=C$[82]
4900 CONVERT FNC(1) TO I$[26,31]
4910 I$[32,63]=C$[101]
4920 I$[64]=C$[134]
4930 IF LEN(I$)>65 THEN 4950
4940 I$[66]="*NO*NAME*"
4950 FOR U=1 TO 32
4960 CONVERT C$[U+100,U+100] TO B
4970 B=(FNC(1)>ABS(B[U]))+2*(B#0)
4980 CONVERT B TO I$[31+U,31+U]
4990 NEXT U
5000 PRINT #3,A[1];I$[1,LEN(I$) MIN 127],O$[1,255], END
5010 MAT PRINT #3;C,D
5020 RETURN
5030 MAT C=ZER
5040 MAT D=ZER
5050 O$=""
5060 I$=C$[1,4]
5070 GOTO 4740
5080 MAT E=ZER
5090 IF END #3 THEN 5020
5100 MAT PRINT #3,33;E
5110 GOTO 4620
5120 REM: PICK UP MAIL
5130 IF O1 THEN 3600
5140 B$="User recieving mail - Please wait."
5150 GOSUB NOT O1 OF 4620
5160 IF END #3 THEN 490
5170 PRINT #3,A[1]; END
5180 READ #3,34
5190 READ #3;O$
5200 IF SYS(3) THEN 490
5210 FOR X=1 TO 4
5220 IF O$[X+15,X+15]="?" THEN 5240
5230 IF O$[X+15,X+15]#C$[X,X] THEN 5190
5240 NEXT X
5250 ASSIGN O$[51,61],1,Z
5260 IF Z>2 THEN 5190
5270 O$=UPS$(O$)
5280 GOTO (LEN(C$)>135) MAX 2*(POS(O$[1,15],"ALL")#0)* NOT POS(B$,'16) OF 5310,5330
5290 PRINT "What is your name ? ";
5300 LINPUT C$[136]
5310 A$=UPS$(C$[136])
5320 IF NOT POS(O$[1,15],A$) THEN 5190
5330 PRINT O$[20,28]" Mail ";
5340 IF NOT POS(O$[1,15],"ALL") THEN 5360
5350 PRINT "for [All Users] ";
5360 PRINT "from "O$[33,FNB(POS(O$[33]," "))+31 MIN 47]"? ";
5370 LINPUT B$
5380 B$=UPS$(B$)
5390 GOTO POS('26"Y",B$[1,1])+1 OF 5190,490
5400 PRINT "FOR: "O$[1,15]" FROM: "O$[33,47]" ID: "O$[29,32]" "O$[20,28]
5410 READ #1,1
5420 IF END #1 THEN 5460
5430 READ #1;A$
5440 PRINT A$
5450 IF NOT SYS(3) THEN 5430
5460 IF NOT Z THEN 5490
5470 PRINT "REMOVAL IMPOSSIBLE"
5480 GOTO 5190
5490 PRINT "REMOVE IT? ";
5500 LINPUT A$
5510 A$=UPS$(A$)
5520 IF A$[1,1]#"Y" THEN 5190
5530 ASSIGN *,1
5540 ASSIGN *,2
5550 ASSIGN *,4
5560 PURGE Z,O$[51,61]
5565 IF Z AND POS(O$[51,61],C$[11,15]) THEN 5190
5570 A1=ITM(3)
5580 READ #3,REC(3)
5590 LOCK #3
5600 ADVANCE #3;A1-1,Z
5610 A$[1,61]=" "
5620 UPDATE #3;A$[1,61]
5630 UNLOCK #3
5640 GOTO 5190
5650 REM: SYS
5660 IF O1 THEN 3600
5670 IF END #3 THEN 490
5680 READ #3,1
5690 A=0
5700 FOR X=1 TO 32
5710 READ #3,X
5720 IF TYP(3)#2 THEN 5960
5730 READ #3;B$
5740 CONVERT A$[POS(A$,"/")+1] TO B,5780
5750 CONVERT B$[26,31] TO C,5960
5760 IF C$[82,90]#B$[7,15] THEN 5960
5770 IF C+B*1001)]
5860 O$[3,4]=B$[64,65]
5870 O$[1,1]=D$[3+(FNC(1)>ABS(B[X]))]
5880 O$[2,2]=D$[1+(NUM(C$[100+X])#48)]
5890 IMAGE#,x4a3xaaxx,10axx,9axx,6axx
5900 PRINT USING 5890;B$[1,6],B$[16,25],B$[7,15],O$
5910 FOR Y=66 TO LEN(B$)
5920 PRINT USING "#,a";B$[Y,Y]
5930 NEXT Y
5940 PRINT
5950 IF SYS(3) THEN 490
5960 NEXT X
5970 GOTO 490
5980 REM: Any Messages?
5990 IF END #3 THEN 6250
6000 MAT READ #3,33;E
6010 FOR X=1 TO 32
6020 IF FNC(1)FND(1) THEN 6240
6030 READ #3,X
6040 IF TYP(3)#2 THEN 6240
6050 READ #3;E$,I$
6060 IF E$[7,15]#C$[82,90] THEN 6240
6070 IF E$[A[1]+31,A[1]+31]<"2" THEN 6240
6080 MAT READ #3;C,D
6090 A=Z=0
6100 FOR Y=1 TO 15
6110 IF SYS(3) THEN 490
6120 Z=Z+D[Y]
6130 GOTO 2*(C[Y]>ABS(B[X]))+(B[X]<1) MAX 1 OF 6230,6150,6140
6140 PRINT "Attempting to interface with "E$[1,4]" on KB:"E$[5,6]
6150 IF LEN(C$)>135 THEN 6180
6160 PRINT "What is your name? ";
6170 LINPUT C$[136]
6180 IF A THEN 6210
6190 PRINT E$[66]":"
6200 A=1
6210 PRINT I$[Z-D[Y]+1,Z]
6220 B[X]=INT(C[Y])
6230 NEXT Y
6240 NEXT X
6250 RETURN
6260 B$="** Break Key Struck on Prompt ** Exiting PIP **"
6261 PRINT B$
6262 GOSUB NOT O1 OF 4620
6270 END