REM >SP
REM ========================================================================
REM Sensory preconditioning, using simple PIT as the measure of conditioning.
REM By Rudolf Cardinal.
REM First written: 26 February 2000.
REM ========================================================================

progname$="SP-PIT"
version_date$="15-Mar-2000"
debug%=0
simple%=0

REM ========================================================================
REM Schedule
REM ========================================================================
REM Described in full in "sensory preconditioning" chapter.
REM May or may not use reminder/extinction phases in practice.
REM   1. Preconditioning, PAIRED or UNPAIRED. S1/S2 or S1->S2.
REM   2. Pavlovian; S2->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   3. Instrumental; RI schedule, 8 sessions (parameter 2, 15, 30, 60, 60, 60, 60, 60).
REM   4. Single brief instrumental extinction (30 min, says JH).
REM   5. TRANSFER TEST, for two sessions. First session: Present S1 (2-min) and ISI (2-min), six times each.
REM   6. TRANSFER TEST. Second session: S2.
REM
REM Stimulus are (1) flashing lights; (2) clicker, counterbalanced S1/S2.
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 Now the boxes are all in the same room, treat them as a single unit.
REM So all "S1=light" animals need to be run at the same time, and separately
REM from all "S1=clicker" animals. Therefore, let's try to rig the preconditioning
REM phase so PAIRED and UNPAIRED animals can run simultaneously.
REM
REM We'll do it this way. The UNPAIRED animals have light/clicker randomised in pairs,
REM and the PAIRED animals get both at the moment when the unpaired animals get the clicker.
REM
REM Counterbalancing is
REM
REM   CB#     S1            S2        Lever     Paired/unpaired
REM   0       light         clicker   left      PAIRED
REM   1       light         clicker   left      UNPAIRED
REM   2       clicker       light     left      PAIRED
REM   3       clicker       light     left      UNPAIRED
REM
REM ========================================================================
REM Revision history.
REM ========================================================================
REM 26 Feb 2000 - started. Based on PIT-simp.
REM 27 Feb 2000 - the random seed hack
REM 28 Feb 2000 - extra test to primary CS (S2)
REM 15 Mar 2000 - minor bug fix


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"

MODE 12
CLS
PRINT "In order to get this running with S and P boxes simultaneously,"
PRINT "I have rigged the random number generator so each session is"
PRINT "different, but every computer will generate the same sequence"
PRINT "on the same session."
PRINT
PRINT "So enter the session number, NUMBERED FROM 1,"
PRINT "SUMMING OVER ALL PHASES AND SESSIONS the rats have experienced."
PRINT

random_seed% = FNget_num_param("Random number seed",0,1,100)
dummy% = RND( -random_seed%)

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_light%=1: stim_clicker%=2: stim_lightclicker%=3: max_stimuli%=3
  cs%=1:       neut%=2
  DIM stimulus$(max_stimuli%): DIM stimulus_2$(max_stimuli%)
  stimulus$(isi%)=     "ISI":stimulus_2$(isi%)="ISI"
  stimulus$(stim_light%)  ="L  ":stimulus_2$(stim_light%)  ="L"
  stimulus$(stim_clicker%)="C  ":stimulus_2$(stim_clicker%)="C"
  stimulus$(stim_lightclicker%)="L+C":stimulus_2$(stim_lightclicker%)="L+C"

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

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


