REM >Bradshaw
REM ========================================================================
REM Mazur/Bradshaw, adjusting delay.
REM THIS IS THE ONE BY ROB/NATHANIEL.
REM A fairly faithful copy of Bradshaw's task.
REM Blocks of presentations (two forced, two free); changes delay if same
REM lever chosen twice in that block.
REM ========================================================================

progname$="Bradshaw"
version_date$="16 Sep 98"
author$="Rudolf Cardinal" :REM most recent author
debug%=0
simple%=1

REM
REM Delay of reinforcement program, written for Arachnid.
REM Supports variations in delay, probability and magnitude of reinforcement.
REM
REM AUTHOR & REVISION HISTORY:
REM
REM Rob Rogers, original code, September 1997
REM =========================================
REM
REM Nathaniel Daw, bug fixes and modifications, June-August 1998
REM ============================================================
REM
REM        * fixed failure to kill lever pipe in FNprocess_left,
REM          FNprocess_right and FNomission, leading to strange bugs
REM          when lever is pressed while retracting
REM        * fixed execution flow bug by inserting ENDPROCs in
REM          PROCforced_interval
REM        * added a few more ENDPROCs and changed the way
REM          PROCremaining_interval finishes (guarantee stack always
REM          unwinds) to further ensure execution flow works as expected.
REM        * added default values to all input statements when configuring
REM          the boxes. This is pretty complicated, esp. wrt counterbalancing
REM          rats on left/right
REM        * changed a lot of single-line ifs to if-then-else-endif or case
REM        * changed file output to be comma-delimited ascii (*script)
REM        * added stimulus to output
REM        * deleted some dead functions
REM        * attempt to fix lockups by (1) changing 0cs timeouts to 10cs
REM        * do (1) by removing food_time%, removing timeout for short
REM          pre reward delays, and changing
REM          the minimum timer value in PROCremaining_interval to 10
REM        * added simplified configuration
REM
REM Rudolf Cardinal, altered output
REM ====================================================
REM
REM 16 Sep 98 - ASCII output by function (not L/R!) for database imports
REM           - PROCstore_config removed (configuration on printout only)
REM           - references to *FX3 removed
REM 17 Sep 98 - my code recognisable by 2-space indent, by the way
REM           - progress towards use of constants, not hard-coded figures
REM           - from L/R to adj/unadj (significant change!!)
REM           - I%(box%) has become trialnum%(box%), and DIM changed 25->(4)
REM           - forced_values%(box%) has become presentation%(box%)
REM           - plurals to singular
REM           - PROCassign_lines
REM           - stepwise probability corrected to continuous
REM           - NB "remain_ITI" often means "time completed so far"
REM           - SPOOLed text log as well as data (type set, too)
REM           - modularised to use libraries
REM           - FNclock timer was being set 4 times rather than once
REM           - shows time to go
REM           - colour etc.
REM           - inputs validated: adjusted delay
REM           - debugging support
REM           - removed useless PROCprint_new_trial (=print_forced_interval)
REM           - prints pellet count, 'cos I'm worried
REM           - printer disabled during debugging
REM 24 Sep 98 - modified to run on pellet/dipper boxes
REM 15 Oct 98 - functions to dispense pellets moved to ProgLibs.Arachnid
REM             and a timer-based version written
REM 17 Oct 98 - a few filename changes, more functions to library
REM
REM Plans
REM           - nosepoke detection
REM           - validate other inputs (probability 0-1, fixeddelay...
REM             ntrials...)

LIBRARY "<RudolfDir>.ProgLibs.Ascii"
LIBRARY "<RudolfDir>.ProgLibs.DateTime"
LIBRARY "<RudolfDir>.ProgLibs.Filename"
date_time$ = FNdate_time_code
LIBRARY "<RudolfDir>.ProgLibs.Arachnid"
LIBRARY "<RudolfDir>.ProgLibs.BoxConst"
PROCcombined_boxes

maxtrials%=25  :REM usually, ntrials%=10
maxpresents%=4 :REM presentations

DIM adj_prob(nboxes%)
DIM unadj_prob(nboxes%)
DIM adj_delay%(nboxes%)
DIM unadj_delay%(nboxes%)
DIM adj_rewards%(nboxes%)
DIM unadj_rewards%(nboxes%)

DIM house_light%(nboxes%)       :REM box line numbers
DIM pellet_light%(nboxes%)
DIM pellet_disp%(nboxes%)
DIM left_lever%(nboxes%)
DIM right_lever%(nboxes%)
DIM left_light%(nboxes%)
DIM right_light%(nboxes%)
DIM left_press%(nboxes%)
DIM right_press%(nboxes%)

DIM adjusted_lever$(nboxes%)     :REM L/R
DIM adj_lever%(nboxes%)          :REM higher-order box line numbers
DIM unadj_lever%(nboxes%)
DIM adj_light%(nboxes%)
DIM unadj_light%(nboxes%)
DIM adj_press%(nboxes%)          :REM lever=out, press=in
DIM unadj_press%(nboxes%)

DIM trialnum%(nboxes%)
DIM presentation%(nboxes%)
DIM forced_orders%(nboxes%)
DIM startClock%(nboxes%)
DIM stopClock%(nboxes%)

DIM remain_ITI%(nboxes%)

DIM subject$(nboxes%)
DIM session_number%(nboxes%)
DIM measures%(nboxes%, maxtrials%, maxpresents%, 5)
DIM responses%(nboxes%, 3)        :REM adj, unadj, omission

adj%=1:unadj%=2
choice%=3:omission%=3
yes%=1:no%=2
stim%=1:resp%=2:latency%=3:adjdelay%=4:rewarded%=5  :REM for measures array
DIM default_delay%(2)
DIM default_prob(2)
DIM default_rewards%(2)
DIM stim_string$(3)
DIM rew_string$(2)
DIM resp_string$(3)

