CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / cpm / qterm / qt43src.lbr / CHAT.ZY / CHAT.ZY

Wrap

Text File | 1991-05-29 | 23.3 KB | 993 lines

; chat.z - handle send/receive chat scripts .incl "c:vars" .var _sends 0 ; send string .var _expect 40 ; expect string .var _explen 80 ; length of expect string .var _sndlen 81 ; length of send string .var _time 82 ; time in seconds to try .var _tries 83 ; number of times to try before failing .var _yes 84 ; new state if success .var _no 85 ; new state if failure .var _slow 86 ; should we slow down outgoing string .var _curtry 87 ; current try at this one .useg .extern area area: ; area where parsed line lives sends: ds 40 ; send string expect: ds 40 ; expect string explen: ds 1 ; length of expect string sndlen: ds 1 ; length of send string time: ds 1 ; time in seconds to try tries: ds 1 ; number of times to try before failing yes: ds 1 ; new state if success no: ds 1 ; new state if failure .extern slow ; externed for hangup slow: ds 1 ; should we slow down outgoing string curtry: ds 1 ; current try at this one .cseg .macro table byte,addr dw addr db byte .endm pchat: pop hl ; needed for chaining pop hl jr ncchat ; don't clear vars when we chain .extern chat chat: call initch ; set up ncchat: ld a,1 ld (opentr),a ; clear number of open tries ld hl,scning dec (hl) call gofil ; get and open a file ld hl,scning inc (hl) jr nc,dochat ; open OK, go do it ld hl,cmdlin call byp ; look at first char on command line or a ; no line - give up right now ret z retryo: ld hl,(chtusr) inc h ; turn to a fcb type drive ld (auxfcb),hl ; replace drive / user in fcb jr tryaux ; try it again .extern ichat ; enter here with command tail at 80: this ichat: ; is used to handle files given to qterm when ; initially invoked call initch ld hl,buffer + 1 call scnfcb ; go parse an fcb call byp ld (ppp),hl ; save base of parameter strings call xferax ; stuff it in auxfcb tryaux: ld a,(opentr) neg ld (scning),a call opnaux ; and open it ld hl,scning ld (hl),0 ; reset scanning flag inc hl ; how many tries dec (hl) ; second time - must be the .LBR failing jr nc,dochat ; opened OK, go use it ret nz ; give up if open failed inc hl call scnfcb ld hl,fcb ld de,auxfcb ; set pointers to fcbs ld b,34 ; 34 bytes to shift swplp: ld a,(de) ld c,a ld a,(hl) ld (de),a ld (hl),c ; swap bytes at hl and de inc hl inc de ; move pointers djnz swplp ; loop till done jr retryo ; and retry the open dochat: call nz,setlbr ; if .LBR file open, then set to read it jp c,fnferr ; file not found - complain & exit ld hl,(ppp) ld de,0x80 ; move the parameters to 0x80 ld b,d ld c,e ; also 0x80 bytes to move ldir ; shift them down call prepclv ; prepare the command line variables ld hl,script ld (ppp),hl ; save address where lines will go ld de,script + 1 ld bc,4096 + 1536 - 1 xor a ld (hl),a ldir ; clear out the script and work areas ld a,0x7f ld (b7flag),a ; flag to zap bit 7 loop: push bc ; save line number in bc call getlin ; get a line pop bc jr c,cnvrt ; eof - now convert labels and parameters ld hl,auxlin ld a,(hl) or a jr z,loop ; ditch blank lines inc hl cp '!' ; first char a '!' jr nz,nobang ; no - so process normally ld e,(hl) call incbyp ld a,e cp ';' ; comment?? jr z,loop ; yes - throw it away _RIGHT_NOW_ cp ':' ; label?? push af call z,label ; yes - save it away pop af ld hl,auxlin + 1 cp '$' ; parameter default? jr nz,nodolr ld a,0x81 ; illegal value - not normally seen ld (hl),a ; set so we don't change nodolr: cp '@' jr nz,nobang ld a,0x82 ; ditto ld (hl),a nobang: ld de,auxlin ; where the line is ld hl,(ppp) ; where we want it to go xferlp: ld a,(de) ld (hl),a ; move a byte inc hl inc de ; bong the pointers or a jr nz,xferlp ; loop till whole line is moved ld (ppp),hl inc c ld de,work - 4 sbc hl,de ; did we overflow? jr c,loop ; no - back for more toobig: call ilprt db 'Script is too large (4K maximum)\r\n\0' ret ; come here when script has been read, labels noted and parameters set cnvrt: xor a ld hl,(ppp) ld (hl),a ; add an empty line to terminate dec a ld (lbrcnt),a ; disable library count jr doscr perr: call ilprt ; print an error msg db 'Bad line in file\r\n\0' call dim ; set dim mode ld hl,auxlin ; point hl at string erplp: ld a,(hl) ; get a character or a jr z,doneer ; exit if done push hl ld c,a call scrout ; send it pop hl inc hl jr erplp doneer: call crlf ; print a newline jp main ; and exit to terminal mode doscr: ld a,0xff ld (b7flag),a ; clear bit 7 zap flag ld (cvtp),a ld a,1 ; initially state 1 scrlp: or a jr nz,moresc push bc finisp: pop bc finis: call ilprt ; state zero means we're done db '\r\nDone\r\n\0' jp main ; straight to main to avoid a second redraw moresc: ld c,a ; save state in c for command recovery dec a ld b,a ld hl,script ; point at script jr z,rps ; if line 1, we're all set srlp: ld a,(hl) inc hl or a jr nz,srlp ; loop till we hit a null djnz srlp rps: ld (redptr),hl ; set up read pointer push bc ; save line number in c call getwl jr c,finisp ; all out of script, exit call parse ; chop it up jr c,perr ; drop on an error pop bc ; line number back to c xor a ld (curtry),a ; zero out current try retry: ld ix,area ld a,(sndlen) ld b,a or (ix + _explen) ; if both strings are empty jr z,finis ; we fell off end of script: return jp m,commnd ; explen == -1 => command type line: go do it push ix pop hl ; address to hl == address of send string ld a,b or a ; zero length? call nz,sendcs ld a,(ix + _explen) ; get expect length or a jr z,expok ; not expecting anything, match by default. call clerw2 ; clear the work buffer for incoming chars ld a,(mode) and lf_bit jr nz,scanex push ix call pexstr db '\r\nLooking for: \0' pop ix scanex: ld c,(ix + _time) ; get time to c second: ld de,600 call setspd ; set the speed qrtrms: ld b,96 ; hang loose a while qmslp: djnz qmslp push hl push bc call procch ; ok, see what characters are waiting jr c,nochar ; nothing waiting - bypass all this mess call stufw2 ; and save in the other buffer ld hl,work2 + 257 + 64 + 1 ld c,(ix + _explen) or a sbc hl,bc ; get that point in buffer ld de,expect ; expect string address to de chekxp: ld a,(de) cp (hl) ; did we match a byte? jr nz,nochar ; no - skip and try again ldi ; move pointers, adjust and test bc jp pe,chekxp ; not done: check some more gotit: pop bc ; got a match! pop de ; clean up stack first expok: ld a,(yes) ; get success state transition push af ld a,(explen) ; see if we actually had anything to match or a jr z,pjs ; nope, so skip all of this ld a,(mode) and mat_bit jr nz,pjs ; don't print if match disabled call pexstr db '\r\nMatch: \0' ; tell that we matched pjs: pop af ; restore success state jp scrlp nochar: pop bc pop hl dec hl ; count down second timer ld a,h or l jp nz,qrtrms dec c ; second timeout done? jp nz,second ; loop back if not ld a,(mode) and mat_bit jr nz,nopf ; don't print if match disabled push ix call ilprt db '\r\nFail\0' ; failed pop ix nopf: inc (ix + _curtry) ; bump try count ld a,(curtry) cp (ix + _tries) ; did we exceed allowed tries? jr nc,failed ; yes - complete fail - do state transition ld a,(mode) and mat_bit jr nz,jrt ; don't print if match disabled push ix call ilprt db ', retry\r\n\0' pop ix jrt: jp retry failed: ld a,(no) ; get fail state transition push af call crlf ; throw a new line jr pjs .extern canscr canscr: call ilprt ; quit if so db '\r\nCancelled\r\n\0' jp main ; long jump to main since we don't know what ; state the stack is in commnd: ld a,c ; restore line number from c ld (prmpfl),a ; use non-zero value to set prompt flag push af ; save line number ld hl,cmdret push hl ; push a return address to get back here ld a,(time) ; get the command letter call ucsa ; force upper case ld hl,chttbl .dseg chttbl: table '.',break table 0x2c,hangup ; we'd like to say ',',hangup but ZSM barfs table 0x82,eval ; was @, but converted during readin to avoid ; getwl substitute problems table 0x81,setstr ; was $, changed for the same reason. table '#',test table '%',stest table '&',mattog table '<',sinput table '>',messag table '~',cf table '[',multi table '(',fileio table 'B',baud table 'C',catch table 'E',echo table 'H',hdxtog table 'J',jctog table 'K',ldfnk table 'L',lftog table 'M',msbtog table 'N',newdsk table 'O',optog table 'P',print table 'Q',quit table 'R',recv table 'S',send table 'U',0x0276 table 'V',vttog table 'W',witog table 'X',pchat table 'Y',hold table 'Z',cclose endctb: .cseg ld b,{endctb - chttbl} / 3 tbllp: ld e,(hl) inc hl ld d,(hl) ; get next table entry to de inc hl cp (hl) ; check byte in a vs. table letter inc hl push de ; push entry point ret z ; if we matched this takes us to the code pop de ; restore stack djnz tbllp ; loop till we run out of table pop hl ; clean up stack cmdret: xor a ld (prmpfl),a ; clear prompt flag pop af ; get line number back inc a ; bump by one: commands always succeed jp scrlp ; loop back for more .extern sendcs sendcs: inc b ; clear the zero flag, and account for an ; extra djnz push bc push hl ; stack these for later popping jr sendi ; and jump to where we delay a bit sendcl: push bc ld a,(hl) ; get next character inc hl ; bump push hl ; and save pointer cp 0xff ; was it a -1? jr nz,nosbrk ; no - check for -2 call break ; send a break jr chrsnt nosbrk: cp 0xfe ; check for -2 jr nz,mdmchr ; no - send char normally ld de,1200 ; set for a 1 second delay call msip ; 1000 1/1000th of a second == 1 second jr chrsnt ; and check for incoming chars mdmchr: push af call modop ; send the character pop af ; restore back to a chrsnt: call lstmod ; keep tabs on incoming chars call lstmod ld a,(slow) or a ; do we need to slow it down sendi: call nz,tenth ; wait a while if so pop hl pop bc djnz sendcl ; and keep on sending ret parse: ld hl,area ; point de at this record push hl ld de,area + 1 ld bc,_curtry ld (hl),b ldir ; nuke parse area pop de ; restore input pointer to de ld hl,auxlin ld a,(hl) cp '!' ; bang? jr nz,nopb ; nope - parse as usual inc hl ld a,(hl) ; get command letter inc hl ld bc,_explen ; move enough stuff to fill to explen ldir ex de,hl ld (hl),b ; null terminate just in case inc hl ld (hl),-1 ; set -1 in sndlen as a flag inc hl ld (hl),a ; and save the letter ret nopb: ld hl,slow ld (hl),b ld a,(auxlin) ; get delimiter cp 'z' + 1 ; greater than 'z'? jr c,noslow ; skip if not ld (hl),a ; else set slow flag noslow: ld hl,auxlin ; point hl at incoming line call scanst ; scan send string ret c ld (sndlen),a ; save length call scanst ; scan expect string ld (explen),a ret c ; exit if error xor a call rednum ; parse time ret c or a jr nz,gottim ld a,15 ; if no time or zero, default to 15 gottim: ld de,time ld (de),a ; save the time inc de xor a call rednum ; scan tries ret c or a jr nz,gottry inc a ; if none or zero set to 1 gottry: ld (de),a inc de pop bc ex (sp),hl ld a,l ; get cur line num to a ex (sp),hl push bc inc a ; add one to get default yes call rednum ; read success ret c ld (de),a inc de xor a call rednum ; and finally the fail value ret c ld (de),a inc a ret .extern scanst scanst: ld b,40 ; count max of 40 chars ld a,(hl) ; get the delimiter to a ld (de),a or a ret z ; return with z to show empty line ld c,a ; copy to c inc hl ; point to next char .extern scnstp scnstp: call parst ; chomp up the string ret c donest: ld a,40 sub b ; get length to a dec b inc b ; test b for zero jr z,bzero ; if b not zero setde: inc de ; bump de djnz setde ; till b runs out bzero: or a ; clear the carry ret .extern parst parst: xor a ld (de),a ; add a trailing null ld a,(hl) ; get next char cp c ; delimiter? ret z ; yes - all done on this string or a ccf ret z ; handle error inc hl cp '\\' ; backslash gets special treatment call z,backsl ; parse the backslash escape inc b dec b ; any space left? jr z,parst ; no - just get end of line dec b ld (de),a ; save the char away inc de jr parst .extern backsl backsl: ld a,(hl) ; get char after backslash inc hl or a ; end of string? scf ; flip carry to true ret z ; return on zero w/ error cp 'k' jr nz,nobrk ld a,0xff ret nobrk: cp 'd' jr nz,nodel ld a,0xfe ret nodel: cp 'f' jr nz,noff ld a,'\f' ret noff: cp 'b' jr nz,nobksp ld a,'\b' ret nobksp: cp 't' jr nz,notab ld a,'\t' ret notab: cp 'n' jr nz,nonl ld a,'\n' ret nonl: cp 'r' jr nz,nocr ld a,'\r' ret nocr: cp 'e' jr nz,noesc ld a,'\e' ret noesc: cp 'x' jr nz,nohex push bc ld bc,0x0200 gethex: ld a,(hl) sub '0' cp 10 jr c,hexok ; valid digit - use it sub 'A' - '0' cp 6 jr c,hexlok ; valid A-F sub 'a' - 'A' cp 6 jr c,hexlok ; valid a-f ld a,b add a,0xfe ; check if b was still 2 jr endoct hexlok: add a,10 ; letter values need 10 added hexok: inc hl ; bump pointer sla c sla c sla c sla c ; c *= 16 or c ; a += c ld c,a djnz gethex jr endoct nohex: sub '0' ; check for octal digit cp 8 jr c,octal ; got one - handle it add a,'0' ; restore character or a ; clear carry ret octal: push bc ld b,2 ; 2 more chars to get ld c,a ; save current value in c getoct: ld a,(hl) ; get another char sub '0' cp 8 ; convert and test jr nc,endoct ; no good - skip inc hl ; now we move the pointer sla c sla c sla c ; c *= 8 or c ; a += c (and clear the carry) ld c,a ; back to c djnz getoct ; loop till three chars done endoct: ld a,c ; char back from c pop bc ret rednum: ex af,af' ; save default value in a' ld a,(hl) or a ; get and test a delimiter jr z,usedef ; end of string - use default inc hl ld c,a ; save it away ld a,(hl) cp c ; check see if anything in field jr nz,isnum ; yes - go parse it usedef: ex af,af' ret isnum: ld b,0 scnnum: ld a,(hl) or a jr z,usedef ; end of string: exit cp c jr z,gotnum ; found delimiter: exit inc hl sub '0' cp 10 ; did we find a digit? ccf ; flip carry: set => error ret c ; so return push af ; save converted digit ld a,b add a,a add a,a add a,b add a,a ld b,a ; b *= 10 pop af add a,b ld b,a ; b += new digit jr scnnum gotnum: ld a,b ret ; label saves a label / line number pair in the symbol table label: push hl ; save input pointer ld hl,work + 1016 ; look in symbol table ld de,8 ; step 8 at a time findlb: add hl,de ; move to next ld a,(hl) or a ; end of table? jr nz,findlb ; no - look at next one pop de ; input pointer back to de ld b,7 ; 7 bytes of label scanit: ld a,(de) ; get an input byte or a jr z,elbl ; null cp ' ' jr z,elbl ; or space terminates it ld (hl),a inc de inc hl djnz scanit ; loop till 7 bytes moved jr addnum ; go add the line number elbl: ld (hl),0 inc hl ; zero fill djnz elbl addnum: ld (hl),c ; save the line number xor a inc hl ld (hl),a ; zero fill end of symtab ld (work + 1528),a ; prevent overflow ret ; flabel - find a label / line number pair in the symbol table flabel: ex de,hl ; label pointer to de ld hl,work + 1016 ; look in symbol table flblp: ld bc,8 ; step 8 at a time add hl,bc ; move to next ld a,(hl) or a ; end of table? jr z,exdert ; yes - undefined labels do odd things ld a,(de) cp (hl) ; check first char jr nz,flblp ; nope - try again push hl push de ; save pointers ld b,7 ; 7 bytes of label fscnit: ld a,(de) ; get an input byte or a jr z,nomtch ; end of input cp (hl) jr nz,nomtch ; no match, but it may be end of label inc de ; bump pointers endok: inc hl djnz fscnit ; all 7 bytes done: we got it ld a,(hl) ; get line number to a pop hl pop hl ; clean stack exdert: ex de,hl ; input pointer back to hl ret ; and home we go nomtch: ld a,(hl) or a jr z,endok ; aha - end of entry in symtab, fake it pop de pop hl ; no good, restore pointers jr flblp ; back to look at the next one ; fparam - find parameter from array at 0x80 whose number is in a .extern fparam fparam: ld hl,strngs ; point at strings fplp: or a ; finished? ret z ; return if so - hl points to string ld e,a ; save a byppl: ld a,(hl) ; step over non-null characters inc hl or a jr nz,byppl ld a,e ; get string number back dec a ; one more done jr fplp ; kilstr - kill string parameter hl points to .extern kilstr kilstr: ld a,(hl) or a ret z ; if it's already empty, we're done push hl ; save hl for later ld e,l ld d,h ksel: inc hl ; loop to find end of old string ld a,(hl) or a jr nz,ksel shftlp: ld a,(hl) ; by now hl points to end, de to string ldi ; move another byte inc a ; test for end of data jr nz,shftlp ; loop till all done ex de,hl xfill: ld (hl),0xff ; replace all the 0xffs inc hl ld a,(hl) cp 'A' ; we've got an 'A' at the end as a stopper jr nz,xfill pop hl ; restore pointer to string ret ; all done ; setstr - set a string variable setstr: call areabu ; point hl at command tail call pnum ret nc inc hl ; skip over letter push hl ; and save address of source push af ; save parm number call fparam ; get ... pop af cp 9 jr nc,repl ; 9 or above is letter string - force replace ld a,(hl) or a ; anything there yet? jr nz,pbcret ; yes - do nothing repl: call kilstr ; and kill current string ex (sp),hl ; save target, restore source call byp ; strip white space ex de,hl ; source to de pop hl ; dest back to hl xor a ; want this null terminated ; and fall into insstr to put it in place ; insstr - shift string addressed by de to string var at hl, use char in ; a (or null) to terminate string at de .extern insstr insstr: push bc ; save bc ld b,a ; term char to b ld c,0 ; count in c push de ; save source in de fslen: ld a,(de) or a ; null jr z,estr1 ; ends the string cp b ; term char? jr z,estr ; yup end of string as well inc c ; count inc de ; and move pointer jr fslen estr: xor a estr1: ld b,a ; set len to word in bc cp c jr z,pop2r push hl ; save target in hl push bc ; and length as well inc bc ld hl,strngs + 511 ; start from very top of string space cpdr ; look for 0 on end of last string pop bc jr nz,isok ; nz means we didn't find it which is OK pop hl ; get hl back pop2r: pop bc pop bc ; clean up stack, de points to end already ret ; exit right now isok: pop de ; target back to de inc hl push hl ; source of lddr on stack sbc hl,de ; hl contains count to move up push bc ; length back on stack ld b,h ld c,l ; count to move to bc pop hl ; length back to hl ex (sp),hl ; resave length, get lower move point push de ; target back on stack ld de,strngs + 511 inc bc ; why in the name of H*LL we have to inc this inc bc ; twice, I don't know. However, it works. lddr ; shift it all up to make the hole pop de ; target back pop bc ; length of string back pop hl ; source push de ; save target ldir ; move string into place ex de,hl ; updated source pointer back to de pop hl ; original hl back pbcret: pop bc ; restore bc ret pnum:; call ucsa sub '1' cp 9 ; is it valid ret c ; default param sub 'A' - '1' cp 26 ; valid letter? ret nc ; return if not add a,9 ; convert above parameters scf ; set carry to show it's OK ret ; prepclv - convert command line args to $1 through $9 prepclv: ld de,0x80 ; point at command line params ld b,0 ; set counter to zero pcvlp: push de ld a,b call fparam ; address this parameter call kilstr ; get rid of the old pop de ex de,hl call byp ; find text ex de,hl ld a,' ' call insstr ; drop the string in place inc b ld a,b cp 9 ; loop till nine are done jr nz,pcvlp ret ; get a line from wherever we're reading, stuff it in auxlin getwl: ld hl,(redptr) ; pick up read pointer ld a,(hl) or a ; first byte zero? scf ret z ; return carry to show end of input ld de,auxlin ; auxlin is where we'll put it gwlp: ld a,(hl) ; get a byte cp '$' jr z,gwstr ; substitute strings, cp '@' jr z,gwnum ; numbers cp '`' jr z,gwlbl ; and labels nullt: ld a,(hl) ldi ; otherwise just transfer or a ; and test the byte jr nz,gwlp ; loop if more ld (redptr),hl ; save updated read pointer ret gwstr: inc hl ; point at letter code for string wanted call ucsahl ; ld a,(hl) ; get it call pnum ; see if it's a valid string number jr nc,nullt ; if not just copy the character as is inc hl push hl ; save string we're reading from push de call fparam ; get the string pop de scp: ld a,(hl) or a jr z,phlgwl ldi jr scp phlgwl: pop hl jr gwlp gwnum: inc hl ; point at variable letter call ucsahl ; convert to upper case sub 'A' ; make it into an index cp 26 ; in range? jr nc,nullt ; nope - convert as a straight letter inc hl ; skip over the variable number push hl ; save source push de ; and target ld e,a ld d,0 ld hl,vars add hl,de ld a,(hl) ; fetch the value pop hl ; restore target to hl jr dumpa gwlbl: inc hl push de ; save target call flabel ; find the label inc a ex (sp),hl ; restore target, save source dumpa: ld (hl),'0' - 1 ; put in hundreds digit ld e,0 hundlp: inc (hl) sub 100 jr nc,hundlp add a,100 call cinc ld (hl),'0' - 1 tenlp: inc (hl) sub 10 jr nc,tenlp call cinc add a,'0' + 10 ld (hl),a inc hl ex de,hl ; target back to de pop hl ; source to hl jr gwlp ; and we're done ; cinc - inc hl only if (hl) != 0: used to format numbers cinc: dec e inc e ; test e jr nz,docinc ; already set, force a save ld c,a ; save a ld a,(hl) cp '0' ; pointing at a zero? ld a,c ; restore a ret z ; return if so, docinc: inc hl ; otherwise bump hl inc e ; and set e ret ; print expect string, but ignore control characters pexstr: call dim ; dim mode pop hl call prtslp ; print inline string push hl ; resave return address ld hl,expect ld bc,(explen - 1) ; get explen to b prtncc: ld a,(hl) ; get a character cp ' ' jr c,nopcc ; less than space, don't print cp 0x7f ; check >= delete push bc push hl ld c,a ; char to c for printout call c,scrout ; out it goes if legal pop hl pop bc nopcc: inc hl ; move pointer djnz prtncc ; loop till all done jp crlf .dseg .extern scning scning: db 0 .extern opentr opentr: db 0 ; should be useg, but need to bump hl for lbrs .extern lbrs lbrs: db '/QTERM.LBR\0' ; name of qterm script library .useg redptr: ds 2 .extern ppp ppp: ds 2 ; parameter pointer .extern chtusr chtusr: ds 1 ; extra drive / user to try for chat scripts .extern chtdrv chtdrv: ds 1 cvtp: ds 1 ; do we convert params and numbers in getwl