//File: AuxiliaryMenuBox.Bcpl

//Bcpl/f AuxiliaryMenuBox.Bcpl

//Written by: Kerry A. LaPrade, XEOS (using a lot of code
// stolen from Keith Knox)

//Last modified December 5, 1980 4:53 PM (by LaPrade)
// Fixed bug associated with ConvertBlock() clip. Now
// clips if origin is out of bounds as well as if offset
// is out of bounds.

//Last modified September 17, 1980 11:22 AM (by LaPrade)
// Fixed ConvertBlock() to clip instead of abort if offset
// is out of bounds. Also slowed down (by 50%) blinking
// of cursor in GetConfirmation().

//Modified January 22, 1980 7:13 PM (by LaPrade)
// Deleted get "BitBlt.d", added OverwriteBox and changed
// "GetConfirmation" to blink the cursor instead of flash
// the screen.

//Modified December 18, 1979 3:24 PM by Lyle Ramshaw (PARC)
// changed TypeStringInBox to use the Notify window added
// to PrePress

//Modified November 19, 1979 10:39 AM (by LaPrade)
// Added TypeStringInBox
//
//Modified November 5, 1979 3:16 PM (by LaPrade)
//Date: July 17, 1978 10:10 AM

//Stored under MAXC <AltoSource>PrePressSources.DM

get "AuxiliaryMenuDefs.D"
get "GoodFoo.d"

// outgoing procedures
//external
// [
// BoxBitblt
// BoxDimensionX
// BoxDimensionY
// ChangeCursor
// ConfirmMenuSelection
// CursorInside2
// GetConfirmation
// GetMouseButton
// InvertScreen
// OverwriteBox
// PartialFillBox
// TypeStringInBox
// ]

// outgoing statics
//external
// [
// ]
//static
// [
// ]

// incoming procedures
//external
// [
// BitBlt
// ]

// incoming statics
//external
// [
// ]

// internal statics
//static
// [
// ]

// File-wide structure declaration.
structure BLOCK:
[
bca
word
bmr
word
lx
word
ty
word
]

//*********************************************************
let PartialFillBox(box, background, xskip, yskip, dw, dh; numargs na)
= valof
//*********************************************************

//Returns true if successful, false if unsucessful
[
// background=0 -- flip memory -- default
// background=1 -- fill with ones (black in normal mode)
// background=2 -- fill with grey
// background=3 -- fill with zeroes (white in normal mode)
// background=4 -- flip with grey

// bkgndopsource fngrey
// 023#16-1
// 103#14-1
// 203#14 125252 or 52525
// 303#14 0

// check arguments
if (na eq 0) % (box eq 0) then resultis false
// define boundaries of the box
let bits=box>>BOX.bits
let Xo=box>>BOX.xorigin
let Yo=box>>BOX.yorigin
let Xc=box>>BOX.xcorner
let Yc=box>>BOX.ycorner
if Xo eq Xc % Yo eq Yc then resultis false

if na ls 2 then background=box>>BOX.background
test na ls 3
ifso xskip=1
// add to outline
ifnot if xskip ls 0 then resultis false
test na ls 4
ifso yskip=1
// add to outline
ifnot if yskip ls 0 then resultis false

let Tempdw = Xc - Xo + 1 - xskip - 2 * bits
test na ls 5
ifso dw = Tempdw - xskip
ifnot if dw gr Tempdw % dw ls 0 then resultis false

let Tempdh = Yc - Yo + 1 - yskip - 2 * bits
test na ls 6
ifso dh = Tempdh - yskip// add to outline
ifnot if dh gr Tempdh % dh ls 0 then resultis false

if na ls 6 % dh ls 0 then
dh = Yc - Yo + 1 - 2 * (yskip + bits)// add to outline
if (dw le 0) % (dh le 0) then resultis false

// get dcb
let dcb=box>>BOX.dcb
if dcb eq 0 then resultis false
let map=dcb>>DCB.bitmap
let width=dcb>>DCB.width

// define function and grey block
let fn=background ? #14,#16
let g0,g1,g2,g3=-1,-1,-1,-1
switchon background into
[
case flip:fn=#16;endcase
case black:endcase
case gray:setgrey(Yo+bits,lv g0,lv g1,lv g2,lv g3);endcase
case white:g0=0;g1=0;g2=0;g3=0;endcase
case grayFlip:fn=#16;setgrey(Yo+bits,lv g0,lv g1,lv g2,lv g3);endcase
]

// flip the box
// using CallBitBlt function from MenuBoxUtils.asm
// CallBitBlt(fn,u,dbca,dbmr,dlx,dty,dw,dh,sbca,sbmr,slx,sty,g0,g1,g2,g3)
CallBitBlt(fn,0,map,width, Xo+bits+xskip, Yo+bits+yskip, dw,dh,0,0,0,0,g0,g1,g2,g3)
resultis true

]

