REM >PIT-simp
REM ========================================================================
REM Simple Pavlovian-instrumental transfer (Balleine, 1994).
REM By Rudolf Cardinal.
REM First written: 13 August 99.
REM ========================================================================

progname$="PIT-simp"
version_date$="14-Aug-99"
debug%=0
simple%=0

REM ========================================================================
REM Schedule
REM ========================================================================
REM Described in full in "anterior cingulate cortex" chapter.
REM May or may not use reminder/extinction phases in practice.
REM   1. Pavlovian; CS->pellet on RI-30s schedule (2-min CS presentations)
REM      ISI is 2-4 min, chosen randomly for each cycle but the same for
REM      all boxes (for clicker synchrony). Begin with ISI. Six cycles.
REM   2. On the eighth session, two presentations of the NEUT stimulus are given.
REM      Therefore eight cycles in total. Arbitrarily, NEUT cycles are numbers
REM      2 and 6.
REM   3. Instrumental; RI schedule, 8 sessions (parameter 2, 15, 30, 60, 60, 60, 60, 60).
REM   4. Single Pavlovian reminder, identical to phase 1.
REM   5. Single brief instrumental extinction (30 min, says JH).
REM   6. TRANSFER TEST, for two sessions.
REM      After Balleine.
REM      Two-minute presentations of S1/S2/ISI, randomised in triplets, x 4, with two constraints:
REM         - the same for all four boxes (to avoid clicker cross-talk)
REM         - one triplet mustn't start with the stimulus that ended the previous
REM           triplet
REM
REM Stimulus are (1) flashing lights; (2) clicker, counterbalanced CS+/NEUT.
REM Houselight on throughout. Dipper down. Traylight not used.
REM Left lever only. Reinforcer is one white sucrose pellet.
REM
REM ========================================================================
REM Counterbalancing and order
REM ========================================================================
REM Objective: to ensure boxes in the same room only use the clicker synchronously.
REM Since most Pavlovian sessions only use one stimulus, this means counterbalancing
REM is by room. Clicker either with IV boxes or autoshaping kit... go for IV.
REM
REM Counterbalancing is therefore
REM
REM   Box     CB#     CS+           NEUT      Lever
REM   P1-4    0       light (S1)    clicker   left
REM   S1-4    1       clicker (S2)  light     left
REM
REM ========================================================================
REM Revision history.
REM ========================================================================
REM 13 Aug 99 - started. Based on PIT-mult, q.v., but better behaviourally.
REM 14 Aug 99 - one INELEGANT thing is that FNpav_component_length needs to know counterbalancing. See PROCpav_display_startup


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"   :PROCcombined_boxes
LIBRARY "<RudolfDir>.ProgLibs.Random"     :dummy% = RND(-TIME)

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

REM Reinforcers, stimuli, other internal constants

  REM This is OK, despite already using pellet%() as a line number.
  pellet%=1: extinction%=2: max_reinforcers%=2
  DIM reinforcer$(max_reinforcers%): DIM reinforcer_2$(max_reinforcers%)
  reinforcer$(pellet%)=    "pellet ":reinforcer_2$(pellet%)="pellet"
  reinforcer$(extinction%)="ext    ":reinforcer_2$(extinction%)="none"

  isi%=0: stim_one%=1: stim_two%=2: max_stimuli%=2
  cs%=1:       neut%=2
  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

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