PROCinit
REM ON ERROR PROCerror
MODE 12
PROCkill_all
PROCdefine_constants
PROCdefine_switches
PROCdefine_strings

IF debug% THEN PROCset_debugging_values

IF simple%=1 THEN
  PROCsimple_config :REM this is a replacement which assumes more defaults
ELSE
  PROCget_config    :REM full configuration
ENDIF

tottime% = session_time% / 100   :REM rough guess of total time in seconds
PROCassign_lines
PROCselect_and_open_file
PROCprint_config

PROCscreen
PROCcontrol_box

REM ON ERROR OFF
END

REM ================== EXPT. PROCEDURE DEFINITIONS ==========================

DEF PROCerror
     REPORT: PRINT " at line "; ERL
     REM     IF f% >= 0 THEN CLOSE#f%
     PROCend_expt
     END
ENDPROC

DEF PROCdefine_constants
     default_ntrials% =          10
     default_session_time% =     290000
     default_trial_duration% =   7000
     default_limited_hold% =     1000
     default_forced_interval% =  1000

     default_delay%(unadj%)  = 0
     default_delay%(adj%)    = 200
     default_prob(unadj%)    = 1
     default_prob(adj%)      = 1
     default_rewards%(unadj%) = 1
     default_rewards%(adj%)   = 2

     food_time% =                10
     f% =                       -10

     adjustment_change = 0.2        :REM change delay by 20%...
     min_adjdelay% = 200
     max_adjdelay% = 4500
ENDPROC

DEF PROCset_debugging_values
  default_ntrials%=3
  default_session_time%=100*60*4 :REM 4 minutes
  default_trial_duration%=2000
  default_limited_hold%=1000 :REM levers out for...
  default_forced_interval%=100
  max_adjdelay%=450
ENDPROC

DEF PROCdefine_switches
  REM PROCcombined_boxes has already been called
  FOR box% = 1 TO nboxes%
    house_light%(box%)  = FNswitch_number(box%,houselight_line%,nboxes%)
    pellet_light%(box%) = FNswitch_number(box%,centrelight_line%,nboxes%)
    pellet_disp%(box%)  = FNswitch_number(box%,pellet_line%,nboxes%)
    left_lever%(box%)   = FNswitch_number(box%,leftlevercontrol_line%,nboxes%)
    right_lever%(box%)  = FNswitch_number(box%,rightlevercontrol_line%,nboxes%)
    left_light%(box%)   = FNswitch_number(box%,leftlight_line%,nboxes%)
    right_light%(box%)  = FNswitch_number(box%,rightlight_line%,nboxes%)
    left_press%(box%)  = FNswitch_number(box%,leftlever_line%,nboxes%)
    right_press%(box%) = FNswitch_number(box%,rightlever_line%,nboxes%)

    PROCgovn_switch(house_light%(box%), E%)
    PROCgovn_switch(pellet_light%(box%), E%)
    PROCgovn_switch(pellet_disp%(box%), E%)
    PROCgovn_switch(left_lever%(box%), E%)
    PROCgovn_switch(right_lever%(box%), E%)
    PROCgovn_switch(left_light%(box%), E%)
    PROCgovn_switch(right_light%(box%), E%)
    PROCfree_switch(left_press%(box%), E%)
    PROCfree_switch(right_press%(box%), E%)
  NEXT box%
ENDPROC

DEF PROCdefine_strings
  resp_string$(adj%) = "Adj"
  resp_string$(unadj%) = "Unadj"
  resp_string$(omission%) = "Omission"
  rew_string$(yes%) = "Yes"
  rew_string$(no%) = "No"
  stim_string$(adj%) = "Adj"
  stim_string$(unadj%) = "Unadj"
  stim_string$(choice%) = "Choice"
ENDPROC

DEF PROCsimple_config
  REM simplified config added for the benefit of our guest operators
  REM locks down most values to their defaults, only inputs
  REM the bare necessities.

  REM the following turns off fancy number formatting teporarily
  save% = @%
  @% = "g0.0"

  PRINT "Delayed reinforcement/probability program (";version_date$;")."
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT "Most recent author: ";author$
  PRINT "Experiment date/timestamp is ";:COLOUR3:PRINTdate_time$:COLOUR7
  PRINT
  PRINT "Enter config for "; nboxes%; " boxes as follows....": PRINT

  REM use all the defaults
  session_time% = default_session_time%
  ntrials% = default_ntrials%
  trial_duration% = default_trial_duration%
  forced_interval% = default_forced_interval%
  limited_hold% = default_limited_hold%

  FOR box% = 1 TO nboxes%
    PRINT TAB(10, 13); SPC(44)
    PRINT TAB(10, 15); SPC(44)
    PRINT TAB(10, 11); "Box: "; box%
    INPUT TAB(10, 13) "Subject: " subject$(box%)
    INPUT TAB(25, 13) "Session: " session_number%(box%)

    REM odd-numbered boxes have L=unadj, R=adj
    REM even-numbered boxes have the reverse
    IF (box% MOD 2)=0 THEN
      adjusted_lever$(box%)="L"
    ELSE
      adjusted_lever$(box%)="R"
    ENDIF

    adj_delay%(box%) = default_delay%(adj%)
    unadj_delay%(box%) = default_delay%(unadj%)
    adj_prob(box%) = default_prob(adj%)
    unadj_prob(box%) = default_prob(unadj%)
    adj_rewards%(box%) = default_rewards%(adj%)
    unadj_rewards%(box%) = default_rewards%(unadj%)

    REM the only thing we need to input now is the adjusting delay
    PRINT TAB(10,15) "Adjusting delay: ("; default_delay%(adj%); ")"
    INPUT TAB(35,15) adj_delay%(box%)
    IF adj_delay%(box%) = 0 THEN
      adj_delay%(box%) = default_delay%(adj%)
      PRINT TAB(35,15) adj_delay%(box%)
    ENDIF
    IF adj_delay%(box%) < min_adjdelay% THEN adj_delay%(box%)=min_adjdelay%
    IF adj_delay%(box%) > max_adjdelay% THEN adj_delay%(box%)=max_adjdelay%

  NEXT box%
  CLS

  REM restore number formatting to normal
  @% = save%