//*********************************************************
and setgrey(line,lvg0,lvg1,lvg2,lvg3) be
//*********************************************************
[
let grey=#52525
test (line & 1) eq 1
ifso [ @lvg0=not grey;@lvg1=grey;@lvg2=not grey;@lvg3=grey ]
ifnot [ @lvg0=grey;@lvg1=not grey;@lvg2=grey;@lvg3=not grey ]
]

//*********************************************************
and GetMouseButton(selection) =
//*********************************************************
selecton (selection<<SELECTION.keys) & 7 into
[
case 2:
3
case 1:
2
case 4:
default:
1
]

//*********************************************************
and ConfirmMenuSelection(prompt, selection; numargs na) = valof
//*********************************************************
[
//Asks for confirmation unless the third mouse key was used
test (na gr 1) & (selection<<SELECTION.key3 eq 1)
ifso resultis true
ifnot resultis GetConfirmation(prompt)
]

//*********************************************************
and GetConfirmation(prompt) = valof
//*********************************************************
[
Ws(prompt); Ws(" [confirm] ")
// InvertScreen(); for I = 1 to 10000 do Noop(); InvertScreen()
let questionMark = table
[
0b;
1700b;
3740b;
7160b;
6060b;
60b;
160b;
340b;
700b;
600b;
600b;
0b;
600b;
600b;
600b;
0b
]
ChangeCursor(questionMark)
until Endofs(keys) do Gets(keys)

[
while Endofs(keys) do
[
for I = 0 to 15 do cursorBitMap!I = not cursorBitMap!I
for I = 1 to 15000 do Noop()
]
let temp = Gets(keys)
switchon temp into
[
case $*n: //RETURN key
case $y:
case $Y:
Wl("YES")
ChangeCursor(questionMark)
resultis true

case 177b: //DEL key
case $n:
case $N:
Wl("NO")
ChangeCursor(questionMark)
resultis false
]
]
repeat
]

//*********************************************************
and ChangeCursor(pattern) be
//*********************************************************
[
let temp = vec 15
MoveBlock(temp, cursorBitMap, 16)
MoveBlock(cursorBitMap, pattern, 16)
MoveBlock(pattern, temp, 16)
]

////*********************************************************
//and InvertScreen() be
////*********************************************************
// [
// let dcb = @#420
// while dcb do
// [
// dcb>>DCB.background = not dcb>>DCB.background
// dcb = @dcb
// ]
// ]
//
//*********************************************************
and CursorInside2(box, XCursor, YCursor, returnXY; numargs na) = valof
//*********************************************************
[
// default cursor location to center of cursor
if (na eq 0) % (box eq 0) then resultis false
if na ls 3 then [ XCursor=0 ; YCursor=0 ]
XCursor=@#424+XCursor
YCursor=@#425+YCursor

// define box coords
let Xo=box>>BOX.xorigin
let Xc=box>>BOX.xcorner
let Yo=box>>BOX.yorigin
let Yc=box>>BOX.ycorner
if Xo eq Xc % Yo eq Yc then resultis false

// if dcb was specified, find absolute coords from dcb chain
let top=FindDCB(box)
// returns # lines to the dcb
if top eq true then resultis false
// couldn’t find the dcb
let left=top ? 16*((box>>BOX.dcb)>>DCB.indentation),0
Xo=Xo+left
Yo=Yo+top
Xc=Xc+left
Yc=Yc+top

// compare cursor coords to absolute coords
if (XCursor ge Xo) & (XCursor le Xc) then
[
if (YCursor ge Yo) & (YCursor le Yc) then
[
if na gr 3 then
[
returnXY!0 = XCursor - Xo
returnXY!1 = YCursor - Yo
]
resultis true
]
]
resultis false

]

