REM >YokedCRf
REM YokedCRf - Yoked Conditioned Reinforcement
REM ------------------------------------------
REM by Rudolf Cardinal

progname$="YokedCRf"
version_date$="27 Sep 98"
debug%=1

REM to do
REM display functions should differ by type
REM when master ends, slave should
REM many slave variables irrelevant
REM file format
REM slave interval timers pointless - only nosepokes count
REM
REM DESIGN - 
REM each box has a master() variable.
REM Master boxes are their own master.
REM All processing is based on the master boxes.
REM In the initialization, ask "which box is the master for this?"
REM answers can be a number (if same as box, is a master)
REM or a code for "unused".
REM
REM Display can work on a per-box basis, should display
REM this master() variable.
REM
REM SHARE FUNCTIONS WITH CRF, USING CRFLIB?

REM Based on !CRf, but with master/yoked boxes.
REM Master box as !CRf; yoked box receives the same stimuli
REM but has no levers.
REM
REM Basic differences
REM -----------------
REM * Initialization code is based on pairs, not boxes.
REM * Display code is based on boxes.
REM
REM Revision history:
REM -----------------
REM 27 Sep 98 - first written, based on !CRf
REM 17 Oct 98 - modularisation

REM ==================================
REM Libraries
REM ==================================

PROCinit              :REM Arachnid init
PROCkill_all          :REM Arachnid init
LIBRARY "<RudolfDir>.ProgLibs.Filename"
LIBRARY "<RudolfDir>.ProgLibs.DateTime"
LIBRARY "<RudolfDir>.ProgLibs.Ascii"
LIBRARY "<RudolfDir>.ProgLibs.Arachnid"
LIBRARY "<RudolfDir>.ProgLibs.BoxConst"
PROCcombined_boxes

REM ==================================
REM Constants
REM ==================================

REM specific to YokedCRf:
REM ---------------------
npairs% = 2
DIM master%(npairs%), yoked%(npairs%)
master_status% = 1
yoked_status% = 2
DIM box_type%(nboxes%), pair_number%(nboxes%)

REM were in CRf:
REM ------------

gentimer% = 0         :REM Arachnid timer numbers, called as (e.g.)
bintimer% = nboxes%   :REM bintimer%+box%, or gentimer%+box%. Most of
                      :REM my functions that use gentimer% abbreviate
                      :REM this to just box%, so ensure gentimer%=0.
                      :REM ('gen' = general.)
inftimer% = 2*nboxes% + 1 :REM only one of these! Doesn't get called
                          :REM with a "+box%" offset, so needs "+1"
ticktimer% = 2*nboxes% + 2 :REM only the one...

nbins% = 3         :REM number of bins to count in
bintime% = 60000   :REM each bin is 10min (600 s = 60000 cs)

cr1_time% = 50     :REM 0.5 sec
cr2_time% = 30     :REM 0.3 sec
random_ratio = 0.5 :REM Reinforcer occurs on 50% of CR lever presses

leverchoice% = 3       :REM press lever 3 times to make it the CR lever
leverchoicetime% = 100 :REM ... within 100 csec ... consecutively

yes%=1 : no%=0
left%=1 : right%=2
infusing% = 1: diffusing% = 2

inf_time% = 12500 :REM 125s of infusion
diff_time% = 6000 :REM 60s of diffusion

ticktime% = 100 : REM update clocks once every second

not_watching% = 0
whichlever_state% = 1
start_state% = 2
wait_state% = 3
cr_state% = 4
ncr_state% = 5         :REM as no NCR consequences, never used.
finished_state% = 6

IF debug% = 1 THEN
  bintime% = 1000
  inf_time% = 500: diff_time% = 500
ENDIF

quit$="quit"+CHR$13
quitcount% = 1

REM ==================================
REM Variable assignments
REM ==================================

inftimer_status%=no%

DIM cr_lever%(nboxes%)      :REM which lever is the CR?
DIM ncr_lever%(nboxes%)     :REM ... so the other one is ...
DIM lever$(nboxes%)         :REM a human-friendly version
DIM leftcount%(nboxes%)     :REM used for initial lever choice
DIM rightcount%(nboxes%)
DIM watching%(nboxes%)
DIM counting%(nboxes%)
DIM start_time%(nboxes%)    :REM start of *this* nosepoke

DIM state%(nboxes%)         :REM what phase is the box in?
DIM finished%(nboxes%)      :REM all done?
DIM bin1_start%(nboxes%)    :REM time at start of bin 1
DIM bin%(nboxes%)           :REM which bin is the box in? 0 => before,
                            :REM nbins%+1 => done

REM *** Monitored aspects

DIM box_name$(nboxes%)              :REM what's the rat called?
DIM start_time$(nboxes%)            :REM time of starting poke
DIM end_time$(nboxes%)

DIM cr_responses%(nboxes%,nbins%)  :REM count of CR responses
DIM ncr_responses%(nboxes%,nbins%) :REM count of NCR responses
DIM reinf_count%(nboxes%,nbins%)   :REM count of secondary reinforcers