ENDPROC


DEF PROCget_config
  REM the following turns off fancy number formatting teporarily
  save% = @%
  @% = "g0.0"

  PRINT"Delayed/probabilistic reinforcement (";version_date$;", ";author$;"."
  IF debug%=1 THEN PRINT "*** DEBUGGING!!! ***"
  PRINT "Experiment date/timestamp is ";:COLOUR3:PRINTdate_time$:COLOUR7
  PRINT "Enter config for "; nboxes%; " boxes as follows....": PRINT

  PRINT "session time ("; default_session_time%; " csecs): ";
  INPUT TAB(30,4) "" session_time%
  IF (session_time% = 0) THEN
    session_time% = default_session_time%
    PRINT TAB(30,4); session_time%
  ENDIF

  PRINT "ntrials ("; default_ntrials%; "): ";
  INPUT TAB(30,5) "" ntrials%
  IF (ntrials% = 0) THEN
    ntrials% = default_ntrials%
    PRINT TAB(30,5); ntrials%
  ENDIF

  PRINT "trial duration ("; default_trial_duration%; " csecs): ";
  INPUT TAB(30,6) "" trial_duration%
  IF (trial_duration% = 0) THEN
    trial_duration% = default_trial_duration%
    PRINT TAB(30,6); trial_duration%
  ENDIF

  PRINT "forced interval ("; default_forced_interval%; " csecs): ";
  INPUT TAB(30,7) "" forced_interval%
  IF (forced_interval% = 0) THEN
    forced_interval% = default_forced_interval%
    PRINT TAB(30,7); forced_interval%
  ENDIF

  PRINT "limited hold ("; default_limited_hold%; " csecs): ";
  INPUT TAB(30,8) "" limited_hold%
  IF (limited_hold% = 0) THEN
    limited_hold% = default_limited_hold%
    PRINT TAB(30,8); limited_hold%
  ENDIF

  FOR box% = 1 TO nboxes%
    PRINT TAB(10, 13); SPC(44)
    PRINT TAB(10, 15); SPC(44)
    PRINT TAB(10, 17); SPC(44)
    PRINT TAB(10, 19); SPC(44)
    PRINT TAB(10, 21); SPC(44)
    PRINT TAB(10, 23); SPC(44)

    PRINT TAB(10, 11); "Box: "; box%
    INPUT TAB(10, 13) "Subject: " subject$(box%)
    INPUT TAB(25, 13) "Session: " session_number%(box%)

    IF (box% MOD 2)=0 THEN
      adjusted_lever$(box%)="L"
    ELSE
      adjusted_lever$(box%)="R"
    ENDIF

    PRINT TAB(10, 23); "Adjusted Lever (";adjusted_lever$(box%);")"
    INPUT TAB(48, 23) lever$
    CASE lever$ OF
      WHEN "L","l": adjusted_lever$(box%) = "L"
      WHEN "R","r": adjusted_lever$(box%) = "R"
      OTHERWISE:    REM leave it as it is, then!
                    PRINTTAB(48,23) adjusted_lever$(box%)
    ENDCASE

    PRINT TAB(10, 15); "Parameters";
    PRINT TAB(35, 15); "Unadj"; TAB(45, 15); "Adj"

    PRINT TAB(10, 17); "Delays: (";
    PRINT default_delay%(unadj%); ", "; default_delay%(adj%); ")";
    INPUT TAB(35, 17) unadj_delay%(box%)
    IF unadj_delay%(box%) = 0 THEN
      unadj_delay%(box%) = default_delay%(unadj%)
      PRINT TAB(35,17); unadj_delay%(box%);
    ENDIF
    INPUT TAB(45, 17) adj_delay%(box%)
    IF adj_delay%(box%) = 0 THEN
      adj_delay%(box%) = default_delay%(adj%)
      PRINT TAB(45,17); adj_delay%(box%);
    ENDIF
    IF adj_delay%(box%) < min_adjdelay% THEN adj_delay%(box%)=min_adjdelay%
    IF adj_delay%(box%) > max_adjdelay% THEN adj_delay%(box%)=max_adjdelay%

    PRINT TAB(10, 19); "Probabilities: (";
    PRINT default_prob(unadj%); ", "; default_prob(adj%); ")";
    INPUT TAB(35, 19) unadj_prob(box%)
    IF unadj_prob(box%) = 0 THEN
      unadj_prob(box%) = default_prob(unadj%)
      PRINT TAB(35, 19); unadj_prob(box%);
    ENDIF
    INPUT TAB(45, 19) adj_prob(box%)
    IF adj_prob(box%) = 0 THEN
      adj_prob(box%) = default_prob(adj%)
      PRINT TAB(45,19); adj_prob(box%);
    ENDIF

    PRINT TAB(10, 21); "Rewards: (";
    PRINT default_rewards%(unadj%); ", "; default_rewards%(adj%); ")";
    INPUT TAB(35,21) unadj_rewards%(box%)
    IF unadj_rewards%(box%) = 0 THEN
      unadj_rewards%(box%) = default_rewards%(unadj%)
      PRINT TAB(35,21); unadj_rewards%(box%);
    ENDIF
    INPUT TAB(45,21) adj_rewards%(box%)
    IF adj_rewards%(box%) = 0 THEN
      adj_rewards%(box%) = default_rewards%(adj%)
      PRINT TAB(45,21); adj_rewards%(box%);
    ENDIF

  NEXT box%
  CLS

  REM restore number formatting to normal
  @% = save%
