'...:....1....:....2....:....3....:....4....:....5....:....6....:....7....:....8
Option Explicit
const	emCOREDriverVersion=3.213
' Last update: 2005:0307:1900
' 3.213 fix: x_OTT was a bad reference.  Over The Top box must be passed in
'		after the last overflow box.
' 3.212 new: score routine now lights OVER THE TOP in x_OTT if it exists
' 3.212 new: emState has a slamtilt routine
' 3.212 fix: gameover sets .tilted as well in emState (but does not show TILT)
' 3.212 fix: tilt with TILT_ALL now does not show bonus
' 3.211 fix: score_special buglet fixed: call addscore, not score, dope!
' 3.210 fix: made emSet/Check/Clear capable of dropwalls
' 3.205 fix: fixed score-overflow calculation (off by an order of magnitude).
' 3.205 fix: fixed score-wraparound replays (they work now).
' NEW CLASS: emVPConfig
' emCORE - Object classes, functions and subroutines common to all
' machines.  This includes:
'	- logic functions min and max (not in VBscript!)
'	- simple dictionary routines
'	- error handling and debugging
'	- enabling/disabling of objects
'	- setting/clearing of indicators
'	- drop targets
'	- eject holes
'	- gates
'	- flipper posts (should only ever have one, but...)
'	- backbox initialisation
'	- score reel initialisation
'	- replay scoring
'	- bonus queues
'
' things you will not find here:
'	- bonus collect/reset routines (machine specific)
'	- the cam timer and rotor (machine specific)
'*****************************
'#### debugger box ("We interrupt this program...")
'# dd:  debug dialog
'#
sub dd(iTitle, iMsg)
	msgbox iMsg, vbOKonly, iTitle
end sub

'# debugger monitor in a textbox

dim debugging
	debugging = false

public sub dbx(a)
	dim ao
	dim msg

	if not debugging then exit sub

	if not isobject(dtx) then exit sub

	if typename(dtx) <> text_t then 
		dd "dbx: debugging disabled", _
		"You have no debugging box (typename(dtx) = " & _
			typename(dtx) & " vs " & text_t & ")"		
		exit sub
	end if

	if isarray(a) then
		for each ao in a
			msg = msg & " " & ao
		next
	else
		msg = a
	end if

	dtx.text = msg
end sub

'# checking the scores to make sure they match the reels.

public sub pscores()
	dim m, p
	if not debugging then exit sub

	if not isobject(x_scores) then exit sub
	if not isobject(scores) then exit sub

	for p = 0 to scores.maxplayers
		m = m & scores.score(p) & vbNewLine
	next
	x_scores.text = m
end sub

'# Show all cam positions
sub showcams()
	dim i		' index
	dim m		' text string
	dim s, f	' scores and features
	if not debugging then exit sub
	if typename(x_cams) <> text_t then
		dmsg "showcams:  debugging disabled", _
		"You have no cams box (typename (x_cams) = " & _
		typename(x_cams) & " vs " & text_t & ")"
		exit sub
	end if

	m = ""

	for i = 1 to ubound(camstack)
		s = camstack(i) and C_SCORE
		f = camstack(i) and C_FMASK
		m = m & s & "/" & hex(f) & " "
	next
	m = m & hex(c_pending)
	x_cams.text = m
end sub

'####
'Logic Functions, seeing as VBscript did not see fit to include such things
' as max(), min() and others.
'
'
' max() - returns the greater of two numbers
' min() - returns the lesser of two numbers
' nmax() - returns the greatest in a list
' nmin() - returns the least in a list
'
' sizeof() - returns the size of an array or collection


function max(a,b): max = b: if a > max then max = a: end if: end function
function min(a,b): min = b: if a < min then min = a: end if: end function

function nmax(a)
	dim o

	nmax = 0
	for each o in a
		if o > nmax then
			nmax = o
		end if
	next
end function

function nmin(a)
	dim o

	nmin = 0
	for each o in a
		if o < nmin then
			nmin = o
		end if
	next
end function
		

function sizeof(a)
    dim o
    if isarray(a) then sizeof = ubound(a): exit function

    sizeof = -1
    if typename(a) <> coll_t then exit function
    for each o in a: sizeof = sizeof + 1: next
end function


'##### TYPE DEFINITIONS
' == typedefs

const	null_t = "Null"
const	array_t = "Array"
const	light_t = "Light"
const	wall_t = "Wall"
const	bumper_t = "Bumper"
const	coll_t = "Collection"
const	text_t = "Textbox"
const	reel_t = "DispReel"
const	flipper_t = "Flipper"
const	gate_t = "Gate"
const	eject_t = "Kicker"

' == useful error codes
const	EOVERFLOW=6	' overflow
const	EFPE=11		' division by zero
const	ENOARG=448	' named argument not found
const	EUNVAR=500	' variable is undefined
const	EDANGERSCR=502	' object not safe for scripting
const	EDANGERINIT=503	' object not safe for initialising
const	EDANGERCREAT=504 ' object not safe for creating
const	EUNQUAL=505	' invalid or unqualified reference
const	EUNCLASS=506	' class undefined


' == constants for timing
const	TIMER_GOTTLIEB=60
const	TIMER_BALLY=68
const	TIMER_WILLIAMS=74

'#####
' DICTIONARY MANAGEMENT
'
' simplistic dictionary management:
'  emAddObj() - adds an object.  RETURN:  object's name/NULL
'  emGetObj() - finds an object in the dictionary.  RETURN: True/False
'  emIs() - determines if an object matches its name.  RETURN: True/False
'  emSetEnt() - goes to the beginning of the dictionary. RETURN: True/False
'  emGetEnt() - returns the next object in the dictionary. RETURN Object/NULL

const	OTYPE_NONE=0	' in case we deallocate anything.  Highly unlikely...
const	OTYPE_DROP=1	' drop targets
const	OTYPE_EJECT=2	' eject holes
const	OTYPE_FLIP=3	' flip flags
const	OTYPE_POST=4	' flipper post
const	OTYPE_GATE=5	' ballsaver gate
const	OTYPE_ALTQ=6	' feature alternation queues
const	OTYPE_BQUEUE=7	' bonus queues
const	OTYPE_CQUEUE=8	' collection queues ** not done **
const	OTYPE_CYCLER=9	' cycling values
const	OTYPE_BUILDER=10	' bonus builder queue
const OTYPE_TILT=11	' we will probably not be searching for this one...
const	OTYPE_LIGHTING=12	' lighting circuits

const	OTYPE_NTYPES=12	' current maximum number of types

private	emDictionary()	' object dictionary
private emEntry		' entry pointer
private	ents		' number of entries present
	ents = 0	' init to zero

function emAddObj(iName, iObj)
	emAddObj = NULL
	if not eval(iName) is iObj then
		dd "emAdd", "Registration mismatch for " & iName
		err.raise EUNQUAL	' invalid or unqualified reference
	end if
	emAddObj = iName
	redim preserve emDictionary(2,ents)
	emDictionary(0,ents) = iName
	emDictionary(1,ents) = iObj.otype
	ents = ents + 1
end function

function emIs (iObj)
	emIs = false
	if not IsObject(iObj) then exit function: end if
	if iObj.name = NULL then exit function: end if
	emIs = TRUE
end function

function emGetObj(otype)
	dim m(): redim m(ubound(emDictionary,2))
	dim p, q
	q = 0
	for p = 0 to ubound(m)
		if emDictionary(1,p) = otype then
			set m(q) = eval(emDictionary(0,p))
			q = q + 1
		end if
	next
	redim preserve m(q-1)
	emGetObj = NULL
	if (q >= 0) then emGetObj = m
end function

' sets the pointer to the top of the dictionary

function emSetEnt()
	if ents = 0 then emSetEnt = FALSE: exit function: end if
	emSetEnt = TRUE
	emEntry = 0
end function

' emGetEnt(object *obj, int *type)
'	sets obj to be the name of the object entry (obj is write-only)
'	sets type to be the type of the object (type is write-only)

function emGetEnt(byref iObj, byref iType)
	if emEntry >= ents then emGetEnt = FALSE: exit function: end if
	emGetEnt = TRUE
	set iObj = eval(emDictionary(0,emEntry))
	iType = emDictionary(1,emEntry)
	emEntry = emEntry + 1
end function

