*******************************************************************************
*
* BoxCtl CDEFProc -- Version 3.0
*
* (C)  Copyright Apple Computer, Inc. 1988-1990
* All rights reserved.
*
* Developer Technical Support Apple II Sample Code
*
* by Keith Rollin
*
* This is a Custom Control for the Apple IIGS. It is similar in appearance
* and action to the 'resize' box you get when clicking on an object in GS Draw
* or MacDraw.
*
* The Control is essentially a frame with 4 or 8 grow knobs on the corners
* and/or edges. Dragging on any of these knobs will grow the control. Dragging
* on the frame will move the entire control (like moving a window). A flag can
* be set so that the control will be dragged if the user clicks in the interior
* of the control as well. Part codes for the knobs and frame are listed below.
*
* Snapping the rectangle's coordinates to a grid is also supported. The
* rectangle is snapped to the nearest point on the grid. This effectively means
* that I perform rounding, and not truncating.
*
* The frame of the control is the rectangle passed to NewControl. The size of
* the knobs and the size of the grid are passed in ctlValue. The 'interior drag
* flag' is passed in ctlFlags. See below for details.
*
* Color is supported. Currently, only two colors are used: one for the frame,
* and one for the knobs. The default colors are black.
*
*******************************************************************************
*
*   Part Code returned:
*
*           $A0 for all parts of the control (all parts are 'indicators')
*
*
*   CtlValue:   Bits  8-15: width of grow knobs
*               Bits  0- 7: height of grow knobs
*
*   CtlFlag bits:
*               7 = 1 - Control is invisible
*                 = 0 - Control is visible
*               2 = 1 - Has edge knobs
*                 = 0 - Doesn't
*               1 = 1 - Has corner knobs
*                 = 0 - Doesn't
*               0 = 1 - Clicking in interior will drag control
*                 = 0 - Clicking in interior does nothing
*
*   Data:   Contains a pointer to the following data block. This data
*           block holds the following information, which is copied to
*           the end	of the control record:
*
*               WORD: Min Y when growing
*               WORD: Min X when growing
*               WORD: Max Y when growing
*               WORD: Max X when growing
*               WORD: Spacing for Y segment of grid
*               WORD: Spacing for X segment of grid
*
*   Color Table:
*       WORD: Bits  12-15:  <reserved>
*	 8-11:  Knob Color
*	 4- 7:  Inactive Frame/Knob Color
*	 0- 3:  Frame Color
*
*******************************************************************************
*
*   How to use the Control:
*
*       Initialization and tracking of the control work just like any other;
*       set it up with NewControl. When GetNextEvent returns inContent, call
*       FindControl to see if you hit the control. If you did, call
*       TrackControl.
*
*   Initialization:
*
*               pha		; space for result
*               pha
*               PushLong theWindow
*               PushLong #theRect	; pointer to bounding rectangle
*               PushLong #0	; no title
*               PushWord #%00000111	; vis, int will drag, corners & edges
*               PushWord #$0503	; Width = 5/Height = 3
*               PushLong #CtrlData	; Pointer to additional data
*               PushLong #BoxProc	; pointer to DefProc
*               PushLong #0	; refcon
*               PushLong #0	; use std color table
*               _NewControl
*               PullLong theControl
*
*   theRect     dc.w    50,140,110,300
*   CtrlData    dc.w    10      ; min Y
*               dc.w    10      ; min X
*               dc.w    100     ; max Y
*               dc.w    200     ; max X
*               dc.w    16      ; grid Y
*               dc.w    32      ; grid X
*
*******************************************************************************
**********************************************************************
*                                                                    *
*     This program and its derivatives are licensed only for         *
*     use on Apple computers.                                        *
*                                                                    *
*     Works based on this program must contain and                   *
*     conspicuously display this notice.                             *
*                                                                    *
*     This software is provided for your evaluation and to           *
*     assist you in developing software for the Apple IIGS           *
*     computer.                                                      *
*                                                                    *
*     DISCLAIMER OF WARRANTY                                         *
*                                                                    *
*     THE SOFTWARE IS PROVIDED "AS IS" WITHOUT                       *
*     WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,               *
*     WITH RESPECT TO ITS MERCHANTABILITY OR ITS FITNESS             *
*     FOR ANY PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO             *
*     THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH            *
*     YOU.  SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU (AND            *
*     NOT APPLE OR AN APPLE AUTHORIZED REPRESENTATIVE)               *
*     ASSUME THE ENTIRE COST OF ALL NECESSARY SERVICING,             *
*     REPAIR OR CORRECTION.                                          *
*                                                                    *
*     Apple does not warrant that the functions                      *
*     contained in the Software will meet your requirements          *
*     or that the operation of the Software will be                  *
*     uninterrupted or error free or that defects in the             *
*     Software will be corrected.                                    *
*                                                                    *
*     SOME STATES DO NOT ALLOW THE EXCLUSION                         *
*     OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY              *
*     NOT APPLY TO YOU.  THIS WARRANTY GIVES YOU SPECIFIC            *
*     LEGAL RIGHTS AND YOU MAY ALSO HAVE OTHER RIGHTS                *
*     WHICH VARY FROM STATE TO STATE.                                *
*                                                                    *
*                                                                    *
**********************************************************************
	eject
;-------------------------------------------
;
; --- Constants
;
; --- Stack Frame/Local Direct Page usage
;

OrigD	equ 1	; caller's saved direct page register
OrigB	equ OrigD+2	; caller's saved data bank register
work	equ OrigB+1	; general use work space
CtlPtr	equ work+4	; pointer to control record
RtnAddr	equ CtlPtr+4	; RTL address back to Control Manager
theCtlHandle	equ RtnAddr+3	; handle to control record
CtlParam	equ theCtlHandle+4	; add'l parameter passed to DefProc
CtlCode	equ CtlParam+4	; operation to perform
ReturnValue	equ CtlCode+2	; space for return value to Ctl Mgr.

;
; --- Offsets for my control record
;