ENDPROC

DEF PROCassign_lines
  FOR box% = 1 TO nboxes%
    IF adjusted_lever$(box%) = "L" THEN
      adj_lever%(box%)   = left_lever%(box%)
      unadj_lever%(box%) = right_lever%(box%)
      adj_light%(box%)   = left_light%(box%)
      unadj_light%(box%) = right_light%(box%)
      adj_press%(box%)   = left_press%(box%)
      unadj_press%(box%) = right_press%(box%)
    ELSE
      adj_lever%(box%)   = right_lever%(box%)
      unadj_lever%(box%) = left_lever%(box%)
      adj_light%(box%)   = right_light%(box%)
      unadj_light%(box%) = left_light%(box%)
      adj_press%(box%)   = right_press%(box%)
      unadj_press%(box%) = left_press%(box%)
    ENDIF
  NEXT
ENDPROC

DEF PROCcontrol_box
  TIME = 0
  PROCon_house_lights
  PROCpipe_timer(100, session_time%, 0, "FNend_expt(", 0, E%)
  PROCpipe_timer(0, 100, 100,"FNclock(", 1, E%)
  FOR box% = 1 TO nboxes%
    PROCpipe_fkey(box%+4, 0, 1, "FNkill_box(", box%, E%)
    PROCstart_trial(box%)
  NEXT box%
  PROCpipe_fkey(11, 0, 1, "FNend_expt(", 0, E%)
  PROCwait(E%): *AE
ENDPROC

DEF PROCon_house_lights
  FOR box% = 1 TO nboxes%
    PROCswitch_on(house_light%(box%), E%)
  NEXT box%
ENDPROC

DEF PROCend_expt
  FOR box% = 1 TO nboxes%
    PROCswitch_off(house_light%(box%), E%)
    PROCswitch_off(pellet_light%(box%), E%)
    PROCswitch_off(pellet_disp%(box%), E%)
    PROCswitch_off(left_lever%(box%), E%)
    PROCswitch_off(right_lever%(box%), E%)
    PROCswitch_off(left_light%(box%), E%)
    PROCswitch_off(right_light%(box%), E%)
  NEXT box%
  PROCstore_data
  IF debug%=0 THEN VDU 2
  REM *spoolon //only// appends to existing files;
  REM therefore this relies on PROCprint_config having created the file.
  OSCLI("SPOOLON "+logfile$) :REM SPOOLON //only// appends!
  PROCprint_data
  PROCprocess_responses
  PROCprint_responses
  OSCLI("SPOOLON")
  VDU 3
  OSCLI("SETTYPE "+logfile$+" TEXT")
  PROCkill_all
  END
ENDPROC

DEF PROCkill_box(box%)
  PROCswitch_off(house_light%(box%), E%)
  PROCswitch_off(pellet_light%(box%), E%)
  PROCswitch_off(pellet_disp%(box%), E%)
  PROCswitch_off(left_light%(box%), E%)
  PROCswitch_off(right_light%(box%), E%)
  PROCswitch_off(left_lever%(box%), E%)
  PROCswitch_off(right_lever%(box%), E%)
  boxes_finished% = boxes_finished% + 1
  IF boxes_finished% = nboxes% THEN PROCend_expt
ENDPROC

DEF PROCprocess_responses
  FOR box% = 1 TO nboxes%
    FOR trial% = 1 TO ntrials%
      FOR I% = 1 TO 4
        responses%(box%, measures%(box%, trial%, I%, resp%)) += 1
      NEXT I%
    NEXT trial%
  NEXT box%
ENDPROC

DEF PROCstart_trial(box%)
  IF trialnum%(box%) = ntrials% THEN
    PROCkill_box(box%)
  ELSE
    trialnum%(box%) += 1
    presentation%(box%) = 0
    forced_orders%(box%) = RND(2)
    PROCprint_trial_index(box%)
    PROCforced_interval(box%)
  ENDIF
ENDPROC

DEF PROCforced_interval(box%)
  presentation%(box%) += 1
  PROCswitch_on(pellet_light%(box%), E%)
  remain_ITI%(box%) = forced_interval%
  PROCprint_forced_interval(box%)
  IF presentation%(box%) = 5 THEN
    PROCprocess_choice(box%)
  ELSE: REM IF presentation%(box%) < 5 THEN
    PROCpipe_timer(box%, forced_interval%, 0, "FNgo_ahead(", box%, E%)
  ENDIF
ENDPROC

DEF PROCgo_ahead(box%)
  CASE presentation%(box%) OF
    WHEN 1:     IF (forced_orders%(box%) = 1) THEN
                  PROCshow_adj(box%)
                ELSE
                  PROCshow_unadj(box%)
                ENDIF

    WHEN 2:     IF (forced_orders%(box%) = 1) THEN
                  PROCshow_unadj(box%)
                ELSE
                  PROCshow_adj(box%)
                ENDIF

    WHEN 3,4:   PROCshow_choice(box%)

    OTHERWISE:  PRINT "Unexpected argument to PROCgo_ahead()"
  ENDCASE
ENDPROC

DEF PROCshow_adj(box%)
  PROCprint_waiting(box%)
  PROCprint_adj_lever(box%)
  PROCpipe_switch(adj_press%(box%), On, 1, "FNprocess_adj(", box%, E%)
  PROCswitch_on(adj_lever%(box%), E%)
  measures%(box%,trialnum%(box%), presentation%(box%), stim%) = adj%
  startClock%(box%) = TIME
  PROCpipe_timer(box%, limited_hold%, 0, "FNomission(", box%, E%)
ENDPROC