DIM cr_total%(nboxes%), ncr_total%(nboxes%), reinf_total%(nboxes%)
DIM wait_pokestotal%(nboxes%), cr_pokestotal%(nboxes%)
DIM wait_durtotal%(nboxes%), cr_durtotal%(nboxes%)

DIM wait_pokes%(nboxes%,nbins%)
DIM cr_pokes%(nboxes%,nbins%)
DIM ncr_pokes%(nboxes%,nbins%)
DIM wait_pokedur%(nboxes%,nbins%)
DIM cr_pokedur%(nboxes%,nbins%)
DIM ncr_pokedur%(nboxes%,nbins%)

DIM poke_latency%(nboxes%)  :REM time from start of bin 1 until first
DIM cr_latency%(nboxes%)    :REM whatever. Initialized to -1.
DIM ncr_latency%(nboxes%)

REM *** final records; boxes are re-used but data is copied here

records% = nboxes% * 10     :REM allows 10 'goes' per box max.
rec% = 0                    :REM number of records begun
DIM boxrec%(nboxes%)        :REM so you know which record it *will* be
DIM rec_box_name$(records%)
DIM rec_box_number%(records%)
DIM rec_start_time$(records%)
DIM rec_end_time$(records%)
DIM rec_lever$(records%)

DIM rec_cr_responses%(records%,nbins%)
DIM rec_ncr_responses%(records%,nbins%)
DIM rec_reinf_count%(records%,nbins%)

DIM rec_cr_total%(records%),rec_ncr_total%(records%),rec_reinf_total%(records%)
DIM rec_wait_pokestotal%(records%), rec_cr_pokestotal%(records%)
DIM rec_wait_durtotal%(records%), rec_cr_durtotal%(records%)

DIM rec_wait_pokes%(records%,nbins%),rec_cr_pokes%(records%,nbins%),rec_ncr_pokes%(records%,nbins%)
DIM rec_wait_pokedur%(records%,nbins%),rec_cr_pokedur%(records%,nbins%),rec_ncr_pokedur%(records%,nbins%)
DIM rec_poke_latency%(records%), rec_cr_latency%(records%), rec_ncr_latency%(records%)


REM =================================
REM Initialize screen
REM =================================

MODE 12:CLS
dummy=RND(-TIME): REM seed random number generator
PRINT "TestInstr by Rudolf Cardinal, ";version_date$;
IF debug%=1 THEN
  COLOUR 3:PRINT" -- debugging!":COLOUR7
ELSE
  PRINT
ENDIF
PRINT
INPUT LINE "What's today's experiment called? " exp_title$

PRINT
OSCLI("CAT")
PRINT
logfile$ = FNget_filename("TEXT LOG - enter filename (no spaces etc.)")
datafile$ = FNget_filename("DATA FILE - enter filename (no spaces etc.)")
date_time$ = FNdate_time_code

PRINT
PRINT "And the rats... (NB no commas!)"
FOR i% = 1 TO nboxes%
  PRINT "  Rat in box ";i%;": ";
  INPUT LINE "" box_name$(i%)
NEXT

REM ==========================================
REM Init hardware, assign events and run
REM ==========================================
PROCdefine_pairs
PROCstart
PROCpipe_keybd(0,0,0,"FNkeyboard_handler(",0,E%)
PROCwait(E%): *AE
END

REM ============================================
REM ********************************************
REM ============================================

DEF PROCdefine_pairs
  LOCAL i%
  FOR i%=1 TO npairs%
    master%(i%) = (i%*2)-1    :REM 1,3,5,7...
    box_type%((i%*2)-1) = master_status%
    pair_number%((i%*2)-1) = i%
    yoked%(i%) = i%*2         :REM 2,4,6,8...
    box_type%(i%*2) = yoked_status%
    pair_number%(i%*2) = i%
  NEXT
ENDPROC

DEF PROCstart
  REM when we're ready, initialise and go
  PRINT"Ready to run, press a key to start..."
  IF GET
  PROCdisplay_startup
  *FX 229,1
  REM that disables the Escape key (*FX229,0 to enable)
  FOR pair% = 1 TO npairs%
    PROCstart_the_pair(pair%)
  NEXT
  REM ... and start the clock display
  PROCpipe_timer(ticktimer%,ticktime%,ticktime%,"FNtick_tick_tick(",1,E%)
ENDPROC

DEF PROCstart_the_pair(pair%)
  rec% += 1
  IF rec%>records% THEN PRINT"Disastrous error -- too many goes. Bug."
  boxrec%(box%) = rec% :REM this pair will be stored as record number rec%
  PROCstart_whichever(master%(pair%))
  PROCstart_whichever(yoked%(pair%))
  PROCswitch_off(leftlevercontrol%(yoked%(pair%)),E%)
  PROCswitch_off(rightlevercontrol%(yoked%(pair%)),E%)
  PROCset_whichlever(master%(pair%))
  PROCdisplay_box(master%(pair%))
  PROCdisplay_box(yoked%(pair%))
