!PFK.BAS - by Mike Foley / Data Control / P.O. Box 101 / Dunedin, FL 33528
!See PFKBAS.HLP for instructions.
!Works with AMOSL 1.3 - May work under 1.2 if ODTIM.SBR is available.
! or just REM out call to ODTIM.SBR & don't use it.
!
MAP1 PNAME,S,6,"PFK"
MAP1 VERSION,S,3, "1.1" !Modified 04-26-86
MAP1 ANSWER,S,24
MAP1 IN$,S,132
MAP1 S$,S,132
MAP1 D$,S,132
MAP1 OLINE,S,132
MAP1 CR,F
MAP1 LF,F
MAP1 X,F :MAP1 NEEDNULL,F
MAP1 ENDFLG,B,1
MAP1 NDO,S,24 !Next do command file name
MAP1 FILE,S,24
MAP1 DIAG,B,1 !SET TO ONE IF ON
MAP1 DEVICE,S,5
MAP1 PPN,S,10
MAP1 DSTRING,S,50
MAP1 IDATE,F
MAP1 ITIME,F
MAP1 FLAG,F,6, -1
MAP1 ODTIM'DATA,S,100
LOOKUP "PFK.WRK",RET :IF RET CALL RWRK !Get last file worked on.
REG: ? :?"PFK ";VERSION;" Preparation Helper. "
IF FILE="" FILE="NONE"
ASK: ?CHR(7);"Enter file to process into a PFK file (";FILE;") > "; :CALL WHAT
IF ANSWER="" AND FILE="NONE" CALL BACK :GOTO ASK
X=INSTR(1,ANSWER,"/A") :IF X AND FILE="" FILE=ANSWER[1,X-1]
IF X AUTO=1 :GOTO AUTO1
X=INSTR(1,ANSWER,"/D") :IF X>1 ANSWER=ANSWER[1,X-1] :DIAG=1
IF ANSWER="/D" DIAG=1 :CALL BACK :GOTO ASK
IF ANSWER="AUTO" CALL BACK :GOTO AUTO
IF ENDFLG END
IF ANSWER="DIR" GOTO DIR
IF ANSWER="?" CALL HELP :GOTO REG
IF ANSWER<>"" FILE=ANSWER
X=INSTR(1,FILE,"/") :IF X FILE=FILE[1,X-1] :CALL DIAG
X=INSTR(1,FILE,".") :IF X FILE=FILE[1,X]
LOOKUP FILE+".PFI",RET :CALL WWRK :CALL OP89
?#89,":R" :?#89,"VUE ";FILE+".PFI" :IF RET=0 ?#89,"Y"
?#89,"RUN PFK " :IF DIAG ?#89,"/D"
?#89,"AUTO" :?#89,"$:" :?#89,"$P"
GOTO CL89
DIR: CALL OP89 :?#89,":R" :?#89,"DIR *.PFI/W"
?#89,"RUN PFK " :IF DIAG ?#89,"/D"
GOTO CL89
AUTO: INPUT LINE "",DEVICE :CALL BACK2
INPUT LINE "",PPN :CALL BACK2
AUTO1: OPEN #1,FILE+".PFI",INPUT
OPEN #2,FILE+".PFK",OUTPUT
IF DIAG OPEN #3,FILE+".DIA",OUTPUT
IF DIAG=0 LOOKUP FILE+".DIA",RET :IF RET KILL FILE+".DIA"
?#2,CHR(138);CHR(162); :IF DIAG ?#3,"CHR(138)CHR(162)";
A1: INPUT LINE #1,IN$ :IF EOF(1) GOTO DONE
IF IN$="STOP" GOTO DONE
IF IN$="" OR IN$[1,1]=";" GOTO A1
X=INSTR(1,IN$,";") :IF X IN$=IN$[1,X-1] :S$=IN$ :CALL TRIMS :IN$=S$
S$=IN$ :CR=0 :LF=0
X=INSTR(1,S$,"/") :IF X S$=S$[1,X-1] :CALL TRIMS
D$=S$
IF S$[1,1]="$" S$=S$[2,LEN(S$)] :GOTO PR0 !$ means text string only
!Use $ if text conflicts with a command
IF IN$="LINE25" OR IN$="LINE25 SHIFT" OR IN$="LINE26" CALL L25 :GOTO A1
IF S$="KEY INSERT CHARACTER" OR S$="KEY INS CHAR" S$=CHR(206) :GOTO PR3
IF S$="KEY DELETE CHARACTER" OR S$="KEY DEL CHAR" S$=CHR(207) :GOTO PR3
IF S$="KEY INSERT WORD" OR S$="KEY INS WORD" S$=CHR(177) :GOTO PR3
IF S$="KEY DELETE WORD" OR S$="KEY DEL WORD" S$=CHR(178) :GOTO PR3
IF S$="KEY INSERT LINE" OR S$="KEY INS LINE" S$=CHR(232) :GOTO PR3
IF S$="KEY DELETE LINE" OR S$="KEY DEL LINE" S$=CHR(203) :GOTO PR3
IF S$="KEY PREV SCREEN" S$=CHR(242) :GOTO PR3
IF S$="KEY NEXT SCREEN" S$=CHR(246) :GOTO PR3
IF S$="KEY HOME" S$=CHR(30) :GOTO PR3
IF S$="KEY PREV WORD" S$=CHR(209) :GOTO PR3
IF S$="KEY NEXT WORD" S$=CHR(247) :GOTO PR3
IF S$="KEY HELP" S$=CHR(185) :GOTO PR3
IF S$="KEY NEW LINE" S$=CHR(161) :GOTO PR3
IF S$="F1" S$=CHR(181) :GOTO PR3
IF S$="F2" S$=CHR(180) :GOTO PR3
IF S$="F3" S$=CHR(211) :GOTO PR3
IF S$="F4" S$=CHR(192) :GOTO PR3
IF S$="F5" S$=CHR(128) :GOTO PR3
IF S$="F6" S$=CHR(129) :GOTO PR3
IF S$="F7" S$=CHR(130) :GOTO PR3
IF S$="F8" S$=CHR(131) :GOTO PR3
IF S$="F9" S$=CHR(132) :GOTO PR3
IF S$="F10" S$=CHR(133) :GOTO PR3
IF S$="F11" S$=CHR(134) :GOTO PR3
IF S$="F12" S$=CHR(135) :GOTO PR3
IF S$="F13" S$=CHR(197) :GOTO PR3
IF S$="F14" S$=CHR(210) :GOTO PR3
IF S$="F15" S$=CHR(212) :GOTO PR3
IF S$="F16" S$=CHR(217) :GOTO PR3
IF S$="F1 SHIFT" S$=CHR(183) :GOTO PR3
IF S$="F2 SHIFT" S$=CHR(182) :GOTO PR3
IF S$="F3 SHIFT" S$=CHR(243) :GOTO PR3
IF S$="F4 SHIFT" S$=CHR(208) :GOTO PR3
IF S$="F5 SHIFT" S$=CHR(136) :GOTO PR3
IF S$="F6 SHIFT" S$=CHR(137) :GOTO PR3
IF S$="F7 SHIFT" S$=CHR(138) :GOTO PR3
IF S$="F8 SHIFT" S$=CHR(139) :GOTO PR3
IF S$="F9 SHIFT" S$=CHR(140) :GOTO PR3
IF S$="F10 SHIFT" S$=CHR(141) :GOTO PR3
IF S$="F11 SHIFT" S$=CHR(142) :GOTO PR3
IF S$="F12 SHIFT" S$=CHR(143) :GOTO PR3
IF S$="F13 SHIFT" S$=CHR(252) :GOTO PR3
IF S$="F14 SHIFT" S$=CHR(254) :GOTO PR3
IF S$="F15 SHIFT" S$=CHR(244) :GOTO PR3
IF S$="F16 SHIFT" S$=CHR(249) :GOTO PR3
IF S$="FUNCT0" S$=CHR(240) :GOTO PR3
IF S$="FUNCT1" S$=CHR(241) :GOTO PR3
IF S$="FUNCT2" S$=CHR(242) :GOTO PR3
IF S$="FUNCT3" S$=CHR(243) :GOTO PR3
IF S$="FUNCT4" S$=CHR(244) :GOTO PR3
IF S$="FUNCT5" S$=CHR(245) :GOTO PR3
IF S$="FUNCT6" S$=CHR(246) :GOTO PR3
IF S$="FUNCT7" S$=CHR(247) :GOTO PR3
IF S$="FUNCT8" S$=CHR(248) :GOTO PR3
IF S$="FUNCT9" S$=CHR(249) :GOTO PR3
!!PUT IN DATE
IF S$="ODTIM" OR S$="ODTIME" CALL ODTIM :S$=DSTRING :CALL TRIMS :GOTO PR2
!!VUE COMMANDS SCREEN CONTROLS
IF S$="RIGHT" OR S$="RIGHT ARROW" S$=CHR(12) :GOTO PR1
IF S$="LEFT" OR S$="LEFT ARROW" S$=CHR(8) :GOTO PR1
IF S$="UP" OR S$="UP ARROW" S$=CHR(11) :GOTO PR1
IF S$="DOWN" OR S$="DOWN ARROW" S$=CHR(10) :GOTO PR1
IF S$="NW" OR S$="NEXT WORD" S$=CHR(23) :GOTO PR1
IF S$="PW" OR S$="PREVIOUS WORD" S$=CHR(1) :GOTO PR1
IF S$="EOL" OR S$="END OF LINE" S$=CHR(14) :GOTO PR1
IF S$="SOL" OR S$="START OF LINE" S$=CHR(21) :GOTO PR1
IF S$="NM" OR S$="NEXT MATCH" S$=CHR(24) :GOTO PR1
IF S$="PP" OR S$="PREVIOUS PAGE" S$=CHR(18) :GOTO PR1
IF S$="NP" OR S$="NEXT PAGE" S$=CHR(20) :GOTO PR1
IF S$="EOF" OR S$="LP" OR S$="LAST PAGE" S$=CHR(5) :GOTO PR1
IF S$="END" S$=CHR(5) :GOTO PR1
IF S$="CC" OR S$="CENTER SCREEN" OR S$="CENTER CURSOR" S$=CHR(19) :GOTO PR1
IF S$="SS" OR S$="STOP SCROLL" S$=CHR(19) :GOTO PR1
IF S$="HOME" OR S$="HOME POSITION" S$=CHR(30) :GOTO PR1
IF S$="IL" OR S$="INSERT LINE" S$=CHR(2) :GOTO PR1
IF S$="DL" OR S$="LINE DEL" OR S$="LINE DELETE" OR S$="DELETE LINE" S$=CHR(26) :GOTO PR1
IF S$="CL" OR S$="CONCATENATE LINES" S$=CHR(15) :GOTO PR1
IF S$="IC" OR S$="CHAR INS" OR S$="INSERT CHARACTER" S$=CHR(6) :GOTO PR1
IF S$="DC" OR S$="CHAR DEL" OR S$="CHARACTER DELETE" OR S$="DELETE CHARACTER" S$=CHR(4) :GOTO PR1
IF S$="DPC" OR S$="DELETE PREVIOUS CHARACTER" S$=CHR(127) :GOTO PR1
IF S$="RUB" OR S$="RUBOUT" S$=CHR(127) :GOTO PR1
IF S$="DEL" OR S$="DELETE TO END OF LINE" S$=CHR(25) :GOTO PR1
IF S$="DW" OR S$="DELETE WORD" S$=CHR(22) :GOTO PR1
IF S$="CIM" OR S$="CHARACTER INSERT MODE" S$=CHR(17) :GOTO PR1
IF S$="LIM" OR S$="LINE INSERT MODE" S$=CHR(28) :GOTO PR1
IF S$="BM" OR S$="BLOCK MARK" OR S$="SET BLOCK MARKERS" OR S$="BLOCK" S$=CHR(16) :GOTO PR1
IF S$="ESC" OR S$="ESCAPE" S$=CHR(27) :GOTO PR1
!!ALPHACALC SCREEN CONTROLS - SOME ARE SAME AS IN VUE
IF S$="SLA" OR S$="SHIFT LEFT ARROW" S$=CHR(21) :GOTO PR1
IF S$="SRA" OR S$="SHIFT RIGHT ARROW" S$=CHR(14) :GOTO PR1
IF S$="AA" OR S$="AUTO ADVANCE" S$=CHR(28) :GOTO PR1
IF S$="AE" OR S$="AUTO EDIT" S$=CHR(27)+CHR(28) :GOTO PR1
IF S$="BCLEAR" OR S$="BLOCK CLEAR" S$=CHR(27)+CHR(81) :GOTO PR1
IF S$="BCOPY" OR S$="BLOCK COPY" S$=CHR(27)+CHR(67) :GOTO PR1
IF S$="BERASE" OR S$="BLOCK ERASE" S$=CHR(27)+CHR(31) :GOTO PR1
IF S$="BCOL" OR S$="BORDER COLUMN" S$=CHR(27)+CHR(66) :GOTO PR1
IF S$="BROW" OR S$="BORDER ROW" S$=CHR(27)+CHR(98) :GOTO PR1
IF S$="CANCEL" OR S$="MENU" S$=CHR(27)+CHR(27) :GOTO PR1
IF S$="COLDEL" OR S$="COL DEL" OR S$="COLUMN DELETE" S$=CHR(27)+CHR(4) :GOTO PR1
IF S$="COLINS" OR S$="COL INS" OR S$="COLUMN INSERT" S$=CHR(27)+CHR(6) :GOTO PR1
IF S$="EDIT" S$=CHR(27)+CHR(69) :GOTO PR1
IF S$="ERACOL" OR S$="ERASE COLUMN" S$=CHR(27)+CHR(22) :GOTO PR1
IF S$="ERAROW" OR S$="ERASE ROW" S$=CHR(27)+CHR(25) :GOTO PR1
IF S$="EX" OR S$="EXECUTE" S$=CHR(27)+CHR(88) :GOTO PR1
IF S$="HELP" S$=CHR(27)+CHR(63) :GOTO PR1
IF S$="SH" OR S$="SHIFT HOME" S$=CHR(5) :GOTO PR1
IF S$="LC" OR S$="LOCK COLUMN" S$=CHR(27)+CHR(76) :GOTO PR1
IF S$="LR" OR S$="LOCK ROW" S$=CHR(27)+CHR(108) :GOTO PR1
IF S$="MO" OR S$="MOVE" S$=CHR(9) :GOTO PR1
IF S$="NS" OR S$="NEXT SCREEN" S$=CHR(20) :GOTO PR1
IF S$="PS" OR S$="PREVIOUS SCREEN" S$=CHR(18) :GOTO PR1
IF S$="PC" OR S$="PROTECT CELL" S$=CHR(112) :GOTO PR1
IF S$="RC" OR S$="RECOMPUTE" S$=CHR(27)+CHR(82) :GOTO PR1
IF S$="RD" OR S$="ROW DELETE" S$=CHR(26) :GOTO PR1
IF S$="RI" OR S$="ROW INSERT" S$=CHR(2) :GOTO PR1
IF S$="SL" OR S$="SCREEN LEFT" S$=CHR(27)+CHR(91) :GOTO PR1
IF S$="SR" OR S$="SCREEN RIGHT" S$=CHR(27)+CHR(93) :GOTO PR1
!!MISCL ADDED SCREEN CONTROLS
IF S$="SPACE" S$=CHR(32) :GOTO PR1
IF S$="TAB" S$=CHR(9) :GOTO PR1
IF S$="CR" OR S$="CARRAGE RETURN" S$="" :D$="" :CR=1 :GOTO PR1
IF S$="LF" OR S$="LINE FEED" S$="" :D$="" :LF=1 :GOTO PR1
IF S$="CRLF" S$="" :D$="" :CR=1 :LF=1 :GOTO PR1
!DROP THRU
PR0: CR=1 :LF=1
PR1: CALL HOWMANY
PR2: ?#2;S$; :?D$; :IF DIAG ?#3;D$;
IF CR AND INSTR(1,IN$,"/NCR")>0 CR=0
IF LF AND INSTR(1,IN$,"/NLF")>0 OR INSTR(1,IN$,"/NOLF")>0 LF=0
IF LF=0 AND INSTR(1,IN$,"/LF")>0 LF=1
IF CR+LF AND INSTR(1,IN$,"/NCRLF")>0 OR INSTR(1,IN$,"/NOCRLF")>0 CR=0 :LF=0
IF CR ?#2;CHR(13); :?"+CR"; :IF DIAG ?#3;"+CR";
IF LF ?#2;CHR(10); :?"+LF" :IF DIAG ?#3;"+LF"
IF S$[1,4]="VUE " CALL MAKVUE
CNT=CNT+1 :GOTO A1
PR3: IF NEEDNULL CALL NEEDNULL ELSE NEEDNULL=1
?#2;S$; :?D$ :IF DIAG ?#3;D$;
GOTO A1
NEEDNULL: ?#2;CHR(0); :?"+NULL" :IF DIAG ?#3;"(00)";
RETURN
DONE: CLOSE #1 !! :IF NEEDNULL CALL NEEDNULL
CLOSE #2
? :IF DIAG CLOSE #3 :?"Diag file:";FILE;".DIA"
IF CNT<1 KILL FILE+".PFK" :?"No PFK file produced." :GOTO LEAVE
?"Ready to use the ";FILE;".PFK"
?"Use ";FILE;".CMD to set LINE25 and F-keys."
IF OP4 CLOSE #4
CALL OP89 :?#89,":R" :?#89,"SIZE ";FILE;".PFK"
IF OP4 ?#89,FILE
GOTO CL89
RWRK: OPEN #1,"PFK.WRK",INPUT :INPUT LINE #1,FILE :CLOSE #1 :RETURN
WWRK: OPEN #1,"PFK.WRK",OUTPUT :?#1,FILE :CLOSE #1 :RETURN
LEAVE: END
WHAT: ANSWER="" :ENDFLG=0 :INPUT LINE "",ANSWER :ANSWER=UCS(ANSWER)
IF ANSWER="E" OR ANSWER="Q" OR ANSWER="X" ENDFLG=1
RETURN
NOP: ?"NOT PROCESSED." :RETURN
BACK: ?CHR(7);
BACK2: ?TAB(-1,3);TAB(-1,2);TAB(-1,9); :RETURN
OP89: X=0 !make a .DO command file
NDO: X=X+1 :NDO=X USING "#ZZZZZ" :NDO=NDO+".DO" :LOOKUP NDO,NRET :IF NRET GOTO NDO
OPEN #89,NDO,OUTPUT :OP89=1 :?#89,":S" :?#89,"ERASE ";NDO :RETURN
CL89: CLOSE #89 :CHAIN NDO :RETURN
HELP: S$="BAS:PFKBAS.HLP" :LOOKUP S$,RET :IF RET GOTO H1
S$="HLP:PFKBAS.HLP" :LOOKUP S$,RET :IF RET=0 ?"No help in library." :RETURN
H1: OPEN #10,S$,INPUT :? :X=0
HL: INPUT LINE #10,S$ :IF EOF(10) GOTO D10
?S$ :X=X+1 :IF X>22 CALL CR :CALL BACK2 :X=0 :IF ENDFLG GOTO D10
GOTO HL
D10: CLOSE #10 :RETURN
CR: ?"Press RETURN to proceed > "; :CALL WHAT :RETURN
DIAG: DIAG=1 :?"Diag mode on." :RETURN
MAKVUE: !Check to see if file exists - if not create it.
S$=S$[5,LEN(S$)] :LOOKUP S$,RET :IF RET RETURN
OPEN #9,S$,OUTPUT :CLOSE #9 :RETURN
L25: !Setup 25th line display and comamnd file
INPUT LINE #1,S$ :IF OP4 GOTO L25SH
OPEN #4,FILE+".CMD",OUTPUT :OP4=1
?"Preparing ";FILE;".CMD as a command file to set LINE25 and F-keys."
?#4,"DEL *.PFK"
?#4,"LOAD ";DEVICE;FILE;".PFK"; :IF PPN<>"" ?#4;"[";PPN;"]" ELSE ?#4
!Replace line above with one below if all .PFK files are to be in LIB:
! ?#4,"LOAD LIB:";FILE;".PFK"
?#4,"SET ECHO" :?#4,":R" :S$=S$+SPACE(80)
?#4,":<z ";S$;" " :?#4;">" :RETURN
L25SH: S$=S$+SPACE(80) :?#4;":<Z ";S$;" " :?#4;">" :RETURN
TRIMS: T=1 :OLINE="" ! ROUTINE TO REMOVE TABS AND STRIP S$
FOR I=1 TO 80
IF S$[I;1]=CHR(9) OLINE=OLINE+SPACE(9-T) :T=1 :GOTO NXI
T=T+1 :IF T=9 T=1
OLINE=OLINE+S$[I;1]
NXI: NEXT I :XCALL STRIP,OLINE
S$=OLINE :RETURN
HOWMANY: !howmany times to do a process
CALL GETX :IF X<1 RETURN
OLINE="" :FOR I=1 TO X :OLINE=OLINE+S$ :NEXT I
S$=OLINE :RETURN
ODTIM: !process a date requirement
CALL GETX :IF X<1 X=-1
ODTIM'DATA="-1,0,1,2,4,8,16,32,64,128,256,384,512,1024,2048,4096,8192,16384"
OLINE=X :IF INSTR(1,ODTIM'DATA,OLINE)=0 X=-1
FLAG=X :XCALL ODTIM,DSTRING,DATE,TIME,FLAG
IF FLAG=-1 GOTO FMTDTE1
IF FLAG=8 GOTO FMTDTE2
RETURN
FMTDTE1: !Re format the ODTIM date (Monday, February 10, 1986 05:10:00 PM)
!To read February 10, 1986
SP=INSTR(1,DSTRING,CHR(32))+1 :EP=INSTR(1,DSTRING,":")-4
DSTRING=DSTRING[SP,EP] :RETURN
FMTDTE2: !Re format the date
DSTRING=DSTRING[7,8]+DSTRING[4,5]+DSTRING[1,2]
RETURN
GETX: !check for a slash argument and set into X
X=INSTR(1,IN$,"/") :IF X<1 RETURN
X=IN$[X+1,LEN(IN$)] :RETURN