DEF PROCshow_unadj(box%)
  PROCprint_waiting(box%)
  PROCprint_unadj_lever(box%)
  PROCpipe_switch(unadj_press%(box%),On, 1, "FNprocess_unadj(", box%, E%)
  PROCswitch_on(unadj_lever%(box%), E%)
  measures%(box%,trialnum%(box%), presentation%(box%), stim%) = unadj%
  startClock%(box%) = TIME
  PROCpipe_timer(box%, limited_hold%, 0, "FNomission(", box%, E%)
ENDPROC

DEF PROCshow_choice(box%)
  PROCprint_waiting(box%)
  PROCprint_choice(box%)
  PROCpipe_switch(adj_press%(box%), On, 1, "FNprocess_adj(", box%, E%)
  PROCpipe_switch(unadj_press%(box%),On, 1, "FNprocess_unadj(", box%, E%)
  PROCswitch_on(adj_lever%(box%), E%)
  PROCswitch_on(unadj_lever%(box%), E%)
  measures%(box%,trialnum%(box%), presentation%(box%), stim%) = choice%
  startClock%(box%) = TIME
  PROCpipe_timer(box%, limited_hold%, 0, "FNomission(", box%, E%)
ENDPROC

DEF PROCprocess_adj(box%)
  measures%(box%,trialnum%(box%), presentation%(box%), resp%) = adj%
  measures%(box%,trialnum%(box%), presentation%(box%), latency%) = stopClock%(box%) - startClock%(box%)
  measures%(box%,trialnum%(box%),presentation%(box%),adjdelay%) = adj_delay%(box%)
  remain_ITI%(box%) += measures%(box%,trialnum%(box%), presentation%(box%), latency%)
  remain_ITI%(box%) += adj_delay%(box%)

  PROCswitch_on(adj_light%(box%), E%)
  PROCprint_adjusted_delay(box%)
  PROCprint_adj_press(box%)
  PROCprint_press_latency(box%)

  IF RND(1) <= adj_prob(box%) THEN
    measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = yes%
    IF adj_delay%(box%) > 0 THEN
      PROCpipe_timer(box%,adj_delay%(box%),0, "FNadj_pellet(", box%, E%)
    ELSE
      temp% = FNadj_pellet(box%, -1)
    ENDIF
  ELSE
    measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = no%
    IF adj_delay%(box%) > 0 THEN
      PROCpipe_timer(box%,adj_delay%(box%),0, "FNomit_pellet(", box%, E%)
    ELSE
      temp% = FNomit_pellet(box%, -1)
    ENDIF
  ENDIF
ENDPROC

DEF PROCprocess_unadj(box%)
  measures%(box%,trialnum%(box%), presentation%(box%), resp%) = unadj%
  measures%(box%,trialnum%(box%), presentation%(box%), latency%) = stopClock%(box%) - startClock%(box%)
  measures%(box%,trialnum%(box%), presentation%(box%), adjdelay%) = adj_delay%(box%)
  remain_ITI%(box%) += measures%(box%,trialnum%(box%),presentation%(box%), latency%)
  remain_ITI%(box%) += unadj_delay%(box%)

  PROCswitch_on(unadj_light%(box%), E%)
  PROCprint_fixed_delay(box%)
  PROCprint_unadj_press(box%)
  PROCprint_press_latency(box%)

  IF RND(1) <= unadj_prob(box%) THEN
    measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = yes%
    IF unadj_delay%(box%) > 0 THEN
      PROCpipe_timer(box%,unadj_delay%(box%),0,"FNunadj_pellet(",box%,E%)
    ELSE
      temp% = FNunadj_pellet(box%, -1)
    ENDIF
  ELSE
    measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = no%
    IF unadj_delay%(box%) > 0 THEN
      PROCpipe_timer(box%,unadj_delay%(box%),0,"FNomit_pellet(",box%, E%)
    ELSE
      temp% = FNomit_pellet(box%, -1)
    ENDIF
  ENDIF
ENDPROC

DEF PROComission(box%)
  measures%(box%,trialnum%(box%),presentation%(box%), resp%) = omission%
  measures%(box%,trialnum%(box%),presentation%(box%), latency%) = stopClock%(box%) - startClock%(box%)
  measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = no%
  measures%(box%, trialnum%(box%), presentation%(box%), adjdelay%) = adj_delay%(box%)
  remain_ITI%(box%) += measures%(box%,trialnum%(box%), presentation%(box%), latency%)
  PROCprint_omission(box%)
  PROCremaining_interval(box%)
ENDPROC

DEF PROCprocess_choice(box%)

  IF (measures%(box%,trialnum%(box%),3,resp%)=adj%) AND (measures%(box%,trialnum%(box%),4,resp%)=adj%) THEN
    REM adjusted lever chosen twice; increase adjusted delay
    adj_delay%(box%) = adj_delay%(box%) * (1+adjustment_change)
  ENDIF
  IF (measures%(box%,trialnum%(box%),3,resp%)=unadj%) AND (measures%(box%,trialnum%(box%),4,resp%)=unadj%) THEN
    REM unadjusted lever chosen twice; increase adjusted delay
    adj_delay%(box%) = adj_delay%(box%) * (1-adjustment_change)
  ENDIF

  REM One could argue about the algorithm.
  REM For example, with adjustment_change=0.2 (20% change),
  REM this code would go up from 100 to 120
  REM and down from 100 to 80,
  REM but down from 120 to 96 (rather than back to 100).
  REM If you wanted the latter, you'd multiple/divide by (1+adjchange).

  REM Now ensure it's within limits:
  IF adj_delay%(box%) < min_adjdelay% THEN adj_delay%(box%)=min_adjdelay%
  IF adj_delay%(box%) > max_adjdelay% THEN adj_delay%(box%)=max_adjdelay%

  PROCstart_trial(box%)
ENDPROC