ENDPROC

DEF PROCstart_whichever(box%)
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)
  bin%(box%) = 0
  FOR bint% = 1 TO nbins%
    cr_responses%(box%,bint%)=0
    ncr_responses%(box%,bint%)=0
    reinf_count%(box%,bint%)=0
    wait_pokes%(box%,bint%)=0
    cr_pokes%(box%,bint%)=0
    ncr_pokes%(box%,bint%)=0
    wait_pokedur%(box%,bint%)=0
    cr_pokedur%(box%,bint%)=0
    ncr_pokedur%(box%,bint%)=0
  NEXT
  cr_total%(box%)=0: ncr_total%(box%)=0: reinf_total%(box%)=0
  wait_pokestotal%(box%)=0:cr_pokestotal%(box%)=0
  wait_durtotal%(box%)=0:cr_durtotal%(box%)=0

  finished%(box%) = no%
  watching%(box%) = not_watching%
  counting%(box%) = no%
  poke_latency%(box%) = -1: cr_latency%(box%) = -1: ncr_latency%(box%) = -1
ENDPROC

DEF FNtimeout(box%,R%)
  IF R%=0 =0
  leftcount%(box%) = leverchoice%
  rightcount%(box%) = leverchoice%
=0

DEF FNpick_lever_l(box%,R%)
  IF R%=0 =0
  IF state%(box%) <> whichlever_state% THEN =0
  leftcount%(box%) -= 1: rightcount%(box%) = leverchoice%
  IF leftcount%(box%) <= 0 THEN
    PROCstart_box(box%,leftlever%(box%))
  ELSE
    PROCpipe_timer(box%,leverchoicetime%,0,"FNtimeout(",box%,E%)
  ENDIF
=0

DEF FNpick_lever_r(box%,R%)
  IF R%=0 =0
  IF state%(box%) <> whichlever_state% THEN =0
  rightcount%(box%) -= 1: leftcount%(box%) = leverchoice%
  IF rightcount%(box%) <= 0 THEN
    PROCstart_box(box%,rightlever%(box%))
  ELSE
    PROCpipe_timer(box%,leverchoicetime%,0,"FNtimeout(",box%,E%)
  ENDIF
=0

DEF PROCstart_box(box%,cr%)
  LOCAL slave%
  slave% = yoked%(pair_number%(box%))
  REM This will only come here for a MASTER box.
  IF box_type%(box%)<>master_status% THEN VDU7:PRINT"*** Bug! start_box() ***"
  PROCkill_switch(leftlever%(box%),E%)
  PROCkill_switch(rightlever%(box%),E%)
  :REM don't know if that's needed, but there were some funny problems
  cr_lever%(box%) = cr%
  CASE cr_lever%(box%) OF
    WHEN leftlever%(box%):  ncr_lever%(box%) = rightlever%(box%)
                            lever$(box%) = "L"
    WHEN rightlever%(box%): ncr_lever%(box%) = leftlever%(box%)
                            lever$(box%) = "R"
  ENDCASE
  bin%(box%) = 0 : REM before bin 1 has started
  bin%(slave%) = 0
  PROCpipe_switch(cr_lever%(box%),On,1,"FNcr_lever(",box%,E%)
  PROCpipe_switch(ncr_lever%(box%),On,1,"FNncr_lever(",box%,E%)
  PROCset_start(box%)
  IF FNswitch(panelpress%(box%),E%)=On THEN PROCenter_magazine(box%)
  REM if the rat's already in, let's get going!
  PROCdisplay_box(box%)
ENDPROC

REM *****************************************************************
REM Levers
REM *****************************************************************

DEF FNcr_lever(box%,R%)
  IF R%=0 =0
  LOCAL i%, slave%
  slave% = yoked%(pair_number%(box%))
  REM These levers are piped *throughout*. Therefore this function must
  REM only initiate a CR response if the box was in the "wait" state.
  REM But lever presses are counted if the box is in wait, cr or ncr states.
  REM
  IF (state%(box%)=wait_state% OR state%(box%)=cr_state% OR state%(box%)=ncr_state%) THEN cr_responses%(box%,bin%(box%)) += 1
  IF state%(box%) <> wait_state% THEN =0
  REM don't want to initiate one CR during another one!
  PROCfirst_cr(box%)
  IF RND(1) < random_ratio THEN
    PROCgive_a_cr(box%)
    PROCgive_a_cr(slave%)
  ELSE
    PROCdisplay_box(box%)
    PROCdisplay_box(slave%)
  ENDIF
=0

DEF PROCgive_a_cr(box%)
  PROCstop_counting(box%)     :REM only stop if actually doing something!
  reinf_count%(box%,bin%(box%)) += 1
  PROCset_cr1(box%)
  PROCpipe_timer(box%,cr1_time%,0,"FNcr_halfway(",box%,E%)
  PROCstart_counting(box%)
  PROCdisplay_state(box%)
