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. SUBROUTINE USRCMD(CMDLIN,ICODE,IGOTIT) CHARACTER*80 CMDSTR BYTE CMLN(80) 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... LOGICAL*1 AVBLS(100,27),WRK(128),VBLS(8,RRW,RCL) INTEGER*2 TYPE(RRW,RCL),VLEN(9) REAL*8 XAC,XVBLS(RRW,RCL) REAL*8 TAC,UAC,VAC INTEGER*4 JVBLS(2,RRW,RCL) 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 9990 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 WRITE(6,760) 760 FORMAT(' PRESS RETURN TO REDRAW SPREADSHEET>') READ(IOLVL,761,END=800,ERR=800)N 761 FORMAT(4A1) 750 ICODE=2 C FLAG THE MAIN COMMAND PARSER WE HANDLED THE COMMAND IGOTIT=1 C 9990 CONTINUE RETURN 800 CONTINUE CLOSE(UNIT=IOLVL) C RESET TO NORMAL I/O OFF CONSOLE. IOLVL=5 GOTO 750 END