REM Session parameters

  stimulus_length% = 12000                :REM S1 and S2 are on for 120 s (2 min). Applies to Pavlovian and transfer tests.
  pav_components% = 2 * 6                 :REM 6 ISI, 6 CS.
  pav_final_components% = 2*6 + 2*2       :REM 8 ISI, 6 CS, 2 NEUT.
  test_components% = 3 * 4                :REM 4 ISI, 4 CS, 4 NEUT.
  max_components% = 16                    :REM Greatest of all the components.
  rt_param% = 30                          :REM An RT-30s schedule. Note - in _seconds_.
  instr_session_length% = 30 * 60 * 100   :REM 30-min instrumental sessions
  ext_session_length% = 30 * 60 * 100     :REM 30-min first extinction session
  max_isi_length% = 4 * 60 * 100
  min_isi_length% = 2 * 60 * 100

  IF debug%=1 THEN
    stimulus_length%=1500
    rt_param%=5
    pav_components% = 3 * 2
    pav_final_components% = 3 * 2
    test_components% = 3 * 3
    instr_session_length% = 3 * 60 * 100
    ext_session_length% = 3 * 60 * 100
    min_isi_length% = 5 * 100
    max_isi_length% = 15 * 100
  ENDIF

  REM Fill an array with ISI lengths. (Won't use all the values, just those that correspond to ISI component numbers.)
  DIM pav_isi_length%(max_components%)
  FOR dummy% = 1 TO max_components%
    pav_isi_length%(dummy%) = FNrandom_integer(min_isi_length%,max_isi_length%)
  NEXT

  REM Allocate stimuli for the test according to the triplet constraint.
  REM *** MAGIC NUMBERS.
  REM *** This code relies on stimuli being coded from 0-2, and components from 1-.
  DIM test_component_stimulus%(test_components%)
  FOR dummy% = 1 TO test_components%-2 STEP 3
    REPEAT
      test_component_stimulus%(dummy%) = FNrandom_integer(0,2)
    UNTIL dummy%=1 OR test_component_stimulus%(dummy%)<>test_component_stimulus%(dummy%-1)
    REM That implemented the "no two consecutive components the same" constraint.
    REM The rest implements the triplet randomization.
    REPEAT
      test_component_stimulus%(dummy%+1) = FNrandom_integer(0,2)
    UNTIL test_component_stimulus%(dummy%+1) <> test_component_stimulus%(dummy%)
    oodle% = 0
    REPEAT
      test_component_stimulus%(dummy%+2) = oodle%
      oodle% += 1
    UNTIL test_component_stimulus%(dummy%+2)<>test_component_stimulus%(dummy%+1) AND test_component_stimulus%(dummy%+2)<>test_component_stimulus%(dummy%)
  NEXT


REM ========================================================================
REM Timers, variables
REM ========================================================================

  clock_timer%     = nboxes% * 0 + 1  :REM only one of them
  stim_1_timer%    = nboxes% * 1
  stim_2_timer%    = nboxes% * 2
  component_timer% = nboxes% * 3      :REM Pavlovian component timer
  rt_timer%        = nboxes% * 4
  ri_timer%        = nboxes% * 5      :REM RI schedule for one lever
  session_timer%   = nboxes% * 6      :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
  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
  DIM nosepoke_time%(nboxes%, max_components%)    :REM total nosepoke time in the component
  DIM pellets_given%(nboxes%, max_components%)
  DIM schedule$(nboxes%)

  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%)                 :REM RI schedule sets this to yes as appropriate
  DIM lever_presses%(nboxes%, max_components%)  :REM #lever presses in that component
  DIM component_start_time%(nboxes%)            :REM Lever depression start time is relative to this
  DIM lever_down_at%(nboxes%)                   :REM Lever depression duration relative to this

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


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

