C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. c c Add "annotation" commands via main force & awkwardness as follows: c 1. ANN command will create a file named cell.ANN for the current c cell (or overwrite an old one) dynamically for up to 20 lines c of text, just firing up the command "EDIT namecell.ANN" so the user c gets to do full screen edits. THE "name" part of the files is c taken from the first 6 characters of the sheet name. If these c are not in the uppercase alpha range they will be ignored, however, c so it is a good idea for sheet titles to have recognizable initial c 6 characters. c 2. QUERY or ? command will display the name.ANN file if it exists c after setting cursor to top of screen and doing line erase c there. c SUBROUTINE USRCMD(CMDLIN,ICODE,IGOTIT) CHARACTER*80 CMDSTR PARAMETER CUP=1,EL=12,ED=11,SGR=13 BYTE CMLN(80) LOGICAL*1 NMSH(80) COMMON/NMSH/NMSH EQUIVALENCE(CMLN,CMDSTR) C DUMMY PLACE FOR USER COMMANDS TO PARSE CMDLIN AND HANDLE C ADDITIONAL COMMANDS FOR VMS PORTACALC. INCLUDE 'VKLUGPRM.FTN' C DEFINE VALUE AREA FOR SPREAD SHEET. MORE WILL BE NEEDED GENERALLY C OUT OF COMMONS, BUT AT A MINIMUM, THIS WILL ALLOW SOME ACCESS TO C USEFUL NUMBERS. LOOK IN XQTCMD FOR MORE... INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP) INTEGER*2 TYPE(RRWP,RCLP),VLEN(9) INTEGER*2 IOLVL,FOOBAR COMMON/FOOBAR/FOOBAR COMMON/IOLVL/IOLVL REAL*8 XAC,XVBLS(RRWP,RCLP) REAL*8 TAC,UAC,VAC LOGICAL*1 FORM(4) LOGICAL*1 CELNAM(8) character*18 annam logical*1 annams(18) equivalence(annam,annams(1)) CHARACTER*8 CELNM CHARACTER*4 CELRW EQUIVALENCE(CELNM,CELNAM(1)) EQUIVALENCE(FORM(1),CELNAM(1)) EQUIVALENCE(CELRW,CELNAM(5)) LOGICAL*1 EDNAM(16) COMMON/EDNAM/EDNAM C EDITOR STRING NAME... DEFAULT "EDIT" INTEGER*4 JVBLS(2,RRWP,RCLP) EQUIVALENCE(XAC,AVBLS(1,27)) EQUIVALENCE(TAC,AVBLS(1,20)) EQUIVALENCE(UAC,AVBLS(1,21)) EQUIVALENCE(VAC,AVBLS(1,22)) EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1)) EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1)) COMMON/V/TYPE,AVBLS,VBLS,VLEN c available parsing aid: c call varscn(line,ibgn,lend,lstchr,id1,id2,ivalid) c where line(ibgn... lend) is scanned. If variable found c ivalid=1 else ivalid=0. id1,id2 are dims in xvbls for c variable found if any. lstchr is last char found+1... C OTHER USEFUL ROUTINES IN THE SHEET: C GN(LAST,LEND,NUMBER,LINE) C LOOKS FROM LINE(LAST) THRU LINE(LEND) FOR A NUMBER AND C RETURNS ANY NUMBER IN "NUMBER" ARG. ASSUMES "LINE" IS A C BYTE ARRAY. (NO INDICATION OF WHERE THE NUMBER WAS FOUND C HOWEVER). THROWS OUT LEADING SPACES, TERMINATES ON A NON C NUMERIC. C INDEX(LINE,CHAR) C EXPECTS LINE TO BE NULL TERMINATED AND RETURNS EITHER C THE SUBSCRIPT (COUNTING FROM 1) OF CHAR IN LINE OR THE C MAX SUBSCRIPT IN LINE (I.E., WHERE IT HIT THE NULL TERMINATOR). C NOTE THIS DIFFERS FROM THE "STANDARD" VERSION OF INDEX WHICH C RETURNS 0 FOR "NOT FOUND" -- THIS VERSION RETURNS MAX LENGTH C FOR "NOT FOUND". STOPS AT 512 BYTES HOWEVER... C PARSING IS UP TO USER. NOTE VARSCN MAY BE CALLED TO PARSE LOGICAL*1 CMDLIN(132) INTEGER*4 ISTTS C C INSERT CODE FOR ADDING A LIB$SPAWN CALL HERE TO PASS COMMANDS TO C DCL IF THEY BEGIN WITH A $ CHARACTER. IGOTIT=0 IF(CMDLIN(1).NE.'$'.AND.CMDLIN(1).NE.'}')GOTO 8000 C C HERE CALL THE LIB$SPAWN WITH THE COMMAND LINE AS AN ARGUMENT... DO 1000 NN=1,80 1000 CMLN(NN)=CMDLIN(NN+1) CMLN(80)=13 ! ADD C.R. AFTER LINE C ABOVE, INSERT A CR AFTER CMD LINE ISTTS=LIB$SPAWN(CMDSTR) C ASSUME WE NEED A REDRAW AFTER THE SPAWN FINISHES IF(CMDLIN(1).NE.'}')GOTO 750 IESC=27 C FAKE AN = TO RESET KEYPAD MODE HERE WRITE(6,760)IESC 760 FORMAT(' Press RETURN to redraw spreadsheet>',1A1,'=') READ(IOLVL,761,END=800,ERR=800)N 761 FORMAT(4A1) 750 continue 950 CONTINUE ICODE=2 C FLAG THE MAIN COMMAND PARSER WE HANDLED THE COMMAND IGOTIT=1 GOTO 9990 8000 CONTINUE IF(CMDLIN(1).NE.'D'.OR.CMDLIN(2).NE.'T'.OR.CMDLIN(3).NE.'R') 1 GOTO 8990 IGOTIT=1 ICODE=2 CALL DTRCMD(CMDLIN(4)) C ISSUE DATATRIEVE COMMAND... 8990 CONTINUE IF(CMDLIN(1).NE.'F'.OR.CMDLIN(2).NE.'I'.OR.CMDLIN(3).NE.'L') 1 GOTO 9000 IGOTIT=1 C FLAG FOR RECALCULATION BUT NOT TOTAL REDISPLAY IF PREFIX IS C 'FIL' RATHER THAN 'DTR'... ICODE=3 CALL DTRCMD(CMDLIN(4)) C ISSUE DATATRIEVE COMMAND... C 9000 CONTINUE IF(CMDLIN(1).NE.'A'.OR.CMDLIN(2).NE.'N')GOTO 9200 C ANNOTATE COMMAND SEEN IGOTIT=1 ICODE=2 DO 9001 N=1,80 CMLN(N)=32 9001 CONTINUE CALL IN2AS(PROW,FORM) WRITE(CELRW,9002)PCOL-1 9002 FORMAT(I4.4) ICM=17 C EDIT NAME IS 16 CHARS LONG DO 9040 N=1,6 IXX=NMSH(N) IF(IXX.GT.96)IXX=IXX-32 IF(IXX.LT.65.OR.IXX.GT.90)GOTO 9040 CMLN(ICM)=IXX ICM=ICM+1 9040 CONTINUE ICM=ICM-1 DO 9003 N=1,8 CMLN(N+ICM)=CELNAM(N) 9003 CONTINUE CMLN(ICM+9)='.' CMLN(ICM+10)='A' CMLN(ICM+11)='N' CMLN(ICM+12)='N' CMLN(ICM+13)=' ' CMLN(80)=13 DO 8603 N=1,16 CMLN(N)=EDNAM(N) 8603 CONTINUE C CMLN(1)='E' C CMLN(2)='D' C CMLN(3)='I' C CMLN(4)='T' C CMLN(5)=' ' C NOW HAVE "EDIT name.ANN" c built... go fire it up for creation or modification of annotation... DO 9150 N=17,ICM+12 IF(CMLN(N).EQ.' ')CMLN(N)='0' 9150 CONTINUE ISTTS=LIB$SPAWN(CMDSTR(1:ICM+14)) GOTO 9990 9200 CONTINUE IF(CMDLIN(1).NE.'?'.AND.(CMDLIN(1).NE.'Q'.OR.CMDLIN(2) 1 .NE.'U'.OR.CMDLIN(3).NE.'E')) GOTO 9300 C QUERY COMMAND SEEN IGOTIT=1 ICODE=2 DO 9237 N=1,18 9237 ANNAMS(N)=32 CALL IN2AS(PROW,FORM) WRITE(CELRW,9002)PCOL-1 ICM=0 DO 9240 N=1,6 IXX=NMSH(N) IF(IXX.GT.96)IXX=IXX-32 IF(IXX.LT.65.OR.IXX.GT.90)GOTO 9240 ICM=ICM+1 ANNAMS(ICM)=IXX 9240 CONTINUE DO 9241 N=1,8 ANNAMS(ICM+N)=CELNAM(N) 9241 CONTINUE ANNAMS(ICM+9)='.' ANNAMS(ICM+10)='A' ANNAMS(ICM+11)='N' ANNAMS(ICM+12)='N' DO 9250 N=1,18 IF(ANNAMS(N).EQ.' ')ANNAMS(N)='0' 9250 CONTINUE ANNAMS(ICM+13)=' ' OPEN(UNIT=2,NAME=ANNAM(1:ICM+13) 1 ,ACCESS='SEQUENTIAL',STATUS='OLD', 1 ERR=9210) DO 9030 N=1,20 READ(2,9031,END=9032,ERR=9032)WRK 9031 FORMAT(128A1) CALL UVT100(CUP,N+2,1) CALL UVT100(EL,2) WRITE(6,9035)WRK 9035 FORMAT(128A1) 9030 CONTINUE 9032 CONTINUE C THIS DISPLAYS ALL THE ANNOTATION WE HAVE... CLOSE(UNIT=2) CALL UVT100(CUP,LLCMD,1) CALL UVT100(EL,2) WRITE(6,760) READ(IOLVL,761,END=800,ERR=800)N GOTO 9990 9210 CONTINUE ICODE=3 CALL UVT100(CUP,LLDSP,1) call uvt100(EL,2) WRITE(6,9211) 9211 FORMAT(' No annotation found on this cell.') 9300 CONTINUE 9990 CONTINUE RETURN 800 CONTINUE CLOSE(UNIT=IOLVL) C RESET TO NORMAL I/O OFF CONSOLE. FOOBAR=0 IOLVL=5 CLOSE(UNIT=5) OPEN(UNIT=5,FILE='SYS$COMMAND:',CARRIAGECONTROL='NONE') C REOPEN CONSOLE IN CASE OF INITIALIZER FILES... GOTO 750 END