'
'#####
' CLASS OBJECTS:
'  COMMON FIELDS FOR ALL OBJECTS:
'   (public) .name - the name the object has
'   (public) .otype - the type of object
'   (public) .create - create the new object
'   (public) .register(name) - register the object
'   (public) .setprops(va) - set object properties (sounds and subs)
'
'  emDropTarget - create a drop target bank from a set of drop targets
'   (public) .alldown - tells if all targets are down (True/false)
'   (public) .reset - resets a bank
'
'  emEject - create a managed eject hole
'   (public) .hasball() - true if a ball is present, false otherwise
'   (public) .isdrain() - true if the eject hole is a drain, false otherwise
'   (public) .bonus() - returns the bonus queue the ball collects, or NULL
'   (public) .eject() - kick the ball out
'   (private) .mDir, .mForce - direction and force of ejection
'
'  emFlip - create a fliptarget
'
'  emGate - create a managed ball-saver gate and associated light
'	also works for pass-through gates.
'
'  emAlternator - create an alternation event manager
'
'  emBonus - create a simple bonus queue (10 elements), filled or sparse.
'   .show() - show the bonus
'   .add() - add bonus
'   .dec() - decrement bonus
'
'  emCollQueue - create a collection bonus queue	** not done **
'
'  emTilt - table tilt handler
'
'   - scoring setup
'
'  emState - backbox setup
'********
' And here we go.
'
' XXX this needs a touch of work to be functional for banks
' which do not reset except at the start of a ball/game.