dummy% = RND(-TIME)
MODE 12
COLOUR yellow%
PRINT "!";progname$
PRINT "____________________________________________________________________"
COLOUR white%
PRINT "Simple Pavlovian-instrumental transfer (PIT) task."
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%)
NEXT
PROCwait(E%):*AE
PRINT " done."':COLOUR white%
COLOUR red%
boxgroup$ = FNget_letter_param("Is this running on 'S' or 'P' boxes (for counterbalancing)", "SP", "")
COLOUR yellow%
PRINT
PRINT "Please select the Task of the Day:"
COLOUR white%
PRINT
PRINT " 1. Pavlovian training, RT-30s (CS->pellet).              Sessions 1-7."
PRINT " 2. Pavlovian training, with NEUT stimulus presentation.  Session 8."
PRINT " 3. Instrumental training, RI-2/15/30/60s schedule.       Eight sessions."
PRINT " 4. Pavlovian reminder (as 1).                            Zero/one session."
PRINT " 5. Instrumental extinction.                              Zero/one session."
PRINT " 6. TRANSFER TEST.                                        Two sessions."
PRINT
COLOUR red%
task% = FNget_num_param("Choose",0,1,10)
CASE task% OF
  WHEN 1:  PROCpavlovian
  WHEN 2:  PROCpavlovian
  WHEN 3:  PROCinstrumental
  WHEN 4:  PROCpavlovian
  WHEN 5:  PROCinstrumental_ext
  WHEN 6:  PROCtransfer_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 "(S1=light,S2=clicker)"
  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%, taskname$
  taskname$="Pavlovian"
  IF task%=2 THEN pav_components% = pav_final_components%: taskname$="Pavlovian_Neut"
  PROCget_ratinfo
  PROCselect_2_filenames
  PROCwarn_kickoff
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+","+taskname$+","+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%, length%
  component%(box%) += 1
  IF component%(box%)>pav_components% THEN PROCpav_finished(box%):=0
  REM Finished previous. /// Start new.
  stim% = FNpav_stimulus(cb%(box%),component%(box%))
  reinf% = FNpav_reinforcer(stim%, cb%(box%))
  length% = FNpav_component_length(cb%(box%),component%(box%))
  PROCstart_stimulus(stim%, box%, length%)
  IF reinf%<>extinction% THEN PROCrt_schedule(box%, rt_param%)
  PROCpipe_timer(component_timer%+box%, length%, 0, "FNpav_new_component(", box%, E%)
  state%(box%) = simple_watching%: PROCstart_counting(box%)
  PROCpav_display_box(box%)
=0

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

