// September 11, 1980 3:57 PM by Ramshaw *** "UNDERLAY" ***
//Edited by Lyle Ramshaw September 8, 1980 3:24 PM: changed header
// message to Draw 5.0...
// Compile with X/M to set versionX (i.e. no color menu) to true
get "zpDefs.bcpl"
get "sysDefs.d"
get "AltoDefs.d"
// outgoing procedures:
external [
drawJunta
needBlock
]
// outgoing statics:
external [
// overlay stuff
@overlayTable
// display area stuff
@switchDCB
@bitmap
@bitmap00
@height
@width
@scanlineWidth
@bitmapSize
@Xmax
@Ymax
@Xref0
@Yref0
@gridSpacing
// global tables
@splineTable
@textTable
@fontDefTable
@fontFile
@newSplineXYtable
@transformXYtable
@transformModeTable
@selectionTable
@deletionTable
@commandTable
@actionTable
@DTTstack
@DTTstackTop
@freeStorageZone
@lineThicknessTable
// table counters
@maxSplineID
@maxTextID
@maxKnots
@maxItem
@maxDTTstack
//text stuff
@textOK
@textString
@textWidth
@textTop
@textBottom
@textHeight
@textBitmap
@textBitmapSize
// global information
@freeStorageSize
@font
@dspFont
@dspFontAddress
@brush
@color
@versionX
]
static [
// overlay stuff
@overlayTable
// display area stuff
@switchDCB
@bitmap
@bitmap00
@height=defaultHeight
@width=defaultWidth
@scanlineWidth
@bitmapSize
@Xmax
@Ymax
@Xref0
@Yref0
@gridSpacing=0
// global tables
@splineTable
@textTable
@fontDefTable
@fontFile
@newSplineXYtable
@transformXYtable
@transformModeTable
@selectionTable
@deletionTable
@commandTable
@actionTable
@DTTstack
@DTTstackTop=0
@freeStorageZone
@lineThicknessTable
// table counters
@maxSplineID=0
@maxTextID=0
@maxKnots=0
@maxItem=0
@maxDTTstack
//text stuff
@textOK=0
@textString
@textWidth
@textTop
@textBottom
@textHeight
@textBitmap
@textBitmapSize
// global information
@freeStorageSize=0
@font=0
@dspFont=0
@dspFontAddress=0
@defaultFont
@color=black
@brush=4 // square brush is the default
@versionX= not newname X
]
// incoming procedures:
external [
Resets // SYSTEM
Gets
Endofs
Closes
OpenFile
CreateDiskStream
CreateDisplayStream
ShowDisplayStream
FileLength
FilePos
SetFilePos
PositionPage
JumpToFa
ReadBlock
SetBlock
Zero
MoveBlock
DoubleAdd
Usc
SetEndCode
Junta
GetFixed
FixedLeft
InitializeZone
Allocate
initEventTable // ZPINIT2
FPSetup // microFLOAT
drawMain // ZPEDIT
drawFinish
MakeFontEntry // ZPFONTIO
typeForm // ZPUTIL
FPerror
equal
PSerror // SPLINE
giveUp // ZPBLOCK
CheckPSerror
maxBlockSize
ReadUserCmItem // READUSERCMITEM
LoadPackedRAM // READPRAM
MicroFloatRamImage
]
// incoming statics:
external [
@dashOn // ZPDRAW
@dashOff
FPerrprint // microFLOAT
PSzone // PSPLINE
@sampleBuffer // ZPFREEHAND
@maxSampleCount
dsp // SYSTEM
sysZone
lvSysZone
fpSysFont
lvUserFinishProc
OsVersion
]
// local static:
static [
@checkFreeStorage=false
@tempOverlayTable
]
// definitions
manifest [
// 6 lines for dsp stream
nLines=6
dspWidth=3*38
// 1 disk stream
diskStream= lKS+256
systemPoolSize=diskStream+150
// horizontal margin
horMargin=16
]
//*****************************************************************
// initialization and the like
//*****************************************************************
let drawJunta(loadVec, cfa) be [drawJunta
// load & initialize floating point microcode:
LoadPackedRAM(MicroFloatRamImage)
// get overlay information & set EndCode:
let endOfCode=loadVec!($E-$A)
tempOverlayTable=endOfCode
endOfCode=endOfCode+lOVT
Zero(tempOverlayTable, lOVT)
MoveBlock(lv(tempOverlayTable>>OVT.fp), lv(cfa>>CFA.fp), lFP)
let runFile=CreateDiskStream(lv(cfa>>CFA.fp), ksTypeReadOnly)
JumpToFa(runFile, lv(cfa>>CFA.fa))
let pageNumber=cfa>>CFA.fa.pageNumber
for i=1 to numberOfOverlays do [
PositionPage(runFile, pageNumber)
tempOverlayTable>>OVT.pn↑i=pageNumber
// 4th word of overlay header is length (in words)
let ovl=vec 16
ReadBlock(runFile, ovl, 16)
let endOfOverlay=ovl!0 + ovl!4
if Usc(endOfCode, endOfOverlay) eq -1 then
endOfCode=endOfOverlay
tempOverlayTable>>OVT.end↑i=endOfOverlay
tempOverlayTable>>OVT.free↑i=endOfCode-endOfOverlay
// file page number for next overlay
pageNumber=pageNumber + (ovl!4+255)/256
]
Closes(runFile)
SetEndCode(endOfCode)
Junta(levMain, drawInit)
]drawJunta
and drawInit() be [drawInit
// make new system zone
sysZone=InitializeZone(GetFixed(systemPoolSize), systemPoolSize, 0, 0)
@lvSysZone=sysZone
// errors & finish
FPerrprint=FPerror
PSerror=CheckPSerror
@ lvUserFinishProc=drawFinish
// initialize all the DRAW stuff
let dcb1=initDisplayAndStorage()
initEventTable()
overlayTable=needBlock(lOVT)
MoveBlock(overlayTable, tempOverlayTable, lOVT)
sampleBuffer=overlayTable>>OVT.end↑freeHandOverlay
maxSampleCount=overlayTable>>OVT.free↑freeHandOverlay
initUSERCM()
// make display
let pt=@ lvDisplayHeader
switchDCB=dcb1>>DCB.next
dcb1>>DCB.next=pt
while pt>>DCB.next do pt=pt>>DCB.next
pt>>DCB.next=switchDCB
@ lvDisplayHeader=dcb1
//now the magic numbers!
Xmax,Ymax=width-1,height-1
Xref0=64
Yref0=height + 2*horMargin + nLines*((@(dspFontAddress-2)+1)𫙰)
// video camera
if camera>>CAMERA.present then [
camera>>CAMERA.top=Yref0-height+cameraYoffset
camera>>CAMERA.bottom=Yref0+cameraYoffset
camera>>CAMERA.left=Xref0+cameraXoffset
camera>>CAMERA.right=Xref0+width+cameraXoffset
camera>>CAMERA.insideMode=altoOnly
camera>>CAMERA.outsideMode=altoOnly
]
// all set
maxBlockSize()
drawMain()
]drawInit
and initDisplayAndStorage() = valof [initDisplayAndStorage
// get big block for display
// display area is width * height with a 4*16 bit margin
height=defaultHeight
width=defaultWidth
[ scanlineWidth=width/16 + margin
bitmapSize=height*scanlineWidth
bitmap=GetFixed(bitmapSize+1)
if bitmap break
width=width-32
] repeat
// must be an even location, damn it!
bitmap=(bitmap+1) & #177776
bitmap00=bitmap + bitmapSize - scanlineWidth + margin
Zero(bitmap, bitmapSize)
// get the remainder for free storage zone
freeStorageSize=FixedLeft() - 1300
freeStorageZone=GetFixed(freeStorageSize)
test checkFreeStorage
ifso InitializeZone(freeStorageZone, freeStorageSize, 0)
ifnot InitializeZone(freeStorageZone, freeStorageSize, 0, 0)
PSzone=freeStorageZone
textBitmapSize=maxTextHeight*scanlineWidth
textBitmap=needEvenBlock(textBitmapSize)
Zero(textBitmap, textBitmapSize)
//get display control blocks
let DCB1=needEvenBlock(5*lDCB)
let DCB2=DCB1+lDCB
let DCB3=DCB2+lDCB
let DCB4=DCB3+lDCB
let DCB5=DCB4+lDCB
//set up display control blocks
Zero(DCB1, 5*lDCB)
//top margin
DCB1>>DCB.height=horMargin/2
//system display area (for messages)
//second top margin
DCB2>>DCB.height=horMargin/2
//curve area & margin
DCB3>>DCB.bitmap=bitmap
DCB3>>DCB.width=scanlineWidth
DCB3>>DCB.height=height/2
// another margin
DCB4>>DCB.height=horMargin/2
// text display
DCB5>>DCB.indentation=4
DCB5>>DCB.height=maxTextHeight/2
DCB5>>DCB.bitmap=textBitmap
DCB5>>DCB.width=scanlineWidth
//link DCBs
DCB1>>DCB.next=DCB2
DCB2>>DCB.next=DCB3
DCB3>>DCB.next=DCB4
DCB4>>DCB.next=DCB5
DCB5>>DCB.next=0
// decide about the size of tables
readCOMCMparameters()
let gridSpacDef= versionX ? XgridSpacingDefault, gridSpacingDefault
if maxSplineID le 0 % maxSplineID gr 10*maxSplineIDdefault then
maxSplineID=maxSplineIDdefault
if maxTextID le 0 % maxTextID gr 10*maxTextIDdefault then
maxTextID=maxTextIDdefault
if maxKnots le 0 % maxKnots gr 10*maxKnotsDefault then
maxKnots=maxKnotsDefault
if dashOn le 0 % dashOn gr 10*dashOnDefault then
dashOn=dashOnDefault
if dashOff le 0 % dashOff gr 10*dashOffDefault then
dashOff=dashOffDefault
if gridSpacing le 0 % gridSpacing gr 10*gridSpacDef then
gridSpacing=gridSpacDef
maxItem=maxSplineID + maxTextID
maxDTTstack=maxItem + 2*maxTransfPoints + 1
// spline table [length maxSplineID+1] & text table [length maxTextID+1] :
// word 0 is a counter
// words 1 through maxSplineID (maxTextID) are pointers
// to SPLINE (TEXT) structures
let blockSize=(maxSplineID+1)+(maxTextID+1)+(maxChar/2+1)
splineTable=needBlock(blockSize)
Zero(splineTable, blockSize)
textTable=splineTable+maxSplineID+1
textString=textTable+maxTextID+1
// XY tables for new spline & transform, and transform mode table
blockSize=transformModeMax+TRANSFORMtableSize+(2+maxKnots*2)
transformModeTable=needBlock(blockSize)
transformXYtable=transformModeTable+transformModeMax
newSplineXYtable=transformXYtable+TRANSFORMtableSize
Zero(transformModeTable, blockSize)
transformModeTable!0=mTransf2Mode
transformModeTable!1=cTransf2Mode
transformModeTable!2=mTransf4Mode
transformModeTable!3=cTransf4Mode
transformModeTable!4=mTransf6Mode
transformModeTable!5=cTransf6Mode
// selection/deletion table:
blockSize=2*maxItem+2
selectionTable=needBlock(blockSize)
Zero(selectionTable, blockSize)
deletionTable=selectionTable+maxItem+1
// stack for deleted items
DTTstack=needBlock(maxDTTstack)
let FPacs=needBlock(4*32+1)
FPacs!0=32
FPSetup(FPacs)
resultis DCB1
]initDisplayAndStorage
and needBlock(n) = valof [
let b=Allocate(freeStorageZone, n)
unless b finish
resultis b
]
and needEvenBlock(n) = valof [
let b=Allocate(freeStorageZone, n, -1, true)
unless b finish
resultis b
]
and readCOMCMparameters() be [
// (simple minded scanning of COM.CM)
let comcm=OpenFile("COM.CM", ksTypeReadOnly, charItem)
let number, savedNumber= 0,0
until Endofs(comcm) do [
let c=Gets(comcm)
if (c ge $0) & (c le $9) then [
number= number*10 + (c-$0)
loop
]
switchon c into [
case $/: savedNumber=number; number=0; endcase
case $d:
case $D: dashOn=savedNumber; endcase
case $o:
case $O: dashOff=savedNumber; endcase
case $k:
case $K: maxKnots=savedNumber; endcase
case $g:
case $G: gridSpacing=savedNumber; endcase
case $s:
case $S: maxSplineID=savedNumber; endcase
case $t:
case $T: maxTextID=savedNumber; endcase
default: savedNumber=0; number=0; endcase
]
]
Closes(comcm)
]
and initUSERCM() be [initUSERCM
// make font & lineThickness tables from USER.CM entries
let blockSize=FONTFILElength+maxFont*(FONTDEFlength+1)+4
lineThicknessTable=needBlock(blockSize)
Zero(lineThicknessTable, blockSize)
fontFile=lineThicknessTable+4
fontDefTable=fontFile+FONTFILElength
for f=0 to maxFont-1 do fontDefTable!f=fontDefTable+maxFont+f*FONTDEFlength
// get stuff from User.CM (font names, line thickness)
let fontNamesVec=vec 10*maxFont
Zero(fontNamesVec, 10*maxFont)
let fontNames=vec maxFont
for f=0 to maxFont-1 do fontNames!f=fontNamesVec+10*f
let fontSet=vec maxFont
Zero(fontSet, maxFont)
readUSERCM(fontSet, fontNames)
// read fonts
font=-1
for f=0 to maxFont-1 do [
if fontFileInit(fontSet!f, f) eq 0 then fontSet!f=0
if fontSet!f ne 0 & font eq -1 then font=f
]
// if no fonts are there, get system font
if font eq -1 then [
fontSet!0="SYSFONT.AL"
fontFileInit(fontSet!0, 0)
font=0
]
// find largest font file
let maxLength=0
for f=0 to maxFont-1 do
if maxLength ls fontFile>>FONTFILE.length↑f then
maxLength=fontFile>>FONTFILE.length↑f
// pick smallest font as message display font
let minHeight=1000
for f=0 to maxFont-1 do
if fontFile>>FONTFILE.length↑f ne 0 then
if fontFile>>FONTFILE.height↑f ls minHeight then [
minHeight=fontFile>>FONTFILE.height↑f
dspFont=f
]
let dspFontLength=fontFile>>FONTFILE.length↑dspFont
let fontStream=CreateDiskStream(lv(fontFile>>FONTFILE.fp↑dspFont),
ksTypeReadOnly)
dspFontAddress=needBlock(dspFontLength)
ReadBlock(fontStream, dspFontAddress, dspFontLength)
Closes(fontStream)
dspFontAddress=dspFontAddress+2
fontFile>>FONTFILE.length↑dspFont=0
// make system display stream
let dspSize=nLines * lDCB + dspWidth * @(dspFontAddress-2)
dsp=CreateDisplayStream(nLines, Allocate(freeStorageZone,dspSize),
dspSize, dspFontAddress)
ShowDisplayStream(dsp, DSalone)
// all permanent storage should have been allocated by now
// get font buffer
if maxLength ne 0 then
fontFile>>FONTFILE.buffer=needBlock(maxLength)
fontFile>>FONTFILE.current=-1
fontFile>>FONTFILE.bufferLength=maxLength
// initialization message
test versionX
ifso typeForm(0,"*NDRAW 5.2.X [November 23, 1980]*N")
ifnot typeForm(0,"*NDRAW 5.2 [November 23, 1980]*N",
0, "Documentation update on <AltoDocs>DRAW-news.press*N")
typeForm(0, "Fonts 0 to 3 are: ")
for f=0 to maxFont-1 do
typeForm(0, ((fontSet!f) ? fontSet!f, "none"),
0, ((f eq (maxFont-1)) ? "*N", ", "))
]initUSERCM
and fontFileInit(fontName, f) = valof [fontFileInit
// procedure similar to readFontFile (in ZPIO)
if fontName eq 0 resultis 0
let file=OpenFile(fontName, ksTypeReadOnly, 0, 0, lv(fontFile>>FONTFILE.fp↑f))
if file eq 0 then [
fontFile>>FONTFILE.length↑f=0
resultis 0
]
fontFile>>FONTFILE.length↑f=FileLength(file)/2+1
Resets(file)
let ALheader=vec 2
ReadBlock(file, ALheader, 2)
fontFile>>FONTFILE.height↑f=ALheader>>AL.height
fontFile>>FONTFILE.baseline↑f=ALheader>>AL.baseline
Closes(file)
//check font name
resultis MakeFontEntry(fontName, fontDefTable!f, f)
]fontFileInit
and readUSERCM(fontSet, fontNames) = valof [readUSERCM
let fCount=0
let lwCount=0
let forMe=false
let str=vec 128
let usercm=OpenFile("USER.CM", ksTypeReadOnly, charItem)
switchon ReadUserCmItem(usercm, str) into [
case $E:
Closes(usercm)
break
case $L:
if forMe & equal(str, "FONT") then
fCount=fCount + readUSERCMfont(usercm, str, fontSet, fontNames)
if forMe & equal(str, "LINEWIDTH") then
lwCount=lwCount + readUSERCMlineWidth(usercm, str)
loop
case $N:
forMe=equal(str, "DRAW")
loop
case $P:
case $S:
loop
] repeat
if fCount eq 0 then [
fontSet!0="HELVETICA12.AL"
fontSet!1="HELVETICA12B.AL"
fontSet!2="HELVETICA8.AL"
fontSet!3="ARROWS10.AL"
]
// if nothing in USER.CM, use default values (see ZPPRESS.SR)
if lwCount eq 0 then lineThicknessTable=0
]readUSERCM
and readUSERCMfont(usercm, str, fontset, fontNames) = valof [readUSERCMfont
if ReadUserCmItem(usercm, str) ne $P resultis 0
let f=str>>STRING.char↑1 - $0
if (f ls 0) % (f ge maxFont) resultis 0
let length=str>>STRING.length
let istart, iend= 2, length
for i=2 to length do
if str>>STRING.char↑i ne $*S then [ istart=i; break ]
for i=istart to length do
if str>>STRING.char↑i eq $*S then [ iend=i-1; break ]
let name=fontNames!f
for i=istart to iend do
name>>STRING.char↑(i-istart+1)=str>>STRING.char↑i
name>>STRING.length=iend-istart+1
fontset!f=name
resultis 1
]readUSERCMfont
and readUSERCMlineWidth(usercm, str) = valof [readUSERCMlineWidth
if ReadUserCmItem(usercm, str) ne $P resultis 0
let f=str>>STRING.char↑1 - $0
if (f ls 0) % (f gr 3) resultis 0
let length=str>>STRING.length
let istart, iend= 2, length
for i=2 to length do
if str>>STRING.char↑i ne $*S then [ istart=i; break ]
for i=istart to length do
if str>>STRING.char↑i eq $*S then [ iend=i-1; break ]
let num=0
for i=istart to iend do [
let c=str>>STRING.char↑i - $0
if c ls 0 % c gr 9 resultis 0
num=num*10 + c
]
lineThicknessTable!f=num
resultis 1
]readUSERCMlineWidth