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

	//	 bkgnd	op		source	 fn		grey
	//		 0		2			3		#16		-1
	//		 1		0			3		#14		-1
	//		 2		0			3		#14		 125252 or 52525
	//		 3		0			3		#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)
   ]