class emDropTarget
  dim mTargs()      ' the target array
  dim xdown  ' number of times we have gone down
  dim ResetSub
  dim doreset	' do we reset when completed during play?
  dim checked	' have we been checked for state down?
  public Name
  public otype
  private mTargHitSub
  private mResetSound

  private sub class_initialize()
    redim mTargs(0)
        Name = "" : xdown = 0 : otype = OTYPE_DROP
		doreset = 1
		checked = 0
		ResetSub = NULL
  end sub

  public sub register (iName)
      Name = emAddObj(iName, me)
  end sub

  public sub setprops (iDropSub, iDropSnd, iResetSub, iResetSnd)
    dim sDropStr
    dim sResetStr ' what happens when we reset
    dim n

      if not emIs(me) then
        dd "emDropTarget.setprops:", "You must use <Bankname>.register" &_
          " ""bankname"" first."
        err.raise 505
        exit sub
      end if

      if iDropSub <> "" then
        sDropStr = iDropSub & ":me.isdropped = TRUE:"
        if iDropSnd <> ""  then
          sDropStr = sDropStr & "playsound """ & iDropSnd & """:"
        end if
        for n = 0 to ubound(mTargs)
          executeglobal "sub " & mTargs(n).name & "_hit:" &_
          sDropStr & " end sub"
        next
      end if

	  if iResetSub <> "" then
		ResetSub = iResetSub
	  end if			

      if iResetSnd <> ""  then
        mResetSound = iResetSnd
      end if
  end sub

  public sub create (iTargs, iReset)
    dim n : n = 0
	dim p

        select case typename(iTargs)
        case "Wall"
          redim mTargs(0)
          set mTargs(0) = iTargs
          mTargs(0).candrop = true

        case "Variant()"
		redim mTargs(sizeof(iTargs))
          for n = 0 to sizeof(iTargs)
            set mTargs(n) = iTargs(n)
            mTargs(n).candrop = true
          next
        case "Collection"
		redim mTargs(sizeof(iTargs))
          n = 0
           for each p in itargs
	      set mTargs(n) = p
	      p.candrop = true
	    n = n + 1
       next
        end select
	if iReset then
		doreset = true
	else
		doreset = false
	end if
  end sub

	public function check()	' conditional reset
		check = false
		if doreset = false then
			check = true
			exit function
		end if
		check = reset(TRUE)
	end function

  public function reset(iKeep)	' unconditional reset
    dim i

    for i = 0 to ubound(mTargs)
      mTargs(i).isdropped = false
    next
    playsound mResetSound

	if iKeep then
		xdown = xdown + 1
	else
		xdown = 0
	end if
	if (ResetSub <> "") then
		call getref(ResetSub) (xdown)
	end if
	reset = xdown
  end function

  public function alldown()
    dim i
    for i = 0 to uBound(mTargs)

      if not mTargs(i).isdropped then
        alldown = FALSE
        exit function
      end if
    next

    alldown = TRUE
  end function
end class

' eject class

class emEject
	dim mEject
	private mDir, mForce
	private mHit
	public oType
	public mName	' name of the object
	public name		' name we are registered under
	public ballin
	public mSnd
	public collect	' set to the bonus collect type (0 or 1)
	public processing	' if we're already working...
	public isdrain	' set to true if we are a ball drain
	public scoresub	' run this subroutine

	private sub class_initialize()
		mDir = 0: mForce = 10: oType = OTYPE_EJECT
		isdrain = 0: collect = 0
	end sub

	public sub register(iName)
		Name = emAddObj(iName, me)
	end sub

	public sub create(iObj, iDir, iForce)
			set mEject = iObj
			mDir = iDir
			mForce = iForce
			mName = iObj.name
	end sub

' XXX not certain that iDrain and iColl are even used, but they're here.

	public sub setprops(iSnd, iDrain, iColl)
	  dim str
      if not emIs(me) then
dd "emSaucer.setprops", "You must use <saucername>.register" &_
          " ""saucername"" first."
        err.raise EUNQUAL
        exit sub
      end if
		if iSnd <> ""  then
			mSnd = iSnd
		end if
		
		str = "sub " & mName & "_Hit(): " & _
			"set CurrentEject = " & name & ": " &_
			name & ".ballin = TRUE: " &_
			"if incam then emPend PEND_EJECT, TRUE: " &_
			"exit sub: end if: " &_
			name & "_score: end sub"
		executeglobal str
		isdrain = iDrain
		collect = iColl
	end sub

	public sub newball()
		mEject.createball
	end sub

	public sub eject()
		if not ballin then exit sub
		mEject.kick mDir + (rnd(0)*2 - 4), mForce
		if mSnd <> "" then playsound mSnd: ballin = false: end if
	end sub

	public function hasball()
		hasball = ballin
	end function

	public sub score()
		eval(getref(cstr(name & "_score")))
	end sub

end class

const FLIP_INTERVAL=65

class emFlip
'	private i
	dim rst, im, st
	' rst: reset, im: in motion, st: set
	dim istate
	public isflipped
	public name
	public flipscore, resetscore	' scores when flipped, when reset
	dim otype, mName

	private sub Class_Initialize()
		isflipped = 0: istate = 0: otype = OTYPE_FLIP
		flipscore = 0: resetscore = 0
	end sub

	public sub register (iName)
		Name = emAddObj(iName, me)
	end sub

	public sub create(a)
		dim i()
		dim o, x
		dim fs, rs, ts	' flipped, reset, transitional states

		if typename(a) = coll_t then
			redim i(2)
			x = 0
			for each o in a
				set i(x) = o
				x = x + 1
			next
			set st = i(2)
			set im = i(1)
			set rst = i(0)
		else
			set st=a(2)
			set im=a(1)
			set rst=a(0)
			erase i
		end if
		st.candrop = true
		im.candrop = true
		rst.candrop = true
		st.timerinterval = FLIP_INTERVAL
		st.timerenabled = FALSE
		st.isdropped = true : im.isdropped = true
		fs = "sub " & name & "_flip(): " & _
			"if " & name & ".isflipped then exit sub: end if:" &_
			name & ".doflip: " & st.name & ".timerenabled = true:" & _
			"end sub"
		rs = "sub " & name & "_reset(): " & _
			"if not " & name & ".isflipped then exit sub: end if:" &_
			name & ".doflip: " & st.name & ".timerenabled = true:" & _
			"end sub"
		ts = "sub " & st.name & "_timer():" & _
			"me.timerenabled = false: " & Name & ".doflip: end sub"
'dd "emFlip", fs & vbnewline & rs & vbnewline & ts
		executeglobal fs
		executeglobal rs
		executeglobal ts
	end sub

	public sub setprops(iScoreFlip, iScoreReset)
		flipscore = iScoreFlip
		resetscore = iScoreReset
	end sub

	public function flip()
		flip = false
		if isflipped then exit function: end if
		flip = true
		doflip
	end function

	public function reset()
		reset = false
		if not isflipped then exit function: end if
		reset = true
		doflip
	end function

	sub doflip()
		if isflipped then
			if istate = 2 then
				playsound S_flipflag
				st.isdropped = true
				im.isdropped = false
				istate = 1

				st.timerenabled = true
				exit sub
			elseif istate = 1 then
				im.isdropped = true
				rst.isdropped = false
				istate = 0

				isflipped = false
				exit sub
			end if
		else
			if istate = 0 then
				playsound S_flipflag
				rst.isdropped = true
				im.isdropped = false
				istate = 1

				st.timerenabled = true
				exit sub
			elseif istate = 1 then
				im.isdropped = true
				st.isdropped = false
				istate = 2

				isflipped = true
				exit sub
			end if
		end if
	end sub
end class

class emPost
	public isdown
	public name
	dim mName, otype, post
	dim upsound, downsound

	private sub class_initialize()
		isdown = true: mName = "": otype = OTYPE_POST
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iPost, iUpSnd, iDnSnd)
		if not isobject(iPost) then
			dd "emPost", "Object required."
			err.raise EUNQUAL
			exit sub
		end if
		if typename(iPost) <> wall_t then
			dd "emPost", "I need a wall!"
			err.raise EUNQUAL
			exit sub
		end if

		set	post = iPost
			post.candrop = true	' just in case

		if iUpSnd <> "" then upsound = iUpSnd: end if
		if iDnSnd <> "" then downsound = iDnSnd: end if
		up(false)
	end sub

	public sub up(iOn)
		if iOn then
			if post.isdropped = false then exit sub: end if

			post.isdropped = false
			isdown = false
			playsound upsound
		else
			if post.isdropped = true then exit sub: end if

			post.isdropped = true
			isdown = true
			playsound downsound
		end if
	end sub
end class

class emGate
	public isopen
	public name
	dim itype
	dim mName, otype, gate, GLight, GLightState

	private sub class_initialize()
		Glight = NULL: gate = NULL: mName = ""
		GLightState = LightStateOff
		name = "": isopen = FALSE
		otype = OTYPE_GATE
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iGate, iLight, iOnState)
		itype = typename(iGate)
		if (itype <> flipper_t) AND (itype <> gate_t) then
			dd "emGate", "Wrong object for a gate -- "  & itype
			err.raise EUNQUAL
		end if
		set gate = iGate
		if isObject(iLight) then
			if typename(iLight) <> light_t then
				dd "emGate", "Gate indicator present but " &_
					"of wrong type."
				err.raise EUNQUAL
			end if
			set	GLight = iLight
			if (iOnState = 0) then
				GLightState = LightStateBlinking
				GLight.BlinkInterval = 160
			else
				GLightState = iOnState
			end if
			'
		end if
	end sub

	public sub open()
		if (itype = flipper_t) then
			Gate.rotatetoend
		else
			Gate.open = TRUE
		end if
		GLight.state = GLightState
		isopen = TRUE
	end sub

	public sub close()
		if (itype = flipper_t) then
			Gate.rotatetostart
		else
			Gate.open = FALSE
		end if
		emClear GLight
		isopen = FALSE
	end sub
end class



'
' bonus handler
'
const	BSHOW_SEQ=0		' sequential showing -- default
const	BSHOW_FILL=1	' full showing

' this will be mfgr-specific, and so will move stuff out.
'
class emBonus
	dim lightq(10)	'1-9, 10, 20 -- zero-based
	dim ldouble, ltriple	' multiplier lights
	dim how		' how do we show bonus?
	dim mName, otype
	dim AddSound, DecSound
	dim showlights
	public name, maxbonus
	public multiplier
	public bonus, worth

	private sub class_initialize()
		name = "": mname = "": otype = OTYPE_BQUEUE
		how = 0: bonus = 0: maxbonus = GLOB_MAXBONUS
		multiplier=0: ldouble = Empty: ltriple = Empty
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iLights, iHowto, iVal)
		dim i, o
	
		i = 0

		for each o in iLights
			set lightq(i) = o
			i = i + 1
		next

		if iHowto then maxbonus = (sizeof(iLights)) + 1
		how = iHowto
		multiplier = 1
		worth = iVal
	end sub

	public sub initmx(ia)
		if isarray(ia) then
			if sizeof(ia) > 0 then
				set ltriple = ia(1)
			end if
			set ldouble = ia(0)
		else
			if isobject(ia) then
				set ldouble = ia
			end if
		end if
	end sub

	public sub setmx(iMult)
		multiplier = imult
		if isEmpty(ldouble) then exit sub
		emClear ldouble
		emClear ltriple
		select case iMult
		case 2
			emSet ldouble, lightstateon
		case 3
			emSet ltriple, lightstateon
		end select
	end sub

	public sub setprops(iBonusMax, iAddSnd, iDecSnd)
		if iBonusMax > GLOB_MAXBONUS then
			maxbonus = GLOB_MAXBONUS
		else
			maxbonus = iBonusMax
		end if

		if iAddSnd <> "" then AddSound = iAddSnd: end if
		if iDecSnd <> "" then DecSound = iDecSnd: end if
	end sub

	public sub show(iOn)
		dim i

		for i = 0 to ubound(lightq)
			emClear lightq(i)
		next

		if (TableState.tilt_style = TILT_ALL) AND	(TableState.tilted) then
			exit sub
		end if


		showlights = iOn
		if not showlights then exit sub: end if

		if how and (bonus - 1 < (ubound(lightq))) then
			for i = 0 to (bonus - 1)
				emSet lightq(i), LightStateOn
			next
		else
			i = bonus mod 10
			if bonus = 20 then
				emSet lightq(10), LightStateOn
			elseif bonus >= 10 then
				emSet lightq(9), LightStateOn
			end if

			if (i > 0) then
				emSet lightq(i - 1), 1
			end if
		end if
	end sub

	public sub add()
		if (bonus < maxbonus) then bonus = bonus + 1: end if
		playsound AddSound
		show TRUE
	end sub

	public sub decr()
		if (bonus <= 0) then exit sub: end if
		bonus = bonus - 1
		playsound DecSound
		show TRUE
	end sub
end class

class emBuilder
	dim bl()	' bonus builder lights
	dim bp		' bonus builder position
	dim nl		' number of lights involved
	public otype	' object type
	public name		' name of object
	public dothis	' do this when we turn over

	private sub class_initialize()
		bp = 0: nl = 0: otype = OTYPE_BUILDER
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iLights, iSub)
		dim l, n

		nl = sizeof(iLights)
		redim bl(nl)
		n = 0
		for each l in iLights
			set bl(n) = l
			n = n + 1
		next

		if (iSub <> "") then
			dothis = "sub " & name & "_build(): " & iSub & ": end sub"
			executeglobal(dothis)
			dothis = name & "_build"
		end if
	end sub

	public sub build()
		bp = (bp + 1) mod (nl + 1)
		if bp = 0 then
			eval(getref(dothis))
		end if
dbx "emBuilder.build: bbp = " & bp
		show true
	end sub

	public sub reset()
		bp = 0
		show true
	end sub

	public sub show(active)
		dim l
		for l = 0 to nl
			emClear bl(l)
		next
		if not active then exit sub: end if
		emSet bl(bp), lightstateon
	end sub
end class


class emCollQueue
	private sub class_initialize()
		dd "emCollQueue", "Not yet implemented"
	end sub
end class


const	REPLAY_CREDIT=0		' score: credit; special: credit
const	REPLAY_EXTRA=1		' score: extra ball; special: extra ball
const	REPLAY_POINTS=2		' score: none; special: high-digit points
const	REPLAY_NONE=3		' score: none; special: none
' ** credit sound **
public	credit_knock		' default: 0 (always make noise)
const	KNOCK_ALWAYS=0		' credits are always loud
const	KNOCK_INGAME=1		' credits are quiet when the game is over
const	KNOCK_NEVER=2		' credits are always quiet
' default for gottlieb is 1.
' default for bally is 0.

class emScoring
	dim reel()		' player scoring wheel
	dim replayreel	' replay reel
	dim replaylight	' replay light
	dim ovf()		' player overflows
	dim score()		' player scores
	dim rsp, rscore(4)	' replay scores
	dim maxcred		' maximum number of credits
	dim otype, name	'
	dim has_ott		' do we have an OVER THE TOP textbox;
	dim OTTbox		' here it is.

	public ncred	' number of credits on the table
	public maxplayers	' the maximum number of players we can handle
	public curplayer	' the current player up
	public Creel	' current scoring reel
	public Covf		' current overflow
	public score_overflow	' score overflow

	public replay_policy	' replay for score
	public special_policy	' replay for special
	public Free_Play	' Free Play?
	public DidScore	' did we score something?

	public sub class_initialize()
		redim reel(-1): redim ovf(-1): redim score(-1)
		ncred = 0
		maxplayers = 0
		curplayer = 0
		erase rscore:  rsp = 0
		replay_policy = 0
		special_policy = 0
		Free_Play = 0
		DidScore = 0
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iScoreReels, iReplayThings, iOverflows)
		dim op, i, p, rsize

		maxplayers = sizeof(iScoreReels)
		redim reel(maxplayers)
		redim score(maxplayers)

		OTTbox = empty

		i = 0
		for each op in iScoreReels
			set reel(i) = op
			p = typename(op)
			if (p <> reel_t) then
				dd "emScoring", "Expected a " & reel_t & vbNewLine & _
					"Got a " & p
				err.raise 0
			end if
			if (rsize > 0 AND rsize <> reel(i).reels) then
				dd "emScoring", "All reels must be the same size."
				err.raise 0
			end if
			rsize = reel(i).reels
			score(i) = 0
			i = i + 1
		next

		if (isarray(iReplayThings)) then
			if typename(iReplayThings(0)) = reel_t then
				set replayreel = iReplayThings(0)
			end if
			if typename(iReplayThings(1)) = light_t then
				set replaylight = iReplayThings(1)
			end if
		else
			if typename(iReplayThings) = reel_t then
				set replayreel = iReplayThings
			end if
		end if

		if (isobject(replayreel)) then
			if replayreel.range <= 0 then
				Free_Play = TRUE
			else
				maxcred = replayreel.range
			end if
		else
			Free_Play = TRUE
		end if


		i = sizeof(iOverflows)

		if i >= 0 then
			redim ovf(i)
			i = -1
			for each op in iOverflows
				i = i + 1
				set ovf(i) = op
			next
			if (i > maxplayers) then
				has_ott = TRUE
				set OTTbox = iOverflows(maxplayers + 1)
				OTTbox.timerinterval=4000
				executeglobal "sub call_ott():" &_
					OTTbox.name & ".timerenabled = TRUE:" &_
					OTTbox.name & ".text = ""OVER THE TOP"":end sub"
				executeglobal "sub " & OTTbox.name & "_Timer():" &_
						OTTbox.name & ".timerenabled=FALSE:" &_
						OTTbox.name & ".text="""": end sub"
			else
				has_ott = FALSE
			end if
		end if