DEF FNrt_tick(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(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%)
  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,PELLETS,NP_NUM,NP_TIME,")
  PROCprint_line(ch%,"COUNTERBALANCING,COMPUTER,STIMULUS,STIM_DESC,REINFORCER,COMPONENT_DURATION")
  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$(pellets_given%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_num%(box%,t%)))
      PROCprint_string(ch%,","+STR$(nosepoke_time%(box%,t%)))
      PROCprint_string(ch%,","+STR$(cb%(box%)))
      PROCprint_string(ch%,","+boxgroup$)
      stim% = FNpav_stimulus(cb%(box%),t%)
      PROCprint_string(ch%,","+stimulus_2$(stim%))
      PROCprint_string(ch%,","+FNdescribe_stimulus(cb%(box%),stim%))
      PROCprint_string(ch%,","+reinforcer_2$(FNpav_reinforcer(stim%, cb%(box%))))
      PROCprint_line(ch%,","+STR$(FNpav_component_length(cb%(box%),t%)))
    NEXT
  NEXT
  CLOSE#ch%

  COLOUR white%
  LOCAL 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"Schedule was RT-";rt_param%;"s"
  PRINT"Total of ";pav_components%;" components presented, including ISIs"
  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         NP#  NPtime                      "
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    FOR t%=1 TO pav_components%
      PRINTTAB(0);t%;
      PRINTTAB(11);stimulus$(FNpav_stimulus(cb%(box%),t%));
      PRINTTAB(17);reinforcer$(FNpav_reinforcer(FNpav_stimulus(cb%(box%),t%), cb%(box%)));
      PRINTTAB(26);pellets_given%(box%,t%);
      PRINTTAB(39);nosepoke_num%(box%,t%);
      PRINTTAB(44);nosepoke_time%(box%,t%);
    NEXT
    PRINT
  NEXT
  COLOUR green%
  PRINT'"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"'
  PRINT"SUMMARIES - PAVLOVIAN"
  COLOUR white%
  PRINT
  PRINT"Box  Rat  Counterbalancing  Session                 Pellet#"
  PRINT"--------------------------------------------------------------------------"
  REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
  FOR box%=1 TO nboxes%
    peltotal%=0
    FOR t% = 1 TO pav_components%
      peltotal% += pellets_given%(box%, t%)
    NEXT
    PRINTTAB(0);box%;
    PRINTTAB(5);ratname$(box%);
    PRINTTAB(10);cb%(box%);
    PRINTTAB(28);session%(box%);
    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 duration: ";stimulus_length%/100; " s"
  LOCAL i%,time%
  time%=0
  FOR i%=1 TO pav_components%
    time% += FNpav_component_length(cb%(1),i%)    :REM -- INELEGANT.
  NEXT
  PRINT "Overall session duration for today: ";time%/6000;" min"
  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             #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(cb%(box%),component%(box%))
  PRINTTAB(44,line%);stimulus$(stim%);"  ";
  PRINTTAB(54,line%);reinforcer$(FNpav_reinforcer(stim%, cb%(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
REM ========================================================================
  session_length% = instr_session_length%
  LOCAL ri_param%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental training"

  COLOUR yellow%
  PRINT "When you enter session numbers, START FROM ONE for the instrumental sessions."
  PRINT "The RI schedule parameter is set to 2/15/30/60/... according to this."
  COLOUR white%
  PROCinstrumental_communal_start
  FOR box%=1 TO nboxes%
    CASE session%(box%) OF
      WHEN 1:    ri_param% = 2     :IF debug%=1 THEN ri_param%=2
      WHEN 2:    ri_param% = 15    :IF debug%=1 THEN ri_param%=3
      WHEN 3:    ri_param% = 30    :IF debug%=1 THEN ri_param%=4
      OTHERWISE: ri_param% = 60    :IF debug%=1 THEN ri_param%=5
    ENDCASE
    schedule$(box%) = "RI-"+STR$(ri_param%)
    PROCinstrumental_general(box%, "FNlever_ri_func(", session_length%)
    PROCpipe_timer(ri_timer%+box%, 100, 100, "FNri_tick("+STR$(ri_param%)+",",box%, E%)
  NEXT
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC

REM ========================================================================
DEF PROCinstrumental_ext
REM ========================================================================
  session_length% = ext_session_length%
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",Instrumental_Ext,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": instrumental extinction"

  PROCinstrumental_communal_start
  LOCAL box%
  FOR box%=1 TO nboxes%
    schedule$(box%) = "ext"
    PROCinstrumental_general(box%, "FNlever_ext_func(", session_length%)
  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%, lever_func$, session_time%)
  REM Lever functions must conform to FNsomething(..., box%)
  REM Lever_func strings must supply left bracket and include comma if needed.
  lever_func$ += STR$(box%)+")"
  PROCswitch_on(leftlevercontrol%(box%), E%)
  PROCpipe_switch(leftlever%(box%),Over, 1, "FNlever_changed("+STR$(leftlever%(box%)) +","""+lever_func$+""",", box%, E%)
  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(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%)) += 1
    total_lever_presses%(box%) += 1
    lever_down_at%(box%) = TIME
    REM Very Special Case below
    IF total_lever_presses%(box%) > 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, total_lever_presses%(box%)) = TIME - session_start_time%
      response_comp%(box%-1, total_lever_presses%(box%)) = component%(box%) :REM only the transfer tests are interested
    ENDIF
    dummy% = EVAL(lever_func$)
    PROCinstr_display_box(box%)
  ELSE
    PROClever_released(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(box%)
  REM Lever has been released
  IF exceeded_maximum%(box%) = no% THEN response_duration%(box%-1, total_lever_presses%(box%)) = TIME - lever_down_at%(box%)
ENDPROC

DEF FNri_tick(param%, 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%)=yes%
    PROCinstr_display_box(box%)
  ENDIF
=0

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

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

DEF FNins_box_ended(box%, bogus%)
  IF bogus%=0 =0
  finished%(box%) = yes%
  PROCstop_counting(box%)
  IF FNswitch(leftlever%(box%), E%) = On THEN PROClever_released(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% + 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,")
  PROCprint_string(ch%,"SCHEDULE,")
  PROCprint_string(ch%,"PELLETS,NP_NUM,NP_TIME,")
  PROCprint_line(ch%,"LEVER_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_length%)
    PROCprint_string(ch%,d$)
    PROCprint_string(ch%,","+schedule$(box%))
    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_line(ch%,","+STR$(lever_presses%(box%,comp%)))
  NEXT
  CLOSE#ch%

  ch% = OPENOUT(responsefile$)
  PROCprint_line(ch%,"DATE_TIME,RAT,BOX,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%)+","
    IF lever_presses%(box%, comp%)>0 THEN
      FOR t%=1 TO FNmin(max_responses%,lever_presses%(box%, comp%))
        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$+STR$(t%)+","+STR$(response_at%(box%-1,t%))+","+STR$(response_duration%(box%-1,t%))+","+yesno$(rewarded%(box%-1,t%)))
        REM Very Special Case for response_at
      NEXT
    ENDIF
  NEXT
  CLOSE#ch%

  COLOUR white%
  LOCAL 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_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     Reinforcers      Nosepoke#      Nosepoke time"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    t% = 1
    PRINTTAB(0);t%;
    PRINTTAB(18);lever_presses%(box%,t%);
    PRINTTAB(31);pellets_given%(box%,t%);
    PRINTTAB(42);nosepoke_num%(box%,t%);
    PRINTTAB(57);nosepoke_time%(box%,t%);
    PRINT
  NEXT
  COLOUR green%
  PRINT'"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"'
  PRINT"SUMMARIES - INSTRUMENTAL"
  COLOUR white%
  PRINT
  PRINT"Box  Rat  CB  Session   Responses       Reinforcers"
  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(31);lever_presses%(box%,t%);
    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
  PRINT "Session length is ";session_length%/6000;" min"
  COLOUR red%
  PRINT "Asterisk by reinforcer count means reinforcer is available."
  PRINT
  COLOUR green%
  PRINT "NP Box Rat  CB(0-7)        Sched.       Presses     Reinforcers  Status"
  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(27,line%);schedule$(box%);
  PRINTTAB(40,line%);lever_presses%(box%, component%(box%));"  ";
  IF reinf_available%(box%)=yes% THEN PRINTTAB(51,line%);"*";: ELSE PRINTTAB(51,line%);" ";
  PRINTTAB(52,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                                   |
REM |_______________________________________________________________________|

REM ========================================================================
DEF PROCtransfer_test
REM ========================================================================
  LOCAL box%, dummy%
  PROCget_ratinfo
  PROCselect_3_filenames
  PROCwarn_kickoff
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+",TransferTest,"+date_time$+","
  phase_banner$ = "Phase "+STR$(task%)+": transfer test"
  PROCdisplay_startup(phase_banner$)
  PROCtest_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% = FNtest_new_component(box%,1)
    PROCswitch_on(leftlevercontrol%(box%), E%)
    PROCpipe_switch(leftlever%(box%),  Over, 1, "FNtest_lever_changed("+STR$(leftlever%(box%)) +",", box%, E%)
    PROCpipe_fkey(box%,1,0,"FNtest_abort_box(",box%,E%)
  NEXT
  session_start_time% = TIME
  PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
  PROCwait(E%): *AE
ENDPROC


DEF FNtest_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%
  component%(box%) += 1
  IF component%(box%)>test_components% THEN PROCtest_finished(box%):=0
  REM Finished previous. /// Start new.
  stim% = test_component_stimulus%(component%(box%))
  PROCstart_stimulus(stim%, box%, stimulus_length%)
  PROCpipe_timer(component_timer%+box%, stimulus_length%, 0, "FNtest_new_component(", box%, E%)
  state%(box%) = simple_watching%: PROCstart_counting(box%)
  PROCtest_display_box(box%)
=0

DEF FNtest_lever_changed(line%, 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%)) += 1
    total_lever_presses%(box%) += 1
    lever_down_at%(box%) = TIME
    REM Very Special Case below
    IF total_lever_presses%(box%) > 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, total_lever_presses%(box%)) = TIME - session_start_time%
      response_comp%(box%-1, total_lever_presses%(box%)) = component%(box%) :REM only the transfer tests are interested
    ENDIF
    dummy% = FNlever_ext_func(box%)
    PROCtest_display_box(box%)
  ELSE
    PROClever_released(box%)
  ENDIF
=0

DEF FNtest_abort_box(box%, bogus%)
  IF bogus%=0 =0
  PROCtest_finished(box%)
=0

DEF PROCtest_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%
  PROCtest_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,STIM_DESC,NP_NUM,NP_TIME,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 test_components%
      PROCprint_string(ch%,d$)
      PROCprint_string(ch%,STR$(comp%))
      stim% = test_component_stimulus%(comp%)
      PROCprint_string(ch%,","+stimulus_2$(stim%))
      PROCprint_string(ch%,","+FNdescribe_stimulus(cb%(box%),stim%))
      PROCprint_string(ch%,","+STR$(nosepoke_num%(box%,comp%)))
      PROCprint_string(ch%,","+STR$(nosepoke_time%(box%,comp%)))
      PROCprint_line(ch%,","+STR$(lever_presses%(box%,comp%)))
    NEXT
  NEXT
  CLOSE#ch%

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

  COLOUR white%
  LOCAL 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"                          signalled       Total          Total"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    FOR t% = 1 TO test_components%
      stim% = test_component_stimulus%(t%)
      PRINTTAB(0);t%;" ";stimulus_2$(stim%);
      PRINTTAB(18);lever_presses%(box%,t%);
      PRINTTAB(26);FNdescribe_stimulus(cb%(box%),stim%);"  ";
      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 PROCtest_display_startup
  PRINT "All conducted in extinction."
  PRINT "Session length is ";test_components%*stimulus_length%/6000;" min"
  PRINT
  COLOUR green%
  PRINT "NP Box Rat  CB(0-7) Component#  Stimulus           Responses"
  PRINT "                                                   This component (Total)"
  PRINT "_______________________________________________________________________________"
  REM    01234567890123456789012345678901234567890123456789012345678901234567890123456789
  display_firstline%=VPOS
ENDPROC

DEF PROCtest_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% = test_component_stimulus%(component%(box%))
  PRINTTAB(32,line%);stimulus$(stim%);
  PRINTTAB(41,line%);FNdescribe_stimulus(cb%(box%),stim%);"  ";
  PRINTTAB(51,line%);lever_presses%(box%,component%(box%));" (";total_lever_presses%(box%);")   ";
  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_off(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_off(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(box%)
  PROCsingle_pellet(pellet%(box%))
  pellets_given%(box%, component%(box%)) += 1
ENDPROC

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 2 counterbalancing conditions, numbered 0 and 1.
  REM By default, "P" boxes get 0 (mainly lights) and "S" boxes get 1 (mainly clickers).
  REM The conditions are listed up top.
  IF boxgroup$="P" THEN =0
  IF boxgroup$="S" THEN =1
  VDU 7:PRINT"FNdefault_counterbalancing_condition: Major error (boxgroup$=";boxgroup$;")."
=0

DEF PROCdisplay_counterbalancing(cb%)
  PRINT "CS=";stimulus_2$(FNcs_stimulus(cb%));", ";
  PRINT "NEUT=";stimulus_2$(FNneut_stimulus(cb%))
ENDPROC

DEF FNcs_stimulus(cb%)
  IF cb% = 0 THEN =stim_one%
  IF cb% = 1 THEN =stim_two%
  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNcs_stimulus. ***"
=0

DEF FNneut_stimulus(cb%)
  IF cb% = 0 THEN =stim_two%
  IF cb% = 1 THEN =stim_one%
  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNneut_stimulus. ***"
=0

DEF FNpav_stimulus(cb%,component%)
  REM For "task 1" (Pavlovian training sessions 1-7), components 1, 3... are ISI. Components 2, 4... are CS.
  REM For "task 2" (Pavlovian session 8), the second and sixth stimulus presentations (components 4 and 10) are NEUT. Others are CS.
  IF (component%-1) MOD 2 = 0 THEN =isi%
  IF task%=2 AND (component%=4 OR component%=10) THEN =FNneut_stimulus(cb%)
=FNcs_stimulus(cb%)

DEF FNpav_reinforcer(stimulus%, cb%)
  IF stimulus% = FNcs_stimulus(cb%) THEN =pellet%
=extinction%

DEF FNpav_component_length(cb%,component%)
  IF FNpav_stimulus(cb%,component%)=isi% THEN =pav_isi_length%(component%)
=stimulus_length%

DEF FNdescribe_stimulus(cb%,stim%)
  IF stim% = FNcs_stimulus(cb%) THEN ="CS"
  IF stim% = FNneut_stimulus(cb%) THEN ="NEUT"
="ISI"

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 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 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