!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