' so we don't have overflow indicators, so what?
' we still need to calculate the amount of score
' it takes to flip the reels.

		score_overflow = reel(1).range + 1
		p = reel(1).reels - 1
		while (p > 0)
			score_overflow = score_overflow * (reel(1).range + 1)
			p = p - 1
		wend
	end sub
	
	public sub setplayer(n)
		dim r
		if n > maxplayers then
			n = maxplayers
		end if

		curplayer = n
		set Creel = reel(curplayer)
		if ubound(ovf) >= curplayer then set Covf = ovf(curplayer): end if
	end sub

	public sub add_replay()
		ncred = int(ncred)
		if (ncred < maxcred) then
			replayreel.addvalue(1)
			ncred = ncred + 1
		end if

		if (ncred > 0) then
			emSet replaylight, 1
		end if
		if credit_knock = KNOCK_NEVER then exit sub
		if credit_knock = KNOCK_INGAME and TableState.game = GAME_OVER then exit sub
		PlaySound S_knock
	end sub

	public function take_replay()
		take_replay = false

 		if (isObject(TableState)) then
 			if (TableState.nplayers >= maxplayers) and _
				(TableState.ballinplay = 1) then
 				exit function
 			end if
 		end if
		if ncred > 0 then
			take_replay = true
			replayreel.addvalue(-1)
			ncred = ncred - 1
			if ncred <= 0 then emClear replaylight
		end if
		if Free_Play then
			take_replay = true
		end if
	end function

	public sub reset_replays()
		ncred = 0
		replayreel.setvalue 0
		emClear replaylight
	end sub

	public sub addscore(n)
		if make_replay_score(Score(curplayer), n) then
			score_replay
		end if
		if make_overflow(Score(curplayer), n) then
			if (has_ott) then
				call_ott
			end if
			emSet Ovf(curplayer), emGetOvf(score_overflow)
			playsound S_overflow
		end if
		Score(curplayer) = Score(curplayer) + n
		if (Score(curplayer) > score_overflow) then
			Score(curplayer) = Score(curplayer) mod score_overflow
			if (ubound(ovf) = ubound(score)) then	' we have overflows
				if emCheck(ovf(curplayer)) then
					Score(curplayer) = Score(curplayer) + score_overflow
				end if
			end if
		end if
		DidScore = TRUE
		pscores
	end sub

	public function reset()
		dim i

		reset = true
		for i = 0 to maxplayers
			if (ubound(ovf) = maxplayers) then
				emClear ovf(i)
			end if
			if score(i) <> 0 then
				reset = false
			end if
		next

		if (not reset) and (not table_reset) then
			reset = true
			for i = 0 to maxplayers
				reel(i).updateinterval = 20
			next
		end if
		DidScore = FALSE	' at least at the very beginning, this is so.
	end function

	function table_reset()
		dim i
		dim m		' multiplicand
		dim x		' holder
		dim t		' t: ten.
		dim av	' value to add
		table_reset = false
		for i = 0 to maxplayers
			t = 1
			av = 0
			if (score(i) > 0) then
				for m = reel(i).reels to 1 step -1
					x = (score(i)\t) mod (reel(i).range + 1)
					if (x < reel(i).range) and (t >= minscore) then
						av = av + t
					end if
					t = t * 10
				next
				score(i) = score(i) + av
				if (av) then
					reel(i).updateinterval = 5
					table_reset = true
					reel(i).addvalue(av)
				else
					reel(i).resettozero
					score(i) = 0
				end if
			end if
			pscores
		next
		if (emTakeBonus(NULL)) then
			table_reset = true
		end if
	end function

	function make_overflow(s,n)
		make_overflow = false
		if ((s mod score_overflow) < score_overflow) and _
			(((s mod score_overflow) + n) >= score_overflow) then
			make_overflow = true
		end if
	end function

	function make_replay_score(s, n)
		dim d
		dim m, over, wrap

		s = s mod score_overflow

		if ubound(ovf) >= ubound(score) then
			if (emCheck(ovf(curplayer))) then 
				over = score_overflow
			end if
		end if

		wrap = s		' base wrapped score
		s = s + over	' score + overflow


		for m = 0 to ubound(rscore)
			if (rscore(m) <> 0) AND _
				((((s+n) >= rscore(m)) and (s < rscore(m))) OR _
				(((wrap+n) >= rscore(m)) and (wrap < rscore(m)))) THEN
					make_replay_score = TRUE
				exit function
			end if
		next
		make_replay_score = FALSE
	end function

	public sub add_replay_score(s, n)
		if (rsp) > ubound(rscore) then exit sub: end if
		rscore(rsp) = s * n
		rsp = rsp + 1
	end sub

	public sub clear_replay_scores
		for rsp = 0 to ubound(rscore)
			rscore(rsp) = 0
		next
		rsp = 0
	end sub

	sub score_replay()
		select case replay_policy
		case	REPLAY_CREDIT
			add_replay
		case	REPLAY_EXTRA
			TableState.shootagain TRUE
		end select
	end sub

	public sub score_special()
		select case special_policy
		case	REPLAY_CREDIT
			add_replay
		case	REPLAY_EXTRA
			TableState.shootagain TRUE
		case	REPLAY_POINTS
			Creel.AddValue(10*100*minscore)
			addscore(10 * 100 * minscore)
		end select
	end sub

end class
'
' emState: manage backbox lighting and game state
'
'	** match **
const	MATCH_CREDIT=0		' credit given for match/match is enabled
const	MATCH_NONE=1		' match is disabled

'	** tilt **
const	TILT_BALL_ONLY=0	' tilt disqualifies ball in play only
const	TILT_ENDS_GAME=1	' tilt ends entire game, no match.

'	** tilt style **
const	TILT_ALL=0		' tilt shuts off all lights
const	TILT_SHOWBONUS=1	' tilt leaves bonus showing
const	TILT_NONE=2		' tilt leaves all lights lit (save gates)

'	** game state **
const	GAME_OVER=0			' game totally over
const	GAME_TRANS=1		' in transition - matching or resetting
const	GAME_ON=2			' game fully on

class emState	' backbox routines and miscellaneous state
	dim pup(), pcanplay()
	dim pball()
	dim pmatch(9)
	dim ptilt, pgameover, pshootagain, lshootagain
	dim name, otype, itype
	dim hasmatch
	dim singleplayer
	dim ballinplay
	public matchwheel
	dim tilt_style
	dim mfgr	' who made this piece?
	public nplayers, playerup, hasball
	public same_player, tilted, game
	public match_policy	' give a game for a match?
	public tilt_policy	' tilt ends game?

	private sub class_initialize()
		redim pup(-1): redim pcanplay(-1)
		hasmatch = 0: hasball = 0: singleplayer = 0
		same_player = 0: tilted = 0: game = GAME_OVER
		randomize
		match_policy = MATCH_CREDIT
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

' create: requires tilt, game over, ball in play
	public sub create(iMfgr, iStateList)
		dim i, o
		iMfgr = left(lcase(iMfgr), 1)
		if NOT (iMfgr = "b" OR iMfgr = "g" OR iMfgr = "w") then
dd "Table error", "You need to declare who made the table:" & vbNewLine & _
			"Bally, Gottlieb or Williams."
			err.raise EUNCLASS
		end if
		mfgr = iMfgr
		if sizeof(iStateList) <> 2 then
			dd "emState ERROR", "ERROR: I need:" & vbNewLine & _
				"- tilt indicator" & vbNewLine & _
				"- game over indicator" & vbNewLine & _
				"- ball in play lights or textbox"
			err.raise EUNQUAL
		end if

		set ptilt = iStateList(0)
		set pgameover = iStateList(1)
		i = sizeof(iStateList(2))

		if (i < 0) then ' it's a text box?
			redim pball(0)
			if typename(iStateList(2)) = text_t then
				set pball(0) = iStateList(2)
			else
				dd "emState ERROR", "ERROR:  I need 5 lights " & _
					"(or a textbox) for Ball in Play."
				err.raise EUNQUAL
			end if
		else
			redim pball(i)
			o = iStateList(2)
			if (i < 4) then
				dd "emState ERROR", "ERROR:  I need 5 lights " & _
					"(or a textbox) for Ball in Play."
				err.raise EUNQUAL
			else
				for i = 0 to ubound(pball)
					set pball(i) = o(i)
					emClear pball(i)
				next
			end if
		end if
		hasball = FALSE
	end sub