ENDPROC


DEF FNcr_halfway(box%,R%)
  IF R%=0 =0
  PROCset_cr2(box%)
  PROCpipe_timer(box%,cr2_time%,0,"FNcr_done(",box%,E%)
=0

DEF FNcr_done(box%,R%)
  IF R%=0 =0
  REM end of CR consequence
  PROCstop_counting(box%)
  IF finished%(box%)=yes% THEN PROCset_finished(box%):=0
    :REM on the offchance that a CR is executing as the box finishes.
  PROCset_wait(box%)
  PROCdisplay_box(box%)
=0


DEF FNncr_lever(box%,R%)
  IF R%=0 =0
  REM See comments above (under FNcr_lever)
  IF (state%(box%)<>wait_state% AND state%(box%)<>cr_state% AND state%(box%)<>ncr_state%) THEN =0
  ncr_responses%(box%,bin%(box%)) += 1
  PROCfirst_ncr(box%)
  REM As there are no programmed consequences on the NCR lever, don't
  REM do anything (and ncr_state% is never used).
  PROCdisplay_box(box%)
=0


DEF PROCfirst_cr(box%)
  IF cr_latency%(box%)=-1 THEN cr_latency%(box%)=TIME-bin1_start%(box%)
ENDPROC

DEF PROCfirst_ncr(box%)
  IF ncr_latency%(box%)=-1 THEN ncr_latency%(box%)=TIME-bin1_start%(box%)
ENDPROC


REM *****************************************************************
REM Nosepokes
REM *****************************************************************

DEF PROCstart_counting(box%)
  counting%(box%) = yes%
  IF FNswitch(panelpress%(box%),E%)=On THEN PROCenter_magazine(box%)
  REM as the event is scheduled on a transition, it'll get lost if
  REM the switch is active at startup, without this extra check.
ENDPROC

DEF PROCstop_counting(box%)
  IF watching%(box%) <> not_watching% THEN PROCleave_magazine(box%)
  counting%(box%) = no%
ENDPROC

DEF FNmagazine_changed(box%,R%)
  IF R%=0 =0
  IF counting%(box%)=no% AND state%(box%)<>start_state% THEN =0
  IF FNswitch(panelpress%(box%),E%)=On THEN
    PROCenter_magazine(box%)
  ELSE
    PROCleave_magazine(box%)
  ENDIF
=0

DEF PROCenter_magazine(box%)
  IF R%=0 =0
  LOCAL slave%
  CASE state%(box%) OF
    WHEN wait_state%:  start_time%(box%)=TIME:watching%(box%)=state%(box%)
                       wait_pokes%(box%,bin%(box%)) += 1
                       PROCfirst_poke(box%)
    WHEN cr_state%:    start_time%(box%)=TIME:watching%(box%)=state%(box%)
                       cr_pokes%(box%,bin%(box%)) += 1
                       PROCfirst_poke(box%)
    WHEN ncr_state%:   REM now impossible... this code never executed
                       start_time%(box%)=TIME:watching%(box%)=state%(box%)
                       ncr_pokes%(box%,bin%(box%)) += 1
                       PROCfirst_poke(box%)
    WHEN start_state%: REM rat central, can go
                       IF box_type%(box%) = master_status% THEN
                         slave% = yoked%(pair_number%(box%))
                         start_time$(box%)=TIME$
                         bin1_start%(box%) = TIME
                         bin%(box%) = 1
                         PROCpipe_timer(bintimer%+box%,bintime%,0,"FNbintimeout(",box%,E%)
                         PROCpipe_timer(bintimer%+slave%,bintime%,0,"FNbintimeout(",slave%,E%)
                         PROCset_wait(box%)
                         PROCset_wait(slave%)
                         PROCdisplay_box(box%)
                         PROCdisplay_box(slave%)
                       ENDIF
    WHEN finished_state%:
  ENDCASE
  PROCdisplay_switch(box%)
ENDPROC

DEF PROCfirst_poke(box%)
  REM only comes here from wait/cr/ncr states
  REM which are only entered *after* bin 1 has been started by PROCstart_box
  REM so the following is safe.
  REM I don't believe TIME-bin1_start will ever be -1. A risk, but hey ;-)
  IF poke_latency%(box%)=-1 THEN poke_latency%(box%)=TIME-bin1_start%(box%)
ENDPROC

DEF PROCleave_magazine(box%)
  CASE watching%(box%) OF
    WHEN wait_state%:   wait_pokedur%(box%,bin%(box%))+=TIME-start_time%(box%)
    WHEN cr_state%:     cr_pokedur%(box%,bin%(box%))+=TIME-start_time%(box%)
    WHEN ncr_state%:    ncr_pokedur%(box%,bin%(box%))+=TIME-start_time%(box%)
    WHEN not_watching%:
  ENDCASE
  watching%(box%) = not_watching%
  PROCdisplay_switch(box%)