oCtlMinY	equ octlColor+4
oCtlMinX	equ oCtlMinY+2
oCtlMaxY	equ oCtlMinX+2
oCtlMaxX	equ oCtlMaxY+2
oCtlGridY	equ oCtlMaxX+2
oCtlGridX	equ oCtlGridY+2
oCtlSize	equ oCtlGridX+2

;
; --- Part codes for my control
;

BoxCtlPart	equ $A0	; This is returned to the app.

FramePart	equ $01	; These are used internally to tell
InteriorPart	equ $02	; 'myDragCtl' what part of the
ULPart	equ $03	; control we are dragging.
TopPart	equ $04
URPart	equ $05
RightPart	equ $06
LLPart	equ $07
BottomPart	equ $08
LRPart	equ $09
LeftPart	equ $0A


;
; --- Masks for ctlFlags
;

dragIntMask	equ %00000001	; if set, let user drag on interior
knobCornerMask	equ %00000010	; if set, draw knobs on the corners
knobEdgeMask	equ %00000100	; if set, draw knobs on the edges
visMask	equ ctlInVis

	EJECT
*******************************************************************************
*
CtlData	RECORD
*
* Description:	Storage for CDEF
*
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************

deltaX	ds.b 2	; used when growing the control
deltaY	ds.b 2
ColorPtr	ds.b 4	; pointer to actual color table to use
theParam	ds.b 4	; copy of CtlParam passed on stack
dragPart	ds.b 2	; internal part of control hit

myCtlRect	ds.b 8	; copy of CtlRect in control record
myCtlGridY	ds.b 2	; copy of CtlGridY
myCtlGridX	ds.b 2	; copy of CtlGridX

FrameHeight	ds.b 2
FrameWidth	ds.b 2

knobUL	ds.b 8	; This space is used to store the
knobTop	ds.b 8	; rectangles that define the grow
knobUR	ds.b 8	; knobs on the control. They are
knobRight	ds.b 8	; created as needed, and are not
knobLR	ds.b 8	; stored in the control record.
knobBottom	ds.b 8
knobLL	ds.b 8
knobLeft	ds.b 8

StdColorTable	dc.b $C0	; grey inact frame, blk normal frame
	dc.b $00	; black knobs
StdCtlData	dc.w 10,10,200,640,0,0 ; min 10,10; max 200,640; no grid
oldPenState	ds.b $32	; storage for old pen state.

GreyPattern	dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC
	dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC
	dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC
	dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC

	ENDR

	EJECT
*******************************************************************************
*
BoxProc	PROC
*
* Description:	Main Routine for Custom Control.
*
*
* Inputs:	On entry, the parameters are passed to us on the stack.
*
*	|	| Previous Contents
*	|-------------------|
*	|    ReturnValue	| LONG - Space for return value
*	|-------------------|
*	|    CtlCode	| WORD - operation to perform
*	|-------------------|
*	|    CtlParam	| LONG - add'l parameter
*	|-------------------|
*	|    theCtlHandle	| LONG - Handle to control record
*	|-------------------|
*	|    RtnAddr	| 3 BYTES - RTL address
*	|-------------------|
*	|	| <-- Stack pointer
*
* Outputs:	Put something into ReturnValue, pull off the parameters,
*	and return to the Control Manager.
*
*	|	| Previous Contents
*	|-------------------|
*	|    ReturnValue	| LONG - Space for return value
*	|-------------------|
*	|    RtnAddr	| 3 BYTES - RTL address
*	|-------------------|
*	|	| <-- Stack pointer
*
* External Refs:
	import InitCtlData
	import myDrawCtl
	import myTestCtl
	import myInitCtl
	import myDragCtl
	import myNewValue
	import mySetParams
	import myRecSize
	import Null
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

;
; We are going to be using the stack as our direct page for the
; custom control. The equates listed at the beginning of the custom
; control (right after the pageful of comments that explain it)
; describe the layout of the stack frame.
;
; The way we set up the stack frame as our direct page is by first
; saving the old contents of the DP register, transfering the stack
; pointer to the accumulator, and then transferring that to the DP
; register. We also save the contents of the Data Bank Register and
; reset it to the Program Bank Register so that we don't have to
; use 3-byte long addressing anywhere. We will restore both of these
; registers when we leave the custom control.
;

	pha	; push on some room	for 'CtlPtr'
	pha
	pha	; push on some room	for 'work'
	pha

	phb	; save the Data Bank register
	phd	; save the Direct Page register

	phk	; switch data bank to program bank
	plb
	tsc	; switch Direct Page into stack
	tcd

	jsr InitCtlData	; init some handy data

	lda <CtlCode	; get routine # to call
	cmp #recSize+1	; we only know of 12 CtlCodes
	blt ShiftIt
	lda #6	; force unknown codes to null events
ShiftIt
	asl a
	tax
	jsr (CtlTable,x)

	sta <ReturnValue	; save the return value
	stx <ReturnValue+2

;
; The Return Value has been stored on the stack, and it is time for us to
; return back to the Control Manager. Before we do so, however, we must
; remove the parameters that were passed to us on the stack. We do this
; by moving the RTL address up just below the Return Value, getting the
; stack pointer, and adding an amount to it so that we point to where
; the RTL address has been moved to. We can then simply RTL back to the
; Control Manager, and it will pick up the Return Value right off of the
; stack!
;
	lda <RtnAddr	; move the return address up
	sta <ReturnValue-3
	lda <RtnAddr+1
	sta <ReturnValue-2

	tsc	; Get the stack pointer

	pld	; restore caller's Data Bank and
	plb	; Direct Page registers

	clc	; Adjust the stack pointer to point to
	adc #ReturnValue-4	; the new location of the RTL address.
	tcs	; Put the stack pointer back.

	rtl	; back to the caller


; This is a table of pointers to routines to be called for specific
; CtlCodes passed to us. The 'null' entries are pointers to a
; routine that does nothing except return 'no error'.