' initplayers: requires players_up (as an array) and players_can_play (ditto)
	public sub initplayers(iaObjs)
		dim mPCanPlay, mPup, mShootAgain, mLShootAgain
		dim i, o

		i = sizeof(iaObjs)
'		dd "emState CHECK", "sizeof(iaObjs) is " & i
' I have seen single player games with Same Player Shoots Again, so...

		if isarray(iaObjs(0)) then
			mPCanPlay = iaObjs(0)
		else
			set mPCanPlay = iaObjs(0)
		end if

		if isarray(iaObjs(1)) then
			mPup = iaObjs(1)
		else
			set mPup = iaObjs(1)
		end if

	' shoot again backbox
		if (i >= 2) then
			if isObject(iaObjs(2)) then
				set pshootagain = iaObjs(2)
			else
				pshootagain = NULL
			end if
		end if
	' shoot again playfield
		if (i >= 3) then
			if isObject(iaObjs(3)) then
				set lshootagain = iaObjs(3)
			else
				lshootagain = NULL
			end if
		end  if
	' players up, players can play
		if sizeof(mPCanplay) <> sizeof(mPup) then
			dd "emState - WARNING", "number of possible players != " & _
				"players up"
		end if

		redim pcanplay(sizeof(mPCanPlay))
		redim pup(sizeof(mPup))
		i = 0
		for each o in mPCanPlay
			set pcanplay(i) = o
			i = i + 1
 			emClear o
		next
		i = 0
		for each o in mPup
			set pup(i) = o
			i = i + 1
 			emClear o
		next
	end sub

' initmatch: initialize match boxes
	public sub initmatch(iMatchBoxes)
		dim i
		i = sizeof(iMatchBoxes)
		if (i <> ubound(pmatch)) then
			dd "emState ERROR", _
				"ERROR:  If you're gonna do matchboxes," & _
				"I need ten of them."
			err.raise EUNQUAL
		end if

		for i = 0 to ubound(pmatch)
			set pmatch(i) = iMatchBoxes(i)
			emClear pmatch(i)
		next

'		emSet pmatch(matchwheel), matchwheel * minscore
		hasmatch = TRUE
	end sub

' setmatch -- NEW
	public sub setmatch(pos)
		if not hasmatch then exit sub
		if (pos < 0) or (pos > ubound(pmatch)) then
			matchwheel=int(rnd(0)*10)
		else
			matchwheel=pos
		end if
		showmatch true
	end sub

' tilt: set tilted = true - plus enforce policy
	public sub tilt(active)
		tilted = active
		if active then 
			playsound S_tilt
			emSet ptilt, "TILT"
			if tilt_style < TILT_NONE then
				emFLights false
				emCyclerSet NULL, false
			end if
			if tilt_style < TILT_SHOWBONUS then
				emGI false
				emShowBonus false
			end if
			Scores.didscore = true
		else
			emGI true
			emCyclerSet NULL, true
			emClear ptilt
			emShowBonus true
		end if
		if tilt_policy = TILT_ENDS_GAME then
			gameover 1	' >0 makes IMMEDIATE game over.
			setball 0
		end if
	end sub

' slamtilt: tilt, no match
	public sub slamtilt
		dim p, s
		s = tilt_style
		p = tilt_policy
		tilt_policy = TILT_ENDS_GAME
		tilt_style = TILT_ALL
		tilt TRUE
		tilt_policy = p
		tilt_style = s
	end sub
		

' shootagain: set same_player = true
	public sub shootagain(active)
		same_player = active
		if active then
			emSet pshootagain, SHOOT_AGAIN
			emSet lshootagain, 1
		else
			emClear pshootagain
			emClear lshootagain
		end if
	end sub

' showmatch:  display match wheel
	public sub showmatch(active)
		dim x

		if not hasmatch then exit sub

		if active and (match_policy = MATCH_CREDIT) then
			if matchwheel then
				emSet pmatch(matchwheel), matchwheel * minscore
			else
				emSet pmatch(matchwheel), _
					right(cstr(minscore * 10),len(cstr(minscore)))
			end if
		else
			for x = 0 to ubound(pmatch)
				emClear pmatch(x)
			next
		end if
	end sub

' addmatch: increment the match wheel
	public sub addmatch()
		matchwheel = (matchwheel + 1) mod 10
		playsound S_matchwheel
	end sub

' decmatch: decrement the match wheel (some machines went the other way)
	public sub decmatch()
		if matchwheel = 0 then
			matchwheel = 9
		else
			matchwheel = matchwheel - 1
		end if
		playsound S_matchwheel
	end sub

' checkmatch: compare current score to the matchwheel

	public function checkmatch(s)
		checkmatch = false
		if match_policy then exit function
		checkmatch = (( (s mod (10 * minscore)) / minscore ) = matchwheel)
	end function

' gameover: set game = false -- DISPLAY ONLY!
	public sub gameover(active)
		if active then
			emSet pgameover, "GAME OVER"
			tilted = true	' for all intents and purposes...
			showball 0: showplayer -1:
' Let the endgame cam handle gameon=false via C_END
 			if active > 0 then game = GAME_OVER: exit sub
		else
			game = GAME_TRANS
			emclear pgameover
		end if
	end sub


' setcanplay: set the number of players
	public sub setcanplay(n)
		if (n > Scores.maxplayers) then exit sub: end if
		nplayers = n
		showcanplay(n)
	end sub

' showcanplay: show us how many can play
	public sub showcanplay(n)
		dim x
		if isarray(pcanplay) then
			for each x in pcanplay
				emClear x
			next
			if (mfgr = "w") then	' Only Williams did this.
				emSet pcanplay(x), x
			else
				for x = 0 to n
					emSet pcanplay(x), x
				next
			end if
		else
			emSet pcanplay, n
		end if
	end sub

' addplayer: add a player to the roster.

	public function addplayer()
		addplayer = false

		if (nplayers > Scores.maxplayers) then
			exit function
		end if
		addplayer = true
		setcanplay(nplayers + 1)
	end function

' setplayer: set the player who is up
	public sub setplayer(n)
		if (n > nplayers) then exit sub
		playerup = n
'dd "tablestate:setplayer", n
		showplayer(n)
		if (n < 0) then exit sub
 		Scores.setplayer(n)
	end sub

' function nextplayer: advance player and ball.  Return FALSE on last ball.
' Need to figure out how to do the Gottlieb rotation.  That might be cam-
' specific. -- NOTE:  do not call nextplayer on single-player games!
 	public function nextplayer()
'dd "nextplayer: ", "nextplayer: playerup = " & playerup & _
'	"; ball = " & ballinplay & "nplayers = " & nplayers
		nextplayer = true
		emTiltReset	' this is pretty much a given
 		if playerup >= nplayers then
 			if ballinplay >= nballs then
' dd "nextplayer", "game over?"
 				nextplayer = false
				playsound S_nextplayer
 				exit function
 			else
' dd "nextplayer", "add ball"
 				addball true
				playsound S_nextball
 				playerup = 0
 			end if
 		else
' dd "nextplayer", "next player"
 			playerup = playerup + 1
			playsound S_nextplayer
 		end if
 		setplayer playerup
 	end function
	
' showplayer: show us which player is up
	public sub showplayer(player)
		dim x
		if isarray(pup) then
			for each x in pup
				emClear x
			next
			if player < 0 then
				exit sub
			elseif player > nplayers then
				for each x in pup
					emSet x, Player + 1
				next
				exit sub
			end if
			emSet pup(player), player
		else
			emSet pup, player + 1
		end if
	end sub

' function addball: increment/decrement (TRUE/FALSE)
' and show the ball in play/balls to play.  Returns FALSE if the decrement
' reaches zero.
 
 	public function addball(increment)
 		if increment then
 			ballinplay = ballinplay + 1
 			if ballinplay > GLOB_MAXBALLS then
 				ballinplay = GLOB_MAXBALLS
 			end if
 		else
 			ballinplay = ballinplay - 1
 		end if
		if ballinplay > 0 then
			showball ballinplay
' dd "addball", "showball " & ballinplay
		end if
		addball = (ballinplay > 0)
 	end function

' setball:  Set the ball in play/balls to play
	public sub setball(n)
		if (n > GLOB_MAXBALLS) then exit sub: end if
		ballinplay = n
		showball(n)
	end sub

' showball: show us which ball it is
	public sub showball(ball)
		dim x
'dd "showball", "ubound (pball) = " & ubound(pball) & _
'	"; ball = " & ball
		if ubound(pball) > 0 then
			for each x in pball
				emClear x
			next
			if (ball = 0) then exit sub: end if
			emSet pball(ball - 1), ball
		else
			if ball then
				emSet pball(0), ball
			else
				emClear pball(0)
			end if
		end if
	end sub
end class

