// F E D I T U T I L (PREPRESS)
// catalog number ???
//
//
get "ix.dfs"
get "fedit.dfs"
// outgoing procedures
external
[
GetButtonPress
GetCharCoord
PaintRectangle
ConvertString
PaintString
MakeSamples
FetchSample
]
// outgoing statics
//external
// [
// ]
//static
// [
// ]
// incoming procedures
external
[
PaintWidthMarker
WriteCharBit
//FEDITFILE
EditFindChar
WindowRead
WindowReadBlock
FLDI
FAD
FTR
FDV
TypeForm
]
// incoming statics
external
[
ViewForeground
ViewBackground
DisAdr
bits
SampleXof
SampleYof
WidthMarker
EFactorX
EFactorY
sysFont
]
// internal statics
static
[
SampleM1 //Value of WidthMarker 1 when sampling done.
SampleM3 // 3
]
// File-wide structure and manifest declarations.
structure STR: [
len byte
char↑1,255 byte
]
// Procedures
let
//Paint a rectangular area. Op is OpOn,OpOff or OpToggle. Pat is the
// bit pattern to use.
PaintRectangle(x,y,wid,height,op,pat,patxor; numargs n) = valof [
if n eq 6 then patxor=0
let yh=y+height-1
if ((yh&1) ne 0) then pat=pat xor patxor
let a=(DisYTop-yh)*DisWid+DisAdr //First word of sl
let xr=x+wid
let lw=x rshift 4; let lb=x
let rw=xr rshift 4; let rb=xr
let lmsk= (bits!(lb-1)-1)
let rmsk=not (bits!(rb-1)-1)
let lw1=lw+1; let rw1=rw-1
test op eq OpRead then //Just check at first non-zero pattern
[
if pat eq 0 then
[
pat=pat xor patxor
a=a+DisWid
]
let lmskp=lmsk&pat
let rmskp=rmsk&pat
let IsItOn= (a!lw & lmskp)
test lw eq rw then
IsItOn=IsItOn & rmskp
or
[
for i=lw1 to rw1 do IsItOn=IsItOn % (a!i & pat)
IsItOn=IsItOn % (a!rw & rmskp)
]
resultis (IsItOn ne 0)
]
or
[
for i=1 to height do
[
test lw eq rw
ifso
[
let w=lmsk&rmsk&pat
a!lw=selecton op into
[
case OpToggle: a!lw xor w
case OpOn: a!lw % w
case OpOff: a!lw &(not w)
]
]
ifnot
[
let lmskp=lmsk&pat
let rmskp=rmsk&pat
switchon op into [
case OpToggle: a!lw=a!lw xor lmskp
for i=lw1 to rw1 do a!i=a!i xor pat
a!rw=a!rw xor rmskp
endcase
case OpOn: a!lw=a!lw % lmskp
for i=lw1 to rw1 do a!i=a!i % pat
a!rw=a!rw % rmskp
endcase
case OpOff: a!lw=a!lw & not lmskp
for i=lw1 to rw1 do a!i=a!i & not pat
a!rw=a!rw & not rmskp
endcase
]
]
pat=pat xor patxor
a=a+DisWid
]
]
]
and
//Use normal convert instruction to paint a line of text on the screen.
// x,y are coordinates; str is the string. Returns right-most x value.
ConvertString(x,y,str) = valof [
let convrt=table [ //convrt(ac0,ac2,ac3)
#55001;//sta 3,1,2
#50411;//sta 2,.+11
#35003;//lda 3,3,2
#131000;//mov 1,2
#67000;//convrt
#161001;//mov 3,0,skp requires extension
#161000;//mov 3,0 char width in ac3
#30403;//lda 2,.+3
#35001;//lda 3,1,2
#1401;//jmp 1,3
0; //place to store ac 2
]
let fontbase=sysFont //Font!
let xoff,yoff=0,fontbase!-2
let yadr=(DisYTop-y-yoff)*DisWid+DisAdr
let tab=vec 2
tab!0=DisWid
for i=1 to str>>STR.len do
[
let dwa=yadr+((x+xoff) rshift 4)-DisWid
tab!1=15-((x+xoff))
x=x+convrt(dwa,tab,fontbase+str>>STR.char↑i)
]
resultis x
]
and
//Paint a string on the display, using the edited character font
// as a source of characters: x,y are coordinates; str is string
// to paint; up (optional) is a 2-word vector that gets updated x,y.
PaintString(x,y,str,up; numargs n) be [
for i=1 to str>>STR.len do
[
let c=str>>STR.char↑i
let w=vec CharWidthsize
let s=EditFindChar(c,w,1) //Look on scratch
if s eq 0 then s=EditFindChar(c,w,2)
if s then
[
let xl=x+w>>CharWidth.XL
let yb=y+w>>CharWidth.YB
let adr=(DisYTop-yb)*DisWid+DisAdr+(xl/16)
xl=xl rem 16
let b=WindowRead(s) //FHEAD
let p=vec 100
let hw=b<<FHEAD.hw //Words high.
let ns=b<<FHEAD.ns //Number of scan lines.
for i=1 to ns do
[
let dp=adr
WindowReadBlock(s,p,hw)
for pc=0 to hw-1 do for j=0 to 15 do
[
if ((p!pc)&(bits!j)) ne 0 then
@dp=@dp%(bits!xl)
dp=dp-DisWid
]
xl=xl+1
if xl eq 16 then
[
xl=0
adr=adr+1
]
]
x=x+@(lv w>>CharWidth.WX)
y=y+@(lv w>>CharWidth.WY)
]
]
if n eq 4 then
[
up!0=x; up!1=y
]
]
and
//Get a mouse button depression.
GetButtonPress(lvx,lvy,WaitForButtonOff) = valof [
if WaitForButtonOff then
while ((@butloc)&butall) ne butall do [ let a=2 ]
let b=nil
[
b=@butloc
@lvx=curloc!0
@lvy=DisYTop-curloc!1
if (b&butall) ne butall then break
] repeat
if (b&but1) eq 0 then resultis 1
if (b&but2) eq 0 then resultis 2
if (b&but3) eq 0 then resultis 3
]
and
//Given an x,y coordinate, compute which area of the screen the thing
// lies in. Returns:
// 0 Edit area, on a Foreground character spot
// 1 Left border area
// 2 Right border area
// 3 Bottom border
// 4 Top border
//
// 5 In edit areas, but not near enough to active point
// -1 Out of the area entirely.
GetCharCoord(x,y,lvx,lvy) = valof [
let GCC(oc,lvc,lvcode,scales,siz) = valof
[
//Coordinate c; scales!0=units; scales!1=max value.
// Store in lvc the truncated unit.
// Store in lvcode:
// 0 if in edit area
// 1 if in border at min end
// 2 if in border at max end
// -1 otherwise
// Return 0 if on active spot; 1 if between
let unit=scales!0
let c=oc+100*unit //Avoid negative rounding problems
let i=c/unit-100
let frac=c rem unit
let u4=unit rshift 4
let res=0
if frac le u4 then res=1
if (unit-frac) le u4 then [ i=i+1; res=1 ]
@lvc=i
@lvcode=(oc ls -FrameW-BorderW)? -1,
(i ls 0)? 1,
(i ls scales!1)? 0,
(oc ge siz & oc ls siz+FrameW+BorderW)? 2,-1
resultis res
]
let codex,codey=nil,nil
let ax=GCC(x-BoxX,lvx,lv codex,lv ViewForeground>>VIEW.Xunit,BoxXSiz)
let ay=GCC(y-BoxY,lvy,lv codey,lv ViewForeground>>VIEW.Yunit,BoxYSiz)
if codex eq 0 & codey eq 0 then
[
if ax eq 0 & ay eq 0 then resultis 0
resultis 5
]
if (codex%codey) eq -1 then resultis -1
if codex ne 0 then
[
if ay ne 0 then resultis codex
resultis 5
]
if codey ne 0 then
[
if ax ne 0 then resultis codey+2
resultis 5
]
]
and
//Stuff for sampling....
//Accomplish the sample function! -- very simple for now
MakeSamples() = valof [
//Save current 0,0 point so it can be put back when user selects a char
// from the sampling set.
SampleM1=WidthMarker!1
SampleM3=WidthMarker!3
//Zero the sampling area
PaintRectangle(SamXLeft,SamYBot,SamW*SamRowCount,SamYTop-SamYBot+1,OpOff,-1)
let xs=EFactorX
let ys=EFactorY
let xs2=xs/2
let ys2=ys/2
let xn=ViewForeground>>VIEW.Xnum
let yn=ViewForeground>>VIEW.Ynum
let xnb=ViewBackground>>VIEW.Xnum
let ynb=ViewBackground>>VIEW.Ynum
let area=xs*ys
let samno=0
let bestsamno=0 //Best sample number
let bestabserror=10000 //Best absolute value of error
let besterror=nil //Best signed error
let chararea=nil
for xoff=-xs2 to xs-xs2-1 do //For all offsets
for yoff=-ys2 to ys-ys2-1 do
[
let cumabserror=0 //Cumulative absolute value of error
let cumerror=0 //Cumulative signed error
chararea=0 //Total character area
SampleXof!samno=xoff
SampleYof!samno=yoff
//Decide for each foreground bit.
for x=0 to xn-1 do
for y=0 to yn-1 do
[
//Count 1 bits at this spot
let xxs=x*xs
let yys=y*ys
let cnt=0
for xb=0 to xs-1 do
for yb=0 to ys-1 do
[
let xxb=xoff+xb+xxs
let yyb=yoff+yb+yys
//Following is equivalent to
// if ReadCharBit(ViewBackground,xxb,yyb)
// then cnt=cnt+1
if ( valof [
if xxb ls 0 % xxb ge xnb %
yyb ls 0 % yyb ge ynb then resultis 0
let adr=xxb*ynb+yyb //Bit address
let w=adr rshift 4 //See BitMap
let b=bits!(adr)
resultis (((lv ViewBackground>>VIEW.BM)!w)&b) ne 0
] ) then cnt=cnt+1
//End of equivalent
]
//Majority vote
chararea=chararea+cnt
let val=(cnt gr (4*area)/8)
let error=(val? area,0)-cnt
let abserror=(error ls 0)? -error,error
cumerror=cumerror+error
cumabserror=cumabserror+abserror
if val then WriteSampledBit(samno,x,y,val)
]
if cumabserror ls bestabserror then
[
bestsamno=samno
bestabserror=cumabserror
besterror=cumerror
]
samno=samno+1
]
//Highlight best sampling
for i=0 to xn-1 do
WriteSampledBit(bestsamno,i,-1,-1)
FLDI(1,area)
FLDI(2,besterror); FLDI(3,bestabserror); FLDI(4,chararea)
FDV(2,1); FDV(3,1); FDV(4,1)
TypeForm("Best error: ",2,2)
TypeForm("; |error| ",2,3)
TypeForm("; Total area ",2,4,0)
resultis bestsamno
]
and
//Fetch a sample from the sample area into the working area.
FetchSample(x,y,lvofx,lvofy) be [
let samrow=(SamYTop-y)/SamH
let samcol=(x-SamXLeft)/SamW
let samno=samrow*SamRowCount+samcol
//Return offsets
@lvofx=SampleXof!samno
@lvofy=SampleYof!samno
//Restore 0,0 point before reading in background
PaintWidthMarker(1,SampleM1)
PaintWidthMarker(3,SampleM3)
//Now read sampled char selected, transfer it to working area.
for x=0 to ViewForeground>>VIEW.Xnum-1 do
for y=0 to ViewForeground>>VIEW.Ynum-1 do
WriteCharBit(ViewForeground,x,y,
WriteSampledBit(samno,x,y))
]
and
//Paint a sampled bit into the "view" area for sampled chars.
// Samno indexes the sample number; x and y are the bit posn,
// val is the value.
WriteSampledBit(samno,x,y,val; numargs n) = valof [
let samrow=samno/SamRowCount
let samcol=samno rem SamRowCount
let yb=SamYTop-SamH-SamH*samrow+y
let xl=SamXLeft+samcol*SamW+x
let a=(DisYTop-yb)*DisWid+DisAdr+(xl rshift 4)
let b=bits!(xl)
if n eq 3 then resultis ((@a)&b) ne 0
@a=(@a & not b)%(val & b)
]