ENDPROC


REM *****************************************************************
REM States of the box
REM *****************************************************************

DEF PROCset_whichlever(box%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_on(leftlevercontrol%(box%),E%)
  PROCswitch_on(rightlevercontrol%(box%),E%)
  PROCswitch_off(dipper%(box%),E%)
  state%(box%) = whichlever_state%
  lever$(box%) = "?"
  leftcount%(box%) = leverchoice%
  rightcount%(box%) = leverchoice%
  :REM this state terminates when one lever is pressed leverchoice% times
  :REM (consecutively) by the experimenter within leverchoicetime%
  PROCpipe_switch(leftlever%(box%),On,1,"FNpick_lever_l(",box%,E%)
  PROCpipe_switch(rightlever%(box%),On,1,"FNpick_lever_r(",box%,E%)
  PROCpipe_switch(panelpress%(box%),Over,1,"FNmagazine_changed(",box%,E%)
ENDPROC

DEF PROCset_start(box%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  IF box_type%(box%) = master_status% THEN
    PROCswitch_on(leftlevercontrol%(box%),E%)
    PROCswitch_on(rightlevercontrol%(box%),E%)
  ELSE
    REM slave should never get to set_start, really
    PROCswitch_off(leftlevercontrol%(box%),E%)
    PROCswitch_off(rightlevercontrol%(box%),E%)
  ENDIF
  PROCswitch_off(dipper%(box%),E%)
  state%(box%) = start_state%
ENDPROC

DEF PROCset_wait(box%)
  state%(box%) = wait_state%
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  IF box_type%(box%) = master_status% THEN
    PROCswitch_on(leftlevercontrol%(box%),E%)
    PROCswitch_on(rightlevercontrol%(box%),E%)
  ELSE
    PROCswitch_off(leftlevercontrol%(box%),E%)
    PROCswitch_off(rightlevercontrol%(box%),E%)
  ENDIF
  PROCswitch_off(dipper%(box%),E%)
  PROCstart_counting(box%)
ENDPROC

DEF PROCset_cr1(box%)
  IF box_type%(box%) = master_status% THEN
    PROCswitch_on(leftlevercontrol%(box%),E%)
    PROCswitch_on(rightlevercontrol%(box%),E%)
  ELSE
    PROCswitch_off(leftlevercontrol%(box%),E%)
    PROCswitch_off(rightlevercontrol%(box%),E%)
  ENDIF
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_on(traylight%(box%),E%)
  PROCswitch_off(dipper%(box%),E%)
  state%(box%) = cr_state%
ENDPROC

DEF PROCset_cr2(box%)
  IF box_type%(box%) = master_status% THEN
    PROCswitch_on(leftlevercontrol%(box%),E%)
    PROCswitch_on(rightlevercontrol%(box%),E%)
  ELSE
    PROCswitch_off(leftlevercontrol%(box%),E%)
    PROCswitch_off(rightlevercontrol%(box%),E%)
  ENDIF
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_on(dipper%(box%),E%)
  state%(box%) = cr_state% :REM still
ENDPROC

REM PROCset_ncr abandoned because no consequences of NCR lever

DEF PROCset_finished(box%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_off(leftlevercontrol%(box%),E%)
  PROCswitch_off(rightlevercontrol%(box%),E%)
  PROCswitch_off(dipper%(box%),E%)
  state%(box%) = finished_state%
ENDPROC


REM *****************************************************************
REM Count everything in 10-minute bins
REM *****************************************************************

DEF FNbintimeout(box%,R%)
  IF R%=0 =0
  REM Bin time has elapsed. Move to next bin.
  REM This does *not* take account of any CR/NCR currently in progress
  REM (e.g. by waiting for it to finish). This introduces a maximum pseudo-
  REM bin timing inaccuracy of the duration of the CR or NCR consequence.
  REM If the final timeout occurs during a CR/NCR, it'll be interrupted
  REM Important that counting is stopped during the transition!

  PROCstop_counting(box%)
  bin%(box%) += 1

  cr_total%(box%)        +=  cr_responses%(box%,bin%(box%)-1)
  ncr_total%(box%)       += ncr_responses%(box%,bin%(box%)-1)
  reinf_total%(box%)     +=   reinf_count%(box%,bin%(box%)-1)
  wait_durtotal%(box%)   +=  wait_pokedur%(box%,bin%(box%)-1)
  cr_durtotal%(box%)     +=    cr_pokedur%(box%,bin%(box%)-1)
  wait_pokestotal%(box%) +=    wait_pokes%(box%,bin%(box%)-1)
  cr_pokestotal%(box%)   +=      cr_pokes%(box%,bin%(box%)-1)

  IF bin%(box%) > nbins% THEN
    PROCfinish(box%)
  ELSE
    PROCpipe_timer(bintimer%+box%,bintime%,0,"FNbintimeout(",box%,E%)
    PROCstart_counting(box%)
    PROCdisplay_box(box%)
  ENDIF
=0

REM ***********************************************************
REM Finishing up and all display code
REM ***********************************************************

DEF PROCfinish(box%)
  PROCkill_switch(leftlever%(box%),E%)
  PROCkill_switch(rightlever%(box%),E%)
  PROCkill_switch(panelpress%(box%),E%)
  PROCset_finished(box%)
  PROCdisplay_box(box%)
  end_time$(box%)=TIME$

  PROCcopy_to_record(box%,boxrec%(box%))

  REM "multiple goes" technique: if and only if a box is restarted
  REM before all boxes are finished, the program continues.
  REM So the check below is still valid.

  REM don't call display_box as trial% now too big
  REM I'm scared that if I start reporting for a box before they've
  REM all finished, the other three will be inaccurately timed for
  REM the last session. Hence this check.
  finished%(box%) = yes%
  FOR i% = 1 TO nboxes%
    IF finished%(i%) <> yes% THEN ENDPROC
  NEXT
  PROCkill_all  :REM get rid of the keyboard handler! (and inftimer...)

  *FX229,0
  REM re-enable Escape key

  VDU 2    :REM turn on printer
  CLS
  OSCLI("SPOOL "+logfile$)  :REM output to logfile
  PRINT"**********************************************************"
  PRINT"Results from !TestInstr on ";TIME$
  PRINT"Experiment: ";exp_title$
  PRINT"Date/time code: ";date_time$
  PRINT"Log filename: ";logfile$
  PRINT"Data filename: ";datafile$
  PRINT"Using ";nbins%;" bins of ";bintime%/6000;" min each."
  PRINT"**********************************************************"'
  FOR i% = 1 TO rec%
    PROCfinal_output(i%)
  NEXT
  OSCLI("SPOOL")
  OSCLI("SETTYPE "+logfile$+" TEXT")
  VDU 3                            :REM printer off, close file

  REM Now output raw data for importing into Access/Excel
  REM Times in seconds
  ch% = OPENOUT(datafile$)
  PROCprint_line(ch%,"PROGNAME,SESSION_ID,BOX,CR_LEVER,CR_LATENCY,NCR_LATENCY,BIN,CR,NCR,REINF,CR_POKES,CR_POKETIME,WAIT_POKES,WAIT_POKETIME")
  FOR i% = 1 TO rec%
    d1$=progname$+","+date_time$+"-"+STR$(i%)+","+STR$(rec_box_number%(i%))+","+rec_lever$(i%)+","+STR$(rec_cr_latency%(i%)/100)+","+STR$(rec_ncr_latency%(i%)/100)+","
    FOR j% = 1 TO nbins%
      d2$ = d1$ + STR$(j%)+","+STR$(rec_cr_responses%(i%,j%))+","+STR$(rec_ncr_responses%(i%,j%))+","+STR$(rec_reinf_count%(i%,j%))+","
      d2$ = d2$ + STR$(rec_cr_pokes%(i%,j%))+","+STR$(rec_cr_pokedur%(i%,j%)/100)+","+STR$(rec_wait_pokes%(i%,j%))+","+STR$(rec_wait_pokedur%(i%,j%)/100)
      PROCprint_line(ch%,d2$)
    NEXT
  NEXT
  CLOSE#ch%

  PRINT'"Finished at ";TIME$
  PRINT"If you want that again, use PROCfinal_output(record number)."''
  FOR i% = 1 TO rec%
    PRINT"Record ";i%;": box ";rec_box_number%(i%);" (";rec_box_name$(i%);"): CR ";rec_cr_total%(i%);", NCR ";rec_ncr_total%(i%)
  NEXT
ENDPROC

DEF PROCcopy_to_record(box%,rec%)
  REM oh, for a language with classes

  rec_box_name$(rec%) = box_name$(box%)
  rec_box_number%(rec%) = box%
  rec_start_time$(rec%) = start_time$(box%)
  rec_end_time$(rec%) = end_time$(box%)
  rec_lever$(rec%) = lever$(box%)

  FOR bint% = 1 TO nbins%
    rec_cr_responses%(rec%,bint%) = cr_responses%(box%,bint%)
    rec_ncr_responses%(rec%,bint%) = ncr_responses%(box%,bint%)
    rec_reinf_count%(rec%,bint%) = reinf_count%(box%,bint%)
    rec_wait_pokes%(rec%,bint%) = wait_pokes%(box%,bint%)
    rec_cr_pokes%(rec%,bint%) = cr_pokes%(box%,bint%)
    rec_ncr_pokes%(rec%,bint%) = ncr_pokes%(box%,bint%)
    rec_wait_pokedur%(rec%,bint%) = wait_pokedur%(box%,bint%)
    rec_cr_pokedur%(rec%,bint%) = cr_pokedur%(box%,bint%)
    rec_ncr_pokedur%(rec%,bint%) = ncr_pokedur%(box%,bint%)
  NEXT

  rec_cr_total%(rec%) = cr_total%(box%)
  rec_ncr_total%(rec%) = ncr_total%(box%)
  rec_reinf_total%(rec%) = reinf_total%(box%)
  rec_wait_pokestotal%(rec%) = wait_pokestotal%(box%)
  rec_cr_pokestotal%(rec%) = cr_pokestotal%(box%)
  rec_wait_durtotal%(rec%) = wait_durtotal%(box%)
  rec_cr_durtotal%(rec%) = cr_durtotal%(box%)
  rec_poke_latency%(rec%) = poke_latency%(box%)
  rec_cr_latency%(rec%) = cr_latency%(box%)
  rec_ncr_latency%(rec%) = ncr_latency%(box%)
ENDPROC


DEF PROCdisplay_startup
  CLS
  PRINT"TestInstr, by Rudolf Cardinal, ";version_date$;
  IF debug%=1 THEN
    COLOUR 3:PRINT" -- debugging!":COLOUR7
  ELSE
    PRINT
  ENDIF
  PRINT"Developed from an experimental design by Cella Olmstead."
  PRINT"Experiment: ";:COLOUR 1:PRINTexp_title$:COLOUR 7
  PRINT"Number of bins:     ";nbins%;" (of ";bintime%/6000;" min each)"
  PRINT"Started at:         ";TIME$
  PRINT
  PRINT"- Times shown below are in seconds. System accuracy is 1cs."
  PRINT"- First line: current bin. Second line: sum of completed bins."
  PRINT"- Type 'quit' and press Return to abort in an emergency. Case-sensitive."
  PRINT"- Press <Space> for an infusion timer (infusion: ";inf_time%/100;"s, wait: ";diff_time%/100;"s)."
  PRINT"- You may RESTART a box by typing its number when it is in the"
  PRINT"  Finished state. Program will end when all boxes have finished."
  PRINT
  PRINT"Box Rec LR Bin State    In?  CR#  NCR#  Reinf#  wait-time  CR-time  ";:COLOUR 2:PRINT"Time left":COLOUR 7
  PRINT"-----------------------------------------------------------------------------"
  REM   0         1         2         3         4         5         6
  display_firstline%=VPOS
ENDPROC

DEF PROCdisplay_box(box%)
  line% = FNdisplay_line(box%)
  PRINTTAB(0,line%);box%;
  PRINTTAB(4,line%);boxrec%(box%);
  PRINTTAB(8,line%);lever$(box%);
  PRINTTAB(11,line%);bin%(box%);
  IF bin%(box%) <= nbins% THEN
    PRINTTAB(29,line%);SPC(50);
    PRINTTAB(29,line%);cr_responses%(box%,bin%(box%));
    PRINTTAB(34,line%);ncr_responses%(box%,bin%(box%));
    PRINTTAB(40,line%);reinf_count%(box%,bin%(box%));
    PRINTTAB(48,line%);wait_pokedur%(box%,bin%(box%))/100;
    PRINTTAB(59,line%);cr_pokedur%(box%,bin%(box%))/100;
  ENDIF
  PRINTTAB(29,line%+1);SPC(50);
  PRINTTAB(29,line%+1);cr_total%(box%);
  PRINTTAB(34,line%+1);ncr_total%(box%);
  PRINTTAB(40,line%+1);reinf_total%(box%);
  PRINTTAB(48,line%+1);wait_durtotal%(box%)/100;
  PRINTTAB(59,line%+1);cr_durtotal%(box%)/100;

  PROCdisplay_state(box%)
  PROCdisplay_switch(box%)
ENDPROC

DEF PROCdisplay_state(box%)
  line% = FNdisplay_line(box%)
  PRINTTAB(15,line%);
  CASE state%(box%) OF
    WHEN whichlever_state%: COLOUR 3:PRINT"R or L?";:COLOUR 7
    WHEN start_state%:      COLOUR 1:PRINT"Poke?  ";:COLOUR 7
    WHEN finished_state%:   COLOUR 3:PRINT"* Done.";:COLOUR 7
    WHEN wait_state%:       PRINT"Waiting";
    WHEN cr_state%:         PRINT"CR     ";
    WHEN ncr_state%:        PRINT"NCR    ";
  ENDCASE
ENDPROC

DEF PROCdisplay_switch(box%)
  IF box%=0 THEN PRINT"some berk is calling for box 0"
  line% = FNdisplay_line(box%)
  PRINTTAB(24,line%);
  CASE FNswitch(panelpress%(box%),E%) OF
    WHEN On:  PRINT"*";
    WHEN Off: PRINT" ";
  ENDCASE
ENDPROC

DEF FNtick_tick_tick(junk%,R%)
  IF R%=0 =0
  LOCAL i%
  COLOUR 2
  FOR i% = 1 TO nboxes%
    PRINTTAB(68,FNdisplay_line(i%));
    IF (state%(i%)=wait_state% OR state%(i%)=cr_state%) THEN
      PRINT FNtimeleft(i%);
    ELSE
      PRINT"     ";
    ENDIF
  NEXT
  COLOUR 7
=0

DEF FNdisplay_line(box%)
= display_firstline% + (box%-1)*3

DEF PROCfinal_output(r%)
  LOCAL npt%, npc%
  PRINT"====================================================================="
  PRINT"Record #";r%
  PRINT"Box ";rec_box_number%(r%);" - ";rec_box_name$(r%);" (CR = ";rec_lever$(r%);")"
  PRINT"Started at:   ";rec_start_time$(r%)
  PRINT"Finished at:  ";rec_end_time$(r%)
  PRINT"====================================================================="
  PRINT"*** The bottom line: total CR# = ";rec_cr_total%(r%);", NCR# = ";rec_ncr_total%(r%)
  PRINT"*** Latencies from session start (-0.01=never): CRpress ";rec_cr_latency%(r%)/100;" s, NCRpress = ";rec_ncr_latency%(r%)/100;" s"
  REM PRINTTAB(7);"First nosepoke ";rec_poke_latency%(r%)/100;
  REM commented out as always 0, stupid. Nosepoke starts the session!
  npt%=0:npc%=0
  FOR b% = 1 TO nbins%
    npt% += rec_cr_pokedur%(r%,b%)
    npt% += rec_wait_pokedur%(r%,b%)
    npc% += rec_cr_pokes%(r%,b%)
    npc% += rec_wait_pokes%(r%,b%)
  NEXT
  PRINT"*** Total nosepoke time = ";npt%/100;" s; total nosepoke count = ";npc%
  PRINT
  PRINT"Total number of secondary reinforcers: ";rec_reinf_total%(r%)
  FOR b% = 1 TO nbins%
    PRINT" BIN ";b%;":"
    PRINTTAB(7); "CR lever responses:   ";rec_cr_responses%(r%,b%);
    PRINTTAB(40);"NCR lever responses:   ";rec_ncr_responses%(r%,b%)
    PRINTTAB(7); "- Reinforcers delivered: ";rec_reinf_count%(r%,b%)
    PRINTTAB(7); "- CR period: nosepoke count = ";rec_cr_pokes%(r%,b%);
    PRINT        "; duration = ";rec_cr_pokedur%(r%,b%)/100;" sec"
    PRINTTAB(7); "- Wait period: nosepoke count = ";rec_wait_pokes%(r%,b%);
    PRINT        "; duration = ";rec_wait_pokedur%(r%,b%)/100;" sec"
  NEXT
  PRINT
  PRINT
  REM0         1         2         3         4         5         6
ENDPROC

REM ***********************************************************
REM Restarting a box
REM ***********************************************************

DEF FNkeyboard_handler(P%,R%)
IF R%=0 =0
  key% = GET

  IF key%=ASC(MID$(quit$,quitcount%,1)) THEN
    quitcount% += 1
    IF quitcount% > LEN(quit$) THEN PROCabort_program
  ELSE
    quitcount% = 1   :REM restart the 'counter'
  ENDIF

  IF key%=32 THEN PROCinftimer:=0

  IF key%>=ASC("1") AND key%<=ASC("9") THEN b%=key%-ASC("0") ELSE =0
  IF b%>nboxes% THEN =0
  IF finished%(b%)=no% THEN =0
                        :REM Piss orff! We're the Judean People's Front!
  IF rec%=records% THEN =0     :REM too many already, don't start another
  PROCstart_the_box(b%)
=0

DEF PROCinftimer
  IF inftimer_status% <> no% THEN ENDPROC
  inftimer_status% = infusing%
  VDU 7
  COLOUR 5:PRINTTAB(65,0);"Infusing... ":COLOUR 7
  PROCpipe_timer(inftimer%,inf_time%,0,"FNinftimer2(",1,E%)
ENDPROC

DEF FNinftimer2(junk%,R%)
IF R%=0 =0
  inftimer_status% = diffusing%
  VDU 7 :REM beep
  COLOUR 5:PRINTTAB(65,0);"Diffusing...":COLOUR 7
  PROCpipe_timer(inftimer%,diff_time%,0,"FNinftimer3(",1,E%)
=0

DEF FNinftimer3(junk%,R%)
IF R%=0 =0
  inftimer_status% = no%
  VDU 7
  PRINTTAB(65,0);"            "
=0

DEF FNtimeleft(box%)
  LOCAL t%,m%,s%,t$
  t% = bin1_start%(box%) + (nbins%*bintime%) - TIME
  m%=(t%/100) DIV 60
  s%=(t%/100) MOD 60
  t$=""
  IF m%<10 THEN t$+=" "
  t$+=STR$(m%)+":"
  IF s%<10 THEN t$+="0"
  t$+=STR$(s%)
=t$

DEF PROCabort_program
  PROCkill_all
  CLS
  PRINT"Program aborted by user at ";TIME$
  *FX229,0
  REM enable Escape key again
  END
ENDPROC