class emCycler
	public otype, name
	dim sp	' score pointer
	dim np	' number of positions
	' I did this this way because of the difficulties of navigating
	' multi-dimensional arrays, and of using such objects as timers.
	dim lights(), lights2()
	dim ts, ws	' cycle, score, timer, wait subroutines

	private sub class_Initialize()
		otype = OTYPE_CYCLER
		name = ""
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create(iDelay, iLights)
		dim n
		dim o

		n = sizeof(iLights)
		redim lights(n)	' not usually more than 2 sets...
		
		n = 0
		for each o in iLights
			set lights(n) = o
			n = n + 1
		next

		np = n
		lights(0).timerinterval = iDelay
		lights(1).timerinterval = 8 * camtimer.interval
		ts = "sub " & lights(0).name & "_timer(): " & _
			"me.timerenabled = false: " & _
			name & ".cycle true: end sub"
		ws = "sub " & lights(1).name & "_timer(): "  &_
			"me.timerenabled = false: " & _
			lights(0).name & ".timerenabled = true: end sub"
		executeglobal ts
		executeglobal ws
	end sub
	
	public sub duplights(iLights)
		dim n
		dim o
		redim lights2(np)

		n = 0
		for each o in iLights
			set lights2(n) = o
			n = n + 1
		next
	end sub
	
	public sub start()	' start us off
'		executeglobal cstr(lights(0).name & ".timerenabled = true") 
'		eval(getref(cstr(lights(0).name & ".timerenabled = true")))
		lights(0).timerenabled = true
	end sub
	
	public sub cease(show)	' stop the cycler, possibly turning it off
'		executeglobal cstr(lights(0).name & ".timerenabled = false")
'		eval(getref(cstr(lights(0).name & ".timerenabled = true")))
		lights(0).timerenabled = false
		cycle(show)
	end sub
	
	public function score()	' score our value
		if TableState.game = GAME_OVER then exit function: end if
		lights(0).timerenabled = false
		lights(1).timerenabled = true
		score = sp
	end function
	
	public sub cycle(show)	' show the cycler and advance
		dim l

		if (not show) then
			for l = 0 to ubound(lights)
				emClear lights(l)
				emClear lights2(l)
			next
			exit sub
		end if

		emClear lights(sp)
		emClear lights2(sp)
		sp = (sp + 1) mod (np)
		emSet lights(sp), LightStateOn
		emSet lights2(sp), LightStateOn
		lights(0).timerenabled = true
	end sub
end class

const	ALTQ_LOW=1	' low-point (1 or 10) scores cause the alternation
const	ALTQ_MED=2	' mid-point (10 or 100) scores cause the alternation
const	ALTQ_CAM=3	' a cam cycle causes the alternation
const	ALTQ_JET=4	' a jet bumper causes the alternation.

class emAltQ
	dim name, otype
	public qtype
	dim nlight()
	dim np
	dim ap
	dim ison, all_on
	dim handler

	private sub class_initialize()
		name = "": otype = OTYPE_ALTQ
		ap = 0 : np = 0 : ison = false
	end sub

	public sub register(iName)
		name = emAddObj(iName, me)
	end sub

	public sub create (iQtype, iLights, iHandler)
		dim n, l

		qtype = iQtype
		n = sizeof(iLights)
		redim nlight(n)
		np = n + 1
		handler = iHandler
		
		n = 0
		for each l in iLights
			if (not isNull(l)) then
				set nlight(n) = l
			end if
			n = n + 1
		next
	end sub

	public function rotate()
		dim o

		for each o in nlight
			emClear o
		next
		ap = (ap + 1) mod np
		rotate = ap
		' it is up to the caller to decide what to show.
	end function

	public sub onoff(active)
		ison = active
	end sub

	public sub showall(active)
		dim o
		if active and ison then
			for each o in nlight
				emSet o, LightStateOn
			next
		else
			for each o in nlight
				emClear o
			next
			show true
		end if
	end sub

	public sub show(active)
		if (active and ison) then
			emSet nlight(ap), LightStateOn
		end if
	end sub
end class

class emTilt
 	dim name
 	dim objs()
 	dim ttimer
 	dim otype
	dim decay
 	dim tiltometer
 	public sensitivity
 
 	private sub class_initialize()
 		name = "": tiltometer = 0
 		redim objs(-1)
 		otype = OTYPE_TILT
 	end sub
 
 	public sub register(iName)
 		name = emAddObj(iName, me)
 	end sub
 
 	public sub create(byref iTimer, iPeriod, iObjs)
 		dim p, o, s
 		redim objs(sizeof(iObjs))
 
 		if typename(iTimer) <> "Timer" then
 			dd "emTilt", "You need a tilt timer!"
 			Err.Raise EUNQUAL
 		end if
 
 		set tTimer = iTimer
 
 		ttimer.interval = iPeriod
 		p = 0
 		for each o in iObjs
 			set objs(p) = o
			emDisable o
			emEnable o, 0
 			p = p + 1
 		next
 		s = "sub " & itimer.name & "_timer(): me.enabled = false: " & _
 			name & ".swing: end sub"
 		executeglobal s
		' initialise the pendulum decay
		p = itimer.interval
		decay = 0.63
		while (p < 1)
			decay = decay * decay
			p = p + itimer.interval
		wend
		decay = 1 - decay
	end sub

  	public sub tilt(active)
 		dim p
 		for each p in objs
 			if active then
 				emDisable p
 			else
 				emEnable p, 0
 			end if
 		next
 		TableState.tilt active
		emSetPost false
		emCloseGate null
 	end sub
 
 	sub tTimer_timer()
  		me.enabled = false
 		swing
 	end sub
 
 	sub swing()
 		if int(tiltometer * 1000) > 0 then
 			dbx tiltometer
 			tiltometer = tiltometer * decay
 			ttimer.enabled = true
 		end if
 	end sub
 		
 	public sub nudge(force)
 		tiltometer = tiltometer + force
 		ttimer.enabled = true
 		if tiltometer > (10 - sensitivity) then
 			tilt(true)
 		end if
 	end sub
 end class

const LTYPE_GI = 0
const LTYPE_FEATURE = 1
 
class emLighting
 	dim l()
 	public otype, name
 	public ltype
 
 	private sub class_initialize()
 		otype = OTYPE_LIGHTING
 	end sub
 
 	public sub register(iName)
 		name = emAddObj(iName, me)
 	end sub
 
 	public sub create(iLtype, iLights)
 		dim o, i
 
 		redim l(sizeof(iLights))
 
 		i = 0
 		for each o in iLights
 			set l(i) = o
			i = i + 1
 		next
 		ltype = iLtype
 	end sub
 
 	public sub onoff(active)
 		dim o
 
 		for each o in l
 			if active then
 				emSet o, lightstateon
 			else
 				emClear o
 			end if
 		next
 	end sub
 end class
 
 sub emGI(onoff)
 	dim l
 	if nlight < 0 then exit sub
 
 	for each l in BLighting
 		if (l.ltype = LTYPE_GI) then
 			l.onoff onoff
 		end if
 	next
 end sub
 
 sub emFLights(onoff)
 ' I don't think we'll see this used much except to CLEAR lighting.
 	dim l
 	if nlight < 0 then exit sub
 
 	for each l in BLighting
 		if (l.ltype = LTYPE_FEATURE) then
 			l.onoff onoff
 		end if
 	next
 end sub

' Parameter Adjustments
' written by Greywolf
' This is a piss-poor attempt at replacing forms and menus,
' but nothing else seems to want to work correctly. 
class emVPTparam
	dim param(), curval(), interval(), pmax(), caption(), acap()
	dim config, cval, cpar, out

	public sub init(box, vals)	' key-name, valid-bits
		dim ii, icap
		dim kvp	'key-val pointer
		if not (isarray(vals)) then exit sub: end if
		if (typename(box) <> "Textbox") then exit sub: end if
		set out = box
		out.fontcolor = rgb(0,0,0)
		out.backcolor = rgb(255,204,0)
		out.istransparent = TRUE
		if ((ubound(vals) + 1) mod 3) then
			msgbox "wrong number of params in init of config flags -- " & ubound(vals) + 1
			exit sub
		end if

		ii = ubound(vals) \ 3

		redim param(ii), curval(ii), pmax(ii)
		redim caption(ii), acap(ii)

		

		for ii = 0 to ubound(vals) step 3
			caption(ii\3) = vals(ii)
			param(ii\3) = vals(ii + 1)
			if (isarray(vals(ii + 2))) then
				pmax(ii\3) = ubound(vals(ii + 2))
				acap(ii\3) = vals(ii+2)
			else
				pmax(ii\3) = vals(ii + 2)
				acap(ii\3) = null
			end if
			curval(ii\3) = 0
 		next

		cval = 0
		cpar = 0
	end sub

	public sub prevp()
'		msgbox "prevp: cpar = " & cpar
		if cpar = 0 then
			cpar = ubound(param)
		else
			cpar = cpar - 1
		end if
		showp TRUE
	end sub

	public sub nextp()
'		msgbox "nextp: cpar = " & cpar
		if cpar = ubound(param) then
			cpar = 0
		else
			cpar = cpar + 1
		end if
		showp TRUE
	end sub

	public sub incr()
