REM >PIT-mult
REM ========================================================================
REM Multiple aspects of Pavlovian-instrumental transfer.
REM See opening menu for a list.
REM By Rudolf Cardinal.
REM Search for "***" to find current issues.
REM First written: 8 May 99
REM ========================================================================

progname$="PIT-mult"
version_date$="16-Jun-99"
debug%=0

REM ========================================================================
REM Revision history.
REM ========================================================================
REM  8 May 99 - started.
REM 10 May 99 - spoke to AD. Keep dipper up continuously and lower to collect reinforcement.
REM             Dipper lowering time of 50 cs works fine (and keeps it
REM             within the 1-s granularity of the schedule!).
REM             This makes nosepokes during dipper operation much less interesting! Nevertheless, let's keep it.
REM             RT schedule is programmed appropriately.
REM 14 May 99 - more output added to Pavlovian data file after first day's run
REM 15 May 99 - clock now magenta
REM 16 May 99 - summarizes ratname/session before kickoff
REM 17 May 99 - wrote most of the instrumental schedules...
REM 18 May 99 - something... bored of this...
REM 24 May 99 - boxes are ignited before choice of task
REM           - instrumental completed, only transfer tasks to go
REM           - memory saving for per-response records, plus safety checks
REM           - NOTE: have taken on Nathaniel's naming convention (if bogus%=0 =0)
REM             because I had R%/E% confused at one point and therefore
REM             had one of my functions executed by Arachnid at the start.
REM             Curse its name.
REM  1 Jun 99 - Specific transfer test written.
REM           - If I were rewriting, I'd probably log all responses in one flat array,
REM             ensuring that each entry kept track of its index in case another response occurred
REM             before the lever was released. Would save memory, relative to this technique,
REM             in which max_responses is the max# for each lever. Oh well.
REM           - Individual response code now uses total #responses on that lever as the final index,
REM             not responses in that component (which was a bug waiting to happen if the number of
REM             components exceeded 1 - would have overwritten previous component's results).
REM           - Response component recording added to instrumental code (for the benefit of the transfer tests).
REM  2 Jun 99 - Displays for specific transfer test.
REM           - separate lever_changed code (to call a different box display function)
REM           - modified all output code to use output_header$, which I'd ignored so far.
REM           - Wrote general test (piece of cake at this point).
REM 16 Jun 99 - Second extinction test shortened to 5 min (talked with JH).

REM ========================================================================
REM Overall view.
REM ========================================================================
REM PAVLOVIAN
REM   Stimuli last 2 min (D&D 1987; Tony). S1, S2 and ISI.
REM   During stimulus, deliver pellets on RT-30s schedule (D&D 1987; C&R 1988)
REM
REM INSTRUMENTAL
REM   It works up: RI-2/15/30 for each lever, then concurrent RI-30.
REM   (See notes on meeting with Tony.)
REM
REM PAVLOVIAN REMINDER
REM   Same as initial Pavlovian.
REM
REM INSTRUMENTAL EXTINCTION
REM   Following C&R, one 8-min session with both levers present and unreinforced.
REM
REM SPECIFIC TRANSFER TEST
REM   Both levers available throughout and never reinforced.
REM   Choices, choices...
REM
REM   C&R: "Eight presentations each of the 30-s light and noise SDs in a counterbalanced order with an ITI of 30 s". Balleine: "The test
REM   session begain with the insertion of the lever. There followed, in pseudo-random order, four 2-min presentations of
REM   each of the tone and the clicker, interspersed with four 2-min periods with no stimuli." D&D: "Two-minute light and clicker stimuli
REM   occurred in alternation until five of both types had been presented. For half the animals in each S-R and deprivation condition
REM   assignment the session started with the stimulus associated with sucrose, whereas the remaining animals received the stimulus that had
REM   signalled pellets first." [D&D's multiple schedule had an extinction (ISI) component between each stimulus component.]
REM
REM   -- Option 1 (after D&D): S1 -> ISI -> S2 -> ISI, five times.
REM   For:      Means that half the rats get sucrose stimulus first and half pellet, plus half of each of those groups get the stimulus
REM             that began their Pavlovian training and half the one that came second. Plus it's simple on the box front - all boxes will
REM             have clickers at the same time.
REM   Against:  ISI always after stimuli; artefactual "potentiation"?
REM   -- Option 2 (afer B?): {S1 / S2 / ISI} randomised, x 5.
REM   For:      No possible order effects relative to the ISI.
REM   Against:  Clickers from other boxes might be audible.
REM   Against:  Might have the same stimulus consecutively.
REM   -- Option 3: S1 -> S2 -> ISI, five times.
REM   -- Option 4 (modified D&D): half S1 -> ISI -> S2 -> ISI, five times.
REM                               half ISI -> S1 -> ISI -> S2, five times.
REM   For:      Eliminates order effects relative to ISI.
REM   For:      One set of boxes for each condition, so no clicker problem.
REM   For:      Half of the rats get sucrose/pellet, half get pellet/sucrose. Of each of those halves, half get firstPavstim/secondPavstim,
REM             half second/first. Of each of those quarters, half get leftstim/rightstim, half rightstim/leftstim.
REM   Comment:  40-min session, more ISI than previous Pavlovian training. (But should be OK: D&D trained Pavlovian with no ISIs, then
REM             introduced ISIs instrumental/test phases.)
REM   -- Option 5: ISI -> S1 -> ISI -> S2, five times.
REM   Tends to underestimate the effect of stimuli, but saves the problem of ensuring that the order (stim->ISI v. ISI->stim)
REM   was really counterbalanced across lesion groups. Jeremy's preferred option.
REM   In any case, we'll probably summarize across blocks.
REM   Decided and written up in Methods chapter - went for option 5. See FNspecific_test_stimulus.
REM
REM GENERAL TRANSFER TEST
REM   Exactly as the specific transfer test, but with only the pellet lever present.




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

PROCinit              :REM Arachnid init
PROCkill_all          :REM Arachnid init
LIBRARY "<RudolfDir>.ProgLibs.Ascii"
LIBRARY "<RudolfDir>.ProgLibs.UI"
PROCdefine_colours
LIBRARY "<RudolfDir>.ProgLibs.DateTime"
LIBRARY "<RudolfDir>.ProgLibs.Filename"
date_time$ = FNdate_time_code
LIBRARY "<RudolfDir>.ProgLibs.Arachnid"
LIBRARY "<RudolfDir>.ProgLibs.BoxConst"
LIBRARY "<RudolfDir>.ProgLibs.Random"
PROCcombined_boxes

REM ========================================================================
REM Constants, timers, variables
REM ========================================================================

REM This seems OK, despite already using pellet%() as a line number.
sucrose%=0: pellet%=1: extinction%=2: max_reinforcers%=3: nleverdim%=1    :REM nleverdim% used to save memory (sucrose/pellet lever)
isi%=0: stim_one%=1: stim_two%=2: max_stimuli%=3
DIM reinforcer$(max_reinforcers%): DIM reinforcer_2$(max_reinforcers%)
reinforcer$(sucrose%)=   "sucrose":reinforcer_2$(sucrose%)="sucrose"
reinforcer$(pellet%)=    "pellet ":reinforcer_2$(pellet%)="pellet"
reinforcer$(extinction%)="ext    ":reinforcer_2$(extinction%)="none"
DIM stimulus$(max_stimuli%): DIM stimulus_2$(max_stimuli%)
stimulus$(isi%)=     "ISI":stimulus_2$(isi%)="ISI"
stimulus$(stim_one%)="S1 ":stimulus_2$(stim_one%)="S1"
stimulus$(stim_two%)="S2 ":stimulus_2$(stim_two%)="S2"

no%=0: yes%=1: DIM yesno$(1): yesno$(no%)="N": yesno$(yes%)="Y"
not_watching%=0: simple_watching%=1: sucrose_watching%=2

max_cb%=7                     :REM Counterbalancing conditions are 0-7.

sucrose_duration% = 50        :REM Takes 0.5s for dipper arm to get liquid
stimulus_length% = 12000      :REM S1 and S2 are on for 120 s (2 min). Applies to Pavlovian and transfer tests.
pav_components% = 3 * 5       :REM Three stimuli (ISI, S1, S2), 5 times each.
spec_components% = 4 * 5      :REM S1/ISI/S2/ISI, 5 times each.
max_components% = 20          :REM Greatest of all the components.
rt_param% = 30                :REM An RT-30s schedule. Note - in _seconds_.
                              :REM Instrumental schedules are done in their own procedures.
instr_session_length% = 30 * 60 * 100   :REM 30-min instrumental sessions
ext_session_length% = 8 * 60 * 100      :REM 8-min first extinction session
ext2_session_length% = 5 * 60 * 100     :REM 5-min second extinction session

REM Note easy error to make: I put the clock timer last in this series.
REM However, other timers are numbered e.g. pellet_timer%+box%, where
REM box% starts at 1. I call the clock timer simply as clock_timer%.
REM Therefore there was an overlap. Dangerous.
clock_timer%     = nboxes% * 0
pellet_timer%    = nboxes% * 1
sucrose_timer%   = nboxes% * 2
stim_1_timer%    = nboxes% * 3
stim_2_timer%    = nboxes% * 4
component_timer% = nboxes% * 5      :REM Pavlovian component timer
rt_timer%        = nboxes% * 6
ri_timer_1%      = nboxes% * 7      :REM RI schedule for one lever
ri_timer_2%      = nboxes% * 8      :REM "
session_timer%   = nboxes% * 9      :REM Instrumental session (may be several components, in a test phase)

DIM cb%(nboxes%)              :REM counterbalancing condition
DIM component%(nboxes%)       :REM which component is the box in?
DIM finished%(nboxes%)        :REM has the box finished?
DIM state%(nboxes%)           :REM nosepoke monitoring state (e.g. normal, sucrose)
DIM counting%(nboxes%)        :REM used to pause counting when changing state
DIM watching%(nboxes%)        :REM Only true *during* a poke. Used to know where to store results (becomes a copy of state).
DIM start_time%(nboxes%)      :REM start of *this* nosepoke

DIM ratname$(nboxes%)
DIM session%(nboxes%)
DIM nosepoke_num%(nboxes%, max_components%)     :REM total # nosepokes in the component (excl. sucrose poking, where applicable)
DIM nosepoke_time%(nboxes%, max_components%)   :REM total nosepoke time in the component (excl. sucrose poking, where applicable)
DIM nosepoke_suc_num%(nboxes%, max_components%) :REM #pokes during sucrose reinforcer, where applicable
DIM nosepoke_suc_time%(nboxes%, max_components%):REM #pokes during sucrose reinforcer, where applicable
DIM sucrose_given%(nboxes%, max_components%)    :REM } number of reinforcers given in the component
DIM pellets_given%(nboxes%, max_components%)    :REM }
DIM suc_schedule$(nboxes%)                      :REM } schedule names
DIM pel_schedule$(nboxes%)                      :REM }