REM Session parameters

  stimulus_length% = 12000                :REM S1 and S2 are on for 120 s (2 min). Applies to Pavlovian and transfer tests.
  precond_components% = 4 * 3                 :REM ISI-S1-ISI-S2, or ISI-both-ISI-ISI
  pav_components% = 2 * 6                 :REM 6 ISI, 6 CS
  test_components% = 2 * 6                :REM 6 ISI, 6 CS
  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
    precond_components% = 4*2
    pav_components% = 3 * 2
    test_components% = 3 * 2
    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 preconditioning, randomised in pairs.
  REM *** This code relies on components being coded from 1-.
  DIM precond_component_stimulus%(precond_components%)
  FOR dummy% = 1 TO precond_components%-3 STEP 4
    precond_component_stimulus%(dummy%    ) = isi%
    precond_component_stimulus%(dummy% + 2) = isi%
    IF FNrandom_integer(0,1)=0 THEN
      precond_component_stimulus%(dummy% + 1) = stim_light%
      precond_component_stimulus%(dummy% + 3) = stim_clicker%
    ELSE
      precond_component_stimulus%(dummy% + 1) = stim_clicker%
      precond_component_stimulus%(dummy% + 3) = stim_light%
    ENDIF
  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 ========================================================================

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%
PRINT
PRINT "REMEMBER - counterbalancing 0(paired) & 1(unpaired) should be run together,"
PRINT "           but NOT at the same time as counterbalancing 2(paired) & 3(unp.)"
PRINT "           because 0&1 have S1=light and 2&3 have S1=clicker."
PRINT
COLOUR red%
boxgroup$ = FNget_letter_param("Is this running on 'S' or 'P' boxes (just out of interest)", "SP", "")
COLOUR yellow%
PRINT
PRINT "Please select the Task of the Day:"
COLOUR white%
PRINT
PRINT " 1. Preconditioning (S1->S2 or S1//S2).                   Two sessions."
PRINT " 2. Pavlovian training, RT-30s (S2->pellet).              Eight sessions?"
PRINT " 3. Instrumental training, RI-2/15/30/60s schedule.       Eight sessions."
PRINT " 4. Instrumental extinction.                              Zero/one session."
PRINT " 5. TRANSFER TEST - preconditioning (lever +/- S1).       One session."
PRINT " 6. TRANSFER TEST - primary CS (lever +/- S2).            One session."
PRINT
COLOUR red%
task% = FNget_num_param("Choose",0,1,6)
CASE task% OF
  WHEN 1:  PROCprecondition
  WHEN 2:  PROCpavlovian
  WHEN 3:  PROCinstrumental
  WHEN 4:  PROCinstrumental_ext
  WHEN 5:  PROCtransfer_test
  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 "The program CANNOT guess for you."
  PRINT "The choices are as follows:   (L=light,C=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 R E C O N D I T I O N I N G             |
REM |_______________________________________________________________________|

REM ========================================================================
DEF PROCprecondition
REM ========================================================================

  REM This basically runs the Pavlovian session, and it's the functions
  REM called by FNpav_new_component that make the difference

  LOCAL box%, dummy%, taskname$
  pav_components% = precond_components%
  taskname$="Preconditioning"
  phase_banner$ = "Phase "+STR$(task%)+": Sensory preconditioning"

  PROCget_ratinfo
  PROCselect_2_filenames
  PROCwarn_kickoff
  output_header$ = progname$+"("+version_date$+"),"+STR$(task%)+","+taskname$+","+date_time$+","
  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


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