DEF PROCremaining_interval(box%)
  remain_ITI%(box%) = trial_duration% - remain_ITI%(box%)
  PROCprint_remain_interval(box%)
  IF remain_ITI%(box%) < 10 THEN remain_ITI%(box%) = 10
  PROCpipe_timer(box%, remain_ITI%(box%),0, "FNforced_interval(", box%, E%)
ENDPROC

REM =================== OUTPUT PROCEDURE DEFINITIONS ========================

DEF PROCselect_and_open_file
  REPEAT
    CLS
    OSCLI("CAT")
    PRINT
    datafile$ = FNget_filename("DATA FILE - Filename for output")
    PRINT'
    PRINT "You selected a DATA file name of.."; datafile$
    choice$ = FNask_yes_no("Is this choice OK?")
  UNTIL choice$ = "Y" OR choice$ = "y"
  REPEAT
    CLS
    OSCLI("CAT")
    PRINT
    logfile$ = FNget_filename("TEXT LOGFILE - Filename for output")
    PRINT'
    PRINT "You selected a LOG file name of.."; logfile$
    choice$ = FNask_yes_no("Is this choice OK?")
  UNTIL (choice$ = "Y" OR choice$ = "y")
ENDPROC

DEF PROCprint_config
  CLS
  PROCdisplay_global_parameters
  PROCcontinue: CLS
  FOR box% = 1 TO nboxes%
    CLS: PRINT :PRINT
    PROCdisplay_box_parameters(box%)
    PROCcontinue
  NEXT box%
  CLS

  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)
  PRINT
  PROCdisplay_global_parameters
  FOR box% = 1 TO nboxes%
    PRINT:PRINT
    PROCdisplay_box_parameters(box%)
  NEXT
  OSCLI("SPOOL")
  VDU 3
ENDPROC

DEF PROCdisplay_global_parameters
  PRINT "Delayed reinforcement/probability program."
  IF debug%=1 THEN PRINT"***************** DEBUGGING ******************"
  PRINT "Date/timestamp:  " date_time$
  PRINT "Data file name:  " datafile$
  PRINT "Log file name:   " logfile$
  PRINT
  PRINT "session time:    " session_time%
  PRINT "ntrials:         " ntrials%
  PRINT "trial duration:  " trial_duration%
  PRINT "forced interval: " forced_interval%
  PRINT "limited hold:    " limited_hold%
ENDPROC

DEF PROCdisplay_box_parameters(box%)
  PRINT TAB(10); "Box: "; box%: PRINT
  PRINT TAB(10); "Subject: "; subject$(box%);
  PRINT TAB(25); "Session: "; session_number%(box%): PRINT
  PRINT TAB(10); "Parameters"; TAB(25); "Unadj"; TAB(35); "Adj"
  PRINT TAB(10); "Delays: ";
  PRINT TAB(25); unadj_delay%(box%); TAB(35); adj_delay%(box%)
  PRINT TAB(10); "Probabilities: ";
  PRINT TAB(25); unadj_prob(box%); TAB(35); adj_prob(box%)
  PRINT TAB(10); "Rewards: ";
  PRINT TAB(25); unadj_rewards%(box%); TAB(35); adj_rewards%(box%)
  PRINT TAB(10); "Adjusted Lever : ";
  PRINT TAB(50); adjusted_lever$(box%)
ENDPROC

DEF PROCcontinue
  PRINT TAB(0, 30); "PRESS ANY KEY TO CONTINUE......."
  IF GET
ENDPROC


DEFPROCscreen
  CLS
  COLOUR 7
  FOR Y%=1 TO 29 STEP13
    FOR X%=1 TO 79
      PRINT TAB(X%-1,Y%-1); "_"
    NEXT
  NEXT
  FOR Y%=2 TO 27
    FOR X%=1 TO 80 STEP39
      PRINT TAB(X%-1,Y%-1); "|"
    NEXT
  NEXT
  IF debug%=1 THEN COLOUR3:PRINTTAB(0,0);"*** DEBUGGING!!! ***";:COLOUR7

  FOR box%=1 TO nboxes%
    COLOUR7
    PROCbox(box%): PRINT TAB(X%+2, Y%+1);      "BOX "; box%
    COLOUR5:PRINTTAB(X%+29,Y%+1);"Pellets: ";
    COLOUR7:PRINTTAB(X%+2, Y%+3); "Subject: ";:COLOUR1:PRINTsubject$(box%)
    COLOUR7:PRINTTAB(X%+20,Y%+3); "Treatment: ";
    COLOUR7:PRINTTAB(X%+2, Y%+4); "Session:  ";:COLOUR1:PRINTsession_number%(box%)
    COLOUR7:PRINTTAB(X%+2, Y%+5); "Adjusted lever: ";adjusted_lever$(box%)
    COLOUR7:PRINTTAB(X%+2, Y%+6); "TRIAL:- ";:COLOUR3:PRINT"0"
    COLOUR7:PRINTTAB(X%+2, Y%+7); "STATUS:- ";:COLOUR3:PRINT"-";
    COLOUR7:PRINTTAB(X%+2, Y%+8); "STIMULUS:- ";:COLOUR3:PRINT"-"
    COLOUR7:PRINTTAB(X%+2, Y%+9); "RESPONSE:- ";:COLOUR3:PRINT"-"
    COLOUR7:PRINTTAB(X%+2, Y%+10);"PRESS LATENCY:- ";:COLOUR3:PRINT"-"
    COLOUR7:PRINTTAB(X%+2, Y%+11);"ADJUSTING DELAY:- ";:COLOUR3:PRINT"-"
    COLOUR7:PRINTTAB(X%+2, Y%+12);"STAGE OF TRIAL:- ";:COLOUR3:PRINT"0"
  NEXT
  COLOUR1:PRINTTAB(20, 28); "Press key 'F11' to abort entire session"
  COLOUR7
  PRINT TAB(25, 30); "Elapsed time:"; TAB(40, 30);"0"
  PRINTTAB(25,31); "Remaining:-";