max_responses%=3500      :REM *** This is a guess. 3500 works. It's per lever per box.
DIM exceeded_maximum%(nboxes%) :REM Marker for going over the limit
DIM reinf_available%(nboxes%, max_reinforcers%)        :REM RI schedule sets this to yes as appropriate
DIM lever_presses%(nboxes%, max_components%, nleverdim%)    :REM #lever presses for that lever(reinforcer#) in that component
DIM component_start_time%(nboxes%)                          :REM Lever depression start time is relative to this
DIM lever_down_at%(nboxes%, nleverdim%)                     :REM Lever depression duration relative to this
DIM sucrose_present%(nboxes%)                               :REM These don't change through the session - is the lever available?
DIM pellet_present%(nboxes%)

REM per press:
REM *** Very Special Case: this is dimensioned 0-3, not 1-4 for boxes
DIM total_lever_presses%(nboxes%, nleverdim%)                 :REM keeps track of total (not per-component) presses
DIM response_at%(nboxes%-1, nleverdim%, max_responses%)       :REM Time of each leverpress
DIM response_duration%(nboxes%-1, nleverdim%, max_responses%) :REM Duration " "  "
DIM rewarded%(nboxes%-1, nleverdim%, max_responses%)          :REM If it was reinforced
DIM response_comp%(nboxes%-1, nleverdim%, max_responses%)     :REM For transfer tests only: component (1-20).

IF debug%=1 THEN
  stimulus_length%=1500
  rt_param%=5
  pav_components% = 3 * 2
  spec_components% = 4 * 2
  instr_session_length% = 3 * 60 * 100
  ext_session_length% = 3 * 60 * 100
  ext2_session_length% = 3 * 60 * 100
ENDIF

REM ========================================================================
REM Main menu
REM ========================================================================

dummy% = RND(-TIME)
MODE 12
COLOUR yellow%
PRINT "!";progname$
PRINT "____________________________________________________________________"
COLOUR white%
PRINT "Multiple test schedule for Pavlovian-instrumental transfer (PIT)."
PRINT "By Rudolf Cardinal."
PRINT "Version date: ";version_date$
IF debug%=1 COLOUR yellow%:PRINT"*** DEBUGGING!!! ***":COLOUR white%
PRINT
COLOUR magenta%:PRINT"Turning boxes on...";
FOR box%=1 TO nboxes%
  PROCset_box_beginning(box%)
  REM get houselight on and dipper up.
NEXT
PROCwait(E%):*AE
PRINT " done. Clean out the sucrose before beginning."':COLOUR white%
COLOUR red%
boxgroup$ = FNget_letter_param("Is this running on 'S' or 'P' boxes (aids counterbalancing)", "SP", "")
COLOUR yellow%
PRINT
PRINT "Please select the Task of the Day:"
COLOUR white%
PRINT
PRINT "  1. Pavlovian training, RT-30s (S1->pellets, S2->sucrose)."
PRINT "  2. Instrumental training, RI-2/15/30s schedule (L1->pellets, L2->sucrose)."
PRINT "  3. Pavlovian reminder (as 1)."
PRINT "  4. Instrumental extinction (L1, L2)."
PRINT "  5. SPECIFIC PIT test."
PRINT
PRINT "  6. Pavlovian retraining (as 1)."
PRINT "  7. Instrumental retraining (L1->pellets)."
PRINT "  8. Pavlovian reminder (as 1)."
PRINT "  9. Instrumental extinction (brief) (L1)."
PRINT " 10. GENERAL PIT (IRRELEVANT INCENTIVE) test."
PRINT
COLOUR red%
task% = FNget_num_param("Choose",0,1,10)
CASE task% OF
  WHEN 1:  PROCpavlovian
  WHEN 2:  PROCinstrumental_general_ri(instr_session_length%)
  WHEN 3:  PROCpavlovian
  WHEN 4:  PROCinstrumental_twolever_extinction(ext_session_length%)
  WHEN 5:  PROCspecific_test
  WHEN 6:  PROCpavlovian
  WHEN 7:  PROCinstrumental_pelletlever_ri(instr_session_length%)
  WHEN 8:  PROCpavlovian
  WHEN 9:  PROCinstrumental_pelletlever_extinction(ext2_session_length%)
  WHEN 10: PROCgeneral_test
  OTHERWISE:  VDU7:PRINT '"Error.":END
ENDCASE
END

REM _______________________________________________________________________
REM _______________________________________________________________________

DEF PROCget_ratinfo
  COLOUR yellow%
  PRINT
  PRINT "Thank you. Now enter rat names, session and counterbalancing conditions."
  PRINT "Assuming you chose P/S boxes appropriately, accepting the defaults will lead to"
  PRINT "a wonderful sense of consistency. The choices are as follows:"
  PRINT
  COLOUR white%
  FOR dummy% = 0 TO max_cb%
    PRINT "Condition ";dummy%;": ";
    PROCdisplay_counterbalancing(dummy%)
  NEXT
  FOR box% = 1 TO nboxes%
    COLOUR yellow%
    PRINT
    PRINT "Box ";box%
    PRINT "___________________________________________________________"'
    COLOUR red%
    ratname$(box%) = FNget_str_param("                Rat name","xxx")
    REPEAT
      INPUT "                       Session: " session%(box%)
    UNTIL session%(box%)>0
    cb%(box%) = FNget_num_param("Counterbalancing condition",FNdefault_counterbalancing_condition(box%),0,max_cb%)
  NEXT
  COLOUR yellow%
  PRINT''"CHECK THEM."
  PRINT  "-----------":COLOUR white%
  FOR box%=1 TO nboxes%
    PRINT"   Box ";box%;" (";ratname$(box%);") - session ";session%(box%);" - counterbalancing ";cb%(box%)
  NEXT
  COLOUR yellow%
  PRINT'"Press a key if you're happy. We won't start quite yet.";:COLOUR white%:IF GET
ENDPROC

DEF PROCselect_2_filenames
  PRINT'
  COLOUR white%
  OSCLI("CAT")
  REPEAT
    COLOUR red%
    PRINT
    datafile$ = FNget_filename_default("DATA FILE - Filename for output",FNdefault_filename("D"))
    logfile$ = FNget_filename_default("TEXT LOGFILE - Filename for output",FNdefault_filename("L"))
    IF datafile$=logfile$ THEN COLOUR yellow%:PRINT"--- Unacceptable, can't have the same name for both."
  UNTIL datafile$<>logfile$
ENDPROC

DEF PROCselect_3_filenames
  PROCselect_2_filenames
  REPEAT
    responsefile$ = FNget_filename_default("RESPONSE FILE - Filename for output",FNdefault_filename("R"))
  UNTIL responsefile$<>datafile$ AND responsefile$<>logfile$
ENDPROC

DEF FNdefault_filename(letter$)
  REM e.g. D1F24-24
= LEFT$(letter$,1) + STR$(task%) + ratname$(1) + "-" + STR$(session%(1))

DEF PROCwarn_kickoff
  COLOUR yellow%
  PRINT''"KICKOFF."
  PRINT  "------------"
  PRINT'"Ensure rats in boxes. Press a key to start.";:COLOUR white%:IFGET
ENDPROC

REM  _______________________________________________________________________
REM |                                                                       |
REM |                             P A V L O V I A N                         |
REM |_______________________________________________________________________|

REM ========================================================================
DEF PROCpavlovian
REM ========================================================================
  LOCAL box%, dummy%
  PROCget_ratinfo
  PROCselect_2_filenames
  PROCwarn_kickoff
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Pavlovian,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": Pavlovian training"
  PROCdisplay_startup(phase_banner$)
  PROCpav_display_startup
  FOR box%=1 TO nboxes%
    finished%(box%) = no%
    watching%(box%) = not_watching%
    counting%(box%) = no%
    PROCset_box_beginning(box%) :REM redundant, should already be in this state
    PROCpipe_switch(nosepoke%(box%),Over,1,"FNmagazine_changed(",box%,E%)
    dummy% = FNpav_new_component(box%,1)
    PROCpipe_fkey(box%,1,0,"FNpav_abort_box(",box%,E%)
  NEXT
  session_start_time% = TIME
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

