//CHATDISOPS - Bob Sproull - Display operations for Display Protocol. // Copyright Xerox Corporation 1979 //Routines to draw things on the screen. // modified: November 22, 1978 2:39 PM (E. Taft) get "Chat.d" get "ChatDis.d" //outgoing procedures external [ ClipAndDrawLine DrawLine ShowChar Backup ClipRegion ClipRegionBlt FixGray CaretControl ] //incoming procedures external [ BitBlt Zero SetBlock MoveBlock Block ] //incoming statics external [ ScreenBuffer YMax SS caretTime caretOn ] //File-wide definitions manifest MaskTab1 = #457 // location of system mask table manifest RTC=#430 //ClipAndDrawLine(r,x,y,x1,y1,width) let ClipAndDrawLine(r,x,y,x1,y1,width) be [ // ClipCode(r, p) = code for point (p!0,p!1) if width eq 0 then width=1 let widthOffset=(width ge 0 ? width, -width)-1 let ClipCode(r, wOff, p)= (p!0 ls r>>REG.Left ? 1,0)+ (p!0 gr (r>>REG.Right - wOff) ? 2,0)+ (p!1 ls r>>REG.Top ? 4,0)+ (p!1 gr (r>>REG.Bottom - wOff) ? 16,0) let p1=lv x let p2=lv x1 let c1=nil let c2=ClipCode(r, widthOffset, p2) [ c1=ClipCode(r, widthOffset, p1) if (c1&c2) ne 0 then return //Cannot be seen if c1+c2 eq 0 then break //Visible if c1 eq 0 then //Exchange so p1 off screen [ let t=c1; c1=c2; c2=t let t=p1; p1=p2; p2=t ] let val=r>>REG.Left; let w=0 test c1 ge 8 then // y gr bottom [ val=r>>REG.Bottom - widthOffset; w=1] or test c1 ge 4 then // y ls top [ val=r>>REG.Top; w=1] or if c1 ge 2 then // x gr right [ val=r>>REG.Right - widthOffset; w=0] // x ls left // Endpoints are (p1!0,p1!1) and (p2!0,p2!1); modify p1 so that // p1!w=val let nw=1-w //The "other" one let numerator1=val-p1!w let numerator2=p2!nw-p1!nw let denominator=p2!w-p1!w // Note that numerator1 and denominator have same sign let sign=0 if numerator1 ls 0 then [ numerator1=-numerator1 denominator=-denominator ] if numerator2 ls 0 then [ numerator2=-numerator2; sign=-1 ] // Now apply muldiv let amount=( table [ #55001; //sta 3,1,2 #155000; //mov 2,3 #111000; //mov 0 2 #21403; //lda 0 3 3 #101220; //movzr 0 0 #61020; //mul #31403; //lda 2 3 3 #61021; //div #101010; // mov# 0 0 #121000; //mov 1 0 #171000; //mov 3 2 #35001; //lda 3 1 2 #1401; //jmp 1,3 ] ) (numerator1,numerator2,denominator) p1!nw=p1!nw+(sign? -amount,amount) p1!w=val ] repeat DrawLine(x,y,x1,y1,ScreenBuffer,disWidth,width) ] //DrawLine(x,y,x1,y1,BitMap,WordWidth[,width]) // Draws a line on the screen, from (x,y) to (x1,y1) INCLUSIVE. // Bear in mind that y is measured from the top of the screen! // Width<0 means xor with memory and DrawLine(x,y,x1,y1,BitMap,WordWidth,width; numargs na) be [DL if na ls 7 then width = 1 let dx,dy=x1-x,y1-y let x0,y0 = x,y let yinc=nil // Arrange things to make dx always positive if dx ls 0 then [ dx, dy = -dx, -dy; x0, y0 = x1, y1 ] test dy ge 0 then [ yinc=WordWidth ] or [ dy=-dy; yinc=-WordWidth ] for w=1 to (width ge 0? width,-width) do [ let ybase = y0*WordWidth+BitMap let mapptr=(x0 rshift 4)+ybase let mask=(1+MaskTab1!((not x0))) test dx ge dy then //x is fastest mover. [ let cdl=(dx rshift 1) for i=0 to dx do [ //main loop test width ge 0 then @mapptr=@mapptr % mask or @mapptr=@mapptr xor mask cdl=cdl+dy if cdl gr dx then [ cdl=cdl-dx; mapptr=mapptr+yinc ] mask = mask rshift 1 if mask eq 0 then // crossed a word boundary [ mapptr = mapptr+1 mask = #100000 ] ] y0=y0+1 ] or //y is fastest mover. [ let cdl=(dy rshift 1) for i=0 to dy do [ test width ge 0 then @mapptr=@mapptr % mask or @mapptr=@mapptr xor mask cdl=cdl+dx if cdl gr dy then [ cdl=cdl-dy mask = mask rshift 1 if mask eq 0 then // word boundary [ mapptr = mapptr+1 mask = #100000 ] ] mapptr=mapptr+yinc ] x0=x0+1 ] ] ]DL //ShowChar(r, c) ... Display the character "c" in region "r" and ShowChar(r, c) be [SC if r eq SS>>DISV.CaretRegion then CaretControl(0) if c le #15 then [ c=SpecialChar(r, c) if c ls 0 then return ] let f=r>>REG.Font c=c-f>>STRIK.min if c ls 0 % c gr f>>STRIK.max then c=f>>STRIK.max+1 //Illegal char let xp=f>>STRIK.xPosTable let wid=xp!(c+1)-xp!c if wid eq 0 then //Illegal char if of zero width [ c=f>>STRIK.max+1 wid=xp!(c+1)-xp!c ] if r>>REG.Scroll eq -2 then AutoShove(r, wid) let cx=r>>REG.CurX let bold=0 [ r>>REG.SLX=xp!c r>>REG.DW=wid unless r>>REG.BBCValid then Validate(r) test r>>REG.Italic ifso ShowItalic(r, c) ifnot [ let lvSimple=lv r>>REG.SimpleClip test @lvSimple then [ test r>>REG.CurX ge r>>REG.Left & r>>REG.CurX+wid-1 le r>>REG.Right then BitBlt(r) or if ClipRegion(r, lvSimple) then BitBlt(r) ] or if ClipRegion(r, lvSimple) then BitBlt(r) ] if r>>REG.Bold eq 0 % bold ne 0 then break r>>REG.CurX=cx+1 r>>REG.DLX=cx+1 bold=1 ] repeat cx=cx+wid r>>REG.CurX=cx r>>REG.DLX=cx ]SC // Set up most of the BBC parameters for the region. and Validate(r) be [ let f=r>>REG.Font r>>REG.DTY=r>>REG.CurY-f>>STRIK.ascent+1 r>>REG.DLX=r>>REG.CurX r>>REG.DH=f>>STRIK.ascent+f>>STRIK.descent r>>REG.SBCA=lv f>>STRIK.bitmap r>>REG.SBMR=f>>STRIK.raster r>>REG.STY=0 r>>REG.Function=r>>REG.BBCOp r>>REG.BBCValid=true r>>REG.SimpleClip=false ] //SpecialChar(r, c) // Returns -1 if nothing to do, else char to display and SpecialChar(r, c) = valof [ if c eq #15 then [ r>>REG.CurX=r>>REG.CrX //Carriage return r>>REG.BBCValid=false resultis -1 ] if c eq #12 then [ r>>REG.CurY=r>>REG.CurY+r>>REG.LfY r>>REG.BBCValid=false if r>>REG.Scroll then AutoScroll(r) resultis -1 ] if c eq #11 & r>>REG.Tab ne 0 then [ let t=r>>REG.Tab r>>REG.CurX=((r>>REG.CurX-r>>REG.CrX)/t +1)*t+r>>REG.CrX r>>REG.BBCValid=false resultis -1 ] resultis c ] //ShowItalic(r, c) // BBC is all set up for the standard character. Instead, show // it italic... and ShowItalic(r, c) be [ let sav=vec size BBC/16 let h=r>>REG.DH r>>REG.DLX=r>>REG.DLX+h/4-1 [ r>>REG.DH=(h ls 4)? h,4 MoveBlock(sav, lv r>>BBC.Function, size BBC/16) ClipRegionBlt(r) if h le 4 then break //All done MoveBlock(lv r>>REG.Function, sav, size BBC/16) r>>REG.DLX=r>>REG.DLX-1 r>>REG.DTY=r>>REG.DTY+4 r>>REG.STY=r>>REG.STY+4 h=h-4 ] repeat r>>REG.BBCValid=false ] //ClipRegion(reg, lvSimple) // Clips the BBC destination to correspond to LIMITS of the region. // Also updates BBC source accordingly. // Returns true if there is something to show. // Sets @lvSimple if no part of the thing is off in Y and ClipRegion(reg, lvSimple; numargs n) = valof [ if n eq 1 then lvSimple= lv n @lvSimple=false let t=reg>>REG.DTY //Top of destination let b=t+reg>>REG.DH-1 if b gr reg>>REG.Bottom then [ let bottom=reg>>REG.Bottom if t gr bottom then resultis false reg>>REG.DH=reg>>REG.DH+bottom-b b=bottom reg>>REG.BBCValid=false ] if t ls reg>>REG.Top then [ let top=reg>>REG.Top if b ls top then resultis false let diff=t-top reg>>REG.DH=reg>>REG.DH+diff reg>>REG.STY=reg>>REG.STY-diff reg>>REG.DTY=top reg>>REG.BBCValid=false ] @lvSimple=true let l=reg>>REG.DLX let r=l+reg>>REG.DW-1 if r gr reg>>REG.Right then [ let right=reg>>REG.Right if l gr right then resultis false reg>>REG.DW=reg>>REG.DW+right-r r=right reg>>REG.BBCValid=false ] if l ls reg>>REG.Left then [ let left=reg>>REG.Left if r ls left then resultis false let diff=l-left reg>>REG.DW=reg>>REG.DW+diff reg>>REG.SLX=reg>>REG.SLX-diff reg>>REG.DLX=left reg>>REG.BBCValid=false ] resultis true ] // ClipRegionBlt(r) -- if clip succeeds, blt. and ClipRegionBlt(r) be if ClipRegion(r) then BitBlt(r) //AutoScroll(r) -- scrolls a region that has just witnessed a LF. and AutoScroll(r) be [ let f=r>>REG.Font let dy=r>>REG.LfY //yDiv is the top scan line of the bottom region: let yDiv=r>>REG.CurY-dy+f>>STRIK.descent+1 if yDiv le r>>REG.Top then return //Nothing to do.... SetHuge(r) r>>REG.Function=BBCReplace+BBSBitMap test r>>REG.Bottom+1-yDiv ge dy then //Enuf room for a line? [ //Move bottom part down by dy r>>REG.DTY=yDiv+dy r>>REG.DH=YMax+1 //Make clip do the work r>>REG.STY=yDiv ClipRegionBlt(r) Clear(r, yDiv, dy) ] or [ //Move whole region up by dy let top=r>>REG.Top r>>REG.DTY=top r>>REG.DH=yDiv-top-dy r>>REG.STY=top+dy ClipRegionBlt(r) Clear(r, yDiv-dy, dy) r>>REG.CurY=r>>REG.CurY-dy ] r>>REG.BBCValid=false // This operation is potentially very time-consuming, so give // other guys a chance (Pup code especially) Block() ] // Move current line of region to the right by amount x and AutoShove(r, x) be [ MoveTextLine(r, r>>REG.CurX+x, r>>REG.CurX, x) ] // Backup -- move current line of region to left by amount x and Backup(r, dist) be [ let oldx=r>>REG.CurX let newx=oldx-dist let left=r>>REG.Right+1-dist if newx gr left then left=newx MoveTextLine(r, newx, left, dist) r>>REG.CurX=newx ] // MoveTextLine(r, newx, fillx, filldx) // Moves (CurX to right limit) to destination newx // Then fills in (fillx to fillx+filldx-1) with background and MoveTextLine(r, newx, fillx, filldx) be [ // First, move existing part of line Validate(r) // Set up DTY, DH, DLX. MoveBlock(lv r>>REG.SBCA, lv r>>REG.DBCA, 4) r>>REG.DLX=newx r>>REG.DW=XMax+1 r>>REG.Function=BBCReplace+BBSBitMap ClipRegionBlt(r) // Now, fill in opened up region with background r>>REG.DLX=fillx r>>REG.DW=filldx FixGray(r) r>>REG.Function=BBCReplace+BBSGray ClipRegionBlt(r) r>>REG.BBCValid=false ] //Clear(region, top, height) and Clear(r, top, height) be [ SetHuge(r) r>>REG.Function=BBCReplace+BBSGray r>>REG.DTY=top r>>REG.DH=height FixGray(r) ClipRegionBlt(r) ] and SetHuge(r) be [ r>>REG.DLX=0 r>>REG.DW=XMax+1 r>>REG.SLX=0 r>>REG.SBCA=ScreenBuffer r>>REG.SBMR=disWidth ] and FixGray(r, gray; numargs na) be [ if na eq 1 then gray=r>>REG.ClearColor let gp=lv r>>REG.Gray test gray eq 0 then Zero(gp, 4) or test gray eq -1 then SetBlock(gp, -1, 4) or [ let tg=vec 3 //Temporary for i=0 to 3 do [ let nib=gray nib=nib+(nib*16) nib=nib+nib*256 tg!(3-i)=nib gray=gray rshift 4 ] let q=r>>REG.DTY+1 if r>>REG.DTY ls r>>REG.STY then [ let t=tg!1; tg!1=tg!3; tg!3=t q=-1-q-r>>REG.DH ] for i=0 to 3 do gp!i=tg!((i+q)&3) ] ] // Caret control // w=1 to turn it on, 0 to turn it off and CaretControl(w) be [ if w eq caretOn then return caretOn=w let r=SS>>DISV.CaretRegion caretTime=@RTC+SS>>DISV.CaretRate if r eq 0 then caretTime=0 compileif size BBC/16 ne 16 then [ foo=nil ] let savedB=((table [ 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0 ] )+1)&(-2) // Turning the caret on: test caretOn then [ r>>REG.Function=BBCInvert r>>REG.DLX=r>>REG.CurX-SS>>DISV.CaretDX r>>REG.DTY=r>>REG.CurY-(15-SS>>DISV.CaretDY) r>>REG.DW=16 r>>REG.DH=16 r>>REG.SBCA=(lv SS>>DISV.CaretPattern) r>>REG.SBMR=1 r>>REG.SLX=0 r>>REG.STY=0 test ClipRegion(r) then [ MoveBlock(savedB, r, size BBC/16) BitBlt(r) ] or caretOn=0 r>>REG.BBCValid=false ] or BitBlt(savedB) ]