1983 PC-CALC
Spreadsheet
written in
GW-BASIC
Back to GW-BASIC Table of Contents
Back to GW-Basic Index
6PackNotes:
Well, here it is folks, a spreadsheet written in GW-BASIC by professionals.
Notice the VAST difference in coding in comparison to my simpleton efforts.
Hopefully, i can get a few more examples of this kind of expertise off the
net.
This is a very impressive piece of code to a Joseph_sixpack. It might not
impress the programmers at microsoft, but it impresses the hell out of me.
Hat's off to Guy and John.
Sheesh! 1983? i wonder if they are even still alive? oh well... i expect
the original VisiCalc, reputed to have been written first in gw-basic looked
a lot like this. let's see, if they were maybe 40 then... hey they could be
the same age as me plus or minus maybe... Well, if you guys read this, send
me some updated info on this great gw-basic program. It's on the NET now,
going world wide with one reader a week. :-)
1 '--------------------------------------------------------------------------
2 '| PC-Calc 1.01 27 Oct., 1983 White Crane Systems |
3 '| copyright Guy C. Gordon 3194 Friar Tuck Way |
4 '| (c) 1983 John Vandegrift Doraville, GA 30340 |
5 '| |
6 '| Emulates the popular expensive Spreadsheets at a fraction of |
7 '| the cost. Please forward any comments to the above address. |
8 '| |
9 '| Original IBM-PC version by John Vandegrift. This is the |
10 '| IBM-PC version. This program started life as MINICALC by |
11 '| John Vandegrift, who expanded it to CALC. CALC was adapted |
12 '| to the VICTOR-9000 by Guy Gordon who expanded it to this |
13 '| version (1.00). The two of us then got together to put out |
14 '| PC-CALC as Free Software. |
15 '--------------------------------------------------------------------------
31 '
40 '******************************** NOTICE **********************************
41 ' USER SUPPORTED SOFTWARE (With thanks to Andrew Flugelman) *
42 ' *
43 ' A limited license is granted to all users, to copy this program and *
44 ' distribute it to users subject to the following conditions: *
45 ' *
46 ' 1. None of the notices or credits are to be bypassed, *
47 ' altered, or removed. *
48 ' 2. The program is not to be distributed in modified form. *
49 ' (Users are encouraged to distributed MERGE files.) *
6PackNotes:
i couldn't find any merge files... i don't really know what they are talking
about yet as i haven't examined the program that closely. Ummm it does work
fine as near as i can tell as it ran right out of the unzipped .zip file.
50 ' 3. No fee is to be charged (or any other consideration *
51 ' received) for copying or distributing the program *
52 ' without an express writted agreement with *
53 ' White Crane Systems. *
54 '**************************************************************************
60 DEFINT I-N, C, D, E, R, S, T
61 RMAX=50: CMAX=26: RX=RMAX: CX=CMAX
62 DIM IND$(50,26),EQ$(50,26),VALUE(50,26),VTOT(10),IOP(10)
63 LPT=80: PRINT.FILE$="lpt1:" 'SET THIS FOR YOUR PRINTER
64 'DEF SEG=0: POKE 1047,(PEEK(1047) OR 64) 'SET CAPS
65 GOSUB 8000: GOSUB 7300 'INIT VICTOR VARIABLES
66 KEY OFF: GOSUB 1100 'CREDITS ROUTIN
70 LOCATE 17,1
71 PRINT TAB(15)"If you are using this program and finding it of value,"
72 PRINT TAB(15)"your contribution ($25 suggested) will be appreciated."
73 PRINT
74 PRINT TAB(19)" White Crane Systems"
75 PRINT TAB(19)" 3194 Friar Tuck Way"
76 PRINT TAB(19)" Doraville, GA 30340"
77 PRINT
78 PRINT TAB(15)" You are encouraged to copy and share this program"
79 PRINT TAB(15)"with other users, on the conditions that the program"
80 PRINT TAB(15)"not be distributed in modified form, that no fee or"
81 PRINT TAB(15)"other consideration is charged, and that this notice"
82 PRINT TAB(15)"is not bypassed or removed."
130 GLOBAL.FMT$="2": WINDOW.FLAG$=" ": BOLD$="ON": PREV.FILE$="MATRIX"
140 ROW=1: COL=1: ROW.HOME=0: COL.HOME=0: SCR.ROW=1: SCR.COL=1 'START IN A01
160 GOSUB 1300 'SCREEN OUTLINE
210 FOR I=1 TO 1500: NEXT
220 LOCATE 7,35: PRINT "copyright 1983"
230 IF INKEY$="" THEN 230
240 FOR I=24 TO 5 STEP -1: LOCATE I,15: PRINT SPACE$(65);: NEXT
250 ON ERROR GOTO 9000
300 ' MAIN ROUTINE
320 'I=FRE("")
330 IF IW.FLAG THEN GOSUB 5100 'DISPLAY WINDOW
340 GOSUB 600 'DISPLAY STATUS LINE
350 GOSUB 700 'DISPLAY CELL CURSOR
360 A$=INKEY$: GOSUB 1000: IF A$="" THEN 360
370 IF LEN(A$)>1 THEN A$=MID$(A$,2,1) ELSE 440
380 GOSUB 900 'CURSOR CONTROL
390 IF A$="H" THEN IF SCR.ROW>1 THEN SCR.ROW=SCR.ROW-1: ROW=ROW-1 'UP
400 IF A$="P" THEN IF SCR.ROW1 THEN SCR.COL=SCR.COL-1: COL=COL-1 'LEFT
425 IF A$="G" THEN GOSUB 2600 'CLR
426 IF A$="t" THEN TEMP.COL=COL.HOME+9: TEMP.ROW=ROW.HOME+1: GOSUB 2465: GOTO 300 'PAGE RIGHT
427 IF A$="s" THEN TEMP.COL=COL.HOME-7: TEMP.ROW=ROW.HOME+1: GOSUB 2465: GOTO 300 'PAGE LEFT
428 IF A$="Q" THEN TEMP.ROW=ROW.HOME+23: TEMP.COL=COL.HOME+1: GOSUB 2465: GOTO 300 'PAGE DOWN
429 IF A$="I" THEN TEMP.ROW=ROW.HOME-21: TEMP.COL=COL.HOME+1: GOSUB 2465: GOTO 300 'PAGE UP
430 GOTO 330
435 '
440 IF A$="+" OR A$="=" THEN GOSUB 2000: GOSUB 4800: GOTO 300 'ACCEPT NUM.
450 IF A$="'" OR A$=CHR$(34) THEN GOSUB 1900: GOSUB 4800: GOTO 300 'LABEL
460 IF A$="." THEN GOSUB 2400: GOTO 300 'GOTO
470 IF A$="/" OR A$="?" THEN GOSUB 3000: GOTO 300 'SPECIAL COMMANDS
475 IF A$=CHR$(13) THEN GOSUB 4800: GOTO 300 'JUMP ON CR
480 '
485 '
490 '
495 '
499 BEEP: GOTO 300
600 ' STATUS LINE
601 '
610 A$=STR$(ROW): IF ROW<10 THEN A$="0"+RIGHT$(A$,1) ELSE A$=RIGHT$(A$,2)
620 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT CHR$(COL+64)+A$+"=";
630 A$=IND$(ROW,COL)
640 IF A$="" THEN PRINT "(blank)";: RETURN
650 IF A$="!" THEN PRINT EQ$(ROW,COL);: RETURN ELSE PRINT VALUE(ROW,COL) " "+EQ$(ROW,COL);
660 RETURN
700 ' DISPLAY CELL CURSOR
701 DEF SEG=RAM
710 SCR.ROW=ROW-ROW.HOME: SCR.COL=COL-COL.HOME
720 TEMP.ROW=SCR.ROW+2: TEMP.COL=SCR.COL*9-5
730 M=((SCR.ROW+1)*160-1)+((SCR.COL*9-3)*2-5)
740 FOR II=M+1 TO M+16 STEP 2: POKE II,112: NEXT
750 RETURN
800 ' HIGHLIGHT CELL(I,J) IF DISPLAYED
801 '
810 IF BOLD$<>"ON" OR I<=ROW.HOME OR I>(ROW.HOME+SR) OR J<=COL.HOME OR J>(COL.HOME+SC) THEN RETURN
815 MM=((I-ROW.HOME+1)*160-1)+(((J-COL.HOME)*9-3)*2-5)
820 DEF SEG=RAM:FOR II=MM+1 TO MM+16 STEP 2: POKE II,15: NEXT
830 RETURN
900 ' ERASE OLD CURSOR
901 DEF SEG=RAM
910 FOR II=M+1 TO M+16 STEP 2: POKE II,7: NEXT
920 RETURN
1000 ' 25'th LINE STUFF
1001 KEY OFF
1030 DEF SEG=0: COLOR 0,7 'INVERSE VIDEO
1040 LOCATE 25,1: IF PEEK(1047) AND 64 THEN PRINT "Caps On "; ELSE PRINT "Caps Off";
1050 LOCATE 25,73:IF PEEK(1047) AND 32 THEN PRINT "Numbers"; ELSE PRINT "Cursor ";
1060 LOCATE 25,36: PRINT " PC-Calc ";
1070 COLOR 7,0 'REGULAR VIDEO
1075 RETURN
1100 ' CREDITS ROUTINE
1101 '
1110 A$=" PC-Calc": B$="(": C$=")": D$="White Crane Systems": COUNT=10
1120 CLS: LOCATE 12,41: PRINT "c": GOSUB 1200
1130 A$=" ": B$=" ": C$=" ": D$=" ": COUNT=9
1140 GOSUB 1200
1150 RETURN
1200 FOR I=1 TO COUNT
1210 LOCATE I,37:PRINT A$;
1220 LOCATE 12,4*I:PRINT B$;
1230 LOCATE 12,82-(4*I):PRINT C$;
1240 LOCATE 24-I,33:PRINT D$;
1250 NEXT
1260 RETURN
1300 ' SCREEN OUTLINE
1301 '
1320 FOR I=ROW.HOME+1 TO ROW.HOME+SR
1330 A$=STR$(I): IF I<10 THEN A$="0"+RIGHT$(A$,1) ELSE A$=RIGHT$(A$,2)
1340 LOCATE 2+I-ROW.HOME,1:PRINT A$+CHR$(221);: NEXT
1350 LOCATE 2,3
1360 S$=STRING$(3,219)
1380 FOR J=COL.HOME+65 TO COL.HOME+SC+64: PRINT S$ " " CHR$(J) " " S$;: NEXT
1399 RETURN
1400 ' UPDATE THE SCREEN
1401 '
1405 IF WINDOW.FLAG$<>" " THEN IW.FLAG=-1
1410 FOR I=ROW.HOME+1 TO ROW.HOME+SR: FOR J=COL.HOME+1 TO COL.HOME+SC: GOSUB 1510: IF INKEY$<>CHR$(0)+CHR$(79) THEN NEXT J,I
1430 RETURN
1500 ' DISPLAY CELL(I,J)
1501 '
1505 IF I<=ROW.HOME OR I>ROW.HOME+SR OR J<=COL.HOME OR J>COL.HOME+SC THEN RETURN
1510 LOCATE I-ROW.HOME+2,(J-COL.HOME)*9-5
1520 Q$=IND$(I,J): IF Q$="" THEN PRINT SPC(9): RETURN
1530 IF Q$="!" THEN PRINT EQ$(I,J);SPC(9-LEN(EQ$(I,J))): RETURN
1540 GOSUB 1600
1550 IF Q$="F" THEN PRINT F$; ELSE PRINT USING F$; VALUE(I,J);
1560 RETURN
1600 ' FORMAT STRING
1601 '
1605 F$="########"
1610 IF INSTR("D@B",Q$) THEN GOSUB 1700: RETURN
1620 IF Q$="G" THEN Q$=GLOBAL.FMT$
1625 IF Q$="I" THEN RETURN
1630 IF INSTR("01234567",Q$) THEN MID$(F$,8-VAL(Q$))=".": RETURN
1640 IF Q$="H" THEN ID=2 ELSE IF Q$="F" OR Q$="Q" THEN ID=4 ELSE IF Q$="E" THEN ID=8 ELSE IF Q$="S" THEN ID=16 ELSE ID=32
1645 Q$="F": VAL.B=ABS(VALUE(I,J)): S$="": IF VALUE(I,J)<0 THEN S$="-"
1650 II=INT(VAL.B): IF II=0 THEN I$="" ELSE I$=STR$(II):I$=RIGHT$(I$,LEN(I$)-1)
1660 N=CINT((VAL.B-II)*ID): IF N MOD 2 = 0 THEN IF ID>1 THEN ID=ID/2: GOTO 1660
1670 N$=STR$(N): D$=STR$(ID): D$=RIGHT$(D$,LEN(D$)-1): F$=S$+I$+N$+"/"+D$
1675 IF N=0 THEN IF II=0 THEN F$=S$+"0 " ELSE F$=S$+I$+" "
1680 IF LEN(F$)>8 THEN IF ID>8 THEN ID=8: GOTO 1660: ELSE RETURN
1690 IF LEN(F$)>=8 THEN RETURN ELSE F$=" "+F$: GOTO 1690
1699 '
1700 ' SPECIAL FORMATS
1701 '
1710 IF Q$="@" THEN F$=TIME$: Q$="F": RETURN
1720 IF Q$="D" THEN F$=LEFT$(DATE$,6)+RIGHT$(DATE$,2): Q$="F": RETURN
1730 IF Q$<>"B" THEN RETURN
1735 NBLOCKS=VALUE(I,J-1)*VALUE(I,J)
1740 Q$=STRING$(NBLOCKS\2,&HB1)+STRING$(NBLOCKS MOD 2,221)
1750 F$=SPACE$(9): LSET F$=Q$: II=J
1760 IF LEN(Q$)<10 THEN Q$="F": RETURN: ELSE Q$=RIGHT$(Q$,LEN(Q$)-9)
1770 II=II+1: IF II>COL.HOME+SC THEN Q$="F": RETURN
1780 IND$(I,II)="!": EQ$(I,II)=F$: LSET EQ$(I,II)=Q$
1790 GOTO 1760
1900 ' ACCEPT LABEL (')
1910 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1
1920 LINE INPUT;"Label: ",A$: IF A$="" THEN RETURN
1930 IND$(ROW,COL)="!": VALUE(ROW,COL)=0: EQ$(ROW,COL)=LEFT$(A$,9)
1940 D$=L$+CHR$(B+TEMP.ROW)+CHR$(B+TEMP.COL)
1950 LOCATE TEMP.ROW,TEMP.COL:PRINT EQ$(ROW,COL);
1960 IF LEN(A$)<10 THEN RETURN ELSE A$=RIGHT$(A$,LEN(A$)-9)
1970 IF COLRX THEN TEMP.ROW=RX: BEEP
2468 IF TEMP.COL>CX THEN TEMP.COL=CX: BEEP
2469 ROW=TEMP.ROW: COL=TEMP.COL: GOSUB 900
2470 IF ROW.HOME >= ROW OR COL.HOME >= COL OR ROW > (ROW.HOME+SR) OR COL > (COL.HOME+SC) THEN GOSUB 2500 'ALTER SCREEN
2480 RETURN
2500 ' ALTER SCREEN
2501 '
2510 ROW.HOME=ROW-1: IF WINDOW.FLAG$="R" THEN IF ROW.HOME > 0 THEN ROW.HOME=ROW.HOME-1
2520 COL.HOME=COL-1: IF WINDOW.FLAG$="C" THEN IF COL.HOME > 0 THEN COL.HOME=COL.HOME-1
2530 IF ROW.HOME > RX-SR THEN ROW.HOME = RX-SR: SCR.ROW = 1: IF ROW.HOME < 0 THEN ROW.HOME = 0
2540 IF COL.HOME > CX-SC THEN COL.HOME = CX-SC: SCR.COL = 1: IF COL.HOME < 0 THEN COL.HOME = 0
2550 GOSUB 2600 'CLEAR SCREEN
2570 RETURN
2600 ' CLEAR (CLR)
2610 CLS
2620 GOSUB 1300 'OUTLINE
2630 GOSUB 1400 'UPDATE
2640 RETURN
3000 ' SPECIAL COMMANDS
3030 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1
3040 PRINT "Special Command (A,B,C,D,E,F,G,H,I,J,L,M,N,P,Q,R,S,T,W,Z)? ";
3050 A$=INKEY$: GOSUB 1000: IF A$="" THEN 3050
3060 A$=CHR$(ASC(A$) AND &HDF) 'CONVERT TO UPPER
3070 ON INSTR("ABCDEFGHIJLMNPQRSTWZ",A$) GOSUB 3700,3900,6000,6700,5700,4300,2400,7600,6900,4700,5500,7500,4900,7100,3800,6300,5400,3500,5000,7400
3080 RETURN
3200 ' GET START OF RANGE
3210 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1
3220 INPUT;"Enter source range starting cell: ",INPUT.CELL$
3230 IF INPUT.CELL$="" THEN START.ROW=ROW: START.COL=COL: RETURN
3240 START.COL=(ASC(LEFT$(INPUT.CELL$,1)) AND &HDF)-64
3250 START.ROW=VAL(RIGHT$(INPUT.CELL$,LEN(INPUT.CELL$)-1))
3260 IF START.ROW<1 OR START.ROW>RX OR START.COL<1 OR START.COL>CX THEN PRINT CHR$(7)+"...OUT OF RANGE": FOR II=1 TO 999: NEXT: GOTO 3200
3270 RETURN
3300 ' GET END OF RANGE
3301 '
3310 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT INPUT.CELL$+"- : ";
3320 INPUT;"Enter source range ending cell: ",INPUT.CELL$
3330 IF INPUT.CELL$="" THEN END.ROW=ROW: END.COL=COL: RETURN
3335 IF INPUT.CELL$=CHR$(&HBF) THEN IANS$="N": RETURN
3340 END.COL=(ASC(LEFT$(INPUT.CELL$,1)) AND &HDF)-64
3350 END.ROW=VAL(RIGHT$(INPUT.CELL$,LEN(INPUT.CELL$)-1))
3360 IF END.ROW<1 OR END.ROW>RX OR END.COL<1 OR END.COL>CX THEN BEEP:PRINT "...OUT OF RANGE": FOR II=1 TO 999: NEXT: GOTO 3300
3370 IANS$=" ": IF START.ROW>END.ROW OR START.COL>END.COL THEN LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1: INPUT;"Incorrect range! Press return",IANS$: IANS$="N"
3380 RETURN
3500 ' TOTAL EQUATION /T
3501 '
3510 GOSUB 3200: GOSUB 3300: IF IANS$="N" THEN RETURN
3515 EQ$(ROW,COL)=""
3520 IF IND$(ROW,COL)="" OR IND$(ROW,COL)="!" THEN IND$(ROW,COL)="G"
3530 FOR I=START.ROW TO END.ROW: FOR J=START.COL TO END.COL
3540 A$=STR$(I): A$=RIGHT$(A$,LEN(A$)-1): IF I<10 THEN A$="0"+A$
3550 EQ$(ROW,COL)=EQ$(ROW,COL)+CHR$(J+64)+A$+"+"
3560 GOSUB 800: NEXT J,I
3570 EQ$(ROW,COL)=LEFT$(EQ$(ROW,COL),LEN(EQ$(ROW,COL))-1)
3580 I=ROW: J=COL: GOSUB 6100 'PARSE & DISPLAY
3590 RETURN
3700 ' AVERAGE COMMAND /A
3710 GOSUB 3500
3720 DIF=(END.ROW-START.ROW+1)*(END.COL-START.COL+1)
3730 EQ$(ROW,COL)=EQ$(ROW,COL)+"/"+STR$(DIF)
3740 I=ROW: J=COL: GOSUB 6100
3750 RETURN
3800 ' QUIT ROUTINE /Q
3810 GOSUB 1100
3820 ON ERROR GOTO 0 'TURN OFF ERROR TRAPING
3830 WIDTH 80
3840 LOCATE 22,1
3850 END
3860 SYSTEM
3900 ' BLANK ROUTINE /B
3901 '
3910 GOSUB 3200: GOSUB 3300: IF IANS$="N" THEN RETURN 'RANGE
3920 FOR I=START.ROW TO END.ROW: FOR J=START.COL TO END.COL: IND$(I,J)="": EQ$(I,J)="": VALUE(I,J)=0: GOSUB 1500: NEXT J,I
3940 RETURN
4300 ' FORMAT COMMAND /F
4301 '
4310 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "(G)lobal or (L)ocal? ";
4320 REP.MODE$=INKEY$: IF REP.MODE$="" THEN 4320
4330 IF REP.MODE$<>"L" AND REP.MODE$<>"l" THEN REP.MODE$="G"
4340 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Enter (I)nteger, (0-7) decimals, (H,F,E,S,T) for fractions, or G,B,@,D, or !: ";
4350 A$=INKEY$: IF A$="" THEN 4350 ELSE IF A$>="a" THEN A$=CHR$(ASC(A$) AND &HDF)
4360 IF INSTR("I01234567HFQESTGD@B!",A$)=0 THEN 4340
4370 IF REP.MODE$="G" THEN IF A$="G" THEN 4300 ELSE GLOBAL.FMT$=A$: GOSUB 900: GOSUB 1400: RETURN
4380 GOSUB 3200: GOSUB 3300: IF IANS$="N" THEN 4300 ELSE GOSUB 900
4390 FOR I=START.ROW TO END.ROW: FOR J=START.COL TO END.COL
4420 IF IND$(I,J)="!" THEN EQ$(I,J)=""
4430 Q$=IND$(I,J): IND$(I,J)=A$
4440 IF A$="!" THEN EQ$(I,J)=SPACE$(8): RSET EQ$(I,J)=STR$(VALUE(I,J))
4450 IF INSTR("!@D",A$) THEN VALUE(I,J)=0
4460 IF Q$="@" OR Q$="D" THEN GOSUB 1700: EQ$(I,J)=F$ 'FIX DATE & TIME
4480 IF A$<>"B" THEN GOSUB 1500
4485 NEXT J,I
4490 IF A$="B" THEN GOSUB 1400
4499 RETURN
4700 ' JUMP COMMAND /J
4701 '
4710 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Enter (C)olumn, (R)ow, or (space): ";
4720 JUMP.FLAG$=INKEY$: IF JUMP.FLAG$="" THEN 4720 ELSE JUMP.FLAG$=CHR$(ASC(JUMP.FLAG$) AND &HDF)
4730 IF JUMP.FLAG$<>"C" AND JUMP.FLAG$<>"R" THEN JUMP.FLAG$=" "
4740 RETURN
4800 ' JUMP!
4801 '
4810 IF JUMP.FLAG$="C" THEN IF SCR.ROW"C" AND WINDOW.FLAG$<>"R" THEN WINDOW.FLAG$=" ": GOSUB 1400: ELSE GOSUB 5100
5040 RETURN
5100 ' DISPLAY WINDOW
5105 IW.FLAG=0
5110 IF WINDOW.FLAG$<>"R" THEN 5150 ELSE I=1 'DISPLAY TOP ROW
5115 LOCATE 3,1:PRINT "01";
5120 FOR JI=1 TO SC: LOCATE 3,(JI*9)-5: J=JI+COL.HOME: GOSUB 1520: NEXT: RETURN
5150 IF WINDOW.FLAG$<>"C" THEN RETURN ELSE J=1 'DISPLAY 1'ST COL
5155 LOCATE 2,7:PRINT "A";
5160 FOR JI=1 TO SR: LOCATE JI+2,4: I=JI+ROW.HOME: GOSUB 1520: NEXT: RETURN
5199 '
5400 ' SAVE ROUTINE /S
5410 GOSUB 5600
5420 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Saving data to "+A$;: OPEN "O",#1,A$:
5430 WRITE #1,RX,CX,GLOBAL.FMT$,WINDOW.FLAG$,BOLD$:
5440 FOR I=1 TO RX: FOR J=1 TO CX: WRITE #1,IND$(I,J),EQ$(I,J),VALUE(I,J): NEXT J,I
5490 CLOSE: RETURN
5500 ' LOAD ROUTINE /L
5510 GOSUB 5600
5520 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Loading data from "+A$;: OPEN "I",#1,A$:
5530 INPUT #1,RX,CX,GLOBAL.FMT$,WINDOW.FLAG$,BOLD$: GOSUB 7300
5540 FOR I=1 TO RX: FOR J=1 TO CX: INPUT #1,IND$(I,J),EQ$(I,J),VALUE(I,J): NEXT J,I
5550 CLOSE: ROW=1: COL=1: ROW.HOME=0: COL.HOME=0
5580 IF WINDOW.FLAG$="" THEN WINDOW.FLAG$=" "
5590 GOSUB 2600: RETURN
5600 ' GET FILESPEC
5601 '
5610 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Default = "+PREV.FILE$+" ";
5620 INPUT;"Enter filespec for spreadsheet data file: ",A$
5630 IF A$="" THEN A$=PREV.FILE$
5640 IF INSTR(A$,".")=0 THEN A$=A$+".CAL"
5650 PREV.FILE$=A$
5660 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Insert disk in specified or default drive; press any key: ";
5670 IF INKEY$="" THEN 5670
5680 GOSUB 900
5690 RETURN
5700 ' ENTER EQUATION /E
5701 '
5710 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1: INPUT;"Enter equation: ",A$: GOSUB 5800: EQ$(ROW,COL)=B$
5720 IF IND$(ROW,COL)="" OR IND$(ROW,COL)="!" THEN IND$(ROW,COL)="G"
5730 I=ROW: J=COL: GOSUB 6100: GOSUB 1500
5740 RETURN
5800 ' REGULARIZE CELL ADDRESS
5801 '
5810 B$="": ICELL=1: D$=LEFT$(A$,1)
5820 FOR II=1 TO LEN(A$): C$=D$: D$=MID$(A$,II+1,1): ICELL=ICELL+1
5825 IF C$>="a" THEN C$=CHR$(ASC(C$) AND &HDF)
5830 IF C$>="A" AND C$<=CX$ THEN ICELL=0 ELSE IF ICELL=1 THEN IF D$<"0" OR D$>"9" THEN B$=B$+"0"
5840 B$=B$+C$: NEXT
5850 RETURN
6000 ' COMPUTE EQUATIONS /C
6001 '
6010 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Computing...";: GOSUB 900
6020 FOR I=1 TO RX: FOR J=1 TO CX: GOSUB 6100: IF INKEY$<>CHR$(0)+CHR$(79) THEN NEXT J,I
6040 RETURN
6100 ' PARSE EQUATION (I,J)
6101 '
6110 IF IND$(I,J)="" OR IND$(I,J)="!" OR EQ$(I,J)="" THEN RETURN
6120 VALUE.TMP=0: IOP(1)=1: VTOT(1)=0: LEV=1
6130 FOR II=1 TO LEN(EQ$(I,J)): A$=MID$(EQ$(I,J),II,1): GOSUB 6260: NEXT
6140 VALUE(I,J)=VTOT(1)
6150 GOSUB 1500: GOSUB 800: RETURN
6160 CL=ASC(A$)-64 'OBTAIN ROW & COL
6165 IF INSTR("0123456789",MID$(EQ$(I,J),II+2,1)) THEN N=2 ELSE N=1
6167 RW=VAL(MID$(EQ$(I,J),II+1,N)): II=II+N
6170 VALUE.TMP=VALUE(RW,CL): RETURN
6180 B$="": CNT=-1 'OBTAIN DECIMAL CONSTANT
6190 IF INSTR("0123456789. /",A$) THEN B$=B$+A$: CNT=CNT+1: A$=MID$(EQ$(I,J),II+CNT+1,1): IF A$<>"" THEN 6190
6195 GOSUB 2100: VALUE.TMP=VAL.B: II=II+CNT: RETURN
6200 ' 'FUNCTIONS
6210 IF IOP(LEV)=1 THEN VTOT(LEV)=VTOT(LEV)+VALUE.TMP: RETURN
6220 IF IOP(LEV)=2 THEN VTOT(LEV)=VTOT(LEV)-VALUE.TMP: RETURN
6230 IF IOP(LEV)=3 THEN VTOT(LEV)=VTOT(LEV)*VALUE.TMP: RETURN
6240 IF IOP(LEV)=4 THEN VTOT(LEV)=VTOT(LEV)/VALUE.TMP: RETURN
6250 RETURN
6260 IF (A$>="A" AND A$<="Z") THEN GOSUB 6160: GOSUB 6200: RETURN
6261 IF (A$>="0" AND A$<="9") OR A$="." THEN GOSUB 6180: GOSUB 6200: RETURN
6262 IF A$="+" THEN IOP(LEV)=1 ELSE IF A$="-" THEN IOP(LEV)=2 ELSE IF A$="*" THEN IOP(LEV)=3 ELSE IF A$="/" THEN IOP(LEV)=4
6263 IF A$="(" THEN LEV=LEV+1: VTOT(LEV)=0: IOP(LEV)=1: RETURN
6264 IF A$=")" THEN VALUE.TMP=VTOT(LEV): LEV=LEV-1: GOSUB 6200
6265 RETURN
6300 ' REPLICATION /R
6301 '
6310 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1: INPUT;"Enter source cell: ",INPUT.CELL$
6320 GOSUB 3230: SRC.ROW=START.ROW: SRC.COL=START.COL
6330 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Multiple source cells? (Y/N): ";
6340 MULT$=INKEY$: IF MULT$="" THEN 6340 ELSE IF MULT$="Y" OR MULT$="y" THEN MULT$="Y" ELSE MULT$="N"
6350 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "(A)bsolute or (R)elative? ";
6360 REL$=INKEY$: IF REL$="" THEN 6360 ELSE IF REL$="R" OR REL$="r" THEN REL$="R" ELSE REL$="A"
6370 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1: INPUT;"Starting target cell: ",INPUT.CELL$: GOSUB 3230
6380 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:INPUT;"Ending target cell: ",INPUT.CELL$: GOSUB 3330
6390 IF IANS$="N" THEN RETURN
6400 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Replicating...";: GOSUB 900: S.COL$="A": S.ROW=1: S.R=SRC.ROW
6410 FOR I=START.ROW TO END.ROW: S.C=SRC.COL: FOR J=START.COL TO END.COL
6420 DIFF.ROW=I-S.R: DIFF.COL=J-S.C
6430 IND$(I,J)=IND$(S.R,S.C): EQ$(I,J)=EQ$(S.R,S.C): VALUE(I,J)=VALUE(S.R,S.C)
6440 IF REL$="R" THEN GOSUB 6600 'ALTER EQUATION
6450 IF IND$(I,J)="" OR IND$(I,J)="!" OR EQ$(I,J)="" THEN GOSUB 1500 ELSE GOSUB 6120 'CALCULATE & DISPLAY
6460 IF MULT$="Y" AND START.COL-END.COL<>0 THEN S.C=S.C+1
6470 NEXT J
6480 IF MULT$="Y" AND START.ROW-END.ROW<>0 THEN S.R=S.R+1
6490 NEXT I
6499 RETURN
6600 ' ALTER EQUATION(I,J)
6601 '
6602 IF IND$(I,J)="" OR IND$(I,J)="!" OR EQ$(I,J)="" THEN RETURN
6603 FOR II=1 TO LEN(EQ$(I,J))
6610 A$=MID$(EQ$(I,J),II,1)
6620 IF A$CX$ THEN 6690
6630 IF DIFF.COL<>0 THEN MID$(EQ$(I,J),II,1)=CHR$(ASC(A$)+DIFF.COL)
6635 IF DIFF.ROW=0 THEN II=II+2: GOTO 6690
6640 II=II+1: VA1=VAL(MID$(EQ$(I,J),II,2))
6645 IF VA1RX THEN 6670 ELSE VA1=VA1+DIFF.ROW
6650 IF VA1>9 THEN A1$=RIGHT$(STR$(VA1),2) ELSE A1$="0"+RIGHT$(STR$(VA1),1)
6660 MID$(EQ$(I,J),II,2)=A1$
6670 II=II+1
6690 NEXT II: RETURN
6700 ' DELETE /D
6701 '
6710 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Delete a (R)ow, (C)olumn, or none (RETURN): ";
6720 IANS$=INKEY$: IF IANS$="" THEN 6720 ELSE IANS$=CHR$(ASC(IANS$) AND &HDF)
6730 IF IANS$<>"R" AND IANS$<>"C" THEN RETURN
6735 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Deleting...";: GOSUB 900
6740 IF IANS$="R" THEN 6820
6750 FOR J=COL TO (CX-1): FOR I=1 TO RX: IND$(I,J)=IND$(I,J+1): EQ$(I,J)=EQ$(I,J+1): VALUE(I,J)=VALUE(I,J+1): NEXT I,J
6780 FOR I=1 TO RX: IND$(I,CX)="": EQ$(I,CX)="": VALUE(I,CX)=0: NEXT
6790 S.ROW=1: S.COL$=CHR$(COL+64): DIFF.COL=-1: DIFF.ROW=0
6800 FOR I=1 TO RX: FOR J=1 TO CX: GOSUB 6600: NEXT J,I
6810 GOSUB 1400: RETURN
6820 FOR J=1 TO CX: FOR I=ROW TO (RX-1): IND$(I,J)=IND$(I+1,J): EQ$(I,J)=EQ$(I+1,J): VALUE(I,J)=VALUE(I+1,J): NEXT I,J
6850 FOR I=1 TO CX: IND$(RX,I)="": EQ$(RX,I)="": VALUE(RX,I)=0: NEXT
6860 S.ROW=ROW: S.COL$="A": DIFF.COL=0: DIFF.ROW=-1
6870 FOR I=1 TO RX: FOR J=1 TO CX: GOSUB 6600: NEXT J,I
6880 GOSUB 1400: RETURN
6900 ' INSERT /I
6901 '
6910 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Insert a (R)ow, (C)olumn, or none (RETURN): ";
6920 IANS$=INKEY$: IF IANS$="" THEN 6920 ELSE IANS$=CHR$(ASC(IANS$) AND &HDF)
6930 IF IANS$<>"R" AND IANS$<>"C" THEN RETURN
6935 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Inserting...";: GOSUB 900
6940 IF IANS$="R" THEN 7020
6950 FOR J=(CX-1) TO COL STEP -1: FOR I=1 TO RX: IND$(I,J+1)=IND$(I,J): EQ$(I,J+1)=EQ$(I,J): VALUE(I,J+1)=VALUE(I,J): NEXT I,J
6980 FOR I=1 TO RX: IND$(I,COL)="": EQ$(I,COL)="": VALUE(I,COL)=0: NEXT
6990 S.ROW=1: S.COL$=CHR$(COL+64): DIFF.COL=1: DIFF.ROW=0
7000 FOR I=1 TO RX: FOR J=1 TO CX: GOSUB 6600: NEXT J,I
7010 GOSUB 1400: RETURN
7020 FOR J=1 TO CX: FOR I=(RX-1) TO ROW STEP -1: IND$(I+1,J)=IND$(I,J): EQ$(I+1,J)=EQ$(I,J): VALUE(I+1,J)=VALUE(I,J): NEXT I,J
7050 FOR J=1 TO CX: IND$(ROW,J)="": EQ$(ROW,J)="": VALUE(ROW,J)=0: NEXT
7060 S.ROW=ROW: S.COL$="A": DIFF.COL=0: DIFF.ROW=1
7070 FOR I=1 TO RX: FOR J=1 TO CX: GOSUB 6600: NEXT J,I
7090 GOSUB 1400: RETURN
7100 ' PRINT /P
7101 '
7110 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Starting column (A-"; CX$; "): ";
7120 IANS$=INKEY$: IF IANS$="" THEN 7120 ELSE IANS$=CHR$(ASC(IANS$) AND &HDF)
7130 IF IANS$=CHR$(13) THEN S.COL=COL ELSE S.COL=ASC(IANS$)-64
7140 IF S.COL<1 OR S.COL>CX THEN BEEP:PRINT IANS$+"...OUT OF RANGE";: FOR I=1 TO 999: NEXT: GOTO 7100
7150 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "Printing";LPT;" columns to "+PRINT.FILE$+"...";: GOSUB 900
7155 OPEN "O",#1,PRINT.FILE$: PRINT #1,
7160 IP=S.COL+INT(LPT/9)-1: IF IP>CX THEN IP=CX
7170 FOR I=1 TO RX: FOR J=S.COL TO IP: GOSUB 7200: IF INKEY$=CHR$(0)+CHR$(79) THEN 7190 ELSE NEXT J: PRINT #1,: NEXT I
7190 CLOSE: RETURN
7200 ' PRINT CELL
7205 IF IND$(I,J)="" THEN RETURN
7210 PRINT #1, TAB(((J-S.COL)+1)*9-8);
7220 Q$=IND$(I,J)
7230 IF Q$="!" THEN PRINT #1, EQ$(I,J);: RETURN
7240 GOSUB 1600
7250 IF Q$="F" THEN PRINT #1, F$; ELSE PRINT #1, USING F$;VALUE(I,J);
7260 RETURN
7300 ' DEFAULT VARIABLES
7305 A$=""
7310 IF RX>RMAX THEN RX=RMAX: A$="0"
7320 IF CX>CMAX THEN CX=CMAX: A$="0"
7330 SR=22: IF SR>RX THEN SR=RX
7340 SC=8: IF SC>CX THEN SC=CX
7350 CX$=CHR$(CX+64)
7360 IF A$<>"0" THEN RETURN
7370 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:BEEP:PRINT "MAXIMUM MATRIX SIZE IS";RX;"BY";CX;
7380 FOR I=1 TO 1999: NEXT
7390 RETURN
7400 ' CHANGE DEFAULTS /Z
7410 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT STR$(RX);: INPUT;": Enter maximum row: ",A$: IF A$<>"" THEN RX=VAL(A$)
7420 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT CX$+" ("+RIGHT$(STR$(CX),2)+")";: INPUT;": Enter maximum column: ",A$: IF A$<>"" THEN IF A$>="A" AND A$<="z" THEN CX=ASC(A$)-64 ELSE CX=VAL(A$)
7430 GOSUB 7300
7440 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT STR$(LPT);: INPUT;" Enter printer width: ",A$: IF A$<>"" THEN LPT=VAL(A$)
7450 WIDTH "lpt1:",LPT
7455 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT PRINT.FILE$;: INPUT;": Enter file or device name for printed output: ",A$: IF A$<>"" THEN PRINT.FILE$=A$
7460 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT BOLD$;: INPUT;": Bold ON or OFF? ",A$
7465 IF A$<>"" THEN BOLD$=A$
7470 GOSUB 2600: RETURN
7500 ' MODIFY VALUE /M
7501 '
7510 LOCATE 1,1: PRINT SPC(79);: LOCATE 1,1: INPUT;"finish equation: ",A$: GOSUB 5800: C$=B$
7520 GOSUB 3200: GOSUB 3300: IF IANS$="N" THEN RETURN
7525 LOCATE 1,1: PRINT SPC(79);: LOCATE 1,1: PRINT "Modifying...";: GOSUB 900
7530 FOR I=START.ROW TO END.ROW: FOR J=START.COL TO END.COL
7535 IF EQ$(I,J)<>"" OR IND$(I,J)="" OR IND$(I,J)="!" THEN 7570
7537 VALUE.TMP=0: IOP(1)=1: VTOT(1)=VALUE(I,J): LEV=1
7540 FOR II=1 TO LEN(C$): A$=MID$(C$,II,1): EQ$(I,J)=C$: GOSUB 6260: NEXT II
7560 EQ$(I,J)="": VALUE(I,J)=VTOT(1): GOSUB 1500: GOSUB 800
7570 NEXT J,I
7580 RETURN
7600 ' HELP MENU /H
7610 CLS
7611 PRINT "/A AVERAGE -generates the equation for averaging a series of cells"
7612 PRINT "/B BLANK -erases a series of cells leaving them blank"
7613 PRINT "/C COMPUTE -computes all equations"
7614 PRINT "/D DELETE -deletes the current Row or Column"
7615 PRINT "/E EQUATION -enters an equation into the current cell"
7616 PRINT "/F FORMAT -sets the number of decimal places displayed"
7617 PRINT "/G GOTO -allows you to goto any cell including those off screen"
7618 PRINT "/H HELP -displays these helpful messages"
7619 PRINT "/I INSERT -inserts an entire blank row or column before the current cell"
7620 PRINT "/J JUMP -causes the cursor to auto. jump across the Row or Column"
7622 PRINT "/L LOAD -loads a previously SAVEd Calc file"
7623 PRINT "/M MODIFY -modifies a series of cells by an equation you enter"
7624 PRINT "/N NEW -reruns Calc from the start"
7626 PRINT "/P PRINT -prints as much of the matrix as possible from a given column"
7627 PRINT "/Q QUIT -returns you to MS-DOS"
7628 PRINT "/R REPLICATE cells. Equations can be copied Relative to their position"
7629 PRINT "/S SAVE -saves the current matrix on disk"
7630 PRINT "/T TOTAL -generates the equation for the total of a series"
7633 PRINT "/W WINDOW -places Row 1 or Col A on screen at all times (for labels)"
7636 PRINT "/Z -changes the maximum Row and Column, and the printer defaults"
7637 PRINT "Special keys: HOME = refresh; END = stop; =/+ = enter value; ' = enter label"
7690 PRINT :PRINT "Press any key to continue: ";
7695 IF INKEY$="" THEN 7695 ELSE GOSUB 2600: RETURN
7699 '
8000 ' INITIALIZE VICTOR SCREEN VAIABLES
8001 '
8005 BELL$=CHR$(7) '"YOU CAN RING MY BELLELEL,"
8010 E$=CHR$(27) 'ESCAPE
8020 L$=E$+CHR$(89) 'LOCATE CURSOR STRING
8030 B=31 ' " " BIAS
8040 CL$=E$+"E" 'CLEAR SCREEN STRING
8045 Z$=E$+"K" 'ERASE TO EOL
8050 HOME$=L$+CHR$(B+1)+CHR$(B+1) 'HOME CURSOR
8055 HOME$=HOME$+Z$+HOME$ 'HOME AND CLEAR STATUS LINE
8060 WIDTH 80: WIDTH PRINT.FILE$,LPT
8070 RAM=&HB000: DEF SEG=RAM 'LOCATION OF SCREEN MEMORY
8080 'PRINT E$+"x5" E$+"x1" E$+"y8" 'NO CURSOR, 25'TH LINE, NO LINE FEEDS
8090 RETURN
9000 ' ERROR HANDLER
9005 BEEP
9010 IF ERR=53 THEN LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "FILE NOT FOUND.";: GOTO 9070
9060 LOCATE 1,1:PRINT SPC(79);:LOCATE 1,1:PRINT "ERROR "ERR" IN LINE NUMBER "ERL;
9070 PRINT " Press return to continue:";
9080 IF INKEY$="" THEN 9080
9090 CLOSE: RESUME 300
6PackNotes:
I noticed the "erratic numbering of the line numbers - i would leave those alone
as it may be related to the missing "merge files mentioned above" don't really
know for sure. very impressive piece of coding. gotta long way to go before a
joe sixpack gets to there. ALL my stuff is a simple data-read. this is trick.
Anyhow, if you have the brains, this is what you can do with GW-BASIC.
Go to TOP of page
Go back to GW-BASIC Table of Contents
Back to GW-Basic Index