// F E D I T (PREPRESS)
// catalog number ???
//
// FEDIT -- font editor for low resolution fonts.
//
get "ix.dfs"
get "fedit.dfs"
get "scan.dfs"
// outgoing procedures
external
[
FEdit
ReadCharBit
WriteCharBit
PaintWidthMarker
]
// outgoing statics
external
[
ViewForeground
ViewBackground
DisAdr
WidthMarker
bits
UnsampledWX
UnsampledWY
EFactorX
EFactorY
SampleXof
SampleYof
BackgroundArea
]
static
[
ViewForeground //View parameters for foreground stuff
ViewBackground //View parameters for background char.
DisAdr //Address of display buffer start
WidthMarker //Vector of width information (index by border #)
bits //bits!0=#100000
UnsampledWX //Width of background character (in Alto units).
UnsampledWY // "
EFactorX //Enlargement factor of background
EFactorY
SampleXof //This!sample# = x offset of background
SampleYof // similar
BackgroundArea //Area of background char in its units.
]
// incoming procedures
external
[
//FEDITFILE
EFileStart
EFileFinish
EditFindChar
EditReadChar
EditWriteChar
EditUnWriteChar
//FEDITUTIL
PaintRectangle
ConvertString
GetButtonPress
GetCharCoord
FetchSample
MakeSamples
PaintString
WindowRead
WindowReadBlock
FSGetX
FSPut
FLDI
FDV
Zero; SetBlock; MoveBlock
DpRound
ReadNumber
TypeForm
Scream
]
// incoming statics
external
[
rotation
params
resolutionx
]
// internal statics
static
[
WordString
CurBackOfx //Current background offset in x.
CurBackOfy // ditto for y
Changes //True if current character is changed.
]
// File-wide structure and manifest declarations.
structure STR: [
len byte
char↑1,255 byte
]
// Procedures
let
FEdit(NoBackground) be [
bits=( table [ 0;
#100000; #40000; #20000; #10000;
#4000; #2000; #1000; #400; #200; #100;
#40; #20; #10; #4; #2; #1; 0 ] )+1
//Set cursor
// MoveBlock( #431, table [
// #100000; #140000; #160000; #170000;
// #174000; #176000; #177000; #170000;
// #154000; #114000; #006000; #006000;
// #003000; #003000; #001400; #001400 ] , 16)
//Initialize files.
let factor=EFileStart(NoBackground)
//Initialize view parameters.
EFactorX=factor
EFactorY=factor
let u=StdUnit
if (params&gotresolution) ne 0 then u=resolutionx
let proto=table [ #125252; -1 ]
for i=0 to 1 do [
//ForeGround (i=0); Background (i=1)
let xn=BoxXSiz/u
let yn=BoxYSiz/u
let vsiz=((xn*yn) rshift 4)+(size VIEW/16 +2)
let v=FSGetX(vsiz)
Zero(v,vsiz)
v>>VIEW.Pattern=proto!0
v>>VIEW.PatXor=proto!1
v>>VIEW.Xnum=xn
v>>VIEW.Ynum=yn
v>>VIEW.Xunit=u
v>>VIEW.Yunit=u
test i eq 0 then
[
ViewForeground=v
test factor eq 0
ifso factor=10000
ifnot [
if (u rem factor) ne 0 then
Scream("Background enlargement does not divide cell size.")
u=u/factor
]
proto=table [ #052525; #052525 ]
] or
[
ViewBackground=v
break
]
]
//Misc.
WidthMarker= table [ 0; 2;2;2;2;0;0 ]
let q=vec 100
q!0=0
WordString=q
let q1=vec 49
SampleXof=q1
let q2=vec 49
SampleYof=q2
//Set up display things.
DisAdr=(FSGetX((DisYTop-DisYBot+1)*DisWid+1)+1)&(-2)
Zero(DisAdr,(DisYTop-DisYBot+1)*DisWid)
let db=(FSGetX(5)+1)&(-2)
db!0=@#420
db!1=DisWid
db!2=DisAdr
db!3=(DisYTop-DisYBot+1)/2
@#420=db //Link it in.
//Set up edit area
PaintRectangle(BoxX-FrameW,BoxY-FrameW,FrameW,BoxYSiz+FrameW*2,OpOn,-1)
PaintRectangle(BoxX+BoxXSiz,BoxY-FrameW,FrameW,BoxYSiz+FrameW*2,OpOn,-1)
PaintRectangle(BoxX,BoxY-FrameW,BoxXSiz,FrameW,OpOn,-1)
PaintRectangle(BoxX,BoxY+BoxYSiz,BoxXSiz,FrameW,OpOn,-1)
//Set up menu buttons.
//Menu items for manipulating characters
SetButton(MenuChar,"New Character")
SetButton(MenuCancel,"Cancel modifications")
SetButton(MenuDelete,"Delete this char")
SetButton(MenuBShift,"Shift Background")
SetButton(MenuSample,"Sample")
SetButton(MenuArea,"Area")
SetButton(MenuGrid,"Grid")
SetButton(MenuQuit,"Quit")
//Menu items for showing samples of characters
SetButton(MenuStrikeUC,"Show ABCD...")
SetButton(MenuStrikeLC,"Show abcd...")
SetButton(MenuStrikeSyms,"Show !@#$")
SetButton(MenuNewWords,"Show new words")
SetButton(MenuWords,"Show words")
EditLoop()
]
and
//Main loop of editor
EditLoop() be [
Changes=false //Char has been edited.
let CharCode=-1 //Current char code
let WaitUp=true //True if must wait for button to come up
let GridOn=false
//Now for the edit loop.
[ml
// TypeForm("!") //@
let x,y=nil,nil
let button=GetButtonPress(lv x,lv y,WaitUp)
WaitUp=false //Normally, can "draw"
let xc,yc=nil,nil
let a=GetCharCoord(x,y,lv xc,lv yc)
switchon a into [
case 0: [
let val=(button eq 1)
if button eq 2 then
[
val=not ReadCharBit(ViewForeground,xc,yc)
WaitUp=true //Else will just flash...
]
WriteCharBit(ViewForeground,xc,yc,val)
Changes=true
]
endcase
case 1: case 2:
PaintWidthMarker(a,yc)
Changes=true
endcase
case 3: case 4:
PaintWidthMarker(a,xc)
Changes=true
endcase
case -1: //Check for menu area.
[
let w=vec CharWidthsize
let str=vec 10
if x ge MenuX then
[geMenuX
//Selecting a sampled character prototype.
if y le SamYTop & y ge SamYBot then
[
let ofx,ofy=nil,nil
FetchSample(x,y,lv ofx,lv ofy)
GetBackground(CharCode,-ofx,-ofy)
//Set widths appropriately.
let ux=ViewForeground>>VIEW.Xunit
let uy=ViewForeground>>VIEW.Yunit
let nx=WidthMarker!3+(UnsampledWX+ux/2)/ux
let ny=WidthMarker!1+(UnsampledWY+uy/2)/uy
PaintWidthMarker(4,nx)
PaintWidthMarker(2,ny)
Changes=true
]
//Selecting a menu item
if y le (MenuY+MenuH*MenuMax) & y ge MenuY then
[
let mi=(y-MenuY)/MenuH
let yr=y-MenuY-mi*MenuH
if yr le 10 then
[bu //Button hit
WaitUp=true //Must wait for release
PaintRectangle(MenuX-10,mi*MenuH+MenuY-2,
MenuW+10,MenuH,OpToggle,-1)
switchon mi into [sw
//Cancel, quit, new character all have similar code.
case MenuCancel:
[
EditUnWriteChar(CharCode)
Changes=false
] //Fall into Char:
case MenuDelete:
case MenuQuit:
case MenuChar:
[
if (mi eq MenuDelete % Changes ne 0)
& CharCode ne -1 then
EditWriteChar(CharCode, mi eq MenuDelete)
Changes=false
if mi eq MenuDelete then
[
CharCode=-1
endcase
]
if mi eq MenuQuit then break
if mi eq MenuChar then
[
TypeForm("Next character (or octal code): ",1,str)
let sl=str>>STR.len
test sl eq 1
then CharCode=str>>STR.char↑1
or [
sl=sl+1
str>>STR.char↑sl=$Q
str>>STR.len=sl
CharCode=ReadNumber(str) //Make octal
]
]
WriteCharBit(ViewForeground) //Clear it.
let a=EditFindChar(CharCode,w,1) //Scratch
if a eq 0 then a=EditFindChar(CharCode,w,2)
if a then EditReadChar(ViewForeground,a,w)
if GridOn then ShowGrid(true)
GetBackground(CharCode,0,0) //Background
]
endcase
//New words, words, strikes all display strings of current characters.
case MenuNewWords:
TypeForm("New words: ",1,WordString)
case MenuWords:
[
PutStrings(CharCode,WordString)
]
endcase
case MenuStrikeUC: case MenuStrikeLC: case MenuStrikeSyms:
[
let a=selecton mi into [
case MenuStrikeUC: "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
case MenuStrikeLC: "abcdefghijklmnopqrstuvwxyz"
case MenuStrikeSyms: "1234567890!@#$%~&**()-=+|\{}[]↑←:;*"'<>,./?"
]
PutStrings(CharCode,a)
]
endcase
//Area -- compute area of character currently on screen.
case MenuArea:
[ //Compute area of char on screen
let ar=0
for x=0 to ViewForeground>>VIEW.Xnum-1 do
for y=0 to ViewForeground>>VIEW.Ynum-1 do
if ReadCharBit(ViewForeground,x,y) then ar=ar+1
TypeForm("Area: ",10,ar,". Background area: ")
FLDI(1,BackgroundArea)
FLDI(2,EFactorX); FLDI(3,EFactorY)
FDV(1,2); FDV(1,3)
TypeForm(2,1,0)
]
endcase
//Grid -- toggle the grid status
case MenuGrid:
[
GridOn=not GridOn
ShowGrid(GridOn)
]
endcase
//Shift background -- read it in again at a new spot.
case MenuBShift:
[
let x1,y1=nil,nil
GetButtonPress(lv x1,lv y1,true)
let x2,y2=nil,nil
GetButtonPress(lv x2,lv y2,true)
let xu=ViewBackground>>VIEW.Xunit
let yu=ViewBackground>>VIEW.Yunit
GetBackground(CharCode,(x2-x1)/xu+CurBackOfx,
(y2-y1)/yu+CurBackOfy)
]
endcase
//Sample -- just call the sample subroutine.
case MenuSample:
MakeSamples()
endcase
]sw
PaintRectangle(MenuX-10,mi*MenuH+MenuY-2,
MenuW+10,MenuH,OpToggle,-1)
]bu
]
]geMenuX
]
endcase
default: endcase
]
]ml repeat
EFileFinish() //Go finish off files.
]
and
//Utilities....
SetButton(code,str) be [
let p=vec 2
ConvertString(MenuX,MenuY+code*MenuH,str,p)
]
and
//Show grid?
ShowGrid(GridOn) be [
for x=0 to ViewForeground>>VIEW.Xnum-1 do
for y=0 to ViewForeground>>VIEW.Ynum-1 do
PaintRectangle(x*ViewForeground>>VIEW.Xunit+BoxX,
y*ViewForeground>>VIEW.Yunit+BoxY,1,1,
(GridOn? OpOn,OpOff),-1)
]
and
//Put up visible strings of the characters you are working on.
PutStrings(CharCode,str) be [
if Changes ne 0 & CharCode ne -1 then
EditWriteChar(CharCode)
Changes=false
PaintRectangle(WordX,WordY,WordWid,WordHig,
OpOff,-1) //Clear area
let p=vec 2
let s=#400+CharCode
p!0=WordX; p!1=String2Y
for i=1 to 5 do PaintString(p!0,p!1,lv s,p)
PaintString(WordX,String1Y,str)
]
and
GetBackground(char,xof,yof) be [
CurBackOfx=xof //Save for motions.
CurBackOfy=yof
let w=vec CharWidthsize
WriteCharBit(ViewBackground) //Clear it.
let a=EditFindChar(char,w,3) //Background
if a then EditReadChar(ViewBackground,a,w,xof,yof)
]
and
//Write a "bit" of a character, according to the view given.
WriteCharBit(view,x,y,val; numargs n) be [
let xn=view>>VIEW.Xnum
let yn=view>>VIEW.Ynum
if n eq 1 then
[
PaintRectangle(BoxX,BoxY,BoxXSiz,BoxYSiz,OpOff,
view>>VIEW.Pattern,view>>VIEW.PatXor)
Zero(lv view>>VIEW.BM,((xn*yn+15) rshift 4))
return
]
if x ls 0 % x ge xn %
y ls 0 % y ge yn then return
BitMap(lv view>>VIEW.BM,x*yn+y,val)
let xs=x*view>>VIEW.Xunit+BoxX
let ys=y*view>>VIEW.Yunit+BoxY
PaintRectangle(xs,ys,view>>VIEW.Xunit,view>>VIEW.Yunit,
(val? OpOn,OpOff),view>>VIEW.Pattern,view>>VIEW.PatXor)
]
and
//Read a "bit" of a character, according to the view given.
ReadCharBit(view,x,y) = valof [
let xn=view>>VIEW.Xnum
let yn=view>>VIEW.Ynum
if x ls 0 % x ge xn %
y ls 0 % y ge yn then resultis 0
resultis BitMap(lv view>>VIEW.BM,x*yn+y)
]
and
// Set width markers in the margins of the edit area. First argument is
// border number to deal with (for description of border numbers, see
// GetCharCoord comments). Second argument is value of marker.
// For borders 5 & 6, these are the markers that mark the point of the
// unsampled widths; in this case, value is in Alto units.
PaintWidthMarker(border,val; numargs n) be [
if border eq 0 then return
let op=nil
let p=WidthMarker+border
test n eq 2 then
[
PaintWidthMarker(border) //erase old one.
let otherborder=(border eq 1)? 5,(border eq 3)? 6,0
PaintWidthMarker(otherborder) //erase it.
op=OpOn //Write
@p=val //Save new value
PaintWidthMarker(otherborder,WidthMarker!otherborder)
] or [
op=OpOff
val=@p //Turn off old value.
]
let Altoval=selecton border into [
case 1: case 2:
val*ViewForeground>>VIEW.Yunit
case 3: case 4:
val*ViewForeground>>VIEW.Xunit
case 5: val+(WidthMarker!1*ViewForeground>>VIEW.Yunit)
case 6: val+(WidthMarker!3*ViewForeground>>VIEW.Xunit)
]
let w=(table [ 0;BorderW;BorderW;1;1 ])!border
let h=BorderW+1-w //Width,height of marker
if border ge 5 then
[
if ViewBackground eq 0 then return
h=2; w=2
]
let fixed=(table [ 0; BoxX-FrameW-BorderW;
BoxX+BoxXSiz+FrameW;
BoxY-FrameW-BorderW;
BoxY+BoxYSiz+FrameW;
BoxX+BoxXSiz+FrameW;
BoxY+BoxYSiz+FrameW ] )!border
let x,y=nil,nil
let onScreen = valof [
if Altoval ls 0 then resultis false
test (table [ 0;-1;-1;0;0;-1;0 ] )!border
then [
if Altoval ge BoxYSiz then resultis false
x=fixed; y=Altoval+BoxY
]
or [
if Altoval ge BoxXSiz then resultis false
y=fixed; x=Altoval+BoxX
]
resultis true
]
test onScreen then PaintRectangle(x,y,w,h,op,-1)
or TypeForm("Warning: tick mark for displaying widths lies off screen!*n")
]
and
//Shift a character. View tells which part of char; dir is
// -1 if button push is to determine direction.
// else
// dir=1 at left border, 2 at right, 3 top, 0 bot
// amt is amount to shift (>0 only, please!)
//
//ShiftChar(view,dir,amt) be [
// if dir ls 0 then
// [
// let x,y=nil,nil
// GetButtonPress(lv x,lv y,true) //Get border.
// let dx=x-BoxX
// dir=0
// if y gr BoxY+BoxYSiz-dx then dir=2
// if y gr BoxY+dx then dir=dir+1
// ]
// let xn=view>>VIEW.Xnum
// let yn=view>>VIEW.Ynum
// if dir eq 0 % dir eq 1 then
// [
// for x=0 to xn-1 do
// for y=0 to yn-1 do
// WriteCharBit(view,x,y,
// ReadCharBit(view,
// ((dir eq 0)? x,x+amt),
// ((dir eq 0)? y+amt,y) ))
// ]
// if dir eq 3 % dir eq 2 then
// [
// for x=xn-1 to 0 by -1 do
// for y=yn-1 to 0 by -1 do
// WriteCharBit(view,x,y,
// ReadCharBit(view,
// ((dir eq 3)? x,x-amt),
// ((dir eq 3)? y-amt,y) ))
// ]
//]
//
//and
//Operate on a bit map with base address buf, 'adr' is the bit number.
// Val (optional) is the value to set the bit to (must be 0 or -1)
BitMap(buf,adr,val; numargs n) = valof [
let w=adr rshift 4
let b=bits!(adr )
test n eq 2 then
resultis ((buf!w)&b) ne 0
or buf!w=(buf!w & not b)%(val & b)
]