REM >CapTrain
REM ========================================================================
REM FR1 training, with a cap on the total number of reinforcers.
REM ========================================================================
REM By Rudolf Cardinal.
REM First written 29 Jan 99.
REM ========================================================================

progname$="CapTrain"
version_date$="29 Jan 99"
debug%=0
simple%=0                   :REM Simplifies configuration as much as poss.

REM ========================================================================
REM Method
REM ========================================================================
REM
REM Houselight on. One lever only.
REM Levers are 'debounced' to 10 Hz max.
REM FR1.

REM ========================================================================
REM Revision History
REM ========================================================================
REM 29 Jan 99 - first version, derived from FVRIP.
REM             KNOWN PROBLEM: if multiple pellets are given, the behaviour
REM             when a lever is pressed during the inter-pellet interval
REM             is undefined.

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

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

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

session_time% = 30 * 60 * 100  :REM 30 minutes
nreinf% = 1 :REM pellets per reinforcement
IF debug%=1 THEN session_time% = 1 * 60 * 100 :REM 1 minute for debugging
pellet_gap% = 50 :REM 0.5s between multiple pellets
debounce_time% = 10 :REM debounce to 10 Hz max.

session_timer% = nboxes% * 0    :REM only one used!
pellet_timer% = nboxes% * 1
interval_timer% = nboxes% * 2
debounce_timer% = nboxes% * 3
clock_timer% = nboxes% * 4 + 1  :REM only one used!
left%=1:right%=2:DIM side$(2):side$(left%)="left": side$(right%)="right"

REM ========================================================================
REM Variables
REM ========================================================================

DIM ceiling%(nboxes%)          :REM maximum number of reinforcements allowed
DIM presscount%(nboxes%)       :REM number of presses
DIM reinfcount%(nboxes%)       :REM number of reinforcements
DIM subject$(nboxes%)          :REM subject name
DIM side%(nboxes%)             :REM left or right lever
DIM debouncing%(nboxes%)       :REM press invalid because <10cs since last
DIM finished%(nboxes%)         :REM reached ceiling and finished?

REM ========================================================================
REM Main
REM ========================================================================

dummy% = RND(-TIME)
PROCsay_hello
logfile$ = FNget_filename("TEXT LOG - enter filename (no spaces etc.)")
PROCget_parameters
PROCdisplay_screen
FOR i% = 1 TO nboxes%
  PROCstart_the_box(i%)
NEXT
PROCpipe_timer(session_timer%, session_time%, 0, "FNend_session(", 0, E%)
PROCpipe_fkey(12,0,1,"FNend_session(",0,E%)
start_time% = TIME
PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
PROCwait(E%): *AE
END

REM ========================================================================
REM Startup functions
REM ========================================================================

DEF PROCsay_hello
  MODE 12
  PRINT"CapTrain - capped FR1 training."
  PRINT"By Rudolf Cardinal. Version as of ";version_date$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT"----------------------------------------------------------------------"
  PRINT
ENDPROC


DEF PROCget_parameters
  COLOUR1
  PRINT "1. CHOOSE OVERALL PARAMETERS"
  PRINT "----------------------------":COLOUR7
  session_time%=60*100*FNget_num_param("Session time (min)",session_time%/(60*100),1,120)
  REM nreinf%=FNget_num_param("Number of pellets per reinforcement",1,1,10)

  COLOUR1:PRINT ''
  PRINT "2. PARAMETERS FOR EACH BOX"
  PRINT "--------------------------":COLOUR7
  LOCAL box%
  FOR box%=1 TO nboxes%
    COLOUR3:PRINT'"______________________________ BOX ";box%':COLOUR7
    subject$(box%) = FNget_str_param("Subject name: ","???")
    PRINT"Lever side (";left%;"=left, ";right%;"=right)";
    side%(box%)=FNget_num_param("",left%,left%,right%)
    ceiling%(box%)=FNget_num_param("Maximum number of reinforcers obtainable (0=infinite)",50,0,1000)
  NEXT

  COLOUR3
  PRINT''"3. ALL DONE."
  PRINT"------------"
  PRINT'"OK. Press a key to begin...";:COLOUR7:IFGET
ENDPROC


DEF PROCstart_the_box(box%)
  LOCAL lever%, levercon%
  IF side%(box%)=left% THEN
    lever%=leftlever%(box%)
    levercon%=leftlevercontrol%(box%)
  ELSE
    lever%=rightlever%(box%)
    levercon%=rightlevercontrol%(box%)
  ENDIF
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_on(levercon%,E%)
  PROCpipe_switch(lever%,On,1,"FNcapped_FR1(",box%,E%)
ENDPROC


DEF PROCreinforce(box%)
  PROCspaced_pellet(pellet%(box%),nreinf%,pellet_timer%+box%,pellet_gap%)
  reinfcount%(box%) += 1