DEF FNpav_new_component(box%,bogus%)
  IF bogus%=0 =0
  PROCstop_counting(box%)
  PROCkill_stimuli(box%)
  PROCkill_schedule(box%)
  LOCAL stim%, reinf%
  component%(box%) += 1
  IF component%(box%)>pav_components% THEN PROCpav_finished(box%):=0
  REM Finished previous. /// Start new.
  stim% = FNpav_stimulus(component%(box%), cb%(box%))
  reinf% = FNpav_reinforcer(stim%, cb%(box%))
  PROCstart_stimulus(stim%, box%, stimulus_length%)
  PROCrt_schedule(reinf%, box%, rt_param%)
  PROCpipe_timer(component_timer%+box%, stimulus_length%, 0, "FNpav_new_component(", box%, E%)
  state%(box%) = simple_watching%: PROCstart_counting(box%)
  PROCpav_display_box(box%)
=0

DEF PROCrt_schedule(reinf%, box%, rt_param%)
  PROCpipe_timer(rt_timer%+box%, 100, 100, "FNrt_tick("+STR$(reinf%)+","+STR$(rt_param%)+",",box%,E%)
ENDPROC

DEF FNrt_tick(reinf%, rt_param%, box%, bogus%)
  IF bogus%=0 =0
  REM The principle of an RT schedule: every second, p(reinforcement) = 1/param.
  IF FNprobability < 1/rt_param% THEN PROCreinforcer(reinf%, box%):PROCpav_display_box(box%)
=0

DEF PROCkill_stimuli(box%)
  PROCkill_timer(stim_1_timer% + box%, E%)
  PROCkill_timer(stim_2_timer% + box%, E%)
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(centrelight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)
  PROCswitch_off(clicker%(box%),E%)
ENDPROC

DEF PROCkill_schedule(box%)
  PROCkill_timer(rt_timer% + box%, E%)
  REM if dipper was going down, it'll come up of its own accord.
  PROCswitch_on(dipper%(box%), E%)
  PROCswitch_off(pellet%(box%), E%)
ENDPROC

DEF FNpav_abort_box(box%, bogus%)
  IF bogus%=0 =0
  PROCpav_finished(box%)
=0

DEF PROCpav_finished(box%)
  PROCstop_counting(box%)
  PROCkill_switch(nosepoke%(box%),E%)
  PROCkill_stimuli(box%)  :REM superfluous
  PROCkill_schedule(box%) :REM superfluous
  PROCset_box_ended(box%)
  finished%(box%) = yes%
  PROCpav_display_box(box%)
  LOCAL i%
  FOR i%=1 TO nboxes%
    IF finished%(i%) <> yes% THEN ENDPROC
  NEXT

  REM --------------- All boxes finished now.
  PROCkill_all            :REM to be on the safe side

  LOCAL ch%,t%,d$,stim%
  ch% = OPENOUT(datafile$)
  REM Don't have lines longer than about 160 chars; BASIC can't load it ("Bad program").
  PROCprint_string(ch%,"PROGNAME,PHASE,DESCRIPTION,DATE_TIME,") :REM the output header
  PROCprint_string(ch%,"RAT,BOX,SESSION,")
  PROCprint_string(ch%,"COMPONENT,SUCROSE,PELLETS,NP_NUM,NP_TIME,NP_SUC_NUM,NP_SUC_TIME,")
  PROCprint_line(ch%,"COUNTERBALANCING,COMPUTER,STIMULUS,REINFORCER,COMPONENT_DURATION,DIPPER_TIME")
  FOR box% = 1 TO nboxes%
    d$ = output_header$ + ratname$(box%)+","+STR$(box%)+","+STR$(session%(box%))
    FOR t% = 1 TO pav_components%
      PROCprint_string(ch%,d$+","+STR$(t%)+","+STR$(sucrose_given%(box%,t%))+","+STR$(pellets_given%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_num%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_time%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_suc_num%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_suc_time%(box%,t%)))
      PROCprint_string(ch%,","+STR$(cb%(box%)))
      PROCprint_string(ch%,","+boxgroup$)
      stim% = FNpav_stimulus(t%, cb%(box%))
      PROCprint_string(ch%,","+stimulus_2$(stim%))
      PROCprint_string(ch%,","+reinforcer_2$(FNpav_reinforcer(stim%, cb%(box%))))
      PROCprint_string(ch%,","+STR$(stimulus_length%))
      PROCprint_line(ch%,","+STR$(sucrose_duration%))
    NEXT
  NEXT
  CLOSE#ch%

  COLOUR white%
  LOCAL suctotal%, peltotal%
  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)
  PRINT"====================================================================="
  PRINT"!";progname$;", by Rudolf Cardinal, ";version_date$
  PRINT phase_banner$
  PRINT"Finished at ";TIME$
  PRINT"Date/time code: ";date_time$
  IF debug%=1 COLOUR yellow%:PRINT"--- DEBUGGING!!! ---":COLOUR white%
  PRINT"====================================================================="
  PRINT"Stimulus duration (s) = ";stimulus_length%/100
  PRINT"Dipper down duration (s) = ";sucrose_duration%/100
  PRINT"Schedule was RT-";rt_param%;"s"
  PRINT"Total of ";pav_components%;" components presented (";pav_components%/3;" each)"
  FOR box%=1 TO nboxes%
    PRINT'"BOX ";box%
    PRINT"----------------------------------------------------------------------"
    PRINT"Rat ID:           ";ratname$(box%)
    PRINT"Session:          ";session%(box%)
    PRINT"Counterbalancing: ";cb%(box%);" - "
    PROCdisplay_counterbalancing(cb%(box%))
    PRINT"----------------------------------------------------------------------"
    PRINT"Component  Stim  Reinf    #Pel   #Suc  NP#  NPtime  Suc_NP#   Suc_NPtime"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    FOR t%=1 TO pav_components%
      PRINTTAB(0);t%;
      PRINTTAB(11);stimulus$(FNpav_stimulus(t%, cb%(box%)));
      PRINTTAB(17);reinforcer$(FNpav_reinforcer(FNpav_stimulus(t%, cb%(box%)), cb%(box%)));
      PRINTTAB(26);pellets_given%(box%,t%);
      PRINTTAB(33);sucrose_given%(box%,t%);
      PRINTTAB(39);nosepoke_num%(box%,t%);
      PRINTTAB(44);nosepoke_time%(box%,t%);
      PRINTTAB(52);nosepoke_suc_num%(box%,t%);
      PRINTTAB(62);nosepoke_suc_time%(box%,t%);
    NEXT
    PRINT
  NEXT
  COLOUR green%
  PRINT'"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"'
  PRINT"SUMMARIES - PAVLOVIAN"
  COLOUR white%
  PRINT
  PRINT"Box  Rat  Counterbalancing  Session   Sucrose#      Pellet#"
  PRINT"--------------------------------------------------------------------------"
  REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
  FOR box%=1 TO nboxes%
    suctotal%=0:peltotal%=0
    FOR t% = 1 TO pav_components%
      suctotal% += sucrose_given%(box%, t%)
      peltotal% += pellets_given%(box%, t%)
    NEXT
    PRINTTAB(0);box%;
    PRINTTAB(5);ratname$(box%);
    PRINTTAB(10);cb%(box%);
    PRINTTAB(28);session%(box%);
    PRINTTAB(38);suctotal%;" (";FNliquid_volume(suctotal%);" ml)";
    PRINTTAB(52);peltotal%;" (";FNfood_mass(peltotal%);" g)";
  NEXT
  PRINT
  OSCLI("SPOOL")
  VDU 3
  OSCLI("SETTYPE "+logfile$+" TEXT")
  COLOUR magenta%:PRINT'"NOTE - boxes still on."':COLOUR white%
ENDPROC

DEF PROCpav_display_startup
  COLOUR red%
  PRINT "Stimulus (component) duration: ";stimulus_length%/100; " s"
  PRINT "Reinforcement is delivered on a RT-"; rt_param%; "s schedule."
  PRINT
  PRINT
  COLOUR green%
  PRINT "NP  Box   Rat   CB(0-7)   Component (1-";pav_components%;")";
  PRINT TAB(44);                                    "Stimulus  Reinf   #sucrose  #pellet"
  PRINT "_______________________________________________________________________________"
  REM    01234567890123456789012345678901234567890123456789012345678901234567890123456789

  display_firstline%=VPOS
ENDPROC

DEF PROCpav_display_box(box%)
  LOCAL stim%
  line% = FNdisplay_line(box%)
  COLOUR white%
  PRINTTAB(4,line%);boxgroup$;box%;"  ";
  PRINTTAB(10,line%);ratname$(box%);"  ";
  PRINTTAB(16,line%);cb%(box%);"  ";
  IF finished%(box%)=yes% THEN
    COLOUR yellow%
    PRINTTAB(26,line%);"--- Finished. ---";
    COLOUR white%
    ENDPROC
  ENDIF
  PRINTTAB(26,line%);component%(box%);"  ";
  stim% = FNpav_stimulus(component%(box%), cb%(box%))
  PRINTTAB(44,line%);stimulus$(stim%);"  ";
  PRINTTAB(54,line%);reinforcer$(FNpav_reinforcer(stim%, cb%(box%)));"  ";
  PRINTTAB(62,line%);sucrose_given%(box%, component%(box%));"  ";
  PRINTTAB(72,line%);pellets_given%(box%, component%(box%));"  ";
  PROCdisplay_poke(box%)
