REM >CRf
REM
REM CRf - Conditioned Reinforcement
REM -------------------------------
REM by Rudolf Cardinal

progname$="CRf"
version_date$="15-Mar-2000"
debug% = 0            :REM debugging? shortens all the times

REM Possible things to do:
REM - multiple screens, flashy-looking multitasking (yeah, right)
REM - the box names don't work well for second runs onwards.
REM   (get rid of them altogether?)

REM Tests rats according to an instrumental contingency,
REM namely acquisition of a discriminated lever press
REM response for a conditioned (secondary) reinforcer.
REM More self-explanatory code is in !DiscAp
REM
REM * As testing is in extinction (no sucrose in dipper), a random
REM   ratio 2 is used (a.k.a. VR:1-2), i.e. half of the CR lever presses
REM   are reinforced. This slows extinction compared to presenting an
REM   empty dipper each time.
REM * Although the classical training program uses a 5s light CS and a
REM   5s dipper US, this program uses a reinforcer consisting of lights
REM   for 0.5s and an empty dipper for 0.3s. Empirically, this works better.
REM * Levers are not retracted at any point [confirmed with BJE/TWR/MCO]
REM   and all lever-presses are counted.
REM * Bin timeout *doesn't* take account of any consequences in progress.
REM   This gives perfectly accurate bin times.
REM   As there is no NCR consequence, that is unaffacted.
REM   If a CR consequence was in progress...
REM     - lever counts are fine [discrete event]
REM     - nosepoke would be attributed to CR correctly, but half of the
REM       nosepoke would go in the first of the bins and half in the second.
REM       This would look a bit odd if a bin had no CR presses yet a
REM       non-zero CR nosepoke time.
REM   The alternative would be to wait for the CR to finish and then recall
REM   the bin timeout mechanism. This introduces up to an 0.8s inaccuracy
REM   in the bin timing.
REM   Neither situation seems particularly dire; therefore I'm going with
REM   the "to hell with it" version which is easier to program.
REM
REM 14 Jan 98 - print time at end; seed random number generator
REM 16 Jan 98 - p(CR_consequence | CR_lever) = 0.5
REM           - two-phase CR using dipper, no NCR consequences
REM           - levers don't retract, all lever presses counted
REM 16 Feb 98 - bin timeout policy decided (FNbintimeout and above)
REM           - fixed bug where null CR -> nosepokes not counted afterwards
REM 18 Feb 98 - first used in anger
REM           - bugfix: bin timer started by nosepoke, not lever selection
REM             (stupid!!)
REM           - counts number of reinforcers delivered
REM           - displays totals across all bins (screen and printer)
REM 23 Feb 98 - displays a summary on screen at the end
REM  6 May 98 - boxes can be restarted for a rolling run
REM           - fixed bug when CR was executing as box finished
REM 11 May 98 - fixed two incorrect timer references (pick_lever...)
REM           - infusion timer
REM           - colour
REM           - start_time$ now reflects first poke, not lever choice!
REM           - "time left" indicator
REM           - improved summary output, including automated calculations
REM 23 May 98 - disabled escape key; now type "quit<Enter>" to quit.
REM 16 Jul 98 - clock ticks every second now
REM 15 Sep 98 - renamed from TestInstr to CRf
REM           - uses libraries
REM           - output to data file for importing into Excel/Access
REM           - logfile set to type Text
REM 27 Sep 98 - determines record# in advance and displays it on-screen
REM 17 Oct 98 - a few filename changes, more functions into library
REM             including standardised box global variables
REM 15 Nov 98 - watches in 6x5min bins (rather than 3x10min)
REM           - comma-delimited output also includes bin length.
REM 20 Jan 99 - levers are not extended until first nosepoke (PROCset_start)
REM             (improves salience / prevents responding on nonfunctioning lever)
REM  3 Feb 99 - I claimed to have fixed some small (and unlikely) bug... where?
REM 13 Aug 99 - put in a LOCAL command, though code was not dangerous as it was.
REM 10 Dec 99 - cannot believe this, but the rat name wasn't recorded in the comma-delimited output. Is now.
REM 15 Mar 2000 - records session number too, plus option for an abbreviated (10-min) session. To be used for amphetamine history exp.
REM
REM whichlever:    all lights off but levers out
REM                waits for 3 presses on a lever within a certain time
REM                makes that lever the CR, the other the NCR
REM
REM start:         waits for a nosepoke (implies rat is central)
REM
REM Waiting phase: houselight on
REM                traylight off
REM                dipper down
REM                ... until a lever is pressed.
REM
REM CR lever:      houselight off  } 0.5s
REM                traylight on    }
REM
REM                houselight on   } 0.3s
REM                traylight off   }
REM                dipper up       }
REM
REM NCR lever:     no consequence
REM
REM Finished:      all lights off, levers retracted,
REM                wait for someone to come!

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"
LIBRARY "<RudolfDir>.ProgLibs.UI"
PROCcombined_boxes