CtlTable
	dc.w myDrawCtl	; 0 drawCtl
	dc.w Null	; 1 calcCRect
	dc.w myTestCtl	; 2 testCtl
	dc.w myInitCtl	; 3 initCtl
	dc.w Null	; 4 dispCtl
	dc.w Null	; 5 posCtl
	dc.w Null	; 6 thumbCtl
	dc.w myDragCtl	; 7 dragCtl
	dc.w Null	; 8 autoTrack
	dc.w myNewValue	; 9 newValue
	dc.w mySetParams	;10 setParams
	dc.w myInitCtl	;11 moveCtl
	dc.w myRecSize	;12 recSize

	ENDP

	EJECT
*******************************************************************************
*
myDrawCtl	PROC
*
* Description:	Draw control command.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:
	import CalcCorners
	import SetMyPen
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

; figure out the coordinates of the grow knobs.

	jsr CalcCorners

; Save the pen state, as we'll be changing it a lot.

	PushLong #oldPenState
	_GetPenState

; Set the correct width of the pen for the mode we are in.

	jsr SetMyPen

;
; Set the local variable 'ActivFlag' to indicate how to draw the
; control. We draw it inactive if a) the Hilite value is 255, or b)
; the owner window is inactive and fCtrlTie is set.
;
	ldy #octlHilite	; are we inactive?
	lda [<CtlPtr],y
	and #$00FF
	cmp #$00FF
	beq DrawInactive	; yes, so clear ActivFlag

; At this point, the control can potentially be drawn as an active
; control. But this can only happen if the window is active, or is
; inactive but with the fCtlTie flag clear.

	ldy #octlOwner	; get the pointer to the control's
	lda [<CtlPtr],y	; owning window into 'work'
	sta <work
	iny
	iny
	lda [<CtlPtr],y
	sta <work+2

	ldy #owFrame-4	; get the frame bits
	lda [<work],y
	and #fHilited	; check the Hilite bit
	bne DrawActive	; window is active -> control active
	lda [<work],y	; window is inactive
	and #fCtlTie	; does CtlTie bit affect control?
	bne DrawInactive	; yes, so draw it inactive too

DrawActive	lda #1
	sta ActivFlag
	bra SetColorTable

DrawInactive	stz ActivFlag

; Put the color table pointer into a  Direct page location.

SetColorTable
	lda ColorPtr
	sta <work
	lda ColorPtr+2
	sta <work+2

;
; See if the control is active or not, and set the color
; accordingly.
;

	lda ActivFlag
	bne SetFrameColor

	lda [<work]	; YES - so we are. Use the inactive
	lsr a	; pattern for this.
	lsr a
	lsr a
	lsr a
	and #$000f
	pha
	_SetSolidPenPat

	bra DrawFrame

SetFrameColor
	lda [<work]	; get the color for the frame from
	and #$000f	; the color table and use it.
	pha
	_SetSolidPenPat

DrawFrame
	PushLong #myCtlRect	; draw the frame of the control
	_FrameRect

;
; See if the control is active or not, and set the color accordingly. If
; we so chose we could even decide not to draw knobs on an inactive sizer.
; This is similar to the scrollbar defproc no drawing the thumb on an
; inactive scrollbar.
;

	lda ActivFlag
	beq DrawKnobs	; it's inactive; keep that pattern

	lda [<work]	; get the color of the knobs from
	xba	; the color table and set it.
	and #$000f
	pha
	_SetSolidPenPat

DrawKnobs
	ldy #octlFlag	; do we need corner knobs?
	lda [<CtlPtr],y
	and #knobCornerMask
	beq ckEdges	; no, so check for edge knobs.

	PushLong #knobUL	; yes, so draw them
	_PaintRect

	PushLong #knobUR
	_PaintRect

	PushLong #knobLL
	_PaintRect

	PushLong #knobLR
	_PaintRect

ckEdges
	ldy #octlFlag	; do we need edge knobs?
	lda [<CtlPtr],y
	and #knobEdgeMask
	beq done	; no, so leave

	PushLong #knobTop	; yes, so draw them.
	_PaintRect

	PushLong #knobRight
	_PaintRect

	PushLong #knobBottom
	_PaintRect

	PushLong #knobLeft
	_PaintRect

done
	PushLong #oldPenState ; clean up after ourselves.
	_SetPenState

	lda #0
	tax

	rts

ActivFlag	ds.b 2

	ENDP

	EJECT
*******************************************************************************
*
myTestCtl	PROC
*
* Description:	Hit test command. This routine checks to see if we have
*	chosen the ability to drag the control when we click in
*	the interior or not. If so, then we will always return
*	our partcode (BoxCtlPart = $A0). If not, then we only
*	return our partcode if we click on the frame or a knob.
*
*
* Inputs:	NONE
*
* Outputs:	A = Part code hit
*
* External Refs:
	import TestFrame
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	jsr TestFrame
	cmp #noPart	; hit anything?
	beq exit	; no - return nothing
	lda #BoxCtlPart	; yes - return our partcode
exit
	ldx #0	; high byte of return value always $00
	rts

	ENDP

	EJECT
*******************************************************************************
*
myInitCtl	PROC
*
* Description:	Called to initialize my custom fields of the control
*	record. It calles mySetParams to handle the data that
*	is pointed to by the Data/Params field, and makes sure
*	that the corners of the rectangle lie on the grid.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:
	import mySetParams
	import Snap2Grid
	import SetCtlRect
	import InitCtlData
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

; First, set up some fields based on the value of Param. This is
; a pointer to some additional data, so what SetParams does is
; copy that into our control record.

	jsr mySetParams
	jsr InitCtlData

; Next, make sure the edges of the control are aligned to a grid.

	ldx #^myCtlRect
	lda #myCtlRect
	jsr Snap2Grid

	jsr SetCtlRect

	lda #0	; return nothing
	txa

	rts
	ENDP

	EJECT
