10 'PC\PAD: an MS-BASIC editor/spreadsheet/printing routine; 4/07/83
20 SCREEN 0,0,0:WIDTH 80:CLS:KEY OFF:LOCATE 5,1:Q$=SPACE$(20)
30 PRINT Q$;" PC\PAD (ver. 1.3)"
40 PRINT Q$;"an editor/spreadsheet/printing program"
50 PRINT: PRINT
60 PRINT Q$;" If you are using this program"
70 PRINT Q$;" and find it of value,"
80 PRINT Q$;" a $20 contribution is suggested."
90 PRINT
100 PRINT Q$;" (c) 1983"
110 PRINT Q$;" P. Fraundorf"
120 PRINT Q$;" P.O. Box 11394"
130 PRINT Q$;" St. Louis MO 63105"
140 PRINT
150 PRINT Q$;" You are encouraged to copy and"
160 PRINT Q$;" share this program with others."
170 LOCATE 24,1: PRINT "any key to continue...";
180 Q$=INKEY$: IF Q$="" THEN 180
190 DEFINT I-N: LMX=400: HCW=8: CC$="\" 'set max lines,col width, & cc$
200 DIM A$(LMX+1),M$(50),CSUM(16),RSUM(25): IMX=LMX-22: JMX=IMX-20
210 LCW=2*HCW: LCM=LCW-1: DEF FNV(I,J)=VAL(MID$(A$(I),LCW*J+1,LCW))
220 DEF SEG=0: IF (PEEK(1040) AND 48)=48 THEN LD=13 ELSE LD=7 'mono/color
230 '-----------------------initialize function keys--------------------
240 KEY ON
250 KEY 1,CC$+"view "+CHR$(13) 'relist
260 KEY 2,CC$+"compute"+CHR$(13) 'update computed entries
270 KEY 3,CC$+"up "+CHR$(13) 'look up
280 KEY 4,CC$+"down "+CHR$(13) 'look down
290 KEY 5,CC$+"left "+CHR$(13) 'look left
300 KEY 6,CC$+"right "+CHR$(13) 'look right
310 KEY 7,CC$+"yank "+CHR$(13) 'yank line to memory
320 KEY 8,CC$+"put "+CHR$(13) 'put line in text
330 KEY 9,CC$+"justify"+CHR$(13) 'right justify line
340 KEY 10,CC$+"save "+CHR$(13) 'save + offer restart
350 '---------------------------open source file-----------------------
360 FOR I=0 TO LMX: A$(I)="": NEXT: CLS: ON ERROR GOTO 5000
370 PRINT "disk files:": FILES: PRINT
380 INPUT "disk file name (rtn=none)";F$
390 IF F$<>"" THEN GOSUB 1260 ELSE NLINE=0
400 '------------------------set up editing session--------------------
410 INPUT "working file name (rtn=disk file name)";G$
420 IF G$="" THEN G$=F$ 'if no working name, use disk file name
430 IF G$="" THEN END 'if still no working name, then exit program
440 IP=1: JP=0: IX=1: JY=1 'zero pointers
450 '-------------------------primary operating loop--------------------
460 J0=JP: J1=JP+22: GOSUB 890: LOCATE JY,1 'list lines jp,jp+22
470 COLOR 13,0: LINE INPUT "",X$ 'give control to BASIC screen editor
480 COLOR 10,0: JY=CSRLIN-1
490 XX=INSTR(X$,CC$): IF XX=0 THEN 770 'store new line
500 '-----------------------menu of command primitives------------------
510 Y$=MID$(X$,XX+1,1)
520 IF Y$="v" THEN 460 'view window
530 IF Y$="c" THEN 9990 'update computed entries
540 IF Y$="u" THEN IF JP>0 THEN JP=JP-1:GOTO 460 ELSE 460 'up 1
550 IF Y$="d" THEN IF JPHCW THEN IP=IP-HCW:GOTO 460 ELSE 460 'left 1
570 IF Y$="r" THEN IF IP<178-HCW THEN IP=IP+HCW:GOTO 460 ELSE 460 'right 1
580 IF Y$="y" THEN GOSUB 1382:GOTO 460 'yank line to memory
590 IF Y$="p" THEN GOSUB 1420:GOTO 460 'put line in text
600 IF Y$="j" THEN GOSUB 2060: GOTO 460 'justify line
610 IF Y$="s" THEN GOSUB 1340: GOTO 460 'save working file
620 IF Y$=CC$ THEN Y$=MID$(X$,XX+2,1) ELSE 770
630 '-------------------------- 2-key functions ----------------------
640 IF Y$="v" THEN GOSUB 980: GOTO 460 'help file
650 IF Y$="c" THEN GOSUB 1190: GOTO 460 'reset filenames
660 IF Y$="u" THEN IF JP>19 THEN JP=JP-20:GOTO 460 ELSE JP=0 :GOTO 460
670 IF Y$="d" THEN IF JP64 THEN IP=IP-64:GOTO 460 ELSE IP=1 :GOTO 460
690 IF Y$="r" THEN IF IP<113 THEN IP=IP+64:GOTO 460 ELSE IP=177:GOTO 460
700 IF Y$="y" THEN GOSUB 1382:GOSUB 1410:GOTO 460 'remove line
710 IF Y$="p" THEN 1450 'goto insert loop
720 IF Y$="j" THEN GOSUB 2010: GOTO 460 'reset linewidth
730 IF Y$="s" THEN GOSUB 1570: GOTO 460 'print file
740 IF Y$="q" THEN GOTO 360 'quit/new file prompt
750 '-----------------------store previous screen line------------------
760 'it would be nice to use L$=X$, but alas X$ reflects complex i/o logic
770 L$="": II=0
780 JX=JP+JY-1: Y$=A$(JX): LA=LEN(Y$): IF LA>IP+79 THEN II=1
790 FOR I=79 TO 1 STEP -1
800 X$=CHR$(SCREEN(JY,I))
810 IF II=1 THEN L$=X$+L$ ELSE IF X$<>" " THEN II=1: GOTO 810
820 NEXT
830 LX=IP-1: LL=LEN(L$): IF JX+1>NLINE THEN NLINE=JX+1
840 IF LX>LA THEN A$(JX)=A$(JX)+STRING$(LX-LA," ")+L$: GOTO 870
850 IF LX>LA-79 THEN A$(JX)=LEFT$(A$(JX),LX)+L$: GOTO 870
860 A$(JX)=LEFT$(A$(JX),LX)+L$+STRING$(79-LL," ")+RIGHT$(A$(JX),LA-LX-79)
870 IF JY<23 THEN 470 ELSE IF JP"" THEN G$=X$
1210 PRINT "instruction filename (rtn=";H$;:INPUT")";X$:IF X$<>"" THEN H$=X$
1220 INPUT "switch displays (rtn=no)";I$
1230 IF I$="" THEN RETURN
1240 IF LD=13 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) AND &HCF) OR &H10:SCREEN 1,0,0,0:SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,6,7:LD=7 ELSE IF LD=7 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) OR &H30):SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,12,13:LD=13
1250 RETURN
1260 '=============================load disk file===========================
1270 OPEN F$ FOR INPUT AS #1
1280 FOR NLINE=0 TO LMX
1290 LINE INPUT #1,A$(NLINE)
1300 IF EOF(1) THEN CLOSE #1: RETURN
1310 NEXT
1320 CLOSE #1: RETURN
1330 '=============================save file on disk=========================
1340 OPEN G$ FOR OUTPUT AS #1
1350 FOR I=0 TO NLINE
1360 PRINT #1,A$(I)
1370 NEXT
1380 CLOSE #1: RETURN
1381 '================================yank===================================
1382 LOCATE 24,1:INPUT;"# of lines (rtn=1) ";NM:IF NM<1 THEN NM=1
1383 IX=JP+JY-1
1384 FOR I=0 TO NM-1
1385 M$(I)=A$(IX+I)
1386 NEXT
1387 RETURN
1390 '===============================delete==================================
1400 IF NLINE>NM THEN NLINE=NLINE-NM ELSE NLINE=0
1410 FOR I=IX TO NLINE
1411 A$(I)=A$(I+NM)
1412 NEXT
1413 FOR I=NLINE+1 TO NLINE+NM+1
1414 A$(I)=""
1415 NEXT
1416 RETURN
1419 '=================================put===================================
1420 IX=JP+JY
1430 FOR J=NM-1 TO 0 STEP -1
1440 X$=M$(J):GOSUB 1520
1445 NEXT
1446 RETURN
1450 '============================insertion loop=============================
1460 CLS:J0=JP:J1=JP+JY-1:GOSUB 920:J0=J1+1:J1=JP+21:LOCATE JY+2,1:GOSUB 920
1470 COLOR 11,0: LOCATE JY+1,1,1,LD,0 'display split cursor
1480 LINE INPUT "",X$: X$=STRING$(IP-1," ")+X$: XX=INSTR(X$,CC$)
1490 IF XX<>0 THEN 460 ELSE IF CSRLIN<>JY+2 THEN BEEP: GOTO 1460
1500 IX=JP+JY:GOSUB 1520:JP=JP+1:GOTO 1460
1510 '--------------------------insert x$ at line ix------------------------
1520 FOR I=IX TO NLINE
1530 SWAP X$,A$(I)
1540 NEXT
1550 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN
1560 A$(NLINE)=X$: RETURN
1570 '========================file printing routine==========================
1580 '------------------------set new printer options------------------------
1590 CLS: GOSUB 1940: LW=80: W$="" 'reset printer and initialize
1600 INPUT "top/bottom margins, in inches (rtn=0)";TBM
1610 INPUT "linespacing (d=double; t=triple; h=1/2; s=1/3; rtn=normal)";D$
1620 IF D$="" THEN LX=6 ELSE IF D$="d" THEN LX=3 ELSE IF D$="t" THEN LX=2
1630 IF D$="h" THEN LX=12 ELSE IF D$="s" THEN LX=18
1640 LM=TBM*LX: LPRINT CHR$(27);"A";CHR$(72/LX);CHR$(27);"2";'set linespace
1650 INPUT "characters/inch (s=16.5; m=8.25; l=5; rtn=10) ",C$
1660 IF C$="s" OR C$="m" THEN LPRINT CHR$(15);: LW=132 'set compressed width
1670 IF C$="l" OR C$="m" THEN W$=CHR$(14): LW=LW/2 'set double-width flag
1680 WIDTH "lpt1:",LW
1690 INPUT "intensity (d=double, e=emphasized, b=both, rtn=light) ",I$
1700 IF I$="d" OR I$="b" THEN LPRINT CHR$(27)+"G";'set doublestrike mode
1710 IF I$="e" OR I$="b" THEN LPRINT CHR$(27)+"E";'set emphasized intensity
1720 LPRINT CHR$(27);"D"; 'lines 100-120 set horiz. tabs (10,8,8,8...)
1730 FOR I=18 TO 74 STEP 8: LPRINT CHR$(I);: NEXT
1740 LPRINT CHR$(0);
1750 INPUT;"from row: ",I0
1760 INPUT;" to: ",I1:IF I1=0 THEN I1=NLINE:PRINT I1 ELSE PRINT
1770 INPUT;"from column: ",J0
1780 INPUT;" to: ",J1:IF J1=0 THEN J1=J0+7:PRINT J1 ELSE PRINT
1790 INPUT "indentation (rtn=0 spaces) ";INDENT
1800 IX=I0:J1=(J1-J0+1)*LCW:J0=J0*LCW+1:IF J1+INDENT>=LW THEN J1=LW-INDENT-1
1810 ' -------------------------------print file------------------------------
1820 FOR I=1 TO LM 'begin page
1830 LPRINT
1840 NEXT
1850 FOR I=1 TO 11*LX-2*LM
1860 LPRINT SPC(INDENT);W$+MID$(A$(IX),J0,J1)
1870 IF IXNLINE THEN J1=NLINE
2090 FOR IX=J0 TO J1
2100 GOSUB 2140
2110 NEXT
2120 RETURN
2130 '----------------------------justify line------------------------------
2140 Y$=A$(IX)
2150 '-------------------------remove rightmost spaces----------------------
2160 YL=LEN(Y$):IF RIGHT$(Y$,1)=" " THEN Y$=LEFT$(Y$,YL-1):GOTO 2160
2170 '----------------------replace indentations with nulls-----------------
2180 IF LEFT$(Y$,1)=CHR$(9) THEN Y$=" "+RIGHT$(Y$,YL-1): YL=YL+7
2190 IF YL=0 OR YL=LWIDTH THEN RETURN
2200 Z$="": M=1
2210 WHILE LEFT$(Y$,1)=" ":Z$=Z$+CHR$(0):Y$=RIGHT$(Y$,YL-M):M=M+1:WEND
2220 Y$=Z$+Y$
2230 '------------------------optimize content of line----------------------
2240 IF YL=J
2450 C$=LEFT$(A$(J),1)
2460 IF C$="" OR C$=" " OR C$=CHR$(9) OR C$=CHR$(0) THEN RETURN
2470 WHILE A$(J)<>""
2480 ZL=LEN(A$(J))
2490 M=INSTR(A$(J)," "): IF M=0 THEN ZL=ZL+1: M=ZL
2500 IF YL+M>LWIDTH THEN RETURN
2510 YL=YL+M: Y$=Y$+" ": IF M>1 THEN Y$=Y$+LEFT$(A$(J),M-1)
2520 A$(J)=RIGHT$(A$(J),ZL-M)
2530 WEND
2540 Z$=""
2550 FOR I=NLINE TO J STEP -1: SWAP Z$,A$(I): NEXT
2560 NLINE=NLINE-1
2570 WEND
2580 RETURN
2590 '---------------------line is too long..take something off------------
2600 Z$=RIGHT$(Y$,YL-LWIDTH): YL=LWIDTH: Y$=LEFT$(Y$,LWIDTH)
2610 C$=RIGHT$(Y$,1): YL=YL-1: Y$=LEFT$(Y$,YL)
2620 IF C$<>" " THEN Z$=C$+Z$: GOTO 2610
2630 FOR I=IX+1 TO NLINE: SWAP Z$,A$(I): NEXT
2640 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN
2650 A$(NLINE)=Z$: RETURN
5000 '======================error trapping (line 5000)==================
5010 Q$=" ...File not found... "
5020 IF ERR=53 AND ERL=1270 THEN PRINT Q$: RESUME 370
5030 IF ERR=53 AND ERL=9990 THEN PRINT Q$;: H$="": RESUME 9990
5040 IF ERR=61 AND ERL=1360 THEN PRINT "Disk Full:make room before saving"
5050 IF ERR=25 AND ERL=1940 THEN PRINT "Printer not On-line"
5060 IF ERR=27 THEN PRINT "Out of Paper or Printer Off"
5070 PRINT: PRINT "error #";ERR;" at line ";ERL;"; type CONT to resume..."
5080 STOP: RESUME 460
9610 '===============spread sheet subroutines (line 9610)==============
9620 '---------------------------form column sums-------------------------
9630 IF NROW<2 THEN GOTO 9770
9640 FOR J=0 TO NCOL-1
9650 CSUM(J)=0
9660 FOR I=0 TO NROW-1
9670 CSUM(J)=CSUM(J)+FNV(I+NROW0,J+NCOL0)
9680 NEXT
9690 NEXT
9700 I=NROW0+NROW: TSUM=0
9710 FOR J=NCOL0 TO NCOL0+NCOL-1
9720 X=CSUM(J-NCOL0): GOSUB 9900
9730 TSUM=TSUM+CSUM(J-NCOL0)
9740 NEXT
9750 J=NCOL0+NCOL: X=TSUM: GOSUB 9900
9760 '---------------------------form row sums----------------------------
9770 IF NCOL<2 THEN RETURN
9780 FOR I=0 TO NROW-1
9790 RSUM(I)=0
9800 FOR J=0 TO NCOL-1
9810 RSUM(I)=RSUM(I)+FNV(I+NROW0,J+NCOL0)
9820 NEXT
9830 NEXT
9840 J=NCOL0+NCOL
9850 FOR I=NROW0 TO NROW0+NROW-1
9860 X=RSUM(I-NROW0): GOSUB 9900
9870 NEXT
9880 RETURN
9890 '-----------------replace row i, column j entry with x---------------
9900 X$=STR$(X)
9910 '-----------------replace row i, column j entry with x$--------------
9920 LX=LEN(X$)
9930 IF LXLA THEN A$(I)=A$(I)+STRING$(LX-LA," ")+X$: RETURN
9960 IF LX>LA-LCM THEN A$(I)=LEFT$(A$(I),LX)+X$: RETURN
9970 A$(I)=LEFT$(A$(I),LX)+X$+RIGHT$(A$(I),LA-LX-LCM): RETURN
9980 '----------------------update computed quantities--------------------
9990 IF H$="" THEN LOCATE 24,1: INPUT;"instruction filename";H$: IF H$="" THEN 460 ELSE CHAIN MERGE H$,10000,ALL
10000 '----------ROWCOL.BAS - sample row-column sum instructions-----------
10010 ON ERROR GOTO 5000 'this prevents disabling of error trapping
10020 NROW0=FNV(2,6):NCOL0=FNV(3,6):NROW=FNV(4,6):NCOL=FNV(5,6) 'read table
10030 GOSUB 9630 'form sums
10040 I=NROW0+NROW: J=NCOL0-1: X$="Column Totals" : GOSUB 9920 'label row
10050 I=NROW0-2: J=NCOL0+NCOL: X$="Row Totals" : GOSUB 9920 'label col
10060 GOTO 460 'this exits to the View Function