ENDPROC


REM  _______________________________________________________________________
REM |                                                                       |
REM |                     I N S T R U M E N T A L                           |
REM |_______________________________________________________________________|


REM ========================================================================
DEF PROCinstrumental_general_ri(overall_length%)
REM ========================================================================
  LOCAL default_reinf%, ri_param%
  session_time% = overall_length%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental_Gen_RI,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental training (both levers)"

  COLOUR yellow%
  PRINT "When you enter session numbers, START FROM ONE for the instrumental sessions."
  PRINT "Only a single lever is present for sessions 1-6, counterbalanced in pairs."
  PRINT "Sessions 1/2 use RI-2s; sessions 3/4 use RI-15s; sessions 5/6 use RI-30s."
  PRINT "Sessions 7-10 introduce both levers and use concurrent RI-30s schedules."'
  COLOUR white%
  PROCinstrumental_communal_start
  FOR box%=1 TO nboxes%
    REM Default lever is calculated using CB and session within this phase:
    REM   CB_start_reinforcer=sucrose gives session 1=S, 2=P...
    REM   CB_start_reinforcer=pellet  gives session 1=P, 2=S...
    IF (session%(box%)<=6) THEN
      IF (session%(box%) MOD 2 = 1) THEN default_reinf%=FNbegin_with(cb%(box%)) ELSE default_reinf%=FNend_with(cb%(box%))
      IF default_reinf%=sucrose% THEN
        sucrose_present%(box%) = yes%: pellet_present%(box%) = no%
      ELSE
        sucrose_present%(box%) = no%: pellet_present%(box%) = yes%
      ENDIF
    ELSE
      REM On session 7-10, concurrent RI-30s
      sucrose_present%(box%) = yes%: pellet_present%(box%) = yes%
    ENDIF
    CASE session%(box%) OF
      WHEN 1,2:   ri_param% = 2     :IF debug%=1 THEN ri_param%=2
      WHEN 3,4:   ri_param% = 15    :IF debug%=1 THEN ri_param%=3
      OTHERWISE:  ri_param% = 30    :IF debug%=1 THEN ri_param%=4
    ENDCASE
    suc_schedule$(box%) = "RI-"+STR$(ri_param%)
    pel_schedule$(box%) = "RI-"+STR$(ri_param%)
    PROCinstrumental_general(box%, "FNlever_ri_func(", "FNlever_ri_func(", session_time%)
    IF sucrose_present%(box%) THEN PROCpipe_timer(ri_timer_1%+box%, 100, 100, "FNri_tick("+STR$(ri_param%)+","+STR$(sucrose%)+",",box%, E%)
    IF pellet_present%(box%) THEN PROCpipe_timer(ri_timer_2%+box%, 100, 100, "FNri_tick("+STR$(ri_param%)+","+STR$(pellet%)+",",box%, E%)
  NEXT
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM ========================================================================
DEF PROCinstrumental_twolever_extinction(overall_length%)
REM ========================================================================
  session_time% = overall_length%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental_Both_Ext,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental training (both levers, extinction)"

  PROCinstrumental_communal_start
  LOCAL box%, lever_func$
  lever_func$ = "FNlever_ext_func("
  FOR box%=1 TO nboxes%
    sucrose_present%(box%) = yes%
    pellet_present%(box%) = yes%
    suc_schedule$(box%) = "ext"
    pel_schedule$(box%) = "ext"
    PROCinstrumental_general(box%, lever_func$, lever_func$, session_time%)
  NEXT
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM ========================================================================
DEF PROCinstrumental_pelletlever_ri(overall_length%)
REM ========================================================================
  LOCAL lever_func$, ri_param%
  ri_param% = 30:       IF debug%=1 THEN ri_param%=5
  session_time% = overall_length%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental_Pellet_RI"+STR$(ri_param%)+","+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental training (pellet lever, RI"+STR$(ri_param%)+")"

  PROCinstrumental_communal_start
  lever_func$ = "FNlever_ri_func("
  FOR box%=1 TO nboxes%
    sucrose_present%(box%) = no%
    pellet_present%(box%) = yes%
    pel_schedule$(box%) = "RI-"+STR$(ri_param%)
    PROCinstrumental_general(box%, lever_func$, lever_func$, session_time%)
    PROCpipe_timer(ri_timer_1%+box%, 100, 100, "FNri_tick("+STR$(ri_param%)+","+STR$(pellet%)+",",box%, E%)
  NEXT
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM ========================================================================
DEF PROCinstrumental_pelletlever_extinction(overall_length%)
REM ========================================================================
  session_time% = overall_length%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental_Pellet_Ext,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental training (pellet lever, extinction)"

  PROCinstrumental_communal_start
  LOCAL lever_func$
  lever_func$ = "FNlever_ext_func("
  FOR box%=1 TO nboxes%
    sucrose_present%(box%) = no%
    pellet_present%(box%) = yes%
    pel_schedule$(box%) = "ext"
    PROCinstrumental_general(box%, lever_func$, lever_func$, session_time%)
  NEXT
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM _______________________________________________________________________
REM _______________________________________________________________________
REM _______________________________________________________________________

DEF PROCinstrumental_communal_start
  LOCAL box%
  PROCget_ratinfo
  PROCselect_3_filenames
  PROCwarn_kickoff
  PROCdisplay_startup(phase_banner$)
  PROCinstr_display_startup
  FOR box%=1 TO nboxes%
    exceeded_maximum%(box%) = no%
    finished%(box%) = no%
    watching%(box%) = not_watching%
    counting%(box%) = no%
    component%(box%) = 1    :REM and it'll stay at 1 throughout.
    PROCpipe_switch(nosepoke%(box%),Over,1,"FNmagazine_changed(",box%,E%)
    PROCpipe_fkey(box%,1,0,"FNinstr_abort_box(",box%,E%)
  NEXT
  session_start_time% = TIME
ENDPROC