*******************************************************************************
*
myDragCtl	PROC
*
* Description:	Drag command. We hit something. Determine what it was and
*	drag it around the screen. If we hit the frame, then drag
*	the whole control. If we hit a knob, then we grow the
*	control (just like growing a window).
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:
	import SetMyPen
	import Snap2Grid
	import myDrawCtl
	import FindPart
	import SetCtlRect
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	PushLong #oldPenState ; save drawing state, as we change it
	_GetPenState

	ldy #6	; make a working copy of CtlRect.
loop100	lda myCtlRect,y
	sta drag_rect,y
	dey
	dey
	bpl loop100

	pha	; has the mouse been lifted up?
	PushWord #mUpMask	; ask for any such events
	PushLong #TrackEvent
	_GetNextEvent
	pla

	lda TrackEvent+owhat
	cmp #mouseUpEvt	; was there a mouse up event?
	bne mDown	; no - so start tracking
	brl done	; yes - so leave

mDown
	PushLong #TrackEvent+owhere
	_GlobalToLocal

	lda TrackEvent+owhere
	sta OldMouse	; FindPart likes the mouse Position
	sta theParam	; in 'theParam'
	lda TrackEvent+owhere+2
	sta OldMouse+2
	sta theParam+2

	jsr FindPart	; what did we hit? (returns internal
	sta dragPart	;   partcode number).

	cmp #InteriorPart+1	; what part did we hit?
	bge GrowFrame	; some knob - grow the control
	brl DragFrame	; interior or frame - move the control

;
; This part of the program is called when we detect that we have clicked on
; a grow knob. It tracks the motions of the mouse, and grows/draws the
; control appropriately.
;
GrowFrame
	PushWord #2	; set us to XOR mode. This is for the
	_SetPenMode	; rubber-banding effect of growing.

	jsr SetMyPen	; set my pen's width

	PushLong #GreyPattern ; grow with a grey pattern
	_SetPenPat

	ldy #oCtlMaxX	; get local copies of the maximum
	ldx #6	; and minimum dimensions.
loop0010	lda [<CtlPtr],y
	sta MinY,x
	dey
	dey
	dex
	dex
	bpl loop0010

; validate the min and max values. the min values must be at least $10.
; if not, they are set there. the max values must be at least as large
; as the min values. if not, they are set to $FFFF

	lda #$10
	cmp MinX
	blt ckMinY
	sta MinX

ckMinY	cmp MinY
	blt ckMaxX
	sta MinY

ckMaxX	lda MaxX
	cmp MinX
	bge ckMaxY
ChgX	lda #$FFFF
	sta MaxX

ckMaxY	lda MaxY
	cmp MinY
	bge doneCk
ChgY	lda #$FFFF
	sta MaxY
doneCk

;
; We grow the control with the following algorithm. First, setup by:
;
;  1. saving the current mouse postion in 'NewMouse',
;  2. aligning 'NewMouse' to the grid, and
;  3. making a working copy of the control's rectangle in 'drag_rect'.
;
; We then enter the main loop:
;
;  4. Draw a copy of the rubber-banding rectangle.
;  5. Check the mouse button. If it is up, goto #12
;  6. Put the position of the mouse into 'NewerMouse'. Align it to grid.
;  7. Check it against 'NewMouse'. If it hasn't changed, goto #5.
;  8. Erase the old rubber-Band.
;  9. Calculate the new rectangle and put it into 'drag_rect'
; 10. Move 'NewerMouse' into 'NewMouse'
; 11. Goto #4
;
; The growing is all done. Clean up and leave.
;
; 12. Erase the rubber band.
; 13. Erase the control.
; 14. Invalidate the area under the control
; 15. Make drag_rect the new boundary of the control
; 16. Say goodnite, Gracie.
;

	lda OldMouse
	sta NewMouse
	lda OldMouse+2
	sta NewMouse+2

	ldx #^NewMouse	; make sure we are on the grid!!!
	lda #NewMouse
	jsr Snap2Grid

DrawLoop
	PushLong #drag_rect	; draw the rubber-band
	_FrameRect

WaitLoop
	pha	; has the mouse been lifted up?
	PushWord #mUpMask	; ask for any such events
	PushLong #TrackEvent
	_GetNextEvent
	pla

	lda TrackEvent+owhat
	cmp #mouseUpEvt
	beq done	; mouse up occured - so leave.
	
	lda TrackEvent+owhere ; mouse still down. copy it to
	sta NewerMouse	; NewerMouse
	lda TrackEvent+owhere+2
	sta NewerMouse+2
	
	PushLong #NewerMouse ; convert it to window coordinates.
	_GlobalToLocal

	ldx #^NewerMouse	; make sure the new position is on
	lda #NewerMouse	; the grid.
	jsr Snap2Grid

	lda NewerMouse	; See if the mouse position moved. We
	cmp NewMouse	; only redraw the rubber-band if it did.
	bne ReDraw	; It did - redraw the rubber-band
	lda NewerMouse+2
	cmp NewMouse+2
	beq WaitLoop	; No movement - check button state

ReDraw
	PushLong #drag_rect	; erase the old rubber band
	_FrameRect

	lda NewerMouse	; copy NewerMouse for next loop
	sta NewMouse
	sec	; and update deltaXY for AdjFrameRect
	sbc OldMouse
	sta deltaY

	lda NewerMouse+2
	sta NewMouse+2
	sec
	sbc OldMouse+2
	sta deltaX

	jsr AdjFrameRect	; adjust for drawing the new rect

	brl DrawLoop	; redraw the rubber-band

done
	PushLong #drag_rect	; erase the rubber band
	_FrameRect

	PushLong #myCtlRect	; erase the control
	_EraseRect

	PushLong #myCtlRect	; invalidate the stuff under it
	_InvalRect

	brl Exit
;
; This part of the program is called when we have clicked on either the
; frame or the interior. It calls dragrect to move an outline of the
; control around.
;

DragFrame

; Get the portRect of the window that owns this control. This rectangle
; will be used to control the limits of dragging.

	ldy #octlOwner	; get the pointer to the control's
	lda [<CtlPtr],y	; owning window into 'work'
	sta <work
	iny
	iny
	lda [<CtlPtr],y
	sta <work+2

	ldy #oportRect+6	; copy the PortRect of the window
	ldx #6	; out of its GrafPort into limitRect.
