// UL.SR Underlining get "BRAVO1.DF" get "DISPLAY.DF" get "SELECT.DF" // Incoming procedures external [ enww ugt ult formatx movec finddl mult; formatcp; mapxdxr; errhlt; abs; mpDlDld ] // Incoming statics external [ vsel vcpatxr vxd vxdwidth vheightd macdl vxleftmarg; vxdud; macww; mpWwWwd; ] // Outgoing procedures external [ underline; updateunderline; drawunderline; drawcaret; elapsed; blink; clearcaret; ] // Outgoing statics external [ vulmode cnrgul rgmask; vselcaret; ] // Local procedures: // underline1 // drawunderline // clearunderline // Local statics static [ vulmode cnrgul rgmask; vselcaret; ] // Local manifest manifest [ masktab = #460; noneneeded = 0; bothneeded = 3; firstneeded = 1 lastneeded = 2; leftbiascaret = dxaleft; sizcaret= 7; rightbiascaret = sizcaret-1-leftbiascaret; ]; // U N D E R L I N E // SPE catalogue no. let underline(ulmode,sel) be [ vulmode = ulmode; if sel >> SEL.type eq snone then return; vsel = sel; enww(underline1,sel >> SEL.doc); ] // end underline // U N D E R L I N E 1 // SPE catalogue no. and underline1(ww) be [ let wwd = mpWwWwd ! ww let dlfrom,txdfirst,dlto,txdlast = nil,nil,nil,nil; if (wwd>>WWD.dlLast ls wwd>>WWD.dlFirst) % ugt(vsel >> SEL.cpfirst,(mpDlDld(wwd>>WWD.dlLast))>>DLD.cpLast) % ult(vsel >> SEL.cplast,wwd>>WWD.cpFDispl) then return; dlfrom = finddl(ww,vsel >> SEL.cpfirst); dlto = finddl(ww,vsel >> SEL.cplast); txdfirst = vsel >> SEL.xdfirst; txdlast = vsel >> SEL.xdlast; vxdud = wwd>>WWD.xdUd test dlfrom ls 0 ifso [ dlfrom = wwd>>WWD.dlFirst; txdfirst = (mpDlDld(dlfrom))>>DLD.xdFirst; if vsel >> SEL.type eq scaret then return; ]; ifnot [ if txdfirst ls 0 % ww ne vsel >> SEL.ww then [ formatcp(ww,dlfrom,vsel >> SEL.cpfirst); txdfirst = vxd; if ww eq vsel >> SEL.ww then vsel >> SEL.xdfirst = txdfirst; ] ] test dlto ls 0 ifso [ dlto = wwd>>WWD.dlLast; txdlast = (mpDlDld(dlto))>>DLD.xdLast; ]; ifnot [ if txdlast ls 0 % ww ne vsel >> SEL.ww then [ formatcp(ww,dlto,vsel >> SEL.cplast); txdlast = vxd+vxdwidth-1; if ww eq vsel >> SEL.ww then vsel >> SEL.xdlast = txdlast; ] ] if vsel >> SEL.type eq scaret then [ vsel >> SEL.cplast = vsel >> SEL.cpfirst-1 drawcaret(ww,dlfrom,txdfirst); return; ] test dlfrom eq dlto ifso trydrawunderline(ww,dlfrom,txdfirst,txdlast) ifnot [ trydrawunderline(ww,dlfrom,txdfirst,-1); for i = dlfrom+1 to dlto-1 do trydrawunderline(ww,i,-1,-1); trydrawunderline(ww,dlto,-1,txdlast); ]; ] // end underline1 // T R Y D R A W U N D E R L I N E and trydrawunderline(ww,dl,xdfirst,xdlast) be [ let dld = mpDlDld(dl) if xdfirst eq -1 then xdfirst = dld>>DLD.xdFirst if xdlast eq -1 then xdlast = dld>>DLD.xdLast if (xdlast ls xdfirst) % (dld>>DLD.xdLast ls 0) then return; let tul = dld>>DLD.ul test (xdfirst eq dld>>DLD.xdFirst) & (xdlast eq dld>>DLD.xdLast) ifso [ test vulmode eq uloff ifso if tul gr ulunknown & tul ls ulMaxNorm then [ dld>>DLD.ul = tul + ulMaxNorm cnrgul = cnrgul+1; return; ] ifnot if (tul - ulMaxNorm) eq vulmode then [ dld>>DLD.ul = vulmode; cnrgul = cnrgul-1; return; ]; if tul ge ulMaxNorm then cnrgul = cnrgul-1; dld>>DLD.ul = vulmode; ] ifnot [ if tul ge ulMaxNorm then clearunderline(dl); dld>>DLD.ul = ulunknown; ]; rgmask = selecton vulmode into [ case uloff: table [ 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0 ] case ulmode1: masktab // Hardware Mask case ulmode2: table [ #1;#3;#3;#3;#23;#63;#63;#63;#463;#1463;#1463; #1463;#11463;#31463;#31463;#31463 ] // Dotted line mask default: masktab // Hardware Mask as default ]; let xdhd = (mpWwWwd ! ww)>>WWD.xdUd - xaudleft; let xdfirstindl = dld>>DLD.xdFirst; let nwrds = dld>>DLD.nwrds; let xrfirst = mapxdxr(xdhd,xdfirstindl,xdfirst); if xrfirst ls dxaleft then xrfirst = dxaleft; let xrlast = mapxdxr(xdhd,xdfirstindl,xdlast); if xrlast gr (nwrds lshift 4) then xrlast = (nwrds lshift 4); drawunderline(xrfirst,xrlast,dld>>DLD.pbm,(dld>>DLD.dYdBm)-1,nwrds); ] // end trydrawunderline // D R A W U N D E R L I N E // and drawunderline(xrfirst,xrlast,pbm,height,nwrds,dyd; numargs na) be [ if xrlast ls xrfirst then return; if na ls 6 then dyd = 1 let maskGr = #10421 for tdyd = 0 to dyd-1 do [ let pwbase = pbm+mult(nwrds,height+tdyd); let pwfrom = pwbase+xrfirst << X.wordindex; let pwto = pwbase+xrlast << X.wordindex; let width,shift = nil,nil; let maskGrSh = maskGr lshift ((tdyd << odd) ? 2,0) test pwfrom eq pwto ifso [ width = xrlast-xrfirst; shift = 15-(xrlast << X.bitindex); let tmask = (rgmask ! width) lshift shift let tw = (rv pwfrom) & (not ((masktab ! width) lshift shift)) rv pwfrom = (na ls 6) ? tmask % tw,@pwfrom % (tmask & maskGrSh) ] ifnot [ width = 15-(xrfirst << X.bitindex); let tmask = (rgmask ! width) let tw = rv pwfrom & (not (masktab ! width)) rv pwfrom = (na ls 6) ? tmask % tw,@pwfrom % (tmask & maskGrSh) for i = pwfrom+1 to pwto-1 by 1 do rv i = (na ls 6) ? rgmask ! 15,@i % maskGrSh; // Full Underline; shift = 15-xrlast << X.bitindex; width = xrlast << X.bitindex; tmask = (rgmask ! width) lshift shift tw = rv pwto & (not ((masktab ! width) lshift shift)) rv pwto = (na ls 6) ? tmask % tw,@pwto % (tmask & maskGrSh); ]; ] ] // end drawunderline // U P D A T E U N D E R L I N E and updateunderline() be [ if cnrgul gr 0 then for ww = 0 to macww-1 do [ let wwd = mpWwWwd ! ww vxdud = wwd>>WWD.xdUd; for dl = wwd>>WWD.dlFirst to wwd>>WWD.dlLast do if (mpDlDld(dl))>>DLD.ul ge ulMaxNorm then clearunderline(dl); ] cnrgul = 0; ] // end clearunderline // C L E A R U N D E R L I N E and clearunderline(dl) be [ let dld = mpDlDld(dl); let width = dld>>DLD.nwrds; let pwbase = dld>>DLD.pbm+mult(width,(dld>>DLD.dYdBm)-1); movec(pwbase,pwbase+width-1,0); if dld>>DLD.ul ge ulMaxNorm then cnrgul = cnrgul-1; dld>>DLD.ul = uloff ] // D R A W C A R E T and drawcaret(ww,dl,xd) be [ let dld = mpDlDld(dl) let xdhd = (mpWwWwd ! ww)>>WWD.xdUd - xaudleft; let xdfirstindl = dld>>DLD.xdFirst; let nwrds = dld>>DLD.nwrds; let xr = mapxdxr(xdhd,xdfirstindl,xd); if (xr ls dxaleft) % (xr gr (nwrds lshift 4)) then return; let pwby = nwrds; let pwceil = dld>>DLD.pbm; let pwbase = pwceil + pwby*(dld>>DLD.dYdBm-1); let pwfrom = pwbase+(xr-leftbiascaret) << X.wordindex; let pwto = pwbase+(xr+rightbiascaret) << X.wordindex; let shiftfrom = 1 + ((xr+rightbiascaret) << X.bitindex); let shiftto = 15-((xr+rightbiascaret) << X.bitindex); let tmask = table [ #143; #66; #66; #34; #34; #10 ] ; for i = 0 to 5 do [ if pwfrom ne pwto then rv pwfrom = ((tmask ! i ) rshift shiftfrom) xor (rv pwfrom); rv pwto = ((tmask ! i) lshift shiftto) xor (rv pwto); pwfrom = pwfrom - pwby; pwto = pwto - pwby; ]; vselcaret >> SEL.dl = dl; vselcaret >> SEL.toggle = vselcaret >> SEL.newtoggle; ] // end drawcaret // E L A P S E D // and elapsed(millisecs, nstates, ptimer, ptoggle) = valof [ test @ptoggle eq 0 ifso [ @ptimer = @#430; @ptoggle = 1; ]; ifnot [ let t = millisecs/40; if abs(@#430 - @ptimer) ge t then [ @ptimer = @#430; let ttoggle = @ptoggle + 1 ; resultis (ttoggle gr nstates) ? 1,ttoggle; ]; ]; resultis 0 ; ] // end of elapsed // B L I N K // and blink(lvtoggle,lvtimer,condition) be [ [ vselcaret >> SEL.newtoggle = elapsed(((rv lvtoggle eq 1) ? 300,500),2,lvtimer,lvtoggle); if vselcaret >> SEL.newtoggle then underline(ulmode1,vselcaret); ] repeatwhile condition() ] // C L E A R C A R E T // and clearcaret(lvtoggle) be [ if rv lvtoggle eq careton then underline(ulmode1,vselcaret); ]