// 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 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