loop400	lda [<work],y
	sta limitRect,x
	dey
	dey
	dex
	dex
	bpl loop400

;
; Use dragRect to drag an outline of the control around the
; screen for me.
;
	pha	; space for result
	pha
	PushLong #DragDraw	; no action proc
	PushLong #GreyPattern ; drag pattern
	PushLong OldMouse	; starting location of mouse
	PushLong #drag_rect	; outline to drag
	PushLong #limitRect	; limitRect
	PushLong #limitRect	; slopRect
	PushWord #%00101000	; custom drag flag, ReturnRect flag
	_DragRect

	pla	; pull off and discard the deltas
	pla

	PushLong #myCtlRect	; erase the control in its old pos'n
	_EraseRect

	PushLong #myCtlRect	; invalidate the stuff under it
	_InvalRect

	ldx #^drag_rect	; align the new rectangle to the grid.
	lda #drag_rect
	jsr Snap2Grid

Exit
	ldy #6	; copy over the new	control frame
loop200	lda drag_rect,y
	sta myCtlRect,y
	dey
	dey
	bpl loop200

	PushLong #myCtlRect	; Invalidate the new area under the
	_InvalRect	; control so it will be redrawn.

	PushLong #oldPenState
	_SetPenState	; clean up QuickDraw after ourselves.

	jsr SetCtlRect	; copy new rect into control record

	lda #-1	; Say that we handled it
	tax

	rts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Called by DragRect to draw the rectangle of the control. I draw the outline
; myself so that I can align it to my own grid. The normal aligning of the
; rectangle to the grid only aligns to powers of 2. I align to anything.
;
; When this routine is called, the stack looks like this:
;
;	PUSH:WORD - delta X
;	PUSH:WORD - delta Y
;	PUSH:BYTE[3] - return address
;
; However, since I set the ReturnRect flag, I can ignore the deltas passed to
; me, and use drag_rect directly. I make a copy of it, make sure that it is
; aligned to the grid, draw it, remove the parameters, and return to the
; control manager.
;

DragDraw

RTLAddr	equ 1
DY	equ RTLAddr+3
DX	equ DY+2

	ldx #6	; make a copy of the rectangle that
loop500	lda drag_rect,x	; _DragRect is passing to us. We are
	sta draw_rect,x	; going to modify it so that it is
	dex	; aligned to the grid.
	dex
	bpl loop500

	ldx #^draw_rect	; align the new rectangle to the grid.
	lda #draw_rect
	jsr Snap2Grid

DrawOutline
	PushLong #draw_rect
	_FrameRect

ExitDragDraw
	lda 1,s	; move the RTL address back up
	sta 5,s
	lda 2,s
	sta 6,s

	pla	; remove the parameters (DX, DY)
	pla

	rtl	; back to dragRect!!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Called by the routine that grows the control with a rubber-band
; sort of thing. It uses the part code we hit as an index into
; a table. This table contains a list of offsets into the
; 4 words of drag_rect. It reads in a pair of these offsets and
; uses them to modify the appropriate X/Y coordinates with
; deltaY and deltaX. DeltaY and deltaX are set up by the
; rubber-banding routine.

AdjFrameRect
	ldx #6
loop380	lda drag_rect,x
	sta new_rect,x
	dex
	dex
	bpl loop380

	lda dragPart	; get the part code we are dragging
	sec
	sbc #ULPart
	asl a	; turn it into an index.
	asl a
	tax
	lda PtToAdj,x	; get Y coordinate to adjust
	tay
	lda PtToAdj+2,x	; get X coordinate to adjust
	tax

; if the entry that was fetched from the table was -1, then that means
; that we are making no adjustments in that direction. For instance, it
; we are dragging on the top edge knob, we want to adjust just the top
; side of the rectangle, but want to leave either of the sides alone.

	cpy #-1 	; modify the vertical coordinate
	beq NoChg1	; of choice if necessary.
	clc
	lda deltaY
	adc myCtlRect,y
	sta new_rect,y

NoChg1	cpx #-1	; modify the horizontal coordinate
	beq NoChg2	; of choice if necessary.
	clc
	lda deltaX
	adc myCtlRect,x
	sta new_rect,x

NoChg2
	ldx #^new_rect	; align the rectangle to the grid.
	lda #new_rect
	jsr Snap2Grid

; now that we have a new rectangle, we have to make sure that it is within
; the maximum and minimum sizes allowed.

	sec	; make sure the new Y size is OK
	lda new_rect+4
	sbc new_rect
	bcc NoCopy1
	cmp MinY
	blt NoCopy1	; it's not, so leave old coords there
	inc a
	cmp MaxY
	bge NoCopy1	; it's not, so leave old coords there

	lda new_rect	; it is, so update it.
	sta drag_rect
	lda new_rect+4
	sta drag_rect+4

NoCopy1
	sec	; make sure the new X size is OK
	lda new_rect+6
	sbc new_rect+2
	bcc NoCopy2
	cmp MinX
	blt NoCopy2	; it's not, so leave old coords there
	inc a
	cmp MaxX
	bge NoCopy2	; it's not, so leave old coords there

	lda new_rect+2	; it is, so update it
	sta drag_rect+2
	lda new_rect+6
	sta drag_rect+6
NoCopy2
	rts


PtToAdj	dc.w 0,2,0,-1,0,6,-1,6,4,6,4,-1,4,2,-1,2

TrackEvent	ds.b $10

OldMouse	ds.b 4
NewMouse	ds.b 8
NewerMouse	ds.b 8
drag_rect	ds.b 8
draw_rect	ds.b 8
new_rect	ds.b 8
limitRect	ds.b 8
MinY	ds.b 2
MinX	ds.b 2
MaxY	ds.b 2
MaxX	ds.b 2

	ENDP

	EJECT
