// ktyping.sr User typein // Last modified November 15, 1979 2:28 PM get "BRAVO1.DF" get "CHAR.DF" get "MSG.DF" get "NEWMSG.DF" get "DISPLAY.DF" get "VM.DF" // Incoming procedures external [ mapcp; move; visible; cpvisible; endofkeystream; updatedisplay; finddl; ult; backdylines; ugt; mpDlDld; clearcaret; setsel; blink; nocharwaiting; bravochar; decrmacfrscr; PutSbScr; insertd; setpcsiz; updateparabits; invalidatedisplay; // setmag; // getfontc; replacea; cpfc; DoUfop; MufopFromFop; MufopConcat; FopFromMufop; invalidateband; DoFop; getvch; umax; counttrans; puts; estscrrun; errhlta getbin; putvch; fSwt; endinsertk; formatcp; RoundRatio; XtbFromTc; blinkscreen CbpDirty flushvm ] // Incoming statics external [ mpWwWwd; deltacp; vdlhint; vcpput; cpscrt; vmapstatus; vlook1; vlook2; parsacred; vlb; vpw; vrgcc1; rgmaccp; vselcaret; vww; vcp; vofsetstd; vldlnstd; vldhdrstd; mpIffFfp; vcuripar; ppcd; vdoc; vfcfirst; mpfnof; vmacfr; mpfrfc; rgbs; vbp; rgmpbifc; vxd; dcpendofdoc mpfunfd look1std look2std ] // Outgoing procedures external [ InsertK; ] // Outgoing statics external [ cblind tsread tscorrect vchterm; tsquick; putbacks; cfr; cpc; ] // Local statics static [ cblind tsread tscorrect vchterm; tsquick; putbacks; cpc; cfr; ] // Local manifests manifest [ snone = 0; ] // I N S E R T K // catalogue no. = 109 let InsertK(ww, cp, look1, look2, par, ttbl, chPutbacks, FCalcNumTerm; numargs carg) = valof [ let wwd = mpWwWwd ! ww let doc = wwd>>WWD.doc; putbacks = chPutbacks ne -1 ? true, false; deltacp = 0; vdlhint = 0; vcpput = cpscrt; let parCurrent = vec parovhd; move(par, parCurrent, parovhd); // par properties at pt of insertion let ttblCurrent = vec lnttblMax; move(ttbl, ttblCurrent, lnttblMax); // ttbl properties at pt of insertion let mufopPar = vec 100 let cwMax = 100 mufopPar>>MUFOP.cw = 1 let pcinsertk = nil; let tdy = nil; // let tcp = nil; let vpa = nil; vpa<<VPA.fn = fnscrfs; let bitrailer, biinsert, tfrtrailer, tfrinsert = nil, nil, -1, nil; let sbtrler = "*032*c" // i.e "<ctrlz><cr>" unless visible(ww, cp) do cpvisible(ww, cp) let fboundary = true; let cp1 = nil let ch1 = vlb ? vpw>>lh, vpw>>rh; let fInWordNext = (vrgcc1 ! ch1)<<CC.wrd; let fInWordLast = false // look1 = look1 & not (trailerbits % casebits) look1 = look1 & not trailerbits if cp eq rgmaccp ! doc-dcpendofdoc then look1 = look1 & not visiblebit let pcneeded = true; let lvtoggle = lv (vselcaret>>SEL.toggle); let inword, inwordlast = nil, nil; let tcpmin = cp; cblind = 0; let bifrtrailer,bifrinsert = nil,nil; let look1Next = nil let look2Next = nil // let fboundaryNext = false let ch = nil; [ if CbpDirty() gr 4 then flushvm(); if (not tsread & endofkeystream()) % (tsread & (not tsquick % tscorrect)) do [ updatedisplay(); if vww ne ww then vdlhint = finddl(ww, cp+deltacp); test ult(cp+deltacp, wwd>>WWD.cpFDispl) ifso [ tdy = 10; vcp = wwd>>WWD.cpFDispl; [ tdy = tdy-backdylines(ww, vcp, tdy); ] repeatuntil (vcp eq 0) % (tdy le 0) wwd>>WWD.cpFDispl = vcp; wwd>>WWD.fUpdate = true; loop; ] ifnot if ugt(cp+deltacp, (mpDlDld(wwd>>WWD.dlLast))>>DLD.cpLast) then [ let dld = mpDlDld(wwd>>WWD.dlFirst) wwd>>WWD.cpFDispl = dld>>DLD.cpLast+1; wwd>>WWD.fUpdate = true; loop; ] clearcaret(lvtoggle); setsel(vselcaret, cp+deltacp, cp+deltacp); let timer = nil; blink(lvtoggle, lv timer, nocharwaiting); ] ch = valof [ if putbacks then [ putbacks = false; resultis chPutbacks; ] resultis bravochar(); ] if carg eq 8 then if FCalcNumTerm(ch, deltacp) then [ unless tfrtrailer eq -1 then decrmacfrscr(1); break; ] // if ch eq chtab then // [ // let tc = tcPlain // unless parCurrent>>PAR.fOldtab do // [ // formatcp(ww, finddl(ww, cp+deltacp), cp+deltacp) // let tmag = (wwd>>WWD.fSmall ? 100, 140); // let x = RoundRatio(vxd, 3200, tmag) // let x = vxd lshift 5 // XtbFromTc(x, tcPlain, ttblCurrent, lv tc) // ] // DoFop(iffTc lshift 8 + tc, lv look1, lv look2, 0, 0); // fboundary = true; // ] invalidatedisplay(doc, cp+deltacp, vdlhint); if (ch ge #200) then [ if ch eq ctrlcr then [ vmapstatus = statusblind; mapcp(doc, cp+deltacp, parneeded); unless tfrtrailer eq -1 then decrmacfrscr(1); let bifr = PutSbScr(sbtrler, look1 % trailerbits, look2, parCurrent, ttblCurrent); tcpmin = cp+deltacp; test deltacp eq 2 ifnot [ setpcsiz(doc, pcinsertk, deltacp) for pc = pcinsertk-1 to pcinsertk+1 do updateparabits(doc, pc); ] ifso [ pcinsertk = insertd(doc, cp, 2, fnscr, cpscrt, bifr) pcneeded = false; ] invalidatedisplay(doc, cp+deltacp, vdlhint); tfrtrailer = -1; fboundary = true; cblind = 0; // look1 = look1std; // look2 = look2std; loop; ] let pfop = vec lnufopMax [ rv pfop = selecton ch into [ // case ctrlbs: iffOvstrike lshift 8 + 1 case ctrlul: iffUl lshift 8 + 1 case ctrlshul: iffUl lshift 8 + 0 case ctrlb: iffBold lshift 8 + 1 case ctrlb-#40: iffBold lshift 8 + 0 case ctrli: iffItalic lshift 8 + 1 case ctrli-#40: iffItalic lshift 8 + 0 // case chitbMin+0: // case chitbMin+1: // case chitbMin+2: // case chitbMin+3: // case chitbMin+4: // case chitbMin+5: // case chitbMin+6: // case chitbMin+7: // case chitbMin+8: // case chitbMin+9: // case chitbMin+10: // case chitbMin+11: // case chitbMin+12: // case chitbMin+13: // case chitbMin+14: valof [ // if parCurrent>>PAR.fOldtab then // resultis fopNil // resultis iffTc lshift 8 + (ch - chitbMin) + 1 // ] case #200+$0: case #200+$1: case #200+$2: case #200+$3: case #200+$4: case #200+$5: case #200+$6: case #200+$7: case #200+$8: case #200+$9: valof [ let ffv = ch-(#200+$0) if mpfunfd ! ffv eq 0 then resultis fopNil // setmag(ww) // getfontc(ffv) resultis iffFun lshift 8 + ffv ] case ctrlupar: valof [ pfop ! 1 = vofsetstd resultis iffSuper lshift 8 ] case ctrldownar: valof [ pfop ! 1 = vofsetstd resultis iffProcSub lshift 8 ] case ctrln: iffProcUp lshift 8 + ufopFIncrement + 0 case ctrln-#40: iffProcDown lshift 8 + ufopFIncrement + 0 // case ctrlx: valof [ // pfop ! 1 = vldlnstd // resultis iffLdln lshift 8 // ] // case ctrlshx: valof [ // pfop ! 1 = 0 // resultis iffLdln lshift 8 // ] case ctrlo: case ctrlo-#40: valof [ pfop ! 1 = (ch eq ctrlo ? vldhdrstd, -vldhdrstd) resultis iffLdhdr lshift 8 + ufopFIncrement ] case ctrlq: case ctrlq-#40: valof [ pfop ! 1 = (ch eq ctrlq ? vldhdrstd, -vldhdrstd) / 2 resultis iffLdhdr lshift 8 + ufopFIncrement ] case ctrlj: iffRjCenter lshift 8 + 2 case ctrlj-#40: iffRj lshift 8 + 0 case ctrlc: iffRjCenter lshift 8 + 1 case ctrlc-#40: iffCenter lshift 8 + 0 default: valof [ // if ch ge #200+$A & ch le #200+$Z then // [ // ch = ch+#40; // loop // ] resultis fopNil ] ]; break ] repeat if rv pfop ne fopNil then [ let ffp = mpIffFfp ! (pfop>>UFOP.iff) test ffp<<FFP.fParop ifso [ vmapstatus = statusblind; mapcp(doc, cp+deltacp, parneeded); let tcp = vcuripar>>IPAR.cplast + 1 unless tcp eq rgmaccp ! doc do [ replacea(doc, tcp, 0, 0, 0, 0); if (deltacp eq 0) & (cp ne 0) then replacea(doc, cp, 0, 0, 0, 0); cpfc(doc, vcuripar>>IPAR.cplast); DoUfop(pfop, 0, 0, parCurrent, ttblCurrent); MufopFromFop(ppcd>>PCD.fop, mufopPar, cwMax) MufopConcat(mufopPar, pfop, cwMax, false) ppcd>>PCD.fop = FopFromMufop(mufopPar) invalidateband(doc, vcuripar>>IPAR.cpfirst, vcuripar>>IPAR.cplast); vcuripar>>IPAR.doc = -1; loop; ] ] ifnot [ DoUfop(pfop, lv look1, lv look2, 0, 0); fboundary = true; // unless ch eq ctrlbs % // (ch ge chitbMin & ch ls chitbMin+itbMax) do loop; ] ] ] if ch eq chtopblk then [ DoFop(iffProcClr lshift 8, lv look1, lv look2, 0, 0); fboundary = true; loop; ] switchon ch into [ // case chitbMin+0: // case chitbMin+1: // case chitbMin+2: // case chitbMin+3: // case chitbMin+4: // case chitbMin+5: // case chitbMin+6: // case chitbMin+7: // case chitbMin+8: // case chitbMin+9: // case chitbMin+10: // case chitbMin+11: // case chitbMin+12: // case chitbMin+13: // case chitbMin+14: // if parCurrent>>PAR.fOldtab then endcase // case ctrlbs: case ctrla: case shbs: case bs: cp1 = cp+deltacp-1; if cp1 eq -1 then cp1 = 0; goto backcommon; case ctrlw: cp1 = cp+deltacp-1; test cp1 eq -1 ifso cp1 = 0 ifnot [ inword = (vrgcc1 ! ch1)<<CC.wrd; vdoc = doc; [ if cp1 eq 0 then break; vmapstatus = statusblind; vcp = cp1-1; ch1 = getvch(); inwordlast = (vrgcc1 ! ch1)<<CC.wrd; if inword & (inword ne inwordlast) then break; inword = inwordlast; cp1 = cp1-1; ] repeat ] goto backcommon; // case ctrlq: // if tsread then // cpvisible(ww, cp+deltacp); // vdlhint = finddl(ww, cp+deltacp); // test cp+deltacp eq rgcpfirst ! vdlhint ifso // test vdlhint eq wwd>>WWD.dlFirst ifso // test cp+deltacp eq 0 ifso // cp1 = 0 // ifnot [ // backdylines(ww, cp+deltacp-1, 0) // cp1 = vcp; // ] // ifnot cp1 = rgcpfirst ! (vdlhint-1) // ifnot cp1 = rgcpfirst ! vdlhint // goto backcommon; backcommon: cp1 = umax(cp1, tcpmin); unless (cp+deltacp+cblind eq cp1) % (deltacp eq 0) then [ invalidatedisplay(doc, cp1, vdlhint) counttrans(doc,cp1,cp+deltacp+cblind-1) decrmacfrscr(cfr+cpc, vfcfirst); test cp1 eq cp ifso replacea(doc, cp, deltacp+cblind, 0, 0, 0) ifnot setpcsiz(doc, pcinsertk, cp1-cp); fboundary = true; cblind = 0; tfrtrailer = -1; pcneeded = (cp eq cp1); deltacp = cp1-cp; ] // if ch eq ctrlbs then // [ // ch = ch1 // look1Next = look1 // look2Next = look2 // DoFop(iffOvstrike lshift 8 + 0, lv look1Next, lv look2Next, 0, 0) // fboundaryNext = true // goto putch // ] // if ch ge chitbMin & ch ls chitbMin+itbMax then // [ // ch = chtab // goto putch // ] endcase; case chdel: case chesc: unless tfrtrailer eq -1 then decrmacfrscr(1); break; case ctrls: if deltacp eq 0 then endcase; (mpfnof ! fnscr)>>OF.pos = cpscrt+deltacp-1; puts(fnscr, ch1 & #37); invalidatedisplay(doc, cp+deltacp-1, vdlhint); endcase; // case ctrlv: // endcase; // unless backscan(doc, cp+deltacp, 1, $#) & (cp+deltacp-vcp ls 5) do // loop; // tcp = vcp; // invalidatedisplay(doc, vcp, vdlhint); // vcp = tcp+1; // ch = getint(doc, 8) & #377; // deltacp = deltacp-(vcp-tcp); // cblind = 1; // vcpput = cpscrt+deltacp; // goto putch; putch: default: if ch ge #200 then [ blinkscreen() endcase; ] test fboundary ifso [ unless tfrtrailer eq -1 then decrmacfrscr(1); bifrinsert = estscrrun(1, look1, look2); biinsert = bifrinsert<<BIFR.bi tfrinsert = vmacfr; unless mpfrfc ! tfrinsert eq cpscrt+deltacp+1 then errhlta(194); bifrtrailer = estscrrun(maxcblind-1, look1 % vanbit, look2); bitrailer = bifrtrailer<<BIFR.bi tfrtrailer = vmacfr; test pcneeded ifso [ invalidatedisplay(doc, cp+deltacp, -1); pcinsertk = insertd(doc, cp+deltacp, maxcblind, fnscr, cpscrt+deltacp, bifrinsert); pcneeded = false; ] ifnot setpcsiz(doc, pcinsertk, deltacp+maxcblind); cblind = maxcblind; fboundary = false; ] ifnot [ let pfb = nil; if cblind eq 1 then [ pfb = getbin(fnscr, bitrailer); mpfrfc = pfb+pfb>>FB.mpfrfc; mpfrfc ! tfrtrailer = mpfrfc ! tfrtrailer+maxcblind; setpcsiz(doc, pcinsertk, deltacp+1+maxcblind); cblind = maxcblind+1; ] pfb = getbin(fnscr, biinsert); mpfrfc = pfb+pfb>>FB.mpfrfc; let tfc = mpfrfc ! tfrinsert+1; mpfrfc ! tfrinsert = tfc; (rgbs ! vbp)<<BS.dirty = true if bitrailer ne biinsert then [ unless (bitrailer eq (biinsert+1)) & (tfrtrailer eq 1) then errhlta(195); (rgmpbifc ! fnscr) ! bitrailer = tfc; pfb = getbin(fnscr, bitrailer); mpfrfc = pfb+pfb>>FB.mpfrfc; mpfrfc ! 0 = tfc; ] ] putvch(ch); if fSwt(fInWordLast, (vrgcc1+ch)>>CC.wrd, fInWordNext) % (ch eq chcr) then invalidatedisplay(doc, cp+deltacp, vdlhint) ch1 = ch; cblind = cblind-1; deltacp = deltacp+1; fInWordLast = (vrgcc1+ch)>>CC.wrd // if fboundaryNext then // [ // look1 = look1Next // look2 = look2Next // fboundary = true // fboundaryNext = false // ] endcase; ] ] repeat clearcaret(lvtoggle); vselcaret>>SEL.type = snone; endinsertk(doc, cp, pcinsertk) vchterm = ch; invalidatedisplay(doc, cp+deltacp-1, vdlhint); updatedisplay(); resultis deltacp; ]