//*********************************************************
and BoxBitBlt(BBT, destinationBox, sourceBox; numargs na) = valof
//*********************************************************
[
//Check arguments
if na eq 0 then resultis false
if na ls 2 then destinationBox = 0
if na ls 3 then sourceBox = 0

//Copy BBT
let TempBBT = vec ((size BBT)/16 + 1)
TempBBT = TempBBT & (not 1)
MoveBlock(TempBBT, BBT, size BBT/16)

if destinationBox then
unless ConvertBlock(destinationBox, TempBBT + 2, TempBBT + 6) do resultis false

if sourceBox then
unless TempBBT>>BBT.sType eq sGrayBlock do
unless ConvertBlock(sourceBox, TempBBT + 8, TempBBT + 6) do resultis false

BitBlt(TempBBT)
resultis true
]
//*********************************************************
and ConvertBlock(box, block, widthHeightPair) = valof
//*********************************************************
[
// define boundaries of the box
let outline=box>>BOX.bits
let originPair = vec 1
let cornerPair = vec 1
originPair!0=box>>BOX.xorigin
originPair!1=box>>BOX.yorigin
cornerPair!0=box>>BOX.xcorner
cornerPair!1=box>>BOX.ycorner

let offsetPair = block + 2 //ofsetPair!(0, 1) = lx, ty

for i = 0 to 1 do
[
// if offsetPair!i ls 0 then resultis false
//Clip x (i=0) and y (i=1) offsets just in case.
// if offsetPair!i ls 0 then offsetPair!i = 0
if offsetPair!i ls 0 then
[
widthHeightPair!i = widthHeightPair!i + offsetPair!i
offsetPair!i = 0
]

//Convert x (i=0) and y (i=1) offsets from box relative
// to "absolute" coordinates.
offsetPair!i = offsetPair!i + (originPair!i + outline)

let max = (cornerPair!i - outline + 1) - offsetPair!i

//Clip width (i=0) and height (i=1) if necessary
if widthHeightPair!i gr max then widthHeightPair!i = max
// if widthHeightPair!i le 0 then resultis false
]

// get dcb
let dcb=box>>BOX.dcb
if dcb eq 0 then resultis false
block>>BLOCK.bca=dcb>>DCB.bitmap
block>>BLOCK.bmr=dcb>>DCB.width

resultis true
]

//*********************************************************
and BoxDimensionX(box) =
//*********************************************************
box>>BOX.xcorner - box>>BOX.xorigin + 1 - 2 * box>>BOX.bits

//*********************************************************
and BoxDimensionY(box) =
//*********************************************************
box>>BOX.ycorner - box>>BOX.yorigin + 1 - 2 * box>>BOX.bits

//*********************************************************
and TypeStringInBox(boxNumber, defaultString, promptString, promptBoxNumber; numargs na) = valof
//*********************************************************
[
DefaultArgs(lv na, 1, 0, 0, -1)
let m = MenuData>> DATA.menu
unless (promptString eq 0) % (na ls 4) do
OverwriteBox(m!promptBoxNumber, promptString)
let stringUserTyped = GetString(m!boxNumber, defaultString, sysZone)
if stringUserTyped eq 0 then
[
stringUserTyped = Allocate(sysZone, 1)
stringUserTyped!0 = 0 //stringUserTyped>>STRING.length = 0
]
unless promptString eq 0 do
FillBox(m!promptBoxNumber, white)
resultis stringUserTyped
]

//*********************************************************
and OverwriteBox(box, string) be
//*********************************************************
[
FillBox(box, white, 0)
WriteBox(box, string)
]