*******************************************************************************
*
myNewValue	PROC
*
* Description:	Called when the value of the control is to be changed.
*	The area under the control is invalidated so that it will
*	be redrawn.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:
	import Snap2Grid
	import myDrawCtl
	import SetCtlRect
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	PushLong #myCtlRect	; erase old control
	_EraseRect

	PushLong #myCtlRect	; invalidate area erased
	_InvalRect

	ldx #^myCtlRect	; make sure control is on the grid
	lda #myCtlRect
	jsr Snap2Grid

	jsr SetCtlRect

	lda #0	; return no value
	tax

	rts
	ENDP

	EJECT
*******************************************************************************
*
mySetParams	PROC
*
* Description:	Set new parameters command. Don't set if either of them
*	are negative.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	lda theParam	; these have gotta go on in reverse
	sta <work+2
	lda theParam+2
	sta <work

	ora <work+2	; is this a NULL pointer?
	bne CopyIt	; no - so use it

	lda #^StdCtlData	; yes - so set pointer to default data
	sta <work+2
	lda #StdCtlData
	sta <work

CopyIt
	ldy #oCtlSize-2	; copy the data into control record.
	ldx #oCtlSize-oCtlMinY-2
loop	phy
	txy
	lda [<work],y
	ply
	sta [<CtlPtr],y
	dey
	dey
	dex
	dex
	bpl loop

	lda #0	; return no value
	tax

	rts
	ENDP

	EJECT
*******************************************************************************
*
myRecSize	PROC
*
* Description:	Return record size command.
*
*
* Inputs:	NONE
*
* Outputs:	A = Size of the control record to allocate.
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	lda #oCtlSize	; low word of record size
	ldx #0	; high word

	rts
	ENDP

	EJECT
*******************************************************************************
*
Null	PROC
*
* Description:	Null routine. Does nothing. Returns no error.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************

	lda #0
	tax

	rts
	ENDP

	EJECT
*******************************************************************************
*
InitCtlData	PROC
*
* Description:	Initialize some data that will needs to be handy: Get a
*	pointer to the control record (we are supplied only with
*	a handle), make a local copy of the control rectangle, set
*	up a pointer to a color table, and move CtlParam from a
*	Direct Page location into an absolute location.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

;
; Check to see if the Control Manager is sending us a 'RecSize' call. If it
; is, then we cannot rely on the validity of the Control handle, as it has not
; yet been allocated and is essentially garbage. Since we do not know what it
; points to, we don't want to read from it, as it may actually accidentally
; point to something dangerous, like the IWM I/O locations!!! So if we detect
; a RecSize code, skip over this routine.
;
	lda <CtlCode	; is this a RecSize call?
	cmp #recSize
	beq done	; yes - skip this whole routine

;
; Copy the value in CtlParam into a local location -- off of the direct page.
; We do this for convenience. We may need to pass a pointer to CtlParam to
; a toolbox routine, but you can't do that for a direct page location. The
; number assiciated with a direct page location is really an offset off of the
; base specified by the Direct Page register; it is NOT an absolute memory
; location. So that we can conveniently use 'PushLong #location' if we need
; to, I copy CtlParam to a non-direct page location.
;
	lda <CtlParam
	sta theParam
	lda <CtlParam+2
	sta theParam+2

	ldy #2	; get a handy pointer to the CtlRec
	lda [<theCtlHandle],y
	sta <CtlPtr+2
	lda [<theCtlHandle]
	sta <CtlPtr

	ldy #octlRect+6	; copy the control rect over to the
	ldx #6	; local variable.
loop	lda [<CtlPtr],y
	sta myCtlRect,x
	dey
	dey
	dex
	dex
	bpl loop

;
; The following values are used by Snap2Grid. However, Snap2Grid can be
; called with an invalid Direct Page, so we copy them out the control
; record (which is pointed to by a pointer in our Direct Page) and into
; some absolute locations that we can get to at all times.
;
	ldy #oCtlGridX	; get the X and Y spacings out of the
	lda [<CtlPtr],y	; control record and into some local
	sta myCtlGridX	; storage for easy handling.

	ldy #oCtlGridY
	lda [<CtlPtr],y
	sta myCtlGridY

; Check the color table pointer. If it is non-zero, install it as the
; pointer to the color table we'll be using. If not, then install a
; pointer to a default color table.

	ldy  #octlColor	; Get the pointer to the color
	lda [<CtlPtr],y	; table in the control record.
	sta ColorPtr	; Save it to a local pointer.
	iny
	iny
	lda [<CtlPtr],y
	sta ColorPtr+2
	ora ColorPtr	; is it a NULL pointer?
	bne done	; no, so use it.

	lda #StdColorTable	; yes, install my own color table.
	sta ColorPtr
	lda #^StdColorTable
	sta ColorPtr+2

done
	rts

	ENDP

	EJECT
*******************************************************************************
*
SetCtlRect	PROC
*
* Description:	This routine is called when the control's bounding
*	rectangle has been changed and needs to be written back
*	out to the control record.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	ldy #octlRect+6	; get an offset into the control rec.
	ldx #6	; index to my local record.
loop
	lda myCtlRect,x
	sta [<CtlPtr],y
	dey
	dey
	dex
	dex
	bpl loop

	rts

	ENDP

	EJECT
*******************************************************************************
*
SetMyPen	PROC
*
* Description:	We want our control to look good in both 320 and 640 mode.
*	Because vertical lines are thinner in 640 than 320, its a
*	good idea to draw them doubly thick just so they can be
*	seen. This routine will determine what mode we are in and
*	adjust the pen accordingly.
*
*
* Inputs:	NONE
*
* Outputs:	NONE
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

	pha	; we base pen width on the MasterSCB
	_GetMasterSCB
	pla
	and #$0080	; check the mode bit
	beq pen320	; we are in 320 mode - go push a 1

	PushWord #2	; in 640 mode - push on a 2 width
	bra setpn

pen320	PushWord #1	; in 320 mode - push on a 1 width