DEF PROCinstrumental_general(box%, sucrose_func$, pellet_func$, session_time%)
  REM Lever functions must conform to FNsomething(..., box%, reinf%)
  REM Lever_func strings must supply left bracket and include comma if needed.
  sucrose_func$ += STR$(box%)+","+STR$(sucrose%)+")"
  pellet_func$ += STR$(box%)+","+STR$(pellet%)+")"
  IF sucrose_present%(box%)=yes% THEN
    PROCswitch_on(FNlevercontrol_causing(sucrose%,box%),E%)
    PROCpipe_switch(FNlever_causing(sucrose%,box%), Over, 1, "FNlever_changed("+STR$(sucrose%)+","+STR$(FNlever_causing(sucrose%,box%))+","""+sucrose_func$+""",", box%, E%)
  ENDIF
  IF pellet_present%(box%)=yes% THEN
    PROCswitch_on(FNlevercontrol_causing(pellet%,box%), E%)
    PROCpipe_switch(FNlever_causing(pellet%,box%),  Over, 1, "FNlever_changed("+STR$(pellet%) +","+STR$(FNlever_causing(pellet%,box%)) +","""+pellet_func$+""",", box%, E%)
  ENDIF
  PROCpipe_timer(session_timer%+box%, session_time%, 0, "FNins_box_ended(",box%, E%)
  PROCinstr_display_box(box%)
  state%(box%) = simple_watching%: PROCstart_counting(box%)
ENDPROC

DEF FNlever_changed(reinf%, line%, lever_func$, box%, bogus%)
  IF bogus%=0 =0
  LOCAL dummy%, levercount%
  IF FNswitch(line%,E%)=On THEN
    REM Lever has been depressed.
    lever_presses%(box%, component%(box%), reinf%) += 1
    total_lever_presses%(box%, reinf%) += 1
    lever_down_at%(box%, reinf%) = TIME
    REM Very Special Case below
    IF total_lever_presses%(box%, reinf%) > max_responses% THEN
      exceeded_maximum%(box%) = yes%
      REM This marker used by lever up and reinforcement code to save thinking
      COLOURgreen%:PRINTTAB(0,0);"--- Maximum recorded responses exceed for box ";box%;" ---";:COLOURwhite%
    ELSE
      response_at%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = TIME - session_start_time%
      response_comp%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = component%(box%) :REM only the transfer tests are interested
    ENDIF
    dummy% = EVAL(lever_func$)
    PROCinstr_display_box(box%)
  ELSE
    PROClever_released(reinf%, box%)
    REM This is separate code so it can be called manually at the end of a session, should the lever still be down.
  ENDIF
=0

DEF PROClever_released(reinf%, box%)
  REM Lever has been released
  IF exceeded_maximum%(box%) = no% THEN response_duration%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = TIME - lever_down_at%(box%, reinf%)
ENDPROC

DEF FNri_tick(param%, reinf%, box%, bogus%)
  IF bogus%=0 =0
  REM The principle of an RI schedule: every second, p(reinforcer becomes available) = 1/param.
  REM When the reinforcer is collected by responding, the 'timer' resets.
  IF FNprobability < 1/param% THEN
    reinf_available%(box%, reinf%)=yes%
    PROCinstr_display_box(box%)
  ENDIF
=0

DEF FNlever_ri_func(box%, reinf%)
  IF reinf_available%(box%, reinf%)=yes% THEN
    PROCreinforcer(reinf%, box%)
    IF exceeded_maximum%(box%)=no% THEN rewarded%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = yes%
    reinf_available%(box%, reinf%)=no%
  ELSE
    IF exceeded_maximum%(box%)=no% THEN rewarded%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = no%
  ENDIF
=0

DEF FNlever_ext_func(box%, reinf%)
  IF exceeded_maximum%(box%)=no% THEN rewarded%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = no%
=0

DEF FNins_box_ended(box%, bogus%)
  IF bogus%=0 =0
  finished%(box%) = yes%
  PROCstop_counting(box%)
  IF sucrose_present%(box%)=yes% AND FNswitch(FNlever_causing(sucrose%,box%), E%) = On THEN PROClever_released(sucrose%, box%)
  IF pellet_present%(box%)=yes% AND FNswitch(FNlever_causing(pellet%,box%), E%) = On THEN PROClever_released(pellet%, box%)
  PROCkill_switch(leftlever%(box%), E%)
  PROCkill_switch(rightlever%(box%), E%)
  PROCkill_switch(nosepoke%(box%), E%)
  PROCswitch_off(leftlevercontrol%(box%), E%)
  PROCswitch_off(rightlevercontrol%(box%), E%)
  PROCkill_timer(ri_timer_1% + box%, E%)
  PROCkill_timer(ri_timer_2% + box%, E%)
  PROCkill_timer(session_timer% + box%, E%): REM superfluous
  PROCset_box_ended(box%)
  PROCinstr_display_box(box%)
  LOCAL i%
  FOR i%=1 TO nboxes%
    IF finished%(i%) <> yes% THEN =0
  NEXT

  REM --------------- All boxes finished now.
  PROCkill_all            :REM to be on the safe side

  LOCAL ch%,comp%,t%,d$,stim%,r%
  ch% = OPENOUT(datafile$)
  PROCprint_string(ch%,"PROGNAME,PHASE,DESCRIPTION,DATE_TIME,") :REM the output header
  PROCprint_string(ch%,"RAT,BOX,COUNTERBALANCING,COMPUTER,SESSION,SESSION_DURATION,DIPPER_TIME,")
  PROCprint_string(ch%,"SUC_LEVER_PRESENT,SUC_SCHEDULE,PEL_LEVER_PRESENT,PEL_SCHEDULE,")
  PROCprint_string(ch%,"SUCROSE,PELLETS,NP_NUM,NP_TIME,NP_SUC_NUM,NP_SUC_TIME,")
  PROCprint_line(ch%,"SUC_PRESSES,PEL_PRESSES")
  FOR box% = 1 TO nboxes%
    comp% = 1: REM only one component in instrumental stages
    d$ = output_header$ + ratname$(box%)+","+STR$(box%)+","+STR$(cb%(box%))+"," +boxgroup$+","+STR$(session%(box%))+","+STR$(session_time%)+","+STR$(sucrose_duration%)
    PROCprint_string(ch%,d$)
    PROCprint_string(ch%,","+yesno$(sucrose_present%(box%)))
    PROCprint_string(ch%,","+suc_schedule$(box%))
    PROCprint_string(ch%,","+yesno$(pellet_present%(box%)))
    PROCprint_string(ch%,","+pel_schedule$(box%))
    PROCprint_string(ch%,","+STR$(sucrose_given%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(pellets_given%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(nosepoke_num%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(nosepoke_time%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(nosepoke_suc_num%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(nosepoke_suc_time%(box%,comp%)))
    PROCprint_string(ch%,","+STR$(lever_presses%(box%,comp%,sucrose%)))
    PROCprint_line(ch%,","+STR$(lever_presses%(box%,comp%,pellet%)))
  NEXT
  CLOSE#ch%

  ch% = OPENOUT(responsefile$)
  PROCprint_line(ch%,"DATE_TIME,RAT,BOX,LEVER,RESPONSE_NUM,RESPONSE_AT,RESPONSE_DURATION,REINFORCED")
  comp% = 1: REM only one component for pure instrumental sessions
  FOR box% = 1 TO nboxes%
    d$ = date_time$+","+ratname$(box%)+","+STR$(box%)+","
    FOR r% = 0 TO 1
      IF lever_presses%(box%, comp%, r%)>0 THEN
        FOR t%=1 TO FNmin(max_responses%,lever_presses%(box%, comp%, r%))
          REM the use of lever_presses rather than total_lever_presses does not matter here, for there is only one component
          PROCprint_line(ch%,d$+LEFT$(reinforcer_2$(r%),3)+","+STR$(t%)+","+STR$(response_at%(box%-1,r%,t%))+","+STR$(response_duration%(box%-1,r%,t%))+","+yesno$(rewarded%(box%-1,r%,t%)))
          REM Very Special Case for response_at
        NEXT
      ENDIF
    NEXT
  NEXT
  CLOSE#ch%

  COLOUR white%
  LOCAL suctotal%, peltotal%
  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)
  PRINT"====================================================================="
  PRINT"!";progname$;", by Rudolf Cardinal, ";version_date$
  PRINT phase_banner$
  PRINT"Finished at ";TIME$
  PRINT"Date/time code: ";date_time$
  IF debug%=1 COLOUR yellow%:PRINT"--- DEBUGGING!!! ---":COLOUR white%
  PRINT"====================================================================="
  PRINT"Session time (s) = ";session_time%/100
  PRINT"Dipper down duration (s) = ";sucrose_duration%/100
  FOR box%=1 TO nboxes%
    PRINT'"BOX ";boxgroup$;box%
    PRINT"----------------------------------------------------------------------"
    PRINT"Rat ID:           ";ratname$(box%)
    PRINT"Session:          ";session%(box%)
    PRINT"Counterbalancing: ";cb%(box%);" - "
    PROCdisplay_counterbalancing(cb%(box%))
    PRINT"----------------------------------------------------------------------"
    PRINT"Component  Responses     Reinforcers      Nosepoke#      Nosepoke time"
    PRINT"           Suc    Pel    Suc   Pel        Total   Suc    Total     Suc"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    t% = 1
    PRINTTAB(0);t%;
    PRINTTAB(11);lever_presses%(box%,t%,sucrose%);
    PRINTTAB(18);lever_presses%(box%,t%,pellet%);
    PRINTTAB(25);sucrose_given%(box%,t%);
    PRINTTAB(31);pellets_given%(box%,t%);
    PRINTTAB(42);nosepoke_num%(box%,t%);
    PRINTTAB(50);nosepoke_suc_num%(box%,t%);
    PRINTTAB(57);nosepoke_time%(box%,t%);
    PRINTTAB(67);nosepoke_suc_time%(box%,t%);
    PRINT
  NEXT
  COLOUR green%
  PRINT'"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"'
  PRINT"SUMMARIES - INSTRUMENTAL"
  COLOUR white%
  PRINT
  PRINT"Box  Rat  CB  Session   Responses       Reinforcers"
  PRINT"                        Suc    Pel      Sucrose          Pellet"
  PRINT"--------------------------------------------------------------------------"
  REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
  FOR box%=1 TO nboxes%
    t% = 1
    PRINTTAB(0);boxgroup$;box%;
    PRINTTAB(5);ratname$(box%);
    PRINTTAB(10);cb%(box%);
    PRINTTAB(14);session%(box%);
    PRINTTAB(24);lever_presses%(box%,t%,sucrose%);
    PRINTTAB(31);lever_presses%(box%,t%,pellet%);
    PRINTTAB(40);sucrose_given%(box%,t%);" (";FNliquid_volume(sucrose_given%(box%,t%));" ml)";
    PRINTTAB(57);pellets_given%(box%,t%);" (";FNfood_mass(pellets_given%(box%,t%));" g)";
  NEXT
  PRINT
  OSCLI("SPOOL")
  VDU 3
  OSCLI("SETTYPE "+logfile$+" TEXT")
  COLOUR magenta%:PRINT'"NOTE - boxes still on."':COLOUR white%
=0

DEF FNinstr_abort_box(box%, bogus%)
  IF bogus%=0 =0
  LOCAL dummy%
  dummy% = FNins_box_ended(box%, 1)
=0

DEF PROCinstr_display_startup
  PRINT
  COLOUR red%
  PRINT "Asterisk by reinforcer count means reinforcer is available."
  PRINT
  COLOUR green%
  PRINT "NP Box Rat  CB(0-7) Avail. Sched.       Presses     Reinforcers  Status"
  PRINT "                    S P    Suc   Pel    Suc   Pel   Suc    Pel"
  PRINT "_______________________________________________________________________________"
  REM    01234567890123456789012345678901234567890123456789012345678901234567890123456789
  display_firstline%=VPOS
ENDPROC

DEF PROCinstr_display_box(box%)
  LOCAL stim%
  line% = FNdisplay_line(box%)
  COLOUR white%
  PRINTTAB(3,line%);boxgroup$;box%;
  PRINTTAB(7,line%);ratname$(box%);
  PRINTTAB(12,line%);cb%(box%);
  IF finished%(box%)=yes% THEN
    COLOUR yellow%
    PRINTTAB(65,line%);"--- Finished.";
    COLOUR white%
    ENDPROC
  ENDIF
  PRINTTAB(20,line%);yesno$(sucrose_present%(box%));
  PRINTTAB(22,line%);yesno$(pellet_present%(box%));
  PRINTTAB(27,line%);suc_schedule$(box%);
  PRINTTAB(33,line%);pel_schedule$(box%);
  PRINTTAB(40,line%);lever_presses%(box%, component%(box%), sucrose%);"  ";
  PRINTTAB(46,line%);lever_presses%(box%, component%(box%), pellet%);"  ";
  IF reinf_available%(box%, sucrose%)=yes% THEN
    PRINTTAB(51,line%);"*";
  ELSE
    PRINTTAB(51,line%);" ";
  ENDIF
  PRINTTAB(52,line%);sucrose_given%(box%, component%(box%));"  ";
  IF reinf_available%(box%, pellet%)=yes% THEN
    PRINTTAB(58,line%);"*";
  ELSE
    PRINTTAB(58,line%);" ";
  ENDIF
  PRINTTAB(59,line%);pellets_given%(box%, component%(box%));"  ";
  PROCdisplay_poke(box%)
ENDPROC


REM  _______________________________________________________________________
REM |                                                                       |
REM |           T R A N S F E R   T E S T S                                 |
REM |_______________________________________________________________________|

REM ========================================================================
DEF PROCspecific_test
REM ========================================================================
  LOCAL box%, dummy%, lever_sucrose%, lever_pellet%, control_sucrose%, control_pellet%
  PROCget_ratinfo
  PROCselect_3_filenames
  PROCwarn_kickoff
  COLOUR magenta%
  PRINT '"*** SPECIAL WARNING: Ensure no sucrose in dippers and press a key.";
  COLOUR white%
  IFGET
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",SpecificTest,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": specific PIT test"
  PROCdisplay_startup(phase_banner$)
  PROCspec_display_startup
  FOR box%=1 TO nboxes%
    finished%(box%) = no%
    watching%(box%) = not_watching%
    counting%(box%) = no%
    PROCset_box_beginning(box%) :REM redundant, should already be in this state
    PROCpipe_switch(nosepoke%(box%),Over,1,"FNmagazine_changed(",box%,E%)
    dummy% = FNspec_new_component(box%,1)
    lever_sucrose% = FNlever_causing(sucrose%,box%)
    lever_pellet% = FNlever_causing(pellet%,box%)
    control_sucrose% = FNlevercontrol_causing(sucrose%,box%)
    control_pellet% = FNlevercontrol_causing(pellet%,box%)
    PROCswitch_on(control_sucrose%, E%)
    PROCswitch_on(control_pellet%, E%)
    PROCpipe_switch(lever_sucrose%, Over, 1, "FNspec_lever_changed("+STR$(sucrose%)+","+STR$(lever_sucrose%)+",", box%, E%)
    PROCpipe_switch(lever_pellet%,  Over, 1, "FNspec_lever_changed("+STR$(pellet%) +","+STR$(lever_pellet%) +",", box%, E%)
    PROCpipe_fkey(box%,1,0,"FNspec_abort_box(",box%,E%)
  NEXT
  session_start_time% = TIME
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM ========================================================================
DEF PROCgeneral_test
REM ========================================================================
  REM This shares most of the code written for the specific test; it
  REM just doesn't use the sucrose lever.
  LOCAL box%, dummy%, lever_pellet%, control_pellet%
  PROCget_ratinfo
  PROCselect_3_filenames
  PROCwarn_kickoff
  COLOUR magenta%
  PRINT '"*** SPECIAL WARNING: Ensure no sucrose in dippers and press a key.";
  COLOUR white%
  IFGET
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",GeneralTest,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": general PIT (irrelevant incentive) test"
  PROCdisplay_startup(phase_banner$)
  PRINT '"/// In the general test, only the pellet lever is available."
  PRINT  "    Sucrose totals are displayed as zero. ///"
  PROCspec_display_startup
  FOR box%=1 TO nboxes%
    finished%(box%) = no%
    watching%(box%) = not_watching%
    counting%(box%) = no%
    PROCset_box_beginning(box%) :REM redundant, should already be in this state
    PROCpipe_switch(nosepoke%(box%),Over,1,"FNmagazine_changed(",box%,E%)
    REM The general test does not use the sucrose lever at all.
    dummy% = FNspec_new_component(box%,1)
    lever_pellet% = FNlever_causing(pellet%,box%)
    control_pellet% = FNlevercontrol_causing(pellet%,box%)
    PROCswitch_on(control_pellet%, E%)
    PROCpipe_switch(lever_pellet%,  Over, 1, "FNspec_lever_changed("+STR$(pellet%) +","+STR$(lever_pellet%) +",", box%, E%)
    PROCpipe_fkey(box%,1,0,"FNspec_abort_box(",box%,E%)
  NEXT
  session_start_time% = TIME
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC


DEF FNspec_new_component(box%,bogus%)
  IF bogus%=0 =0
  PROCstop_counting(box%)
  PROCkill_stimuli(box%)  :REM Taken from the Pavlovian code, this works equally here.
  REM But we leave the levers alone (i.e. still on).
  REM If a lever is depressed as we change components, we do not need to worry.
  REM The next thing to be called will be the lever release code, PROClever_released, which isn't interested in which
  REM component we're in. So we can just increment component%(box%) and the lever depression code will adapt.
  LOCAL stim%, reinf%
  component%(box%) += 1
  IF component%(box%)>spec_components% THEN PROCspec_finished(box%):=0
  REM Finished previous. /// Start new.
  stim% = FNspecific_test_stimulus(component%(box%))
  reinf% = FNpav_reinforcer(stim%, cb%(box%))
  PROCstart_stimulus(stim%, box%, stimulus_length%)
  PROCpipe_timer(component_timer%+box%, stimulus_length%, 0, "FNspec_new_component(", box%, E%)
  state%(box%) = simple_watching%: PROCstart_counting(box%)
  PROCspec_display_box(box%)
=0

DEF FNspec_lever_changed(reinf%, line%, box%, bogus%)
  REM no lever_func$ (unlike instrumental code)
  IF bogus%=0 =0
  LOCAL dummy%, levercount%
  IF FNswitch(line%,E%)=On THEN
    REM Lever has been depressed.
    lever_presses%(box%, component%(box%), reinf%) += 1
    total_lever_presses%(box%, reinf%) += 1
    lever_down_at%(box%, reinf%) = TIME
    REM Very Special Case below
    IF total_lever_presses%(box%, reinf%) > max_responses% THEN
      exceeded_maximum%(box%) = yes%
      REM This marker used by lever up and reinforcement code to save thinking
      COLOURgreen%:PRINTTAB(0,0);"--- Maximum recorded responses exceed for box ";box%;" ---";:COLOURwhite%
    ELSE
      response_at%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = TIME - session_start_time%
      response_comp%(box%-1, reinf%, total_lever_presses%(box%, reinf%)) = component%(box%) :REM only the transfer tests are interested
    ENDIF
    dummy% = FNlever_ext_func(box%, reinf%) :REM this differs from instrumental code
    PROCspec_display_box(box%)              :REM this differs from instrumental code
  ELSE
    PROClever_released(reinf%, box%)  :REM from instrumental code
    REM This is separate code so it can be called manually at the end of a session, should the lever still be down.
  ENDIF
=0

DEF FNspec_abort_box(box%, bogus%)
  IF bogus%=0 =0
  PROCspec_finished(box%)
=0

DEF PROCspec_finished(box%)
  PROCstop_counting(box%)
  PROCkill_switch(nosepoke%(box%),E%)
  PROCkill_switch(leftlever%(box%),E%)
  PROCkill_switch(rightlever%(box%),E%)
  PROCkill_stimuli(box%)  :REM superfluous, unless box was aborted.
  PROCset_box_ended(box%) :REM gets the levers in too.
  finished%(box%) = yes%
  PROCspec_display_box(box%)
  LOCAL i%
  FOR i%=1 TO nboxes%
    IF finished%(i%) <> yes% THEN ENDPROC
  NEXT

  REM --------------- All boxes finished now.
  PROCkill_all            :REM to be on the safe side

  LOCAL ch%,comp%,t%,d$,stim%,r%
  ch% = OPENOUT(datafile$)
  PROCprint_string(ch%,"PROGNAME,PHASE,DESCRIPTION,DATE_TIME,") :REM the output header
  PROCprint_string(ch%,"RAT,BOX,COUNTERBALANCING,COMPUTER,SESSION,COMPONENT_DURATION,")
  PROCprint_line(ch%,"COMPONENT,STIMULUS,REINFORCER,NP_NUM,NP_TIME,SUC_PRESSES,PEL_PRESSES")
  FOR box% = 1 TO nboxes%
    d$ = output_header$ +ratname$(box%)+","+STR$(box%)+","+STR$(cb%(box%))+"," +boxgroup$+","+STR$(session%(box%))+","+STR$(stimulus_length%)+","
    FOR comp% = 1 TO spec_components%
      PROCprint_string(ch%,d$)
      PROCprint_string(ch%,STR$(comp%))
      stim% = FNspecific_test_stimulus(comp%)
      PROCprint_string(ch%,","+stimulus_2$(stim%))
      PROCprint_string(ch%,","+reinforcer_2$(FNpav_reinforcer(stim%, cb%(box%))))
      PROCprint_string(ch%,","+STR$(nosepoke_num%(box%,comp%)))
      PROCprint_string(ch%,","+STR$(nosepoke_time%(box%,comp%)))
      PROCprint_string(ch%,","+STR$(lever_presses%(box%,comp%,sucrose%)))
      PROCprint_line(ch%,","+STR$(lever_presses%(box%,comp%,pellet%)))
    NEXT
  NEXT
  CLOSE#ch%

  ch% = OPENOUT(responsefile$)
  PROCprint_line(ch%,"DATE_TIME,RAT,BOX,LEVER,RESPONSE_NUM,RESPONSE_AT,RESPONSE_DURATION,COMPONENT")
  FOR box% = 1 TO nboxes%
    d$ = date_time$+","+ratname$(box%)+","+STR$(box%)+","
    FOR comp% = 1 TO spec_components%
      FOR r% = 0 TO 1
        IF lever_presses%(box%, comp%, r%)>0 THEN
          FOR t%=1 TO FNmin(max_responses%,total_lever_presses%(box%, r%))
            comp% = response_comp%(box%-1,r%,t%)
            PROCprint_line(ch%,d$+LEFT$(reinforcer_2$(r%),3)+","+STR$(t%)+","+STR$(response_at%(box%-1,r%,t%))+","+STR$(response_duration%(box%-1,r%,t%))+","+ STR$(comp%))
            REM Very Special Case for response_at / response_comp
          NEXT
        ENDIF
      NEXT
    NEXT
  NEXT
  CLOSE#ch%

  COLOUR white%
  LOCAL suctotal%, peltotal%, stim%
  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)
  PRINT"====================================================================="
  PRINT"!";progname$;", by Rudolf Cardinal, ";version_date$
  PRINT phase_banner$
  PRINT"Finished at ";TIME$
  PRINT"Date/time code: ";date_time$
  IF debug%=1 COLOUR yellow%:PRINT"--- DEBUGGING!!! ---":COLOUR white%
  PRINT"====================================================================="
  PRINT"Component duration (s) = ";stimulus_length%/100
  FOR box%=1 TO nboxes%
    PRINT'"BOX ";boxgroup$;box%
    PRINT"----------------------------------------------------------------------"
    PRINT"Rat ID:           ";ratname$(box%)
    PRINT"Session:          ";session%(box%)
    PRINT"Counterbalancing: ";cb%(box%);" - "
    PROCdisplay_counterbalancing(cb%(box%))
    PRINT"----------------------------------------------------------------------"
    PRINT"Component  Responses      Stimulus        Nosepoke#      Nosepoke time"
    PRINT"           Suc    Pel     signalled       Total          Total"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    FOR t% = 1 TO spec_components%
      stim% = FNspecific_test_stimulus(t%)
      PRINTTAB(0);t%;" ";stimulus_2$(stim%);
      PRINTTAB(11);lever_presses%(box%,t%,sucrose%);
      PRINTTAB(18);lever_presses%(box%,t%,pellet%);
      PRINTTAB(26);reinforcer_2$(FNpav_reinforcer(stim%, cb%(box%)));
      PRINTTAB(42);nosepoke_num%(box%,t%);
      PRINTTAB(57);nosepoke_time%(box%,t%);
    NEXT
    PRINT
  NEXT
  OSCLI("SPOOL")
  VDU 3
  OSCLI("SETTYPE "+logfile$+" TEXT")
  COLOUR magenta%:PRINT'"NOTE - boxes still on."':COLOUR white%
ENDPROC

DEF PROCspec_display_startup
  PRINT "All conducted in extinction."
  PRINT
  COLOUR green%
  PRINT "NP Box Rat  CB(0-7) Component#  Stimulus (Reinf.)  Sucrose       Pellet"
  PRINT "                                                   This component (Total)"
  PRINT "_______________________________________________________________________________"
  REM    01234567890123456789012345678901234567890123456789012345678901234567890123456789
  display_firstline%=VPOS
ENDPROC

DEF PROCspec_display_box(box%)
  LOCAL stim%
  line% = FNdisplay_line(box%)
  COLOUR white%
  PRINTTAB(3,line%);boxgroup$;box%;
  PRINTTAB(7,line%);ratname$(box%);
  PRINTTAB(12,line%);cb%(box%);
  IF finished%(box%)=yes% THEN
    COLOUR yellow%
    PRINTTAB(20,line%);"--- Finished.   ";
    COLOUR white%
    ENDPROC
  ENDIF
  PRINTTAB(20,line%);component%(box%);
  stim% = FNspecific_test_stimulus(component%(box%))
  PRINTTAB(32,line%);stimulus$(stim%);
  PRINTTAB(41,line%);reinforcer$(FNpav_reinforcer(stim%, cb%(box%)));
  PRINTTAB(51,line%);lever_presses%(box%,component%(box%),sucrose%);" (";total_lever_presses%(box%,sucrose%);")   ";
  PRINTTAB(65,line%);lever_presses%(box%,component%(box%),pellet%);" (";total_lever_presses%(box%,pellet%);")   ";
  PROCdisplay_poke(box%)
ENDPROC


REM  _______________________________________________________________________
REM |                                                                       |
REM |             S H A R E D   C O D E                                     |
REM |_______________________________________________________________________|


REM ========================================================================
REM Overall lighting conditions. Important that these are independent
REM of stimuli, because we need to combine the stimuli.
REM 2-Jun-99: do we? No. But we want the baseline condition to be the same
REM at all times.
REM ========================================================================

DEF PROCset_box_beginning(box%)
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_on(dipper%(box%),E%)

  PROCswitch_off(pellet%(box%),E%)
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(centrelight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_off(clicker%(box%),E%)
  PROCswitch_off(leftlevercontrol%(box%),E%)
  PROCswitch_off(rightlevercontrol%(box%),E%)
ENDPROC

DEF PROCset_box_ended(box%)
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_on(dipper%(box%),E%)

  PROCswitch_off(pellet%(box%),E%)
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(centrelight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)
  PROCswitch_off(traylight%(box%),E%)
  PROCswitch_off(clicker%(box%),E%)
  PROCswitch_off(leftlevercontrol%(box%),E%)
  PROCswitch_off(rightlevercontrol%(box%),E%)
ENDPROC

REM ========================================================================
REM Stimuli and reinforcers
REM ========================================================================

DEF PROCreinforcer(reinforcer%, box%)
  CASE reinforcer% OF
    WHEN sucrose%:    PROCstop_counting(box%)
                      PROCswitch_off(dipper%(box%), E%)
                      PROCpipe_timer(sucrose_timer%+box%, sucrose_duration%, 0, "FNsucrose_finished(",box%,E%)
                      state%(box%) = sucrose_watching%: PROCstart_counting(box%)
                      sucrose_given%(box%, component%(box%)) += 1
    WHEN pellet%:     PROCsingle_pellet(pellet%(box%))
                      pellets_given%(box%, component%(box%)) += 1
    WHEN extinction%: REM nothing
    OTHERWISE:        VDU 7:PRINTTAB(0,0);"*** Invalid call to PROCreinforcer ***"
  ENDCASE
ENDPROC

DEF FNsucrose_finished(box%, bogus%)
  IF bogus%=0 =0
  PROCstop_counting(box%)
  PROCswitch_on(dipper%(box%), E%)
  state%(box%) = simple_watching%
  PROCstart_counting(box%)
=0

DEF PROCstart_stimulus(stimulus%, box%, time%)
  CASE stimulus% OF
    WHEN stim_one%:   REM Stimulus One is the L/R lights flashed at 3 Hz.
                      REM If you use two independent timers (and PROCstart_flash_line)
                      REM you lose synchrony. So we use a userfunc...
                      PROCuserfunc_start_flash("FNstim_1_on("+STR$(box%)+")", "FNstim_1_off("+STR$(box%)+")", stim_1_timer%+box%, 17, 16)

    WHEN stim_two%:   REM Stimulus Two is the clicker operated at 10 Hz (5 Hz cycle, two clicks per cycle).
                      REM Equivalent to 10 cs on, 10 cs off.
                      PROCstart_flash_line(clicker%(box%),stim_2_timer%+box%, 10, 10)

    WHEN isi%:        REM nothing

    OTHERWISE:        VDU 7:PRINTTAB(0,0);"*** Invalid call to PROCstimulus ***"
  ENDCASE
ENDPROC

DEF FNstim_1_on(box%)
  PROCswitch_on(leftlight%(box%),E%)
  PROCswitch_on(rightlight%(box%),E%)
=0

DEF FNstim_1_off(box%)
  PROCswitch_off(leftlight%(box%),E%)
  PROCswitch_off(rightlight%(box%),E%)
=0

REM ========================================================================
REM Counterbalancing
REM ========================================================================

DEF FNdefault_counterbalancing_condition(box%)
  REM There are 8 counterbalancing conditions, numbered 0-7.
  REM By default, "S" boxes get 1-4 and "P" boxes get 5-8.
  REM The conditions are:
  REM   Pavlovian               Instrumental                    Sessions
  REM 0 S1/sucrose, S2/pellet   Left / sucrose, right / pellet  Begin with sucrose
  REM 1 S1/pellet, S2/sucrose   Left / sucrose, right / pellet  Begin with sucrose
  REM 2 S1/sucrose, S2/pellet   Left / pellet, right / sucrose  Begin with sucrose
  REM 3 S1/pellet, S2/sucrose   Left / pellet, right / sucrose  Begin with sucrose
  REM 4 S1/sucrose, S2/pellet   Left / sucrose, right / pellet  Begin with pellet
  REM 5 S1/pellet, S2/sucrose   Left / sucrose, right / pellet  Begin with pellet
  REM 6 S1/sucrose, S2/pellet   Left / pellet, right / sucrose  Begin with pellet
  REM 7 S1/pellet, S2/sucrose   Left / pellet, right / sucrose  Begin with pellet
  REM
  REM *** However, in order that the clickers aren't audible in adjacent cages,
  REM we have the boxes rigged so all the "S" boxes start with S1 and all
  REM the "P" boxes start with S2.
  REM Thus S1-4 are conditions 0,2,5,7
  REM And P1-4 are conditions 1,3,4,6
  IF boxgroup$="S" THEN
    CASE box% OF
      WHEN 1: =0
      WHEN 2: =2
      WHEN 3: =5
      WHEN 4: =7
      OTHERWISE: VDU7:PRINT"FNdefault_counterbalancing_condition can't cope with box number"
    ENDCASE
  ENDIF
  IF boxgroup$="P" THEN
    CASE box% OF
      WHEN 1: =1
      WHEN 2: =3
      WHEN 3: =4
      WHEN 4: =6
      OTHERWISE: VDU7:PRINT"FNdefault_counterbalancing_condition can't cope with box number"
    ENDCASE
  ENDIF
  VDU 7:PRINT"FNdefault_counterbalancing_condition: Major error (boxgroup$=";boxgroup$;")."
=0

DEF FNstim1_consequence(cb%)
  REM cb% is the counterbalancing condition
  REM Even - S1/sucrose, S2/pellet
  REM Odd - S1/pellet, S2/sucrose
  IF (cb% MOD 2)=0 THEN =sucrose% ELSE =pellet%

DEF FNstim2_consequence(cb%)
  IF (cb% MOD 2)=0 THEN =pellet% ELSE =sucrose%

DEF FNleft_consequence(cb%)
  IF ((cb% DIV 2) MOD 2)=0 THEN =sucrose% ELSE =pellet%

DEF FNright_consequence(cb%)
  IF ((cb% DIV 2) MOD 2)=0 THEN =pellet% ELSE =sucrose%

DEF FNbegin_with(cb%)
  IF ((cb% DIV 4) MOD 2)=0 THEN =sucrose% ELSE =pellet%

DEF FNend_with(cb%)
  REM Inverse of FNbegin_with
  IF ((cb% DIV 4) MOD 2)=0 THEN =pellet% ELSE =sucrose%

DEF FNlever_causing(reinf%, box%)
  IF FNleft_consequence(cb%(box%))=sucrose% THEN
    REM Left lever causes sucrose
    CASE reinf% OF
      WHEN sucrose%:    =leftlever%(box%)
      WHEN pellet%:     =rightlever%(box%)
      OTHERWISE:        VDU7:PRINT"Bug into FNlever_causing":=0
    ENDCASE
  ELSE
    REM Left lever causes pellets
    CASE reinf% OF
      WHEN sucrose%:    =rightlever%(box%)
      WHEN pellet%:     =leftlever%(box%)
      OTHERWISE:        VDU7:PRINT"Bug into FNlever_causing":=0
    ENDCASE
  ENDIF

DEF FNlevercontrol_causing(reinf%, box%)
  IF FNleft_consequence(cb%(box%))=sucrose% THEN
    REM Left lever causes sucrose
    CASE reinf% OF
      WHEN sucrose%:    =leftlevercontrol%(box%)
      WHEN pellet%:     =rightlevercontrol%(box%)
      OTHERWISE:        VDU7:PRINT"Bug into FNlevercontrol_causing":=0
    ENDCASE
  ELSE
    REM Left lever causes pellets
    CASE reinf% OF
      WHEN sucrose%:    =rightlevercontrol%(box%)
      WHEN pellet%:     =leftlevercontrol%(box%)
      OTHERWISE:        VDU7:PRINT"Bug into FNlevercontrol_causing":=0
    ENDCASE
  ENDIF

DEF PROCdisplay_counterbalancing(cb%)
  PRINT "S1/";reinforcer$(FNstim1_consequence(cb%));", ";
  PRINT "S2/";reinforcer$(FNstim2_consequence(cb%));" - ";
  PRINT "L->";reinforcer$(FNleft_consequence(cb%));", ";
  PRINT "R->";reinforcer$(FNright_consequence(cb%));" - ";
  PRINT reinforcer$(FNbegin_with(cb%));" first"
ENDPROC

DEF FNstimulus_causing(reinforcer%, cb%)
  CASE reinforcer% OF
    WHEN pellet%:   IF (cb% MOD 2)=0 THEN =stim_two% ELSE =stim_one%
    WHEN sucrose%:  IF (cb% MOD 2)=0 THEN =stim_one% ELSE =stim_two%
    OTHERWISE:      VDU7:PRINTTAB(0,0);"*** Stupid call to FNstimulus_causing. ***"
  ENDCASE
=0

DEF FNpav_reinforcer(stimulus%, cb%)
  CASE stimulus% OF
    WHEN stim_one%:   =FNstim1_consequence(cb%)
    WHEN stim_two%:   =FNstim2_consequence(cb%)
    WHEN isi%:        =extinction%
    OTHERWISE:        VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNpav_reinforcer. ***"
  ENDCASE
=0

DEF FNpav_stimulus(component%, cb%)
  REM Components begin from 1.
  REM Components 1, 4, 7... are ISI.
  REM Components 2, 5, 8... For CB 0-3, the sucrose stimulus. For CB 4-7, pellet stimulus.
  REM Components 3, 6, 9... the opposite.
  IF (component%-1) MOD 3 = 0 THEN =isi%
  IF (component%-1) MOD 3 = 1 THEN
    = FNstimulus_causing(FNbegin_with(cb%),cb%)
  ELSE
    = FNstimulus_causing(FNend_with(cb%),cb%)
  ENDIF
  VDU 7:PRINTTAB(0,0);"*** Nasty error in FNpav_stimulus ***"
=0

DEF FNspecific_test_stimulus(component%)
  REM Component runs from 1-20.
  LOCAL phase%
  phase% = (component% - 1) MOD 4:  REM phase% is now 0-3.
  REM See discussion - went for ISI->S1->ISI->S2 regardless of counterbalancing condition.
  CASE phase% OF
    WHEN 0: = isi%
    WHEN 1: = stim_one%
    WHEN 2: = isi%
    WHEN 3: = stim_two%
  ENDCASE
=0

REM ========================================================================
REM Communal bits and bobs
REM ========================================================================

DEF FNprobability
=RND(1)

REM ========================================================================
REM Communal nosepoke code
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%,bogus%)
  IF bogus%=0 =0
  IF counting%(box%)=no% THEN =0    :REM In this program, nosepokes don't do anything, so we're never interested unless counting them.
  IF FNswitch(nosepoke%(box%),E%)=On THEN
    PROCenter_magazine(box%)
  ELSE
    PROCleave_magazine(box%)
  ENDIF
=0

DEF PROCenter_magazine(box%)
  REM From FNmagazine_changed, we must be counting.
  CASE state%(box%) OF
    WHEN simple_watching%:  start_time%(box%)=TIME:watching%(box%)=state%(box%)
                            nosepoke_num%(box%, component%(box%)) += 1
    WHEN sucrose_watching%: start_time%(box%)=TIME:watching%(box%)=state%(box%)
                            nosepoke_suc_num%(box%, component%(box%)) += 1
    WHEN not_watching%:
  ENDCASE
  PROCdisplay_poke(box%)
ENDPROC

DEF PROCleave_magazine(box%)
  CASE watching%(box%) OF
    WHEN simple_watching%:    nosepoke_time%(box%,component%(box%)) += TIME-start_time%(box%)
    WHEN sucrose_watching%:   nosepoke_suc_time%(box%,component%(box%)) += TIME-start_time%(box%)
    WHEN not_watching%:
  ENDCASE
  watching%(box%) = not_watching%
  PROCdisplay_poke(box%)
ENDPROC

REM ========================================================================
REM Communal display code
REM ========================================================================

DEF PROCdisplay_startup(banner$)
  CLS
  COLOUR magenta%
  PRINT progname$;", by Rudolf Cardinal, ";version_date$;
  IF debug%=1 THEN
    COLOUR yellow%:PRINT" -- debugging!"
  ELSE
    PRINT
  ENDIF
  COLOUR white%
  PRINT 'banner$
  PRINT "____________________________________________________________"
  PRINT
  COLOUR red%
  PRINT"Started at:         ";TIME$
  PRINT "Elapsed time: ";
  clock_x%=POS:clock_y%=VPOS
  PRINT
  PRINT"Press F1-4 to abort boxes."
  COLOUR white%
ENDPROC

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

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

DEF FNclock_tick(dummy%,bogus%)
  IF bogus%=0 =0
  LOCAL t%
  t% = TIME - session_start_time%
  COLOUR magenta%:PRINTTAB(clock_x%,clock_y%);t%DIV6000;" min ";(t%MOD6000)DIV100;" sec     ";:COLOUR white%
=0