ENDPROC

DEF PROCbox(box%)
     IF box% = 1 THEN X% = 0: Y% = 0: ENDPROC
     IF box% = 2 THEN X% = 39: Y% = 0: ENDPROC
     IF box% = 3 THEN X% = 0: Y% = 13: ENDPROC
     IF box% = 4 THEN X% = 39: Y% = 13: ENDPROC
ENDPROC

DEF PROCprint_free_pellet(box%)
  PROCbox(box%)
  COLOUR3:PRINT TAB(X%+11, Y%+7); "Free food"; "          ":COLOUR7
ENDPROC

DEF PROCprint_trial_index(box%)
  PROCbox(box%)
  COLOUR3:PRINT TAB(X%+10, Y%+6); trialnum%(box%):COLOUR7
ENDPROC

DEF PROCprint_remain_interval(box%)
  PROCbox(box%)
  COLOUR3:PRINT TAB(X%+11, Y%+7); "Timing out"; "          ":COLOUR7
ENDPROC

DEF PROCprint_forced_interval(box%)
  PROCbox(box%)
  COLOUR3
  PRINT TAB(X%+11, Y%+7); "Forced interval"; "     "
  PRINT TAB(X%+13, Y%+8); "-"; "                    "
  PRINT TAB(X%+13, Y%+9); "-"; "                    "
  PRINT TAB(X%+18, Y%+10); "-"; "     "
  PRINTTAB(X%+20,Y%+11); adj_delay%(box%); "     "
  PRINT TAB(X%+19, Y%+12); presentation%(box%); "     "
  PRINTTAB(X%+38,Y%+1);" ":REM pellet number!
  COLOUR7
ENDPROC

DEF PROCprint_waiting(box%)
  PROCbox(box%):COLOUR3:PRINTTAB(X%+11, Y%+7); "Wait for press"; "     ":COLOUR7
ENDPROC

DEF PROCprint_adj_lever(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+8); "Adj. lever"; "     ":COLOUR7
ENDPROC

DEF PROCprint_unadj_lever(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+8); "Unadj. lever"; "     ":COLOUR7
ENDPROC

DEF PROCprint_choice(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+8); "Choice of levers"; "     ":COLOUR7
ENDPROC

DEF PROCprint_pellet(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+11, Y%+7); "Pellet"; "    ":COLOUR7
ENDPROC

DEF PROCprint_no_pellet(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+11, Y%+7); "No pellet"; "    ":COLOUR7
ENDPROC

DEF PROCprint_adj_press(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+9); "Adj. press"; "          ":COLOUR7
ENDPROC

DEF PROCprint_unadj_press(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+9); "Unadj press"; "         ":COLOUR7
ENDPROC

DEF PROCprint_adjusted_delay(box%)
  PROCbox(box%):COLOUR3:PRINTTAB(X%+11, Y%+7); "Adjusting delay"; "          ":COLOUR7
ENDPROC

DEF PROCprint_fixed_delay(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+11, Y%+7); "Fixed delay"; "          ":COLOUR7
ENDPROC

DEF PROCprint_press_latency(box%)
  PROCbox(box%)
  COLOUR3:PRINT TAB(X%+18, Y%+10); measures%(box%, trialnum%(box%), presentation%(box%), 3); "          ":COLOUR7
ENDPROC

DEF PROCprint_omission(box%)
  PROCbox(box%):COLOUR3:PRINT TAB(X%+13, Y%+9); "Omission"; "          ":COLOUR7
ENDPROC

DEF PROCstore_data
  LOCAL ch%,save%,box%,trial%,pr%,d$
  save% = @%
  @% = "g0.0"
  ch% = OPENOUT(datafile$)

  PROCprint_line(ch%,"PROGNAME,DATE_TIME,RAT,BOX,ADJUSTEDLEVER,SESSION,TRIAL,PRESENTATION,STIMULUS,RESPONSE,LATENCY,ADJUSTEDDELAY,REWARDED")

  REM loops are box/trial/presentation-within-a-trial
  REM measures contains these (with 5 measures per presentation)
  REM Text values are coded as shown.

  FOR box% = 1 TO nboxes%
    d$=progname$+","+date_time$+","+subject$(box%)+","+STR$(box%)+","+adjusted_lever$(box%)+","+STR$(session_number%(box%))
    FOR trial% = 1 TO ntrials%
      FOR pr% = 1 TO 4
        REM date/time,rat,adjustedlever,box,session,trial,presentation
        PROCprint_string(ch%,d$+","+STR$(trial%)+","+STR$(pr%))

        REM stimulus, response, latency, adjusteddelay, rewarded
        PROCprint_string(ch%,","+stim_string$(measures%(box%,trial%,pr%,stim%)))
        PROCprint_string(ch%,","+resp_string$(measures%(box%,trial%,pr%,resp%)))
        PROCprint_string(ch%,","+STR$(measures%(box%,trial%,pr%,latency%)))
        PROCprint_string(ch%,","+STR$(measures%(box%,trial%,pr%,adjdelay%)))
        PROCprint_line(ch%,","+rew_string$(measures%(box%,trial%,pr%,rewarded%)))
       NEXT pr%
    NEXT trial%
  NEXT box%

  CLOSE#ch%
  @% = save%
ENDPROC