setpn		; width is 1 or 2
	PushWord #1	; Height is always 1
	_SetPenSize

	rts
	ENDP

	EJECT
*******************************************************************************
*
CalcCorners	PROC
*
* Description:	This routine calculates the rectangles for all of the
*	little knobs that are used to grow the control. They are
*	stored locally - not with the control record - and so need
*	to be calculated every time we need to check for hits or
*	to draw the control.
*
*
* Inputs:	NONE
*
* Outputs:	knobXXX, FrameHeight, FrameWidth variables are initialized.
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

top	equ 0	; alias these to something a little
left	equ 2	; more descriptive.
bottom	equ 4
right	equ 6

; Get the size of the knobs. The height and width are stored in the CtlValue
; field in a packed format. This unpacks them and stores them locally for
; ease of access.

	ldy #octlValue
	lda [<CtlPtr],y
	and #$00FF
	sta FrameHeight
	lda [<CtlPtr],y
	xba
	and #$00FF
	sta FrameWidth

;
; We "assembly line" the initialization of the knob rectangles. Instead
; of calculating just one knob at a time, we do a few of them all at the
; same time. Here we initialize the tops and bottoms of the 3 top knobs.

	lda myCtlRect+top
	sta knobUL+top
	sta knobTop+top
	sta knobUR+top
	clc
	adc FrameHeight
	sta knobUL+bottom
	sta knobTop+bottom
	sta knobUR+bottom

;
; Initialize the lefts and rights of the three left knobs.
;
	lda myCtlRect+left
	sta knobUL+left
	sta knobLeft+left
	sta knobLL+left
	clc
	adc FrameWidth
	sta knobUL+right
	sta knobLeft+right
	sta knobLL+right

;
; Initialize the tops and bottoms of the three bottom knobs.
;
	lda myCtlRect+bottom
	sta knobLL+bottom
	sta knobBottom+bottom
	sta knobLR+bottom
	sec
	sbc FrameHeight
	sta knobLL+top
	sta knobBottom+top
	sta knobLR+top

;
; Initialize the lefts and rights of the three right knobs.
;
	lda myCtlRect+right
	sta knobUR+right
	sta knobRight+right
	sta knobLR+right
	sec
	sbc FrameWidth
	sta knobUR+left
	sta knobRight+left
	sta knobLR+left

;
; At this point, the 4 corner knobs have been completely initialized.
; If we are going to be using the edge knobs, then we'll have to do
; some extra math. However, if we aren't, then we'll skip over the
; math.

	ldy #octlFlag
	lda [<CtlPtr],y
	and #knobEdgeMask
	beq done

; Do extra setup for edge knobs
;
; First, get top and bottom coordinates for the side edges:
;
;     top = (myCtlRect.top + myCtlRect.bottom - FrameHeight)/2
;     bot = (myCtlRect.top + myCtlRect.bottom + FrameHeight)/2

	clc
	lda myCtlRect+top
	adc myCtlRect+bottom
	pha
	adc FrameHeight
	lsr a
	sta knobLeft+bottom
	sta knobRight+bottom
	pla
	sec
	sbc FrameHeight
	lsr a
	sta knobLeft+top
	sta knobRight+top

;
; Now perform similar calculations for the left and right sides
; of the top and bottom edge knobs.
;
	clc
	lda myCtlRect+left
	adc myCtlRect+right
	pha
	adc FrameWidth
	lsr a
	sta knobTop+right
	sta knobBottom+right
	pla
	sec
	sbc FrameWidth
	lsr a
	sta knobTop+left
	sta knobBottom+left

done
	rts
	ENDP

	EJECT
*******************************************************************************
*
Snap2Grid	PROC
*
* Description:	This control defproc lets the application optionally create
*	an invisible grid based on local coordinates. When this is
*	done, the 4 corners of the control are always aligned to
*	the coordinates of this grid. This occurs when we drag or
*	resize the control, or call MoveControl. Snap2Grip is the
*	routine that ensures we are on the grid.
*
*
* Inputs:	A = low word of pointer to rectangle to fix
*	X = high word
*
* Outputs:	rectangle is modified in place.
*
* External Refs:	NONE
*
* Entry Points:	NONE
*
*******************************************************************************
	with CtlData

oldD	equ 1
oldB	equ oldD+2
rectPtr	equ oldB+1

;
; We are going to use a local direct page here. This is because Snap2Grid is
; called by my routine that draws the control's recangle as it is being
; dragged. When that happens, we are not using our normal direct page, and
; hence can't use any of the values or work locations there. So we set up
; another one with it's own workspace.
;
	phx	; save the pointer to the rectangle
	pha

	phb	; save the caller's data bank register
	phd	; save the caller'd direct page reg.

	phk	; switch data bank to program bank
	plb

	tsc	; switch direct page to stack pointer
	tcd


;
; WhchGridYX is used to help generalize this routine. We support different
; spacings in the X and Y directions of the grid. As we loop through all 4
; coordinates of the rectangle, we want to make sure that we are using the
; correct spacing. 'whichGridYX' holds flags that tell us when to use X and
; when to use Y spacing (0 = use Y spacing; 1 = use X spacing).
;
	lda #%0101	; Set up some indices into GridYX
	sta whichGridYX

;
; Fix the coordinates by using the following method:
;
;  1. Get the difference between the coordinate we are examining and
;     the next lowest grid location:
;
;          z = coordinate mod GridSize
;
;  2. Z tells how far away from the next lowest grid line
;     the coordinate we are looking at is, so subtracting that
;     value will put the coordinate on the grid.
;
;          coordinate := coordinate - z
;
;  3. However, this is simply truncating, and I don't like the
;     way that feels when resizing the control. So lets add an
;     instruction so that it ROUNDS instead.
;
;          if z > GridSize/2 then
;               coordinate := coordinate + GridSize
;

	ldy #6	; init our loop index
Loop
	sty YSave

	lda whichGridYX	; do we now use X or Y grid spacing?
	and #%0001
	beq UseY
	lda myCtlGridX
	bra UseIt