'		msgbox "incr: param = " & param(cpar) & " value = " & curval(cpar)
		cval = curval(cpar)
		if (cval < pmax(cpar)) then
			cval = cval + 1
		end if
		curval(cpar) = cval
		showp TRUE
	end sub

	public sub decr()
		cval = curval(cpar)
		if (cval > 0) then
			cval = cval - 1
		end if
		curval(cpar) = cval
		showp TRUE
	end sub

' the resulting string will be run thru eval.
	public function getconfig()
		dim i, s
		for i = 0 to ubound(param)
			s = param(i) & "=" & curval(i) & ":"
			getconfig = getconfig & s
		next
	end function

' we have already been initialised.
	public sub setconfig(byref ia)
		dim i

		for i = 0 to ubound(ia)
			ia(i) = int(ia(i))
			curval(i) = ia(i)
		next
	end sub

	public sub showp(show)
		dim s
		if (not show) then
			out.istransparent = TRUE
			out.text = ""
			exit sub
		end if
		out.istransparent = FALSE
		s = caption(cpar) & ": "
		if (isarray(acap(cpar))) then
			s = s & acap(cpar)(curval(cpar))
		else
			s = caption(cpar) & ": " & curval(cpar)
		end if
		out.text = s
	end sub

end class

' ***************
' * end classes *
' ***************

' ****************
' * initializers *
' ****************
dim Scores
set Scores = new emScoring
	Scores.register "Scores"

dim TableState
set TableState = new emState
	TableState.register "TableState"

sub init_Scoring(iReels,iCredit,iOverflows)
	Scores.create iReels, iCredit, iOverflows
end sub

const BB_BASIC=0
const BB_PLAYERS=1
const BB_MATCH=2

sub init_TableState(iWhat, iaObjs, iMfgr)
	select case iWhat
	case BB_BASIC
		TableState.create iMfgr, iaObjs
	case BB_PLAYERS
		TableState.initplayers iaObjs
	case BB_MATCH
		TableState.initmatch iaObjs
	end select
end sub
'** object probe **
'** equivalent to a kernel self-config.

dim ndrop, neject, nflip, npost, ngate, naltq, nbqueue, ncqueue
dim nbuilder, ncycler, nlight, ntilt
ndrop = -1: neject = -1: nflip = -1: npost = -1: ngate = -1
naltq = -1: nbqueue = -1 : ncqueue = -1: nbuilder = -1: ncycler = -1
nlight = -1: ntilt = -1

dim BDrop()
dim BEject()
dim BFlips(3)
dim BPost()
dim BGate()
dim BAltq()
dim BBonusQ()
dim BCqueue()
dim BCycler()
dim BBuilder()
dim BLighting()
dim BTilt()

dim emLoader
emLoader = NULL


sub emObjInit()
	dim n, t, x, i

	if not (emSetEnt()) then exit sub
	while emGetEnt(n, t)
'dd "emObjInit", "n: " & n.name & ", type " &t
		select case t
		case OTYPE_DROP : ndrop = ndrop + 1
		case OTYPE_EJECT : neject = neject + 1
		case OTYPE_FLIP : nflip = nflip + 1
		case OTYPE_POST : npost = npost + 1
		case OTYPE_GATE : ngate = ngate + 1
		case OTYPE_ALTQ : naltq = naltq + 1
		case OTYPE_BQUEUE : nbqueue = nbqueue + 1
		case OTYPE_CQUEUE : ncqueue = ncqueue + 1
		case OTYPE_CYCLER : ncycler = ncycler + 1
		case OTYPE_BUILDER : nbuilder = nbuilder + 1
		case OTYPE_LIGHTING : nlight = nlight + 1
		case OTYPE_TILT : ntilt = ntilt + 1
		end select
	wend

	' reestablish our arrays...
	redim BDrop(ndrop):	redim BPost(npost)
	redim BGate(ngate):	redim BEject(neject)
	redim BAltQ(naltq):	redim BBonusQ(nbqueue): redim BCollQ(ncqueue)
	redim BBuilder(nbuilder):	redim BCycler(ncycler)
	redim BLighting(nlight):	redim BTilt(ntilt)

	' and populate them.

	if (ndrop >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_DROP)
			set BDrop(i) = x
			i = i + 1
		next
	end if

	if (neject>= 0) then
		i = 0
		for each x in emGetObj(OTYPE_EJECT)
			set BEject(i) = x
			i = i + 1
		next
	end if

	if (nflip >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_FLIP)
			set BFlips(i) = x
			i = i + 1
		next
	end if

	if (npost >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_POST)
			set BPost(i) = x
			i = i + 1
		next
	end if

	if (ngate >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_GATE)
			set BGate(i) = x
			i = i + 1
		next
	end if

	if (naltq >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_ALTQ)
			set BAltQ(i) = x
			i = i + 1
		next
	end if

	if (nbqueue >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_BQUEUE)
			set BBonusQ(i) = x
			i = i + 1
		next
	end if

	if (ncqueue >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_CQUEUE)
			set BCQueue(i) = x
			i = i + 1
		next
	end if

	if (ncycler >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_CYCLER)
			set BCycler(i) = x
			i = i + 1
		next
	end if

	if (nbuilder >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_BUILDER)
			set BBuilder(i) = x
			i = i + 1
		next
	end if

	if (nlight >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_LIGHTING)
			set BLighting(i) = x
			i = i + 1
		next
	end if

	if (ntilt >= 0) then
		i = 0
		for each x in emGetObj(OTYPE_TILT)
			set BTilt(i) = x
			i = i + 1
		next
	end if
end sub

'** object reset **
' this is needed at least for flipflags

sub emFlipReset(flip)
	if nflip < 0 then exit sub

	if (flip > nflip) then exit sub

	if (flip < 0) or (flip > ubound(BFlips)) then
'# avoid a potentiall error condition, but alert the programmer.
		dd "emFlipReset", "Trying to reset flip " & flip
		exit sub
	end if
	BFlips(flip).reset
end sub

sub emResetAllFlips ()
	dim x

	if nflip < 0 then exit sub


	for x = 0 to 3 
		camstack(x+2) = camstack(x+2) or (C_FLIP)
		if (tablestate.game = GAME_ON) and (not tablestate.tilted) and _
		  (tablestate.hasball) then
			if (BFlips(x).isflipped) then
				camstack(x+2) = camstack(x+2) or (BFlips(x).flipscore)
			else
				camstack(x+2) = camstack(x+2) or (BFlips(x).resetscore)
			end if
		end if
	next
end sub


' Ball Loader XXX
' #*** this needs to be made more generic; perhaps
' #*** require emLoader to be declared as a emEject.

sub emLoadBall
	if not(isObject(emLoader)) then exit sub
	if typename(emLoader) <> eject_t then exit sub

	if not(TableState.hasball) then
		emLoader.createBall
		emLoader.kick 60, 10
		TableState.hasball = TRUE
		playsound S_loadball
	end if
end sub

' cyclers

sub emCyclerSet(cycler, active)
	dim o
	if (ncycler < 0) then exit sub

	if (isNull(cycler)) then
		for each o in BCycler
			if (active = true) then
				o.start
			elseif (active = false) then
				o.cease false
			else
				o.cease true
			end if
		next
	else
		if (active = true) then
			cycler.start
		elseif (active = false) then
			cycler.cease false
		else
			cycler.cease true
		end if
	end if
end sub

sub emBuilderReset(builder,active)
	dim o
	if (nbuilder < 0) then exit sub
' XXX make generic...
	if (isNull(builder)) then
		for each o in BBuilders
			o.reset
			o.show active
		next
	else
		builder.reset
		builder.show active
	end if
end sub

 '*** drop targets ***
' XXX
' * dammit.  This still doesn't account for multiple banks. *

function emCheckDrops()
	dim b, i, d
	dim n()
	if ndrop < 0 then exit function

	emCheckDrops = empty

	redim n(ndrop)
	i = 0

	for each b in BDrop
		if b.alldown then
			set n(i) = b
			d = d + 1
		end if
		i = i + 1
	next
	if (d = 0) then exit function
	emCheckDrops = n
end function
 
sub emResetDrops(banks)
 	dim b
 	if ndrop < 0 then exit sub

	if isempty(banks) then exit sub

 	if (typename(banks) = null_t) then
 		for each b in BDrop
 			b.reset FALSE
 		next
 	elseif isarray(banks) then
 		for each b in banks
			b.check
 		next
 	else
'dd "typename(banks)", typename(banks)
 		banks.check
 	end if
end sub
 	
'*** posts and gates ***

sub emSetPost(up)
	if npost < 0 then exit sub

     BPost(0).up (up and (not TableState.Tilted) and (TableState.game = GAME_ON))
end sub

sub emCloseGate(which)
	dim x
	if ngate < 0 then exit sub
	if (not isobject(which)) or (isnull(which)) or (isempty(which)) then
		for each x in BGate
			if x.otype <> OTYPE_GATE then dd "WTF", "over...": exit sub
			x.close
		next
	else
		which.close
	end if
