Yeah, that's what I do in my editor I wrote back in '90. Any time an ESC
comes through I evaluate if the next characters are a known function key.
If not, then I check for my own programmed escape action codes, and if not
then it's just an ESC followed by other chars.
No timing necessary and works like a charm for almost 20 years now. :)
Included below, maybe some of it will be of help to you...
* Release Information
* MANAGE-2000 - CSI - Release 5.0
* OO. - Full Page Editor
*===/============================================================\===*
* / Written by Allen E. Elwood 02/07/90 - AK Savage Software \ * =We=
*<------------------------------------------------------------------>* =Be=
* \ (c) Copyright 1990 by AK Savage Software - All Rights Reserved / *
=Bad!=
*===\============================================================/===*
*#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.2 (REPLACING PGM.NAME BY OO.,
FN.NAME BY OO, IO.OPEN.OPTS BY TERM.DATA:LOCK:XREF) ;*#* Copied Source
Follows (09-13-00)
$INCLUDE STANDARD.COMMON.VARIABLES FROM COPY.TOOLS.BP
$INCLUDE STANDARD.COMMON.APP.PROGRAMS FROM COPY.TOOLS.BP
$INCLUDE COM500 FROM COPY.TOOLS.BP
$INCLUDE STANDARD.VARIABLES.END FROM COPY.TOOLS.BP
PGM.NAME='OO.'; FN.NAME ='OO'
CALL IO.OPEN('TERM.DATA:LOCK:XREF',PASSWORDS)
*#*
EQU SEMI.COLON TO ";";EQU SMALL TO "`;";EQU BIG TO "`:";EQU REFRESH TO
"R";EQU DEL.LINE TO "l";EQU INS.LINE TO "M";EQU DEL.CHAR TO "W";EQU
INS.CHAR TO "Q";EQU CTRL.A TO CHAR(1);EQU RIGHT TO CHAR(6);EQU BACKSPACE TO
CHAR(8);EQU TAB TO CHAR(9);EQU DOWN TO CHAR(10);EQU FORM.FEED TO
CHAR(12);EQU CARRIAGE.RETURN TO CHAR(13);EQU LINE.DELETE TO CHAR(13);EQU
LINE.UNDELETE TO "N";EQU LEFT TO CHAR(21);EQU UP TO CHAR(26);EQU ESCAPE TO
CHAR(27);EQU SMALLEST TO CHAR(31);EQU PAGE.DOWN TO CHAR(68);EQU HOME TO
CHAR(72);EQU INSERT.TOGGLE TO CHAR(73);EQU SHIFT.TAB TO "O";EQU PAGE.UP TO
CHAR(85);EQU BIGGEST TO CHAR(127);EQU LAST.LINE TO 23;EQU VOFFSET TO 3;EQU
HOFFSET TO 20;AT.ROW="a";AND.AT="R";COLUMNS="C";ZAG=''
EQU AM TO @AM
EQU SQL.FORMAT TO "X"
* SET BACKSPACE BACK TO CHAR 127 AFTER ROI FIXES VT100 TERMINAL EMULATION
* TO ACTUALLY DO A BACKSPACE ON A VT100
GOSUB 9000 ; * Perform Initialization.
* Perform Full Screen Editing.
GOSUB 100 ; * Display Screen
* CALL SCREEN.MSG(B4.T:'Hit CTRL-A for Menu':AFT.T:'')
ECHO OFF ; ECHO.FLAG=1
LOOP
LOOP
IF LN.TOG THEN PRINT L(24):C(65):LIN:',':COL:EOL:
PRINT L(LIN-VAM):C(COL-HAM):
IF FN.KEY.ACTIVE THEN
FN.KEY.CNTR+=1
IF FN.KEY.CNTR>FN.KEY.LEN THEN
FN.KEY.ACTIVE=0
CH.IN = SEQ(IN())
END ELSE
CH.IN=SEQ(FN.KEY.VAL[FN.KEY.CNTR,1])
END
END ELSE
CH.IN = SEQ(IN())
END
PRINT L(LIN-VAM):C(COL-HAM):
IF CH.IN=2 THEN GOSUB HANDLE.FUNCTION.KEYS
CH.IN = CHAR(CH.IN)
WHILE CH.IN # CTRL.A DO
BEGIN CASE
CASE CH.IN>SMALLEST AND CH.IN<BIGGEST
IF VM.FLAG="Y" THEN
IF CH.IN='}' THEN ch....@vm
IF CH.IN='|' THEN ch....@svm
END
ZIGGY=ZIG<LIN>
ZLEN=LEN(ZIGGY)
IF INSERT.MODE="I" THEN
IF COL>ZLEN THEN
ZIGGY=ZIGGY:SPACE(COL-ZLEN+5)
ZIG<LIN>=ZIGGY[1,COL-1]:CH.IN
END ELSE
ZIG<LIN>=ZIGGY[1,COL-1]:CH.IN:ZIGGY[COL,LEN(ZIGGY)]
END
* PRINT L(LIN-VAM):C(COL-HAM):INS.CHAR
* PRINT L(LIN-VAM):C(COL-HAM):CH.IN
PRINT
L(LIN-VAM):C(1):EOL:CHANGE(ZIG<LIN>[1+HAM,LAST.COL],ESCAPE,'[')
PRINT L(LIN-VAM):C(COL-HAM):
END ELSE
PRINT L(LIN-VAM):C(COL-HAM):
PRINT CH.IN
IF COL>ZLEN THEN
ZIGGY=ZIGGY:SPACE(COL-ZLEN+5)
ZIG<LIN>=ZIGGY[1,COL-1]:CH.IN
END ELSE
ZIGGY[COL,1]=CH.IN
ZIG<LIN>=ZIGGY
END
END
IF COL = LAST.COL+HAM THEN GOSUB 3000 ; * Do a H.Tab
COL+=1
CASE ESCAPE=CH.IN
IP.TIMEOUT = 99999
PRINT L(LIN-VAM):C(COL-HAM):
IF FN.KEY.ACTIVE THEN
FN.KEY.CNTR+=1
IF FN.KEY.CNTR>FN.KEY.LEN THEN
FN.KEY.ACTIVE=0
SECOND.CHAR = SEQ(IN())
END ELSE
SECOND.CHAR = SEQ(FN.KEY.VAL[FN.KEY.CNTR,1])
END
END ELSE
SECOND.CHAR = SEQ(IN())
END
SECOND.CHAR = CHAR(SECOND.CHAR)
IF SECOND.CHAR=ESCAPE THEN
PRINT L(LIN-VAM):C(COL-HAM):
PRINT '['
ZIGGY=ZIG<LIN>
ZIGGY[COL,1]=CH.IN
ZIG<LIN>=ZIGGY
IF COL = LAST.COL+HAM THEN GOSUB 3000 ; * Do a H.Tab
COL+=1
END ELSE
GOSUB 200 ; * Do Other Escape Sequences
END
CASE DOWN = CH.IN
IF LIN = LAST.LINE+VAM THEN GOSUB 1000 ; * Do a V.Tab
LIN+=1
CASE UP = CH.IN
IF LIN>1 THEN
IF LIN=VAM+1 THEN GOSUB 2000 ; * Cancel a V.Tab
LIN-=1
END
CASE LEFT = CH.IN
IF COL>1 THEN
IF COL>2 THEN IF COL=HAM+2 THEN GOSUB 4000 ; * Cancel a H.Tab
COL-=1
END
CASE RIGHT = CH.IN
IF COL = LAST.COL+HAM THEN GOSUB 3000 ; * Do a H.Tab
COL+=1
CASE TAB = CH.IN
COL+=TOFFSET
LOOP WHILE COL>LAST.COL+HAM DO
GOSUB 3000 ; * Do a H.Tab
REPEAT
CASE CARRIAGE.RETURN = CH.IN
IF COL=1 THEN
INS '' BEFORE ZIG<LIN>
* PRINT L(LAST.LINE):C(COL):DEL.LINE:
* PRINT L(LIN - VAM):C(COL):INS.LINE:
GOSUB 100 ; * Display Screen
END ELSE
COL=1
LIN+=1
IF HAM>0 THEN
HAM=0
IF LIN > LAST.LINE+VAM THEN
GOSUB 1000 ; * Do a Vertical Tab
END ELSE
GOSUB 100 ; * Display Screen
END
END ELSE
IF LIN > LAST.LINE+VAM THEN GOSUB 1000 ; * Do a Vertical Tab
END
END
CASE BACKSPACE = CH.IN
IF COL>1 THEN
IF COL>2 THEN IF COL=HAM+2 THEN GOSUB 4000 ; * Cancel a H.Tab
IF INSERT.MODE="I" THEN
ZIGGY=ZIG<LIN>
ZIGA=ZIGGY[1,COL-2]
ZIGB=ZIGGY[COL,99999]
ZIG<LIN>=ZIGA:ZIGB
* PRINT L(LIN-VAM):C(COL-HAM-1):DEL.CHAR:
ZIGGY=ZIG<LIN>
ZIGA=ZIGGY[LAST.COL+HAM,1]
* PRINT L(LIN-VAM):C(LAST.COL):ZIGA:
COL-=1
PRINT
L(LIN-VAM):C(1):EOL:CHANGE(ZIG<LIN>[1+HAM,LAST.COL],ESCAPE,'[')
PRINT L(LIN-VAM):C(COL-HAM):
END ELSE
COL-=1
PRINT L(LIN-VAM):C(COL-HAM):
PRINT " "
IF LEN(ZIG<LIN>)=COL THEN
ZIGGY=ZIG<LIN>
ZIGGY[COL,1]=""
ZIG<LIN>=ZIGGY
END ELSE
ZIGGY=ZIG<LIN>
ZIGGY[COL,1]=" "
ZIG<LIN>=ZIGGY
END
END
END ELSE
IF LIN>1 THEN
LIN-=1
COL=LEN(ZIG<LIN>)+1
IF INT(COL/LAST.COL)>0 THEN
HAM=COL-HOFFSET
GOSUB 100 ; * Display Screen
END
END
END
END CASE
REPEAT
GOSUB 800 ; * Windows Front End
IF INSERT.MODE="I" THEN
PRINT L(24):C(1):EOL:B4.T:'Insert ON':
END ELSE
PRINT L(24):C(1):EOL:B4.T:'Insert OFF':
END
PRINT ' - ':THE.FILE.NAME:' - ':ITEM.NAME:AFT.T:
REPEAT
HANDLE.FUNCTION.KEYS:
IP.TIMEOUT = 99999
FN.KEY.IN = SEQ(IN())
IP.TIMEOUT=99999
EXTRA.RETURN.YOU.DONT.NEED = SEQ(IN())
FN.KEY.ACTIVE=1
FN.KEY.CNTR=1
BEGIN CASE
CASE FN.KEY.IN='49'
FN.KEY.VAL=ESCAPE:"U"
CASE FN.KEY.IN='50'
FN.KEY.VAL=ESCAPE:"D"
CASE FN.KEY.IN='51'
FN.KEY.VAL=ESCAPE:CARRIAGE.RETURN
CASE FN.KEY.IN='52'
FN.KEY.VAL=ESCAPE:"N"
CASE FN.KEY.IN='53'
FN.KEY.VAL=ESCAPE:"I"
CASE FN.KEY.IN='54'
FN.KEY.VAL=ESCAPE:'H'
CASE FN.KEY.IN='55'
FN.KEY.VAL=' WITH @ID LIKE "...'
CASE FN.KEY.IN='56'
FN.KEY.VAL=STR(BACKSPACE,10)
CASE FN.KEY.IN='57'
FN.KEY.VAL=CTRL.A
CASE FN.KEY.IN='58'
FN.KEY.VAL=CTRL.A
CASE 1
FN.KEY.VAL=''
END CASE
FN.KEY.LEN=LEN(FN.KEY.VAL)
IF FN.KEY.LEN<1 THEN FN.KEY.ACTIVE=0
IF FN.KEY.ACTIVE THEN CH.IN=SEQ(FN.KEY.VAL[FN.KEY.CNTR,1])
RETURN
100* Display Screen
PRINT CLR:
LNS=DCOUNT(ZIG,@AM)
START=1+VAM
FINISH=START+LAST.LINE-1
REALLY.LAST.LINE=FINISH
IF FINISH > LNS THEN FINISH=LNS
LSTART=1+HAM
J=0
FOR I=START TO FINISH
J+=1
OUTPUT=CHANGE(ZIG<I>[LSTART,LAST.COL],ESCAPE,'[')
SWAP FORM.FEED WITH '~' IN OUTPUT
PRINT L(J):C(1):OUTPUT:
NEXT I
IF INSERT.MODE="I" THEN
PRINT L(24):C(1):EOL:B4.T:'Insert ON':
END ELSE
PRINT L(24):C(1):EOL:B4.T:'Insert OFF':
END
PRINT ' - ':THE.FILE.NAME:' - ':ITEM.NAME:AFT.T:
RETURN
200* Do other Escape Sequences
SECOND.CHAR=ICONV(SECOND.CHAR,'MCU')
BEGIN CASE
CASE SQL.FORMAT = SECOND.CHAR
*Okay, we'll SQL format anything that the cursor is touching
CURR.LIN = DOWNCASE(ZIG<LIN>)
CURR.WORD = ''
IF (CURR.LIN[COL,1]=' ' OR CURR.LIN[COL,1]='') THEN
CALL SCREEN.MSG('The Cursor MUST be on the Dict Name you want to
format;b;c;h')
END ELSE
*Get the beginning of the line, the go foward one char at a time,
*converting as you go until eol
B=1
IF COL>1 THEN
FOR B=COL TO 1 STEP -1
CURR.VAL=CURR.LIN[B,1]
IF CURR.VAL # DOT THEN
VALID.NUMBER = (OCONV(CURR.VAL,'MCN') > '')
VALID.ALPHA = (OCONV(CURR.VAL,'MCA') > '')
IF NOT(VALID.NUMBER OR VALID.ALPHA) THEN
B+=1
EXIT
END
END
NEXT
END
EE=LEN(CURR.LIN)
PREV.CHAR.WAS.DOT=0
FOR E=B TO EE
CURR.VAL=CURR.LIN[E,1]
IF PREV.CHAR.WAS.DOT THEN CURR.VAL=UPCASE(CURR.VAL)
IF CURR.VAL=DOT THEN
PREV.CHAR.WAS.DOT=1
CURR.VAL=UNDERSCORE
END ELSE
PREV.CHAR.WAS.DOT=0
VALID.NUMBER = (OCONV(CURR.VAL,'MCN') > '')
VALID.ALPHA = (OCONV(CURR.VAL,'MCA') > '')
IF NOT(VALID.NUMBER OR VALID.ALPHA) THEN EXIT
END
CURR.WORD:=CURR.VAL
NEXT
CURR.WORD[1,1]=UPCASE(CURR.WORD[1,1])
WLEN=LEN(CURR.WORD)
ZIG<LIN>[B,WLEN]=CURR.WORD
GOSUB 100 ; * Display screen
END
CASE REFRESH=SECOND.CHAR
HAM=0
COL=1
GOSUB 100 ; * Display screen
CASE SHIFT.TAB=SECOND.CHAR
IF COL>1 THEN
IF COL>TOFFSET THEN COL=COL-TOFFSET ELSE COL=1
LOOP WHILE COL<=HAM DO
GOSUB 4000 ; * Cancel a H.Tab
REPEAT
END
CASE LINE.DELETE=SECOND.CHAR
IF UNDO=0 THEN UNDO=1
ZAG<UNDO>=ZIG<LIN>
UNDO+=1
DEL ZIG<LIN>
* PRINT L(LIN-VAM):C(1):DEL.LINE:
* PRINT L(LAST.LINE):C(1):INS.LINE:
* LSTART=1+HAM
* OUTPUT=CHANGE(ZIG<REALLY.LAST.LINE>[LSTART,LAST.COL],ESCAPE,'[')
* SWAP FORM.FEED WITH '~' IN OUTPUT
* PRINT OUTPUT:
GOSUB 100 ; * Display Screen
CASE LINE.UNDELETE=SECOND.CHAR
IF UNDO>1 THEN UNDO-=1
INS ZAG<UNDO> BEFORE ZIG<LIN>
* PRINT L(LAST.LINE):C(COL):DEL.LINE:
* PRINT L(LIN - VAM):C(COL):INS.LINE:ZAG<UNDO>[1,LAST.COL]
GOSUB 100 ; * Display Screen
CASE HOME=SECOND.CHAR
LIN=1
COL=1
VAM=0
HAM=0
GOSUB 100 ; * Display Screen
CASE PAGE.DOWN=SECOND.CHAR
VAM+=LAST.LINE
LIN=VAM+1
GOSUB 100 ; * Display Screen
CASE PAGE.UP=SECOND.CHAR
IF VAM>0 THEN
VAM-=LAST.LINE
IF VAM<0 THEN VAM=0
LIN=VAM+1
GOSUB 100 ; * Display Screen
END
CASE INSERT.TOGGLE=SECOND.CHAR
IF INSERT.MODE="I" THEN
INSERT.MODE=""
PRINT L(24):C(1):EOL:B4.T:'Insert OFF':
END ELSE
INSERT.MODE="I"
PRINT L(24):C(1):EOL:B4.T:'Insert ON':
END
PRINT ' - ':THE.FILE.NAME:' - ':ITEM.NAME:AFT.T:
PROMPT " "
CASE 1
ERM='VALUE WAS ':SECOND.CHAR:', This Function Not Available;B;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
END CASE
RETURN
800* Windows Front End
WN.TEXT=''
WN.HDNG='OO Windows'
WN.TEXT<1>='Oops'
WN.TEXT<2>='Edit'
WN.TEXT<3>='File'
WN.TEXT<4>='Print'
WN.TEXT<5>='Quick Find'
WN.TEXT<6>='Goto Line'
WN.TEXT<7>='TCL'
WN.TEXT<8>='Dup. Line'
WN.TEXT<9>='Chg Tabs'
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=1
RETURN
CASE WN.RESP=2
GOSUB 850 ; * Editing Window
CASE WN.RESP=3
GOSUB 900 ; * Filing Window
CASE WN.RESP=4
GOSUB 6000 ; * Printing Window
CASE WN.RESP=5
GOSUB QUICK.FIND
GOSUB 100 ; * Display Page
CASE WN.RESP=6
GOSUB 5500 ; * Go to a Specific Line Number.
CASE WN.RESP=7
GOSUB 5600 ; * Issue TCL Commands
CASE WN.RESP=8
GOSUB 5700 ; * Duplicate Current Line
CASE WN.RESP=9
GOSUB CHANGE.TABS
END CASE
RETURN
CHANGE.TABS:
WN.TEXT=''
WN.HDNG='Change Tabs To: '
WN.TEXT<1>='Every 2'
WN.TEXT<2>='Every 3'
WN.TEXT<3>='Every 4'
WN.TEXT<4>='Every 5'
WN.TEXT<5>='Every 6'
WN.TEXT<6>='Every 7'
WN.TEXT<7>='Every 8'
WN.TEXT<8>='Every 9'
WN.TEXT<9>='Enter a column number 10'
GOSUB WINDOW.INPUT
IF WN.RESP = 9 THEN
WN.TEXT = ''
WN.HDNG = 'Enter the column number'
WN.TEXT<1> = 'Column : '
GOSUB WINDOW.ENTRY
TOFFSET = WN.RESP - 1
END ELSE
TOFFSET=WN.RESP+1
END
RETURN
850* Editing
WN.TEXT=''
WN.HDNG='OO Editing Window'
WN.TEXT<1>='Oops, Nevermind'
WN.TEXT<2>='Search and Replace'
WN.TEXT<3>='Format Text'
WN.TEXT<4>='Select Text for Editing'
WN.TEXT<5>='Copy Selected Text to Scratch Pad'
WN.TEXT<6>='Insert Text from Scratch Pad'
WN.TEXT<7>='Insert Text from C:\TRANSFER'
WN.TEXT<8>='Delete Text, Place in Scratch Pad'
WN.TEXT<9>='Merge Entire Document'
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=1
RETURN
CASE WN.RESP=2
GOSUB 5000 ; * Search and Replace
GOSUB 100 ; * Display Page
CASE WN.RESP=3
GOSUB 5100 ; * Format Text.
CASE WN.RESP=4
MSG='The First Line in Selection is:':LIN:'.;B'
CALL SCREEN.MSG(MSG) ; PROMPT " "
SEL.FLAG=1
SEL.START=LIN
CASE WN.RESP=5
GOSUB 5200 ; * Copy Selected Text to Scratch Pad
CASE WN.RESP=6 OR WN.RESP = 7
GOSUB 5300 ; * Insert Text from the Scratch Pad
CASE WN.RESP=8
GOSUB 5400 ; * Delete Selected Text
CASE WN.RESP=9
GOSUB MERGE.ENTIRE.DOCUMENT
END CASE
RETURN
900* File it?
WN.TEXT=''
WN.HDNG='OO File Window'
WN.TEXT<1>='Oops, Nevermind.'
WN.TEXT<2>='Top Out of Document.'
WN.TEXT<3>='Save ':THE.FILE.NAME:'\':ITEM.NAME
WN.TEXT<4>='Start a New Document.'
WN.TEXT<5>='Delete Entire Document.'
WN.TEXT<6>='Save, Pre-Compile and Reload'
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=3
IF LEN(ZIG)>'99999999' THEN
ERM='Warning, ':ITEM.NAME:' is greater than 99999999 Bytes. You
Should'
ERM:=' Delete some of this document to the Scratch Pad, and then'
ERM:=' Save this document. Then, immediatly go into a new document
'
ERM:='and Recover the portion of your document that you deleted by '
ERM:='inserting it from the Scratch Pad. Now Returning to your
document!;C;H'
CALL SCREEN.MSG(ERM)
RETURN
END
WN.HDNG='Are You Sure You Want to File?'
WN.TEXT=''
WN.TEXT<1>='Oops, Nevermind'
WN.TEXT<2>='File and Exit'
WN.TEXT<3>='File, but return to document'
IF THE.FILE.NAME[LEN(THE.FILE.NAME)-2,3]=".BP" THEN WN.TEXT<4>='File,
Compile, & Return'
GOSUB WINDOW.INPUT
IF WN.RESP>2 THEN
WRITEU ZIG ON FILE.NAME, ITEM.NAME
ERM=ITEM.NAME:' - ':LEN(ZIG):' Bytes, Now Saved;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
IF WN.RESP=4 THEN
SS='BX ':THE.FILE.NAME:' ':ITEM.NAME:' (-D,CC)'
PRINT CLR:
PRINT 'Now Compiling ':ITEM.NAME:' in the ':THE.FILE.NAME:' file.'
PERFORM SS
READV SSS FROM VOC, ITEM.NAME,2 ELSE SSS=''
IF SSS='' THEN
CALL SCREEN.MSG('COULD NOT READV VOC - CANNOT DETERMINE PATH FOR
NEWPCODE')
END ELSE
SS='NEWPCODE ':SSS
PRINT SS
PERFORM SS
END
CALL SCREEN.MSG('Hit Return to Continue;C;H') ; PROMPT " "
GOSUB 100 ; * Display Screen
END
RETURN
END
IF WN.RESP=2 THEN
B='Attention : ':ITEM.NAME:' ':LEN(ZIG):' Bytes, is being saved to
':THE.FILE.NAME
PRINT CLR:B
WRITEU ZIG ON FILE.NAME, ITEM.NAME
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
ZIG=B ; LIN=2 ; COL=1 ; VAM=0 ; HAM=0
IF THE.FILE.NAME[LEN(THE.FILE.NAME)-2,3]=".BP" THEN
WN.HDNG='OO Compile Window'
WN.TEXT=''
WN.TEXT<1>='Exit Without Compiling'
WN.TEXT<2>='Compile and Exit'
GOSUB WINDOW.INPUT
IF WN.RESP=2 THEN
SS='BX ':THE.FILE.NAME:' ':ITEM.NAME:' (-D,CC)'
PRINT
PRINT 'Now Compiling ':ITEM.NAME:' in the ':THE.FILE.NAME:'
file.'
PERFORM SS
PRINT 'End of first compile : ':;INPUT DUH.ME
IF NOT(DUH.ME) THEN
SS='BX ':THE.FILE.NAME:' ':ITEM.NAME:' (AU'
PRINT
PRINT 'Now Auditing ':ITEM.NAME:' in the ':THE.FILE.NAME:'
file.'
PERFORM SS
END
READV SSS FROM VOC, ITEM.NAME,2 ELSE SSS=''
IF SSS='' THEN
CALL SCREEN.MSG('COULD NOT READV VOC - CANNOT DETERMINE PATH
FOR NEWPCODE')
END ELSE
SS='NEWPCODE ':SSS
PRINT SS
PERFORM SS
END
END
END
END ELSE
RETURN ; * Back to the HOP.
END
CASE WN.RESP=2
WN.HDNG='OO Top Out Window'
WN.TEXT=''
WN.TEXT<1>='No, Do NOT Top Out!'
WN.TEXT<2>='Yes, Top Out, Do Not File.'
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN GOTO 900 ; * File it?
PRINT CLR:'Now Topping out of : ':ITEM.NAME:' in file :
':THE.FILE.NAME
CASE WN.RESP=1
RETURN ; * Back to the HOP.
CASE WN.RESP=4
WN.HDNG='Save Current Document Before Exiting?'
WN.TEXT=''
WN.TEXT<1>='Save ':ITEM.NAME
WN.TEXT<2>='No Do Not Save, Start New Document'
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN
WRITEU ZIG ON FILE.NAME, ITEM.NAME
ERM='Attention : ':ITEM.NAME:' ':LEN(ZIG):' Bytes, has just been
saved to the ':THE.FILE.NAME
ERM:=' File;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
END
THE.FILE.NAME=""
ITEM.NAME=""
SCRN.SIZE=""
EXTRA.IP="?NO?"
ECHO ON ; ECHO.FLAG=0
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
GOSUB 9000 ; * Perform Initialization
ECHO OFF ; ECHO.FLAG=1
LIN=1 ; COL=1 ; VAM=0 ; HAM=0
GOSUB 100 ; * Display Page
RETURN
CASE WN.RESP=5
WN.HDNG='OO Deletion Window'
WN.TEXT=''
WN.TEXT<1>='Yeah, blow that sucker away!!!'
WN.TEXT<2>="No No No No don't Delete"
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN DELETE FILE.NAME,ITEM.NAME
IF WN.RESP=2 THEN
CALL SCREEN.MSG('You Wimp, ok I did not not not not delete;b;c;h')
END
CASE WN.RESP=6
WRITEU ZIG ON FILE.NAME, ITEM.NAME
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
PERFORM 'BX ':THE.FILE.NAME:' ':ITEM.NAME:' (PRE'
*#* GEN.P LOCK FILE.NAME THE.FILE.NAME ITEM.NAME 'Basic Program' ;*#* Gen
Source Follows
IF LK.DEPTH.CHK THEN IF RECORDLOCKED(FILE.NAME,ITEM.NAME)>0 THEN CALL
LOCK.ERR(1,THE.FILE.NAME,ITEM.NAME)
LRVU = 0
LOOP
BUSY=0
RECORDLOCKU FILE.NAME,ITEM.NAME ON ERROR CALL
LOCK.ERR(2,THE.FILE.NAME,ITEM.NAME) LOCKED BUSY=1
IF BUSY THEN LRVF = FILE.NAME ; CALL
LOCKED.BY.WHOM(LRVF,ITEM.NAME,'Basic Program',0,1,1) ; IF @USER.TYPE THEN
LRVU = 1
UNTIL NOT(BUSY) DO
REPEAT
IF LRVU THEN WRITEVU FN.NAME ON TERM.CTL, PHYS.DEV.NBR, 21
*#*
READ ZIG FROM FILE.NAME, ITEM.NAME ELSE
SS= 'Your file is gone, someone must have deleted it while it was '
SS:='unlocked for the pre-compile. Yell at them, not me....;b;c;h'
CALL SCREEN.MSG(SS)
END
GOSUB 100 ; * Display Page
RETURN
END CASE
* IF SCRN.SIZE="S" THEN PRINT BIG
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
PRINT 'Be Excellent to Each Other.....'
PRINT ' This is OO..........Signing off'
STOP
1000* Do a Vertical Tab
VAM+=VOFFSET
GOSUB 100 ; * Display Screen
RETURN
2000* Cancel a Vertical Tab
IF VAM>0 THEN VAM-=VOFFSET
IF VAM<VOFFSET THEN VAM=0
GOSUB 100 ; * Display Screen
RETURN
3000* Do a Horizontal Tab
HAM+=HOFFSET
GOSUB 100 ; * Display Screen
RETURN
4000* Cancel a Horizontal Tab
IF HAM>0 THEN HAM-=HOFFSET
IF HAM<HOFFSET THEN HAM=0
GOSUB 100 ; * Display Screen
RETURN
5000* Search and Replace
PRINT CLR:B4.T:'OO - Search and Replace'
PRINT 'Hit ESC at any time to Return'
IF INSERT.MODE="I" THEN
PRINT L(24):C(1):EOL:B4.T:'Insert ON':
END ELSE
PRINT L(24):C(1):EOL:B4.T:'Insert OFF':
END
PRINT ' - ':THE.FILE.NAME:' - ':ITEM.NAME:AFT.T:
PRINT L(3):C(1):
ECHO ON ; ECHO.FLAG=0
PRINT 'Upcase Search or Not? (U/<cr>) : ':;INPUT UPUP
IF UPUP='U' THEN UPUP=1 ELSE UPUP=''
5001 PRINT B4.T:L(4):C(1):' Search for String:
':AFT.T:;INPUT SEARCH.VALUE:;PRINT EOL:
IF SEARCH.VALUE=ESCAPE THEN ECHO OFF ; ECHO.FLAG=1; RETURN
IF UPUP THEN SEARCH.VALUE=UPCASE(SEARCH.VALUE)
PRINT B4.T:L(5):C(1):' Replace with String:
':AFT.T:;INPUT REPLACE.VALUE:;PRINT EOL:
IF REPLACE.VALUE=ESCAPE THEN ECHO OFF ; ECHO.FLAG=1; RETURN
IF UPUP THEN REPLACE.VALUE=UPCASE(REPLACE.VALUE)
PRINT B4.T:L(6):C(1):'Line Prompt, or Occurance Prompt
(L/O)':AFT.T:;INPUT UNIVERSAL:;PRINT EOS:
IF UNIVERSAL=ESCAPE THEN ECHO OFF ; ECHO.FLAG=1; RETURN
PRINT B4.T:L(13):C(10):'* Search will begin with line ':LIN:' *':AFT.T:
PRINT B4.T:L(8):C(10): 'Replace ':AFT.T:SEARCH.VALUE:
PRINT B4.T:L(9):C(10):' With ':AFT.T:REPLACE.VALUE:
PRINT B4.T:L(11):C(10):' Is This OK? (Y/N): ':AFT.T:;INPUT OK
IF OK=ESCAPE THEN ECHO OFF ; ECHO.FLAG=1; RETURN
IF OCONV(OK,'MCU')#"Y" THEN GOTO 5001
SLEN=LEN(SEARCH.VALUE)
LNS=DCOUNT(ZIG,@AM)
FOR I=LIN TO LNS
IF UPUP THEN
ZIGGY=UPCASE(ZIG<I>)
END ELSE
ZIGGY=ZIG<I>
END
POSITION=''
POS=0 ; POS.CNT=0
FINDSTR SEARCH.VALUE IN ZIGGY SETTING POS ELSE POS=0
IF POS THEN
XLEN=LEN(SEARCH.VALUE)
YLEN=LEN(ZIGGY)-(XLEN-1)
FOR P=1 TO YLEN
IF ZIGGY[P,XLEN]=SEARCH.VALUE THEN POSITION<-1>=P ; POS.CNT+=1
NEXT P
END
POS=POSITION
* CALL STRING.SEARCH(SEARCH.VALUE,ZIGGY,POS)
* POS.CNT=DCOUNT(POS,AM)
IF UNIVERSAL="O" THEN
FOR J=POS.CNT TO 1 STEP -1
AA=ZIG<I>[1,POS<J>-1]:REPLACE.VALUE:ZIG<I>[POS<J>+SLEN,9999]
PRINT L(13):'Occurence on Line ':I:EOS
PRINT ZIG<I>[1,POS<J>-1]:B4.T:SEARCH.VALUE:
AFT.T:ZIG<I>[POS<J>+SLEN,9999]
PRINT
ZIG<I>[1,POS<J>-1]:B4.T:REPLACE.VALUE:AFT.T:ZIG<I>[POS<J>+SLEN,9999]
PRINT 'Correct? ':;INPUT YES.OR.NO,1
IF YES.OR.NO=ESCAPE THEN
ECHO OFF
ECHO.FLAG=1
LIN=I
VAM=VOFFSET*(INT(LIN/VOFFSET))
IF VAM=LIN THEN VAM-=VOFFSET
RETURN
END
IF ICONV(YES.OR.NO,'MCU')="Y" THEN ZIG<I>=AA
NEXT J
END ELSE
IF POS.CNT THEN
AA=CHANGE(ZIG<I>,SEARCH.VALUE,REPLACE.VALUE)
PRINT L(13):C(1):'Occurence on Line ':I:EOS
PRINT ZIG<I>
PRINT AA
PRINT 'Correct? ':;INPUT YES.OR.NO,1
IF YES.OR.NO=ESCAPE THEN
ECHO OFF
ECHO.FLAG=1
LIN=I
VAM=VOFFSET*(INT(LIN/VOFFSET))
IF VAM=LIN THEN VAM-=VOFFSET
RETURN
END
IF ICONV(YES.OR.NO,'MCU')="Y" THEN ZIG<I>=AA
END
END
NEXT I
ECHO OFF ; ECHO.FLAG=1
ERM='Search and Replace has been completed;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
RETURN
5100* Format Text.
IF THE.FILE.NAME[-3,3] = ".BP" THEN
ERM='Cannot format - Item is in a Basic Proc. Library - ':THE.FILE.NAME
ERM:=';C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
END ELSE
LIN=1
COL=1
VAM=0
HAM=0
DUMMY=0
DUMA=''
WN.HDNG='OO Format Window'
WN.TEXT=''
WN.TEXT<1>='Nevermind'
WN.TEXT<2>='Format for Coorespondence'
WN.TEXT<3>='Format for Mail'
WN.TEXT<4>='Format for 10-900 Characters'
GOSUB WINDOW.INPUT
IF WN.RESP=2 THEN F.SIZE=70
IF WN.RESP=3 THEN F.SIZE=60
IF WN.RESP=4 THEN
ECHO ON
5110 PRINT CLR:'Format for How Many Columns? (10-900) : ':;INPUT
F.SIZE
IF F.SIZE>900 THEN GOTO 5110
IF F.SIZE<10 THEN GOTO 5110
ECHO OFF
END
IF WN.RESP#1 THEN
PRINT CLR:'Now Formating'
WN.TEXT=''
WN.TEXT<1>='Use Force Justify Format'
WN.TEXT<2>='Use Compressed Format'
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN
CALL FORMAT.TEXT(ZIG,F.SIZE,DUMA,DUMMY)
ZIG=DUMA
DUMA=''
END ELSE
INS '' BEFORE ZIG<1>
INS '.F' BEFORE ZIG<1>
CALL FORMAT.TEXT(ZIG,F.SIZE,DUMA,DUMMY)
ZIG=DUMA
DUMA=''
DEL ZIG<1>
END
GOSUB 100 ; * Display Screen
END
END
RETURN
5200* Copy Text to Notepad
IF SEL.FLAG=0 THEN
ERM='You Must First Choose a Beginning Selection Using Select Text, '
ERM:='Move the cursor to the Last Line Desired, and then Use Copy to '
ERM:='Place Text in the Scratch Pad. Then you may Insert this Text '
ERM:='at any desired location(s) by Using Insert Text;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
RETURN
END
IF LIN<SEL.START THEN
SEL.FINISH=SEL.START
SEL.START=LIN
END ELSE
SEL.FINISH=LIN
END
WN.HDNG='Copy will be from Line ':SEL.START:' to Line ':SEL.FINISH
WN.TEXT=''
WN.TEXT<1>='Nevermind, Top Out'
WN.TEXT<2>='Copy the Selected Lines to Scratch Pad'
WN.TEXT<3>='Send to C:\transfer'
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=1
PRINT L24:EOL:
SEL.FLAG=0
RETURN
CASE WN.RESP=2 OR WN.RESP=3
SCRATCH.COUNT=0
SCRATCH.PAD=""
SCRATCH.ID=LOGON.ACCOUNT:'.SCRATCH.PAD'
FOR COUNT = SEL.START TO SEL.FINISH
SCRATCH.COUNT+=1
SCRATCH.PAD<SCRATCH.COUNT>=ZIG<COUNT>
NEXT COUNT
SEL.FLAG=0
DELETE MEMO.FILE,SCRATCH.ID
WRITEU SCRATCH.PAD ON MEMO.FILE, SCRATCH.ID
IF WN.RESP=3 THEN
ACTION = 'PC.SEND MEMOS ':SCRATCH.ID:' C:\TRANSFER\SCRATCH.PAD'
PERFORM ACTION
GOSUB 100 ; * Display Screen
END
SCRATCH.PAD=''
* CALL SCREEN.MSG('Text has been Copied to the Scratch Pad;C;H') ; PROMPT
" "
END CASE
RETURN
5300* Insert Text from Notepad
SCRATCH.ID=LOGON.ACCOUNT:'.SCRATCH.PAD'
IF WN.RESP = 7 THEN
ACTION = 'PC.GET MEMOS ':SCRATCH.ID:' C:\TRANSFER\SCRATCH.PAD O'
PERFORM ACTION
GOSUB 100;*DISPLAY PAGE
END
READ SCRATCH.PAD FROM MEMO.FILE, SCRATCH.ID ELSE
ERM='Sorry, the Scratch Pad is Empty, Cannot Complete Insertion;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
RETURN
END
SCRATCH.COUNT=DCOUNT(SCRATCH.PAD,@AM)
WN.HDNG='Insert Text Window'
WN.TEXT=''
WN.TEXT<1>='Oops, Nevermind!'
WN.TEXT<2>='Insert ':SCRATCH.COUNT:' Lines from Scratch Pad Before
Line:':LIN
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=1
RETURN
CASE WN.RESP=2
FOR COUNT=SCRATCH.COUNT TO 1 STEP -1
INS SCRATCH.PAD<COUNT> BEFORE ZIG<LIN>
NEXT COUNT
* MSG='Inserted ':SCRATCH.COUNT:' Lines from Scratch Pad;C;H'
* CALL SCREEN.MSG(MSG) ; PROMPT " "
GOSUB 100 ; * Display Page
END CASE
RETURN
5400* Delete Text, Place in Scratch Pad
IF SEL.FLAG=0 THEN
ERM='You Must First Choose a Beginning Selection Using Select Text, '
ERM:='Move the cursor to the Last Line Desired, and then Use Delete to '
ERM:='Place Text in the Scratch Pad. To Undo, Just Insert this Text '
ERM:='back at the desired location(s) by Using Insert Text;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
RETURN
END
IF LIN<SEL.START THEN
SEL.FINISH=SEL.START
SEL.START=LIN
WHICH.WAY=0
END ELSE
WHICH.WAY=1
SEL.FINISH=LIN
END
WN.HDNG='Delete will be from Line ':SEL.START:' to Line ':SEL.FINISH
WN.TEXT=''
WN.TEXT<1>='Nevermind, Top Out'
WN.TEXT<2>='Delete the Selected Lines to Scratch Pad'
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=1
PRINT L24:EOL:
SEL.FLAG=0
RETURN
CASE WN.RESP=2
SCRATCH.COUNT=0
SCRATCH.PAD=""
SCRATCH.ID=LOGON.ACCOUNT:'.SCRATCH.PAD'
FOR COUNT = SEL.START TO SEL.FINISH
SCRATCH.COUNT+=1
SCRATCH.PAD<SCRATCH.COUNT>=ZIG<COUNT>
NEXT COUNT
SEL.FLAG=0
WRITEU SCRATCH.PAD ON MEMO.FILE, SCRATCH.ID
FOR COUNT = SEL.START TO SEL.FINISH
DEL ZIG<SEL.START>
IF WHICH.WAY THEN LIN-=1
NEXT COUNT
IF WHICH.WAY THEN
LIN+=1
VAM=VOFFSET*(INT(LIN/VOFFSET))
IF VAM=LIN THEN VAM-=VOFFSET
END
IF LIN<1 THEN LIN=1
SCRATCH.PAD=''
* CALL SCREEN.MSG('Deleted Text has been Copied to the Scratch Pad;C;H')
; PROMPT " "
GOSUB 100 ; * Display Page
END CASE
RETURN
5500* Go to a Specific Page
ECHO ON ; ECHO.FLAG=0
PRINT CLR:B4.T:L(6):'Enter 99999 to go to Bottom'
PRINT L(5):' Go to Line Number : ':;INPUT LINE.NBR
PRINT AFT.T:
CURRENT.BOTTOM=DCOUNT(ZIG,@AM)
IF LINE.NBR>CURRENT.BOTTOM THEN
LIN=CURRENT.BOTTOM
END ELSE
IF LINE.NBR > 0 THEN LIN = LINE.NBR
END
VAM=VOFFSET*(INT(LIN/VOFFSET))
IF VAM=LIN THEN VAM-=VOFFSET
GOSUB 100 ; * Display Page
ECHO OFF ; ECHO.FLAG=1
RETURN
5600* Issue TCL Commands
ECHO ON ; ECHO.FLAG=0
PRINT CLR:
PRINT ' Welcome to the TCL OO Zone '
PRINT ''
PROMPT ""
* IF SCRN.SIZE='S' THEN PRINT BIG:
5610 PRINT "OO:\":;INPUT COMMAND
IF ICONV(COMMAND,'MCU')[1,3]='OFF' OR ICONV(COMMAND,'MCU')[1,3]='LOG' THEN
PRINT 'No No, Bad Idea! Go back to OO, file or top, and then '
PRINT 'you can do the ':COMMAND:' command!'
GOTO 5610 ; * More Commands Master!
END
IF ICONV(COMMAND,'MCU')#'END' THEN
PERFORM COMMAND
GOTO 5610 ; * More Commands Master!
END
* IF SCRN.SIZE='S' THEN PRINT SMALL:
GOSUB 100 ; * Display Page.
ECHO OFF ; ECHO.FLAG=1
RETURN
5700* Duplicate Current Line
ZAK=ZIG<LIN>
INS ZAK BEFORE ZIG<LIN>
*SCRATCH.ID=LOGON.ACCOUNT:'.SCRATCH.PAD'
*WRITEU ZAK ON MEMO.FILE, SCRATCH.ID
PRINT L(LAST.LINE):C(COL):DEL.LINE:
PRINT L(LIN - VAM):C(COL):INS.LINE:ZAK[1,LAST.COL]
GOSUB 100 ; * Display Page
RETURN
*===========================================================================
====
QUICK.FIND:*
PRINT CLR:B4.T:'OO - Quick Find'
PRINT 'Hit ESC at any time to Return'
IF INSERT.MODE="I" THEN
PRINT L(24):C(1):EOL:B4.T:'Insert ON':
END ELSE
PRINT L(24):C(1):EOL:B4.T:'Insert OFF':
END
PRINT ' - ':THE.FILE.NAME:' - ':ITEM.NAME:AFT.T:
PRINT L(3):C(1):
ECHO ON ; ECHO.FLAG=0
IF SEARCH.VALUE = '' THEN SEARCH.VALUE = "Custom "
PREV.SV = SEARCH.VALUE
IF PREV.SV THEN
PRINT B4.T:L(3):C(1):' Hit return to search for ':AFT.T:PREV.SV:AFT.T:'
Again'
END
PRINT B4.T:L(4):C(1):' Search for String: ':AFT.T:;INPUT
SEARCH.VALUE:;PRINT EOL:
IF SEARCH.VALUE=ESCAPE THEN ECHO OFF ; ECHO.FLAG=1; RETURN
IF PREV.SV THEN
IF NOT(SEARCH.VALUE) THEN
SEARCH.VALUE = PREV.SV
END
END
SLEN=LEN(SEARCH.VALUE)
LNS=DCOUNT(ZIG,@AM)
FOR I=LIN TO LNS
ZIGGY=ZIG<I>
POSITION=''
POS=0 ; POS.CNT=0
FINDSTR SEARCH.VALUE IN ZIGGY SETTING POS ELSE POS=0
IF POS THEN
XLEN=LEN(SEARCH.VALUE)
YLEN=LEN(ZIGGY)-(XLEN-1)
FOR P=1 TO YLEN
IF ZIGGY[P,XLEN]=SEARCH.VALUE THEN POSITION<-1>=P ; POS.CNT+=1
NEXT P
END
POS=POSITION
FOR J=POS.CNT TO 1 STEP -1
PRINT L(13):C(1):'Occurence on Line ':I:EOS
PRINT ZIG<I>[1,POS<J>-1]:B4.T:SEARCH.VALUE:
AFT.T:ZIG<I>[POS<J>+SLEN,9999]
LOOP
PRINT L(15):C(7):'Stop Here? ':;INPUT YES.OR.NO,1
YES.OR.NO = UPCASE(YES.OR.NO)
IF YES.OR.NO = 'Y' OR YES.OR.NO = 'N' THEN EXIT
REPEAT
IF YES.OR.NO='Y' THEN
ECHO OFF
ECHO.FLAG=1
LIN=I
VAM=VOFFSET*(INT(LIN/VOFFSET))
IF VAM=LIN THEN VAM-=VOFFSET
RETURN
END
NEXT J
NEXT I
ECHO OFF ; ECHO.FLAG=1
ERM='End of Document Reached;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
RETURN
*===========================================================================
====
MERGE.ENTIRE.DOCUMENT:
ECHO ON ; ECHO.FLAG=0
CRT L(1):C(1):'Merge Entire Document - Hit Escape to
Abort':EOL:L(2):C(1):EOL:L(3):C(1):EOL:
CRT
L(4):C(1):"=================================================================
=":EOL
ANS=""
LOOP
PRINT L(2):C(5):EOL:"Enter Filename Itemname : ":;INPUT FI.NAME
IF FI.NAME=ESCAPE THEN
GOSUB 100 ; * Display Screen
RETURN
END
PRINT L(3):C(5):EOL:' Correct? (Y/N): ':;INPUT ANS
IF ANS=ESCAPE THEN
GOSUB 100 ; * Display Screen
RETURN
END
ANS=OCONV(ANS,'MCU')
UNTIL ANS="Y" DO
IF ANS#"N" THEN CALL SCREEN.MSG('Sorry, ':ANS:' is an invalid response -
try again;B;C;H;')
REPEAT
MERGE.FILE.NAME=FIELD(FI.NAME," ",1)
MERGE.ITEM.NAME=FIELD(FI.NAME," ",2)
OPEN '',MERGE.FILE.NAME TO MERGE.FILE ELSE
ERM='Filename : ':MERGE.FILE.NAME:' Does Not Exist;B;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
GOTO MERGE.ENTIRE.DOCUMENT
END
READ MERGE.RECORD FROM MERGE.FILE, MERGE.ITEM.NAME ELSE
ERM='Itemname : ':MERGE.ITEM.NAME:' Does Not Exist;B;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
GOTO MERGE.ENTIRE.DOCUMENT
END
MERGE.COUNT=DCOUNT(MERGE.RECORD,@AM)
OK.TO.MERGE=1
FOR COUNT=MERGE.COUNT TO 1 STEP -1 WHILE OK.TO.MERGE
IF LEN(ZIG)+LEN(MERGE.RECORD<COUNT>)>99999999 THEN
ERM='Attention, this merge would have resulted in an over 99MB
condition. Merge was halted at Merge Document Line #:':COUNT:',
':MERGE.RECORD<COUNT>:' - Now Returning to Document - It is suggested that
you save your work immediately before adding ANY new lines!!!!!;B;C;H'
CALL SCREEN.MSG(ERM) ; PROMPT " "
OK.TO.MERGE=0
END ELSE
INS MERGE.RECORD<COUNT> BEFORE ZIG<LIN>
END
NEXT COUNT
ECHO OFF ; ECHO.FLAG=1
GOSUB 100 ; * Display Screen
RETURN
6000* Print the Document
WN.HDNG='Printer Type'
WN.TEXT=''
WN.TEXT<1>=' 80 Column Printer'
WN.TEXT<2>='132 Column Printer'
WN.TEXT<3>='132 Column HP4siMX'
WN.TEXT<4>='132 Column Oki'
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN LP.SIZE=80 ELSE LP.SIZE=132
IF WN.RESP=3 THEN HP=1 ELSE HP=0
IF WN.RESP=4 THEN HP=2
WN.HDNG='OO Print Window'
WN.TEXT=''
WN.TEXT<1>='Nevermind'
WN.TEXT<2>='Add Page Breaks'
WN.TEXT<3>='Do Not Add Page Breaks'
* WN.TEXT<4>='Do a BList w/Cross Reference Line Numbers'
GOSUB WINDOW.INPUT
IF WN.RESP=4 THEN
PRINT CLR:'Note that this ONLY works if you have saved your file first!'
SS='BLIST ':THE.FILE.NAME:' ':ITEM.NAME:' (P,M,E,X,I,C,N)'
PRINT
PRINT SS
PERFORM SS
CALL SCREEN.MSG ('Hit Return to Continue;C;H'); PROMPT " "
GOSUB 100 ; * Display Screen
RETURN
END
IF WN.RESP=2 THEN SKIPPER='YES'
IF WN.RESP=3 THEN SKIPPER='NO'
IF WN.RESP#1 THEN
WN.HDNG='OO Left Margin Window'
WN.TEXT=''
WN.TEXT<1>='Add Five Spaces to Left Margin'
WN.TEXT<2>='Do not Change Left Margin'
WN.TEXT<3>='Add Line Numbers to Left Margin'
GOSUB WINDOW.INPUT
IF WN.RESP=1 THEN MARGIN=5 ELSE MARGIN=0
PRINT CLR:B4.T:'Now Printing Document : ':AFT.T:ITEM.NAME
LINES.OUT=DCOUNT(ZIG,@AM)
PRINT
PRINT 'Document contains ':LINES.OUT:' Lines'
PRINT
RQM 1
IF HP=1 THEN PERFORM "SP-ASSIGN = MIS.LSR"
IF HP=2 THEN PERFORM "SP-ASSIGN = OKI"
CALL PRINTER.ON("","")
IF HP THEN PRINT ESCAPE:"&l0O ":ESCAPE:"(8U ":ESCAPE:"(s 0p 16.66h 8.5v
0s 0b 0T"
CRT @(0,5):'Now Printing Page Number : 1'
ALO.ALO=0
IF WN.RESP#2 THEN LP.SIZE=LP.SIZE-5
FOR ALO=1 TO LINES.OUT
IF ZIG<ALO>[1,1]='~' THEN
PRINT TOP.OF.PAGE
END ELSE
SECTIONS=INT(LEN(ZIG<ALO>)/LP.SIZE)
IF WN.RESP#2 THEN
SEC.SEC=(SECTIONS*LP.SIZE)+(SECTIONS*5)
SECTIONS=INT(SEC.SEC/LP.SIZE)
IF SEC.SEC => SECTIONS*LP.SIZE THEN SECTIONS+=1
END ELSE
IF LEN(ZIG<ALO>) => SECTIONS*LP.SIZE THEN SECTIONS+=1
END
IF SECTIONS=0 THEN SECTIONS=1
FOR ALS=1 TO SECTIONS
IF WN.RESP<3 THEN PRINT
SPACE(MARGIN):ZIG<ALO>[((ALS-1)*(LP.SIZE-MARGIN))+1,LEN(ZIG<ALO>[((ALS-1)*(L
P.SIZE-MARGIN))+1,(LP.SIZE-MARGIN)])]
IF WN.RESP=3 THEN PRINT
ALO"L#5":ZIG<ALO>[((ALS-1)*(LP.SIZE-5))+1,LEN(ZIG<ALO>[((ALS-1)*(LP.SIZE-5))
+1,(LP.SIZE-5)])]
ALO.ALO+=1
NEXT ALS
END
IF MOD(ALO.ALO,60)=0 THEN
IF SKIPPER='YES' THEN PRINT TOP.OF.PAGE
CRT @(0,05):'Now Printing Page Number : ':INT(ALO/60)+1
END
NEXT ALO
CALL PRINTER.CLOSE("","")
ERM=B4.T:ITEM.NAME:AFT.T:' has now been printed;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
GOSUB 100 ; * Display Screen
IF HP THEN PERFORM "SP.STD"
END
RETURN
9000* Perform Initialization.
VAM=0 ; HAM=0 ; SCRATCH.PAD="" ; INSERT.MODE='I'
DOT='.'
SEARCH.VALUE = ''
UNDERSCORE='_'
UNDO=0
TOFFSET=5
IF UPCASE(FIELD(LOGON.ACCOUNT,':',1))='MBOWMA' THEN TOFFSET=75
ZIG=''
ZIG<1>='Hi Kiddies, Its OO Time'
LIN=1 ; COL=1
OPEN '', 'VOC' TO VOC ELSE PRINT 'OH MY GOD THE VOC IS GONE';STOP
PRINT CLR:ZIG
IF EXTRA.IP='?NO?' THEN
SCRN.SIZE='' ; THE.FILE.NAME='' ; ITEM.NAME=''
END ELSE
SWAP SEMI.COLON WITH AM IN EXTRA.IP
CNT=DCOUNT(EXTRA.IP,@AM)
IF EXTRA.IP<1> = 'DICT' THEN
DICT.ON = 1
DEL EXTRA.IP<1>
END ELSE
DICT.ON =0
END
IF CNT=1 THEN
ITEM.NAME=EXTRA.IP<1>
READ VR FROM VOC, ITEM.NAME THEN
BEGIN CASE
CASE VR<1>='C'
THE.FILE.NAME=FIELD(VR<3>,' ',1)
CASE VR<1>='R'
THE.FILE.NAME=VR<2>
CASE 1
THE.FILE.NAME="AEE.BP"
END CASE
END ELSE
THE.FILE.NAME="AEE.BP"
END
END
IF CNT>1 THEN THE.FILE.NAME=EXTRA.IP<1> ; ITEM.NAME=EXTRA.IP<2>
IF CNT>2 THEN SCRN.SIZE=EXTRA.IP<3> ELSE SCRN.SIZE=''
EXTRA.IP='?NO?'
END
PROMPT " "
IF THE.FILE.NAME>"" THEN
PRINT 'FILENAME : ':THE.FILE.NAME
END ELSE
PRINT 'FILENAME : ':;INPUT THE.FILE.NAME:
IF THE.FILE.NAME="" THEN
THE.FILE.NAME="AEE.BP"
PRINT "AEE.BP"
END ELSE
PRINT
END
END
FILE.OPEN.ERROR = 0
IF DICT.ON THEN
OPEN 'DICT', THE.FILE.NAME TO FILE.NAME ELSE FILE.OPEN.ERROR = 1
END ELSE
OPEN THE.FILE.NAME TO FILE.NAME ELSE FILE.OPEN.ERROR = 1
END
IF FILE.OPEN.ERROR THEN
ERM='Sorry, but file : ':B4.T:THE.FILE.NAME:AFT.T:' does not
exist!;B;C;H'
CALL SCREEN.MSG(ERM); PROMPT " "
STOP
END
IF ITEM.NAME>'' THEN
PRINT 'ITEMNAME : ':ITEM.NAME
END ELSE
PRINT 'ITEMNAME : ':;INPUT ITEM.NAME
END
LOOP
*#* GEN.P LOCK FILE.NAME THE.FILE.NAME ITEM.NAME ;*#* Gen Source Follows
IF LK.DEPTH.CHK THEN IF RECORDLOCKED(FILE.NAME,ITEM.NAME)>0 THEN CALL
LOCK.ERR(1,THE.FILE.NAME,ITEM.NAME)
BUSY=0
RECORDLOCKU FILE.NAME,ITEM.NAME ON ERROR CALL
LOCK.ERR(2,THE.FILE.NAME,ITEM.NAME) LOCKED BUSY=1
IF BUSY THEN LRVF = FILE.NAME ; CALL
LOCKED.BY.WHOM(LRVF,ITEM.NAME,'',0,0,0) ; IF @USER.TYPE THEN LRVU = 1
*#*
IF NOT(BUSY) THEN EXIT
CALL SCREEN.MSG(THE.FILE.NAME:' ':ITEM.NAME:' locked by
':BY.WHOM:';B;C;H')
PRINT 'Continue trying? (Y/N) : ':;INPUT YORN
IF OCONV(YORN,'MCU')#'Y' THEN STOP
REPEAT
READ ZIG FROM FILE.NAME, ITEM.NAME ELSE
LAST.COL=80
WN.HDNG=ITEM.NAME:' is a New Item'
WN.TEXT=''
WN.TEXT<1>='Continue with this New Item'
WN.TEXT<2>='Change the Item Name'
WN.TEXT<3>='Change the File Name'
WN.TEXT<4>='Change the Item AND File Name'
WN.TEXT<5>='Exit OO'
ECHO.FLAG=0
GOSUB WINDOW.INPUT
BEGIN CASE
CASE WN.RESP=5
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
STOP
CASE WN.RESP=2
ITEM.NAME='' ; EXTRA.IP='' ; EXTRA.IP<1>=THE.FILE.NAME ;
EXTRA.IP<3>=SCRN.SIZE
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
GOTO 9000 ; * Initialization
CASE WN.RESP=3
THE.FILE.NAME='' ; EXTRA.IP='' ; EXTRA.IP<2>=ITEM.NAME ;
EXTRA.IP<3>=SCRN.SIZE
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
GOTO 9000 ; * Initialization
CASE WN.RESP=4
ITEM.NAME=''
THE.FILE.NAME=''
CALL RELEASE.LOCK(FILE.NAME,ITEM.NAME)
GOTO 9000 ; * Initialization
END CASE
* ERM='Attention : ':B4.T:ITEM.NAME:AFT.T:' is a NEW ITEM in
':B4.T:THE.FILE.NAME:AFT.T:';C;H'
* CALL SCREEN.MSG(ERM); PROMPT " "
ZIG=""
END
SEL.FLAG=0 ; LN.TOG=1 ; SCRATCH.COUNT=0
9001 IF SCRN.SIZE='' THEN PRINT "Big or Small (80 or 132 Column) ":;INPUT
SCRN.SIZE
SCRN.SIZE=UPCASE(SCRN.SIZE)
IF SCRN.SIZE='' THEN SCRN.SIZE='B'
IF SCRN.SIZE="S" THEN
LAST.COL=132
* PRINT SMALL
END ELSE
IF SCRN.SIZE#"B" THEN SCRN.SIZE=''; GOTO 9001
LAST.COL=80
END
SET.VALUE.MARK.FLAG:
VM.FLAG=""
PRINT "Use Value Marks? (Y/N) : ":;INPUT VM.FLAG
IF VM.FLAG="" THEN VM.FLAG="N"
VM.FLAG=OCONV(VM.FLAG,'MCU')
IF VM.FLAG#"Y" THEN IF VM.FLAG#"N" THEN GOTO SET.VALUE.MARK.FLAG
OPEN 'MEMOS' TO MEMO.FILE ELSE
ERM='Error, you must have a MEMOS file to use Select,Copy or Paste. '
ERM:='You Must create this file before you can use OO!;B;E;A;C;H'
CALL SCREEN.MSG(ERM)
END
FN.KEY.ACTIVE=0
RETURN
WINDOW.INPUT:
* Yes, we do windows
IF ECHO.FLAG THEN ECHO ON
WN.LINES=DCOUNT(WN.TEXT,@AM)
WN.MAX=''
WN.MAX<1>=LEN(WN.HDNG)
FOR WN.I=1 TO WN.LINES
WN.MAX<-1>=LEN(WN.TEXT<WN.I>)
NEXT I
WN.WIDTH=MAXIMUM(WN.MAX)+8
IF WN.WIDTH > LAST.COL THEN
ERM='Internal Window Width Specification Error for Window: ':WN.HDNG
ERM:=';B;H;E;A'
CALL SCREEN.MSG(ERM)
RETURN
END
IF WN.WIDTH<15 THEN WN.WIDTH=15
WN.WIDTH2=INT(WN.WIDTH/2+1)
WN.SPACE=INT(WN.WIDTH2-INT(LEN(WN.HDNG)/2))
WN.HEAD=STR(" ",80)
WN.HEAD[1,1]='|'
WN.HEAD[WN.SPACE,LEN(WN.HDNG)+6]=WN.HDNG:STR(" ",80)
WN.HEAD[WN.WIDTH,1]='|'
WN.HEAD=WN.HEAD[1,WN.WIDTH+5]
PRINT L(1):C(1):'*':STR('=',WN.WIDTH-2):'*'
PRINT L(2):C(1):WN.HEAD[1,WN.WIDTH]
PRINT L(3):C(1):'|':STR(" ",WN.WIDTH-2):'|'
FOR WN.I=1 TO WN.LINES+1
WN.LIN='| ':WN.I:' - ':WN.TEXT<WN.I>:STR(" ",80)
WN.LIN[WN.WIDTH,1]='|'
WN.LIN=WN.LIN[1,WN.WIDTH]
PRINT L(3+WN.I):C(1):WN.LIN
NEXT WN.I
PRINT L(3+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(4+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(5+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(6+WN.I):C(1):'*':STR('=',WN.WIDTH-2):'*'
WN.INQ=WN.LINES+5
WN.LAST=WN.LINES+7
LOOP
PRINT L(WN.INQ):C(2):' Selection : ':;INPUT WN.RESP,1
IF WN.RESP>WN.LINES OR WN.RESP<1 OR NOT(NUM(WN.RESP)) THEN
IF WN.RESP='' THEN WN.RESP='RETURN'
ERM=WN.RESP:B4.T:' is an Invalid Response, Try Again':AFT.T:';B'
CALL SCREEN.MSG(ERM); PROMPT " "
END ELSE
EXIT
END
REPEAT
START=1+VAM
LSTART=1+HAM
WN.FINISH=START+WN.LAST
J=0
SCRN=""
FOR WN.I=START TO WN.FINISH
J+=1
OUTPUT=CHANGE(ZIG<WN.I>[LSTART,WN.WIDTH],ESCAPE,'[')
LENO=LEN(OUTPUT)
IF LENO<WN.WIDTH THEN OUTPUT=OUTPUT:B4.T:STR(" ",WN.WIDTH-LENO):AFT.T
PRINT L(J):C(1):OUTPUT
NEXT WN.I
PRINT L(LIN-VAM):C(COL-HAM):
IF ECHO.FLAG THEN ECHO OFF
RETURN
WINDOW.ENTRY:
* Yes, we do windows
IF ECHO.FLAG THEN ECHO ON
WN.LINES=DCOUNT(WN.TEXT,@AM)
WN.MAX=''
WN.MAX<1>=LEN(WN.HDNG)
FOR WN.I=1 TO WN.LINES
WN.MAX<-1>=LEN(WN.TEXT<WN.I>)
NEXT I
WN.WIDTH=MAXIMUM(WN.MAX)+8
IF WN.WIDTH > LAST.COL THEN
ERM='Internal Window Width Specification Error for Window: ':WN.HDNG
ERM:=';B;H;E;A'
CALL SCREEN.MSG(ERM)
RETURN
END
IF WN.WIDTH<15 THEN WN.WIDTH=15
WN.WIDTH2=INT(WN.WIDTH/2+1)
WN.SPACE=INT(WN.WIDTH2-INT(LEN(WN.HDNG)/2))
WN.HEAD=STR(" ",80)
WN.HEAD[1,1]='|'
WN.HEAD[WN.SPACE,LEN(WN.HDNG)+6]=WN.HDNG:STR(" ",80)
WN.HEAD[WN.WIDTH,1]='|'
WN.HEAD=WN.HEAD[1,WN.WIDTH+5]
PRINT L(1):C(1):'*':STR('=',WN.WIDTH-2):'*'
PRINT L(2):C(1):WN.HEAD[1,WN.WIDTH]
PRINT L(3):C(1):'|':STR(" ",WN.WIDTH-2):'|'
FOR WN.I=1 TO WN.LINES+1
WN.LIN='| ':WN.I:' - ':WN.TEXT<WN.I>:STR(" ",80)
WN.LIN[WN.WIDTH,1]='|'
WN.LIN=WN.LIN[1,WN.WIDTH]
PRINT L(3+WN.I):C(1):WN.LIN
NEXT WN.I
PRINT L(3+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(4+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(5+WN.I):C(1):'|':STR(" ",WN.WIDTH-2):'|'
PRINT L(6+WN.I):C(1):'*':STR('=',WN.WIDTH-2):'*'
WN.INQ=WN.LINES+5
WN.LAST=WN.LINES+7
LOOP
PRINT L(WN.INQ):C(2):' Selection : ':;INPUT WN.RESP
EXIT
* IF WN.RESP>WN.LINES OR WN.RESP<1 OR NOT(NUM(WN.RESP)) THEN
* IF WN.RESP='' THEN WN.RESP='RETURN'
* ERM=WN.RESP:B4.T:' is an Invalid Response, Try Again':AFT.T:';B'
* CALL SCREEN.MSG(ERM); PROMPT " "
* END ELSE
* EXIT
* END
REPEAT
START=1+VAM
LSTART=1+HAM
WN.FINISH=START+WN.LAST
J=0
SCRN=""
FOR WN.I=START TO WN.FINISH
J+=1
OUTPUT=CHANGE(ZIG<WN.I>[LSTART,WN.WIDTH],ESCAPE,'[')
LENO=LEN(OUTPUT)
IF LENO<WN.WIDTH THEN OUTPUT=OUTPUT:B4.T:STR(" ",WN.WIDTH-LENO):AFT.T
PRINT L(J):C(1):OUTPUT
NEXT WN.I
PRINT L(LIN-VAM):C(COL-HAM):
IF ECHO.FLAG THEN ECHO OFF
RETURN
9999* Abort Routine
CALL SCREEN.MSG('Call Allen, OO has blown;B;E;A;C;H')
END
-----Original Message-----
From: [email protected]
[mailto:[email protected]]on Behalf Of Womack, Adrian
Sent: Tuesday, November 10, 2009 6:03 PM
To: U2 Users List
Subject: Re: [U2] UniData Unibasic IN function
I have a routine that gets variable length keyboard input without using
any naps/sleeps etc - BUT we don't have any keyboard sequences that are
subsets of other sequences. eg. we don't use a single ESC character to
mean anything.
So I basically just keep getting characters whilst the sequence received
is a subset of a known sequence, then I return immediately when the
sequence is complete or no longer matches a known sequence.
Note: I make use of the Universe KEYIN() function.
-----Original Message-----
From: [email protected]
[mailto:[email protected]] On Behalf Of Hona, David
Sent: Wednesday, 11 November 2009 9:37 AM
To: 'U2 Users List'
Subject: Re: [U2] UniData Unibasic IN function
Bob,
This is kind of a FAQ and you'll find a few responses in the archives
for the U2 Users groups (via Google search) in Mail Archive and similar
archiving services...
Here's one response from Martin Phillips (UV specific, but I think you
get the idea) ... maybe an overkill for you?:
http://www.mail-archive.com/[email protected]/msg24904.html
You need to take care that you input routine 'naps' / sleeps for a few
milliseconds between or risk that it hogs the CPU (especially, if in use
by lots of users simulatenously).
Regards
David
-----Original Message-----
From: [email protected]
[mailto:[email protected]] On Behalf Of Bob Woodward
Sent: Wednesday, 11 November 2009 11:18 AM
To: U2 Users Mailing List
Subject: [U2] UniData Unibasic IN function
Hi Folks,
I have a need to capture control/function keys from the keyboard in a
basic program. The IN() function does exactly this but I'm having a bit
of trouble figuring out how to recognize the "end" of a multi-character
keystroke. The cursor keys and function keys all start with ESC
(Char-27) but have a variable number of characters afterwards. I'm
looking for a way to recognize the difference between pressing the F1
key verses typing type <ESC><O><P> keys. They both bring in data,
character by character, as CHAR(27), CHAR(79), then CHAR(80).
I've tried using the INPUT VAR UNFILTERED command but then it requires
an additional Enter key to release the data to the program. I can't set
a length because of the number of characters in the function keys, and
any kind of time limit is going to be too long to be bearable.
Oh, and I also need to be able to recognize the difference between the
escape key by itself verses the start of a function key.
The system is Unidata 6.1. Thanks in advance for any thoughts or
suggestions.
Bob Woodward
System Programmer/Analyst
K2 Sports
************** IMPORTANT MESSAGE *****************************
This e-mail message is intended only for the addressee(s) and contains
information which may be confidential.
If you are not the intended recipient please advise the sender by return
email, do not use or disclose the contents, and delete the message and
any attachments from your system. Unless specifically indicated, this
email does not constitute formal advice or commitment by the sender or
the Commonwealth Bank of Australia (ABN 48 123 123 124) or its
subsidiaries.
We can be contacted through our web site: commbank.com.au.
If you no longer wish to receive commercial electronic messages from us,
please reply to this e-mail by typing Unsubscribe in the subject line.
**************************************************************
_______________________________________________
U2-Users mailing list
[email protected]
http://listserver.u2ug.org/mailman/listinfo/u2-users
DISCLAIMER:
Disclaimer. This e-mail is private and confidential. If you are not the
intended recipient, please advise us by return e-mail immediately, and
delete the e-mail and any attachments without using or disclosing the
contents in any way. The views expressed in this e-mail are those of the
author, and do not represent those of this company unless this is clearly
indicated. You should scan this e-mail and any attachments for viruses. This
company accepts no liability for any direct or indirect damage or loss
resulting from the use of any attachments to this e-mail.
_______________________________________________
U2-Users mailing list
[email protected]
http://listserver.u2ug.org/mailman/listinfo/u2-users
_______________________________________________
U2-Users mailing list
[email protected]
http://listserver.u2ug.org/mailman/listinfo/u2-users