ENDPROC


DEF FNend_session(dummy%, R%)
  IF R%=0 =0
  LOCAL box%
  FOR box% = 1 TO nboxes%
    PROCend_box(box%)
  NEXT
=0


DEF PROCend_box(box%)
  PROCkill_switch(leftlever%(box%),E%)
  PROCkill_switch(rightlever%(box%),E%)
  PROCswitch_off(houselight%(box%),E%)
  PROCswitch_off(leftlevercontrol%(box%),E%)
  PROCswitch_off(rightlevercontrol%(box%),E%)
  PROCswitch_off(pellet%(box%),E%)
  finished%(box%) = 1

  LOCAL t%
  FOR t%=1 TO nboxes%
    IF finished%(t%) <> 1 THEN ENDPROC
  NEXT

  PROCkill_all
  PROCeverything_finished
ENDPROC


DEF PROCeverything_finished
  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)  :REM output to disk
  PROCreport_results
  OSCLI("SPOOL")
  OSCLI("SETTYPE "+logfile$+" TEXT") :REM set file type
  VDU 3
ENDPROC


DEF PROCdisplay_screen
  CLS
  PRINT progname$; " - capped FR1 training."
  PRINT"Rudolf Cardinal. Version date: ";version_date$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT "Press F12 to abort the whole session."'
  PRINT "Session time: ";session_time%DIV6000;" min ";(session_time%MOD6000)DIV100;" sec"
  PRINT "Number of pellets per reinforcement: ";nreinf%
  IF nreinf%>1 THEN PRINT "  - interpellet time ";pellet_gap%;" cs"
  COLOUR 4:PRINT '"Time remaining: ";:COLOUR 7:clockx%=POS:clocky%=VPOS
  PRINT''
  REM   012345678901234567890123456789012345678901234567890123456789012345678
  PRINT"Box    Ceiling       Side    #Presses   #Reinf   Subject"
  PRINT"_____________________________________________________________________"
  display_firstline%=VPOS
  LOCAL box%, y%
  FOR box%=1 TO nboxes%
    y%=FNdisplay_line(box%)
    PRINTTAB(0,y%);box%;
    PRINTTAB(7,y%);ceiling%(box%);
    PRINTTAB(21,y%);side$(side%(box%));
    PROCupdate_box_display(box%)
    PRINTTAB(49,y%);subject$(box%);
  NEXT
ENDPROC


DEF PROCupdate_box_display(box%)
  LOCAL y%
  y%=FNdisplay_line(box%)
  PRINTTAB(29,y%);presscount%(box%);
  PRINTTAB(40,y%);reinfcount%(box%);
ENDPROC


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


DEF PROCreport_results
  LOCAL box%
  CLS
  PRINT progname$;" - completed at ";TIME$
  PRINT"________________________________________________________"''
  PRINT "Session time: ";session_time%DIV6000;" min ";(session_time%MOD6000)DIV100;" sec"
  PRINT "Number of pellets per reinforcement: ";nreinf%
  IF nreinf%>1 THEN PRINT "  - interpellet time ";pellet_gap%;" cs"
  PRINT'
  PRINT"Box    Ceiling      Side    #Presses   #Reinf   Subject"
  PRINT"________________________________________________________"
  REM  012345678901234567890123456789012345678901234567890123456789
  FOR box% = 1 TO nboxes%
    PRINTTAB(0);box%;TAB(7);ceiling%(box%);
    PRINTTAB(21);side$(side%(box%));
    PRINTTAB(29);presscount%(box%);
    PRINTTAB(40);reinfcount%(box%);" (";FNfood_mass(reinfcount%(box%));"g)";
    PRINTTAB(58);subject$(box%)
  NEXT
  PRINT''
ENDPROC


DEF PROCdebounce(box%)
  debouncing%(box%)=1
  PROCpipe_timer(debounce_timer%+box%,debounce_time%,0,"FNdebounce2(",box%,E%)
ENDPROC


DEF FNdebounce2(box%,R%)
  IF R%=0 =0
  debouncing%(box%)=0
=0


DEF FNclock_tick(dummy%,R%)
  IF R%=0 =0
  LOCAL t%
  t% = session_time% - (TIME - start_time%)
  COLOUR4:PRINTTAB(clockx%,clocky%);t%DIV6000;" min ";(t%MOD6000)DIV100;" sec     ":COLOUR7
=0


REM ========================================================================
REM Lever-press functions for individual schedules
REM ========================================================================

DEF FNcapped_FR1(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  PROCreinforce(box%)
  PROCupdate_box_display(box%)
  IF ceiling%(box%)<>0 AND reinfcount%(box%)>=ceiling%(box%) THEN PROCend_box(box%)
=0