end sub

const	ADDB_INIT=0
const	ADDB_STD=1

sub emAddBonus(bq, condition)
	dim q
	if nbqueue < 0 then exit sub

	if (isNull(bq)) then
		for each q in BBonusQ
			if (condition = ADDB_INIT) then
				if (q.bonus = 0) then
					q.add
				end if
			else
				q.add
			end if
		next
	else
		if (condition = ADDB_INIT) then
			if (bq.bonus = 0) then
				bq.add
			end if
		else
			bq.add
		end if
	end if
end sub

function emTakeBonus(bq)
	dim q

	emTakeBonus = false
	if nbqueue < 0 then exit function

	if (isNull(bq)) then
		for each q in BBonusQ
			if q.bonus > 0 then emTakeBonus = true: end if
			q.decr
		next
	else
		if bq.bonus > 0 then emTakeBonus = true: end if
		bq.decr
	end if
end function

sub emBonusMX(bq, mult)
	dim q

	if nbqueue < 0 then exit sub

	if (isNull(bq)) then
		for each q in BBonusQ
			q.setmx mult
		next
	else
		bq.setmx mult
	end if
end sub

' TILT STUFF
sub emNudge(dir, force)
 	Nudge dir, force

	if ntilt < 0 then exit sub
	 if (TableState.tilted) or (TableState.game < GAME_ON) then exit sub
 	BTilt(0).Nudge(force)
 end sub

sub emTiltReset()
	if ntilt < 0 then exit sub
	BTilt(0).tilt false
end sub


'**************
'

'**************
' object activators/deactivators (generic)
'
sub emSet(obj, prop)	' indicator set
	dim t
	dim v

	if not isobject(obj) then exit sub

	t = typename(obj)
	select case t
	case bumper_t
		obj.state = lightstateon
	case light_t	
		obj.state = lightstateon
	case text_t
		obj.text = prop
	case wall_t
		obj.isdropped = false
	end select
end sub

sub emClear(obj)		' indicator clear
	dim t

	t = typename(obj)
	select case t
	case bumper_t	' light only
		obj.state = lightstateoff
	case light_t
		obj.state = lightstateoff
	case text_t
		if obj.uservalue = "" then obj.uservalue = obj.text
		obj.text = ""
	case wall_t
		obj.isdropped = true
	end select
end sub

function emCheck(obj)
	dim t

	emCheck = false
	if not isobject(obj) then exit function

	t = typename(obj)

	select case t
	case light_t
		emCheck = (obj.state > 0): exit function
	case bumper_t
		emCheck = (obj.state > 0): exit function
	case text_t
		emCheck = (obj.text <> ""): exit function
	case wall_t
		emCheck = not (obj.isdropped): exit function
	end select
end function

sub emEnable(obj, prop)	' solenoid enable
	dim t
	dim v

	if not isobject(obj) then exit sub
	if not prop then v = obj.uservalue: else v = prop: end if

	t = typename(obj)
	select case t
	case bumper_t
		if not prop then 
			obj.force = obj.uservalue
		else
			obj.force = prop
		end if
	case wall_t
		if not prop then 
			obj.slingshotstrength = obj.uservalue
		else
			obj.slingshotstrength = prop
		end if
	end select
end sub

sub emDisable(obj)	' solenoid disable
	dim t

	t = typename(obj)
	select case t
	case bumper_t
		if (obj.force > 0) then
			obj.uservalue = obj.force
			obj.force = 0
		end if
	case wall_t
		if (obj.slingshotstrength > 0) then
'dd "emDisable", "disabling slingshot " & obj.name
			obj.uservalue = obj.slingshotstrength
			obj.slingshotstrength = 0
		end if
		if obj.candrop then obj.isdropped = true: end if
	case flipper_t
		obj.rotatetostart
	case gate_t
		obj.open = false
	end select
end sub

' Pending Events
dim c_pending	' pending activities
const	PEND_FLIPS=1	' flips are pending
const	PEND_EJECT=2	' an eject is pending
' Drops are already handled via checkdrops
const	PEND_DRAIN=4	' drain handler is pending
const	PEND_BONUS=8	' bonus is pending
const	PEND_RESET=16	' we are in mid reset

sub emPend(what, how)
	if (how) then
		c_pending = c_pending or what
	else
		c_pending = c_pending and (not what)
	end if
end sub


sub addscore(n)
	dim cs	'current score
	dim tb	'textbox

	cs = Scores.score(Scores.curplayer)

	if (TableState.tilted) or (TableState.game < GAME_ON) then exit sub

	if (int((cs + n) / (1000 * minscore)) <> int(cs/(1000 * minscore))) then
		if matchval >= 0 then
			TableState.addmatch 
		else
			TableState.decmatch
		end if
	elseif n = matchpoint then 
		if matchval >= 0 then
			TableState.addmatch
		else
			TableState.decmatch
		end if
	end if

	if (n = minscore) then
		emAltQChange ALTQ_LOW
	end if
	if (n = (minscore * 10)) then
		emAltQChange ALTQ_MED
	end if
	Scores.addscore n
end sub

sub emAddReplay()
	if Scores.FREE_PLAY then exit sub
	Scores.add_replay
end sub

function emTakeReplay(iScoreObj)
	if incam then emTakeReplay = false: exit function
	emTakeReplay = Scores.take_replay
end function

function emGetOvf(val)
	if val < 1000 then emGetOvf = CStr(val): exit function
	if val < 1000000 then
		emGetOvf = CStr(val/1000) & ",000"
	else
		emGetOvf = CStr(val/1000000) & ",000,000"
	end if
end function

function maxreelscore(reel)
	dim i
	maxreelscore = 1
	for i = reel.reels to 1 step -1
		maxreelscore = maxreelscore * reel.range
	next
end function

'*** end routines ***

'*** scoring ***
public 	matchval
		matchval = 1	' most match wheels went this way
'		matchval = -1	' some went in reverse

'*** Sound Settings

dim	S_coinlock, S_loadball, S_nextball, S_nextplayer
dim	S_highchime, S_midchime, S_lowchime, S_overflow
dim	S_bonusadv, S_bonusdec, S_dropreset, S_eject
dim	S_camclick, S_matchwheel, S_knock, S_addplayer, S_tilt
dim	S_thumper, S_lsling, S_rsling
dim	S_flipup, S_flipdown, S_postup, S_postdown, S_gateopen, S_gateshut
dim S_flipflag, S_reel
' set reasonable defaults here
S_knock = "knocker": S_coinlock = "coinlock": S_loadball="loadball"
S_nextball = "nextball": S_nextplayer = "nextplayer"
S_highchime = "highchime": S_midchime = "midchime": S_lowchime = "lowchime"
S_overflow = "100k_buzzer": S_bonusadv = "bonus": S_bonusdec = "bonus"
S_camclick = "camclick": S_matchwheel = "matchwheel": S_addplayer = "addplayer"
S_thumper = "bumper": S_lsling = "lsling": S_rsling = "rsling"
S_flipup = "flipperup": S_flipdown = "flipperdown": S_eject = "eject"
S_postup = "postup": S_postdown = "postdown": S_gateopen = "opengate"
S_gateshut = "closegate": S_dropreset = "dropreset"
S_flipflag = "flipflag": S_reel = "EMReel": S_tilt = "Tilt"

'** objects that just can't be referenced any other way at the moment.
'dim	CurrentEject

'** nballs and minscore should be kept open

private	nballs	' default number of balls to complete
		nballs=5
public	minscore	' minimum score
		minscore=10	' can be changed to 1, for example

dim	matchpoint	' which point affects the match wheel
	matchpoint=minscore	' usual.
	' Bow and Arrow does it on the 100s.

' *** features ***
' nseq is open for now
public	nseq		' number of sequences completed


' * directives *
sub emScoreSaucers(saucer)
	if neject < 0 then exit sub
	saucer.score
end sub

sub emClearSaucers(saucer)
	if neject < 0 then exit sub
	saucer.eject
end sub

' this really needs to have some attention paid to it:
'	if we're called from the cam routine, it's difficult to control
'	what gets shown.

sub emAltQChange(qtype)
	dim b, f
	if naltq < 0 then exit sub

	for each b in BAltQ
		if (b.qtype = qtype) then
			b.rotate
			f = getref(b.handler)
			eval(f)
		end if
	next
end sub

' this is illumination only
sub emShowBonus(onoff)
	dim o
	if nbqueue < 0 then exit sub
	for o = 0 to nbqueue
		BBonusQ(o).show onoff
	next
end sub

' setting the number of balls per game

const GAMELEN_LONG = 0
const GAMELEN_SHORT = 1
const	GAMELEN_CHECK = 2
const GAMELEN_TEST = 3

function emGameLength(length)
	select case length
	case GAMELEN_LONG
		nballs = 5
	case GAMELEN_SHORT
		nballs = 3
	case GAMELEN_TEST
		nballs = 1
	end select
	 	emGameLength = nballs
end function