REM ========================================================================
DEF PROCpavlovian
REM ========================================================================
  LOCAL box%, dummy%, taskname$
  taskname$="Pavlovian"
  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(15);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-3)   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-3)        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% = FNtest_component_stimulus(cb%(box%), 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% = FNtest_component_stimulus(cb%(box%),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% = FNtest_component_stimulus(cb%(box%),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-3) 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% = FNtest_component_stimulus(cb%(box%),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_light%:   REM Stimulus Light 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_clicker%:   REM Stimulus Clicker 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 stim_lightclicker%:
                      REM both
                      PROCuserfunc_start_flash("FNstim_1_on("+STR$(box%)+")", "FNstim_1_off("+STR$(box%)+")", stim_1_timer%+box%, 17, 16)
                      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 4 counterbalancing conditions, numbered 0-3.
  REM By default, "P" boxes get 0 (mainly lights) and "S" boxes get 1 (mainly clickers).
  REM The conditions are listed up top.
  REM But for half of the animals, this should be changed to 2 & 3.
  IF boxgroup$="S" THEN =0
  IF boxgroup$="P" THEN =1
  VDU 7:PRINT"FNdefault_counterbalancing_condition: Major error (boxgroup$=";boxgroup$;")."
=0

DEF PROCdisplay_counterbalancing(cb%)
  PRINT "S1=";stimulus_2$(FNs1_stimulus(cb%));", ";
  PRINT "S2=";stimulus_2$(FNs2_stimulus(cb%));", ";
  IF FNis_paired(cb%) THEN PRINT "paired" ELSE PRINT "unpaired"
ENDPROC

DEF FNs1_stimulus(cb%)
  IF cb% = 0 OR cb% = 1 THEN =stim_light%
  IF cb% = 2 OR cb% = 3 THEN =stim_clicker%
  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNs1_stimulus. ***"
=0

DEF FNs2_stimulus(cb%)
  IF cb% = 0 OR cb% = 1 THEN =stim_clicker%
  IF cb% = 2 OR cb% = 3 THEN =stim_light%
  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNs2_stimulus. ***"
=0

DEF FNis_paired(cb%)
  IF cb% = 0 OR cb% = 2 THEN =TRUE
  IF cb% = 1 OR cb% = 3 THEN =FALSE
  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNis_paired. ***"
=0

DEF FNpav_stimulus(cb%,component%)
  REM components 1, 3... are ISI. Components 2, 4... are usually stimuli.

  IF task% = 1 THEN
    REM preconditioning, S1->S2
    IF (component%-1) MOD 2 = 0 THEN =isi%
    IF FNis_paired(cb%) THEN
      IF precond_component_stimulus%(component%) = stim_clicker% THEN
        =stim_lightclicker%
      ELSE
        =isi%
      ENDIF
    ELSE
      =precond_component_stimulus%(component%)
    ENDIF
  ENDIF

  IF task% = 2 THEN
    REM Pavlovian, S2->pellet
    IF (component%-1) MOD 2 = 0 THEN =isi%
    =FNs2_stimulus(cb%)
  ENDIF

  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNpav_stimulus. ***"
=0

DEF FNpav_reinforcer(stimulus%, cb%)
  IF task% = 2 AND stimulus% = FNs2_stimulus(cb%) THEN =pellet%
  REM Anything else - non-CS in phase 2, or anything in preconditioning phase...
=extinction%

DEF FNpav_component_length(cb%,component%)
  IF task%=1 AND FNpav_stimulus(cb%,component%)=isi% AND FNis_paired(cb%) AND precond_component_stimulus%(component%)=stim_light% THEN =stimulus_length%
  REM This line ensures that the paired lot stay in sync with the unpaired
  REM lot, despite having an ISI when the unpaired lot have the light.
  IF FNpav_stimulus(cb%,component%)=isi% THEN =pav_isi_length%(component%)
=stimulus_length%

DEF FNdescribe_stimulus(cb%,stim%)
  IF stim% = stim_lightclicker% THEN ="S1+S2"
  IF stim% = FNs1_stimulus(cb%) THEN ="S1"
  IF stim% = FNs2_stimulus(cb%) THEN ="S2"
="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

DEF FNtest_component_stimulus(cb%, component%)
  REM In the transfer test for sensory preconditioning, we present the ISI first
  REM and then S1 (and repeat that pattern 6 times).
  REM So components 1, 3... are ISI

  REM Modified, 28 Feb 2000: allows a test to S2 as well.

  IF (component%-1) MOD 2 = 0 THEN =isi%
  IF task%=5 THEN =FNs1_stimulus(cb%)
  IF task%=6 THEN =FNs2_stimulus(cb%)

  VDU7:PRINTTAB(0,0);"*** Bug manifesting in FNtest_component_stimulus. ***"
=0