LEX 'POSWAIT' * A function to facilitate GOTO & GOSUB. ID #EC * Jack Elhay, with suggestions from R.Sanderson. MSG 0 * see examples at end of code. POLL 0 * PPPM 2/11/88 ENTRY wtp$ CHAR #F * a function ENTRY wtp CHAR #F * a function KEY 'WTPOS$' * see below for syntax TOKEN 132 KEY 'WTPOS' * easier to show than explain TOKEN 133 ENDTXT ATNDIS EQU #2F441 * enable/disable nib for ATTN ARGERR EQU #0BF19 * invalid argument error exit D0=AVS EQU #09B2C * set D0 to AVMEMS AVS2DS EQU #09708 * send buffer at AVMEMS to display RNDAHX EQU #136CB * pop a numeric, round to hex integer REVPOP EQU #0BD31 * reverse a string, then pop it STD0D1 EQU #12A5C * unsupported store D0,D1 (works for CDCC version) RCD0D1 EQU #12A83 * recall D0, D1 also works CHIRP EQU #0EC5A * do an annoying little beep (quote from IDS) RANGE EQU #1B07C * check that a byte is in a given range SLEEP EQU #006C2 * light sleep CKSREQ EQU #00721 * check for service requests POPBUF EQU #010EE * pop a key from key buffer HDFLT EQU #1B31B * hex integer to floating point number conv. FNRTN1 EQU #0F216 * function return F-R0-0 EQU #2F89B * function scratch RAM KEYCOD EQU #1FD22 * keycode => ASCII table NIBHEX 8412 * 1 obligatory string, 1 optional numeric wtp$ ST=1 2 * ST2 set as string o/p flag GOTO START * jump to common code ERR GOVLNG ARGERR NIBHEX 8412 * as above wtp ST=0 2 * ST2 clear for numeric o/p START A=0 A * start with a clean A(A) SETHEX * hexmode required C=C-1 S * parameter count in C(S) ?C=0 S * was it 1? GOYES NONUM * yes, no numeric to pop GOSBVL RNDAHX * no, pop the num. as a hex integer GONC ERR * but it must not be negative D1=D1+ 16 * step past the numeric NONUM CD1EX * swap D1 into C(A) D1=(5) F-R0-0 * set D1 to scratch DAT1=A A * save A(A) in scratch;the num if popped,else 0 D1=C * restore D1 GOSBVL REVPOP * reverse and pop the string CD1EX * D1 into C R2=C * save in R2 (true start of string) C=C+A A * add string's length R1=C * save in R1 (true end of string) C=0 W * clear out C C=A A * copy A(A) into C(A) CSRB * rotate 1 bit right, divides by 2 C=C-1 A * decrement for use as a counter( now LEN-1) R0=C * save it too C=R2 * recall start of string D1=C * set D1 there GOSBVL STD0D1 * this is where we want D1 for later use D0=(5) ATNDIS * point D0 to ATTN enable/disable nib A=0 S * start with a clean A(S) A=A+1 S * we will poke a 1 there to disable DAT0=A S * poke D0=(5) (F-R0-0)+5 * set D0 into scratch, just past our numeric A=R1 * recover end of string address DAT0=A A * this is where we shall write our o/p GOSBVL D0=AVS * set D0 to AVMEMS A=R0 * recover string length LOOP1 C=DAT1 B * read a byte of the string DAT0=C B * write the byte to avmems D1=D1+ 2 * point to next byte D0=D0+ 2 * make room at avmems for it A=A-1 A * decrement counter GONC LOOP1 * loop back for more while A(A)>=0 LCHEX FF0A0D * CR/LF + terminal byte (reversed) DAT0=C 6 * tacked on the end of the string GOSBVL AVS2DS * send it to the display Sleep GOSBVL SLEEP * and nod off, waiting for a keystroke GONC KEY * awakened by a key, process GOSBVL CKSREQ * awakened by clock, external KBD or whatever GOTO Sleep * back to sleep KEY GOSBVL POPBUF * pop the key A=B A * copy it to A(B) A=A+A A * double D1=(5) KEYCOD * point to ASCII table CD1EX * swap into C C=C+A A * add offset into table CD1EX * reset D1, pointing a our key's ASCII A=DAT1 B * read the ASCII B=A B * put back into B(B) GOSBVL RCD0D1 * restore D0,D1 C=R0 * recall length D=C A * put into D(A) A=0 A * clear out A(A) R3=A * to use R3(A) as a counter for valid keystrokes ST=0 1 * ST1 clear means ATTN not pressed LCHEX 0E * ASCII for ATTN key ?C#B B * not ATTN? GOYES LOOP2 * yes,we can go on ST=1 1 * set up a flag, ATTN was pressed GONC ON * won't need to check against the string LOOP2 A=DAT1 B * read a byte of the string LCASC 'ZA' * set the range: upper case alphabet GOSBVL RANGE * test, in range? GOC NOTUPR * no, skip some code AR3EX * swap valid key counter into A(A) A=A+1 A * increment AR3EX * swap back ?A=B B * does our key match this byte (ie. character)? GOYES ON * yes, time to leave the loop NOTUPR D1=D1+ 2 * no, step past the byte D=D-1 A * decrement length counter GONC LOOP2 * while D(A)>=0 go back for more GOSBVL CHIRP * no match with any valid byte, chirp GOTO Sleep * then go back to sleep ON D1=(5) ATNDIS * time to enable ATTN C=0 A * by poking a 0 in DAT1=C 1 * do it D1=(5) F-R0-0 * no recover the numeric C=DAT1 A * recal into C(A) R2=C store in R2 D1=D1+ 5 * move on a little to get C=DAT1 A * D1 for o/p D1=C * reset D1 C=0 W * clean out C again ?ST=1 1 * ATTN? GOYES ZERO * o/p 0 or null string as appropriate C=R2 * pick up numeric ZERO A=R3 * pick valid key count A=A+C A * add ?ST=1 2 * was a string wanted? GOYES STRING * yes GOSBVL HDFLT * no, float C=A W * FNRTN1 needs result in C fnrtn1 GOVLNG FNRTN1 * OUTPUT! STRING C=0 W * clean arn't we? ?A=0 A * result of ATTN GOYES NULL * o/p a null string D1=D1- 2 * otherwise make room for a byte on the stack LCHEX 240 * the 2 is for str Len, 40 for conv to ASCII C=C+A B * C(B) contains the ASCII for 1 character (result) DAT1=C B * write to the stack NULL LCHEX 0F * null str header is F0, 1 byte header is F02 GOTO fnrtn1 * C(XS) was 2 and stayed for 1byte string, now leave. END Typically, WTPOS will be used in situations such as: 1000 ON WTPOS("SrchRplcInsrtMvCpyQuit"[,m]) GOTO 1100,1200,'A','B',1500,'Q' m is strictly not necessary for WTPOS. The function will display the string and go to sleep; it will respond in three different ways. If the key pressed matches the nth upper case character in the string, n[+m] is returned.If ATTN is pressed 0 is returned (this should SUSP the prgm) and if any other key is pressed TITAN chirps and nods off again, awaiting a valid keystroke. WTPOS$ is similar in action returning CHR$(n[+m]+64) for a valid keystroke, a null string for ATTN and a chirp and back to sleep for an invalid keypress. Thus it could be used as follows: 1000 GOTO WTPOS$("SrchRplcInsrtMvCpyQuit"[,m]) Having m allows different parts of the alphabet to be used as labels in a BASIC program. Essentially, this function is equivalent to: DISP A$; @ GOTO CHR$(64+POS(A$,KEYWAIT$)), except that A$ could not contain lower case characters and if there were no match,CHR$(64) would result! This type of immediate jump can be written into powerful menus. The reason for ATTN special handling is to give the user a means of exiting should, by some misadventure, the string argument comprise only lower case characters. Only INIT: 1 would have allowed recovery. Clearly, if the arg. of GOTO is 0 or a null string, the program will suspend, so that some diagnostics may be applied and corrective action taken. J.E.