UseY
	lda myCtlGridY

; we now have the gridsize in the Acc
UseIt
	cmp #2	; Is it 0 or 1? If so, then skip over
	blt ShortCircuit	;   dividing routine.
	sta GridSize	; save this for the divide later.

	pha	; push space on stack for the result
	pha	; of the divide we are going to do.

	lda [<rectPtr],y	; push on the coordinate we are
	pha	;   adjusting as the Dividend
	PushWord GridSize	; push this on as the divisor
	_UDivide	; unsigned divide
	pla	; quotient - we don't want it.
	PullWord Remainder	; remainder is 'z' - Keep it!

	ldy YSave	; get my coordinate index back.
	lda [<rectPtr],y	; get the coordinate to change
	sec
	sbc Remainder	; change it
	sta [<rectPtr],y	; save it back out

	lda GridSize	; Make a GridSize/2
	lsr a
	cmp Remainder	; is remainder < GridSize/2?
	bge ShortCircuit	; yes - so we're done
	lda [<rectPtr],y	; no - so bump the coordinate
	clc
	adc GridSize
	sta [<rectPtr],y

ShortCircuit	lsr whichGridYX	; move the next index into place
	dey	; bump down to the next coordinate
	dey	;   of the rectangle.
	bpl Loop

Exit
	pld	; restore caller's Direct Page reg.
	plb	; restore data bank register
	pla	; remove rect pointer
	pla
	rts	; all done - go bye-bye

whichGridYX	ds.b 2
YSave	ds.b 2
Remainder	ds.b 2
GridSize	ds.b 2

	ENDP

	EJECT
*******************************************************************************
*
FindPart	PROC
*
* Description:	This routine is called to find out exactly which part of
*	the control we clicked in. It first checks to see if we
*	clicked in any of the grow knobs. If so, then it returns
*	an 'internal partcode' telling the calling routine which
*	knob was clicked in. If a knob wasn't clicked in, a check
*	is made to see if we clicked on the frame. If we are
*	allowed to click in the interior, a check is made to see
*	if we clicked there, too.
*
*
* Inputs:	NONE
*
* Outputs:	A = internal partcode of part hit (1-10)
*
* External Refs:
	import CalcCorners
*
* Entry Points:
	entry TestFrame	; called by myTestCtl
*
*******************************************************************************
	with CtlData

	jsr CalcCorners

;
; We first check to see if the mouse was clicked in any of the knobs. We do
; this by assuming a knob was clicked in, and then checking to see if that was
; true. If so, we leave here with the partcode we assumed. If not, we loop
; through and check all of the other knobs. If none of the knobs was clicked
; in, we see if the frame was clicked on.

	ldx #LeftPart	; get last knob's part code
	ldy #7*8	; point to last knob's rect

loop
	phx	; save partcode we're checking for...
	phy	; and the rect's pointer

	pha	; space for _PtInRect result
	PushLong #theParam	; push on the point to check
	lda #^knobUL	; create a pointer to the rect
	pha
	clc	; Bumping just the low byte is OK
	tya	;   unless the GS suddenly lets
	adc #knobUL	;   code segments cross bank
	pha	;   boundaries
	_PtInRect
	pla	; get result of PtInRect
	ply	; retrieve rectangle index
	plx	; retrieve part code
	cmp #0	; did we score a hit?
	bne InKnob	; yes, return with the part code
	dex	; move down to next partcode
	sec	; move down to next rectangle
	tya
	sbc #8
	tay
	bpl loop	; keep going until rect index < 0

	bra TestFrame	; not in knobs - try frame

;
; We just scored a hit on one of the knobs, and X holds the knob number.
; However, the application may not have corner or edge knobs active. So
; if we clicked on an inactive knob, have to check for that and return
; 'inFrame' instead of a knob partcode.
;
InKnob
	ldy #octlFlag	; are corner knobs active?
	lda [<CtlPtr],y
	and #knobCornerMask
	bne ckEdge	; yes - so pass this code on.

	txa	; Corners not allowed. Did we hit one?
	lsr a
	bcs RetFramePart	; yes, so return click on Frame instead

ckEdge
	ldy #octlFlag	; are edge knobs active?
	lda [<CtlPtr],y
	and #knobEdgeMask
	bne done	; yes - so return this code

	txa	; Edges not allowed. Did we hit one?
	lsr a
	bcs TestFrame	; no, so pass this code on.
RetFramePart
	ldx #FramePart	; yes, so return click on Frame instead
done
	txa	; put the part code	in the Acc
	rts

TestFrame

; First test to see	if it is within the	Control's rectangle. It should
; be, but let's check anyway...

	pha
	PushLong #theParam
	PushLong #myCtlRect
	_PtInRect
	pla
	beq NotInFrame	; no in the frame. Signal noPart

; Now see if we differentiate between the frame and the interior

	ldy #octlFlag
	lda [<CtlPtr],y
	and #dragIntMask
	bne RetFramePart	; nope - everything	drags

; Yes we do. Now see if we hit the frame fair and square. Inset the
; control's bounding rectangle by the size of the knobs that are on
; it to create an inner rectangle. If we fall between those two
; rectangles, then I say that you have landed on the frame. If we
; got this far, then we know that we are within the outer rectangle.
; Now see if we are outside of the inner rectangle.

	ldx #6	; make a copy of the control rect
CopyLoop	lda myCtlRect,x	; so that we can reduce it.
	sta innerRect,x
	dex
	dex
	bpl CopyLoop

	PushLong #innerRect	; push on pointer to the rect to inset
	PushWord FrameWidth	; push on the amounts to inset it by
	PushWord FrameHeight ; (these vals inited by CalcCorners)
	_InsetRect

	pha	; see if we are outside of the inner
	PushLong #theParam	; rectangle
	PushLong #innerRect
	_PtInRect

	pla	; check the result
	beq RetFramePart	; we were between rects!

NotInFrame	lda #noPart	; Not *exactly* on the frame.
	rts

innerRect	ds.b 8

	ENDP