DEF PROCprint_data
  FOR box% = 1 TO nboxes%
    PRINT TAB(5); "Box: "; box%
    PRINT TAB(5); "------": PRINT
    FOR trial% = 1 TO ntrials%
      PRINT TAB(5); "Trial: " trial%; TAB(15); "Stimulus";
      PRINT TAB(24); "Response";
      PRINT TAB(34); "Latency"; TAB(44); "Adjusted Delay";
      PRINT TAB(60); "Rewarded"
      PRINT TAB(5); "--------"; TAB(15); "--------";
      PRINT TAB(24); "--------";
      PRINT TAB(34); "-------"; TAB(44); "--------------";
      PRINT TAB(60); "--------"
      FOR I% = 1 TO 4
        PRINT TAB(5); "Stage: "; I%;
        PRINT TAB(15); stim_string$(measures%(box%, trial%, I%, stim%));
        PRINT TAB(25); resp_string$(measures%(box%, trial%, I%, resp%));
        PRINT TAB(35); measures%(box%, trial%, I%, latency%);
        PRINT TAB(48); measures%(box%, trial%, I%, adjdelay%);
        PRINT TAB(60); rew_string$(measures%(box%, trial%, I%, rewarded%))
      NEXT I%: PRINT
    NEXT trial%: PRINT
  NEXT box%: PRINT: PRINT
ENDPROC

DEF PROCprint_responses
  PRINT TAB(15); "Trials"; TAB(25); "Adj."; TAB(35); "Unadj"; TAB(45); "Omissions"
  PRINT TAB(15); "------"; TAB(25); "----"; TAB(35); "-----"; TAB(45); "---------"
  FOR box% = 1 TO nboxes%
    PRINT TAB(5); "Box: "; box%;
    PRINT TAB(17); ntrials%;
    PRINT TAB(26); responses%(box%, adj%);
    PRINT TAB(37); responses%(box%, unadj%);
    PRINT TAB(49); responses%(box%, omission%)
    PRINT TAB(5); "------"
  NEXT box%: PRINT: PRINT

  PRINT "Tomorrow's starting values:"
  PRINT
  FOR box% = 1 TO nboxes%
    PRINT "Box "; box%; ": ("; subject$(box%); ") "; adj_delay%(box%)
  NEXT box%
  VDU 3
ENDPROC

REM ====================== FUNCTION DEFINITIONS =============================

DEF FNask_yes_no(question$)
     question$ = question$ + " (Y/N)?"
     REPEAT
          PRINT question$;
          choice$ = GET$
          PRINT choice$
     UNTIL (choice$ = "Y" OR choice$ = "N" OR choice$ = "y" OR choice$ = "n")
= choice$

DEF FNend_expt(junk%, R%)
     IF R% =0  =0
     PROCend_expt
=0

DEF FNkill_box(box%, R%)
     IF R%=0 =0
     PROCkill_box(box%)
=0

DEF FNclock(junk%, R%)
  IF R%=0 =0
  PRINT TAB(40, 30); "     "; TAB(40, 30); TIME DIV 100; " secs"
  PRINT TAB(40, 31); "         "; TAB(40, 31);
  LOCAL t%
  t% = tottime% - (TIME DIV 100)
  PRINTt%DIV60;" m ";t%MOD60;" s    ";
=0

DEF FNforced_interval(box%, R%)
     IF R%=0 =0
     PROCkill_timer(box%, E%)
     PROCforced_interval(box%)
=0

DEF FNremaining_interval(box%, R%)
     IF R%=0 =0
     PROCkill_timer(box%, E%)
     PROCremaining_interval(box%)
=0

DEF FNgo_ahead(box%, R%)
     IF R%=0 =0
     PROCkill_timer(box%, E%)
     PROCgo_ahead(box%)
=0

DEF PROCstop_things(box%)
  stopClock%(box%) = TIME
  PROCswitch_off(pellet_light%(box%), E%)
  PROCswitch_off(adj_lever%(box%), E%)
  PROCswitch_off(unadj_lever%(box%), E%)
  PROCkill_switch(adj_press%(box%), E%)
  PROCkill_switch(unadj_press%(box%), E%)
  PROCkill_timer(box%, E%)
ENDPROC

DEF FNprocess_adj(box%, R%)
  IF R%=0 =0
  PROCstop_things(box%)
  PROCprocess_adj(box%)
=0

DEF FNprocess_unadj(box%, R%)
  IF R%=0 =0
  PROCstop_things(box%)
  PROCprocess_unadj(box%)
=0

DEF FNomission(box%, R%)
  IF R%=0 =0
  PROCstop_things(box%)
  PROComission(box%)
=0

DEF FNadj_pellet(box%, R%)
  IF R%=0 =0
  LOCAL temp%
  PROCpellet_stop_things(box%)
  temp%=TIME
  PROCdispense_pellets(box%,adj_rewards%(box%))
  remain_ITI%(box%) = remain_ITI%(box%) + (TIME-temp%)
  PROCprint_pellet(box%)
  PROCremaining_interval(box%)
=0

DEF FNunadj_pellet(box%, R%)
  IF R%=0 =0
  LOCAL temp%
  PROCpellet_stop_things(box%)
  temp%=TIME
  PROCdispense_pellets(box%,unadj_rewards%(box%))
  remain_ITI%(box%) = remain_ITI%(box%) + (TIME-temp%)
  PROCprint_pellet(box%)
  PROCremaining_interval(box%)
=0

DEF PROCpellet_stop_things(box%)
  PROCkill_timer(box%, E%)
  PROCswitch_off(adj_light%(box%), E%)
  PROCswitch_off(unadj_light%(box%), E%)
ENDPROC

DEF PROCdispense_pellets(box%,numpellets%)
  PROCfast_pellet(pellet_disp%(box%),numpellets%)
  PROCprint_pellet_num(box%,numpellets%)
ENDPROC

DEF PROCprint_pellet_num(box%,n%)
  PROCbox(box%):COLOUR5:PRINTTAB(X%+38,Y%+1);n%:COLOUR7
ENDPROC

DEF FNomit_pellet(box%, R%)
  IF R%=0 =0
  PROCpellet_stop_things(box%)
  measures%(box%, trialnum%(box%), presentation%(box%), rewarded%) = no%
  PROCprint_no_pellet(box%)
  PROCprint_pellet_num(box%,0)
  PROCremaining_interval(box%)
=0