REM ==================================
REM Constants
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...

REM This bit added 15 Mar 2000
IF FNget_letter_param("Use [N]ormal 30-min session or [A]bbreviated 10-min session?", "NA", "N")="N" THEN
  nbins% = 6         :REM number of bins to count in
  bintime% = 30000   :REM each bin is 5 min
  REM This gives 30 min
ELSE
  nbins% = 5
  bintime% = 12000   :REM each bin is 2 min
  REM This gives 10 min
ENDIF

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
  PRINT "Debugging; all times overridden."
  bintime% = 1000
  inf_time% = 500: diff_time% = 500
ENDIF

PRINT "Press a key...";:IF GET

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 session_number%(nboxes%)        :REM 15 Mar 2000
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_session_number%(records%) :REM 15 Mar 2000
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 progname$;", 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
datafile$ = FNget_filename("DATA FILE - enter filename (no spaces etc.)")
logfile$ = FNget_filename("TEXT LOG - enter filename (no spaces etc.)")
date_time$ = FNdate_time_code

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

REM ==========================================
REM Go!
REM ==========================================
PROCstart
PROCpipe_keybd(0,0,0,"FNkeyboard_handler(",0,E%)
PROCwait(E%): *AE
END

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

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 box% = 1 TO nboxes%
    PROCstart_the_box(box%)
  NEXT
  REM ... and start the clock display
  PROCpipe_timer(ticktimer%,ticktime%,ticktime%,"FNtick_tick_tick(",1,E%)
ENDPROC

DEF PROCstart_the_box(box%)
  REM clear the boxes to the null state
  REM the following stay off throughout the program
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)

  rec% += 1
  IF rec%>records% THEN PRINT"Disastrous error -- too many goes. Bug."
  boxrec%(box%) = rec% :REM this box will be stored as record number rec%

  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
  PROCset_whichlever(box%)
  PROCdisplay_box(box%)
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%)
  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
  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(nosepoke%(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
  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
    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%)
  ELSE
    PROCdisplay_box(box%)
  ENDIF
=0

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(nosepoke%(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(nosepoke%(box%),E%)=On THEN
    PROCenter_magazine(box%)
  ELSE
    PROCleave_magazine(box%)
  ENDIF
=0

DEF PROCenter_magazine(box%)
  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
                       start_time$(box%)=TIME$
                       bin1_start%(box%) = TIME
                       bin%(box%) = 1
                       PROCpipe_timer(bintimer%+box%,bintime%,0,"FNbintimeout(",box%,E%)
                       PROCset_wait(box%)
                       PROCdisplay_box(box%)
    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(nosepoke%(box%),Over,1,"FNmagazine_changed(",box%,E%)
ENDPROC

DEF PROCset_start(box%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_off(leftlevercontrol%(box%),E%)
  PROCswitch_off(rightlevercontrol%(box%),E%)
  REM changed 20 Jan 99 so levers are not out before initial nosepoke
  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%)
  PROCswitch_on(leftlevercontrol%(box%),E%)
  PROCswitch_on(rightlevercontrol%(box%),E%)
  PROCswitch_off(dipper%(box%),E%)
  PROCstart_counting(box%)
ENDPROC

DEF PROCset_cr1(box%)
  PROCswitch_on(leftlevercontrol%(box%),E%)
  PROCswitch_on(rightlevercontrol%(box%),E%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_on(traylight%(box%),E%)
  PROCswitch_off(dipper%(box%),E%)
  state%(box%) = cr_state%
ENDPROC

DEF PROCset_cr2(box%)
  PROCswitch_on(leftlevercontrol%(box%),E%)
  PROCswitch_on(rightlevercontrol%(box%),E%)
  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 5-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(nosepoke%(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 !";progname$;" 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_string(ch%,"PROGNAME,SESSION_ID,RAT,SESSION_NUMBER,BOX,BINTIME,CR_LEVER,CR_LATENCY,")
  PROCprint_line(ch%,"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%)+","+rec_box_name$(i%)+","+STR$(rec_session_number%(i%))+","+STR$(rec_box_number%(i%))+","
    d1$ = d1$ + STR$(bintime%/100)+","+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_session_number%(rec%) = session_number%(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 progname$;", 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(nosepoke%(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"Session number: ";rec_session_number%(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
  LOCAL b%
  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