REM >TestExt
REM Test rats in extinction

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

progname$="TestExt"
version_date$="3 Mar 99"
left%=0:right%=1
no%=0:yes%=1

debug% = no%            :REM debugging? shortens all the times
printer_dead% = yes%   :REM printer broken? doesn't print

nbins% = 6
bintime% = 6000 :REM 1 minute

IF debug%=1 THEN
  nbins%=3
  bintime%=1000
ENDIF

REM ==================================
REM Pseudo-library calls
REM ==================================

PROCinit
PROCkill_all
PROCfelicity_boxes

REM ==================================
REM Variables... and go!
REM ==================================

DIM cocaine_lever%(nboxes%)
DIM sucrose_lever%(nboxes%)
DIM rat$(nboxes%)
DIM bin%(nboxes%)
DIM finished%(nboxes%)

PROCget_parameters

DIM cocaine_responses%(nboxes%,nbins%)
DIM sucrose_responses%(nboxes%,nbins%)
DIM cocaine_total%(nboxes%)
DIM sucrose_total%(nboxes%)

COLOUR 3
PRINT"Ready to run, press a key to start..."
COLOUR 7
IF GET

PROCpretty_screen
PROCstart_the_boxes
PROCwait(E%): *AE
END


REM *****************************************************

DEF PROCpretty_screen
  LOCAL box%
  MODE 12
  PRINT progname$;", by FM/RNC, ";version_date$;
  IF debug%=1 THEN
    COLOUR 3:PRINT" -- debugging!":COLOUR7
  ELSE
    PRINT
  ENDIF
  PRINT"Experiment: ";:COLOUR 1:PRINTexp_title$:COLOUR 7
  PRINT"Session: ";:COLOUR 1:PRINTsession_number%:COLOUR 7
  PRINT"Number of bins:     ";nbins%;" (of ";bintime%/6000;" min each)"
  PRINT"Started at:         ";TIME$
  PRINT"Press <Escape> to abort horribly. Can then use PROCoutput_results."

  PRINT''
  PRINT"RAT       BOX   BIN   Coc#(bin)  Suc#(bin)     Cocaine#(total)  Sucrose#(total)"
  PRINT"_______________________________________________________________________________"'
  REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
  display_firstline%=VPOS

ENDPROC

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

DEF PROCdisplay_box(box%)
  line% = FNdisplay_line(box%)
  COLOUR 1
  PRINTTAB(0,line%);rat$(box%);
  PRINTTAB(10,line%);box%;
  COLOUR 2
  PRINTTAB(16,line%);bin%(box%);
  COLOUR 7
  PRINTTAB(22,line%);cocaine_responses%(box%,bin%(box%));"   ";
  PRINTTAB(33,line%);sucrose_responses%(box%,bin%(box%));"   ";
  PRINTTAB(47,line%);cocaine_total%(box%);
  PRINTTAB(64,line%);sucrose_total%(box%);
ENDPROC

DEF PROCstart_the_boxes
  LOCAL box%
  FOR box%=1 TO nboxes%
    bin%(box%)=1
    finished%(box%)=no%
    PROCswitch_on(leftlevercontrol%(box%),E%)
    PROCswitch_on(rightlevercontrol%(box%),E%)
    PROCswitch_on(houselight%(box%),E%)
    IF cocaine_lever%(box%)=left% THEN
      PROCpipe_switch(leftlever%(box%),On,1,"FNcocaine_pressed(",box%,E%)
      PROCpipe_switch(rightlever%(box%),On,1,"FNsucrose_pressed(",box%,E%)
    ELSE
      PROCpipe_switch(rightlever%(box%),On,1,"FNcocaine_pressed(",box%,E%)
      PROCpipe_switch(leftlever%(box%),On,1,"FNsucrose_pressed(",box%,E%)
    ENDIF
    PROCpipe_timer(box%,bintime%,0,"FNbin_finished(",box%,E%)
  PROCdisplay_box(box%)
  NEXT
ENDPROC

DEF FNcocaine_pressed(box%,R%)
  IF R%=0 =0
  cocaine_responses%(box%,bin%(box%)) += 1
  cocaine_total%(box%) += 1
  PROCdisplay_box(box%)
=0

DEF FNsucrose_pressed(box%,R%)
  IF R%=0 =0
  sucrose_responses%(box%,bin%(box%)) += 1
  sucrose_total%(box%) += 1
  PROCdisplay_box(box%)
=0

DEF FNbin_finished(box%,R%)
  IF R%=0 =0
  bin%(box%) += 1
  REM We will not exit this procedure until bin has been checked against nbins,
  REM so are not vulnerable to a lever press going into a nonexistent bin.
  IF bin%(box%) > nbins% THEN
    finished%(box%)=yes%
    PROCkill_switch(leftlever%(box%),E%)
    PROCkill_switch(rightlever%(box%),E%)
    PROCswitch_off(leftlever%(box%),E%)
    PROCswitch_off(rightlever%(box%),E%)
    PROCswitch_off(houselight%(box%),E%)
    PROCcheck_finished
  ELSE
    PROCpipe_timer(box%,bintime%,0,"FNbin_finished(",box%,E%)
    PROCdisplay_box(box%)
  ENDIF
=0

DEF PROCcheck_finished
  LOCAL box%
  FOR box%=1 TO nboxes%
    IF finished%(box%)<>yes% THEN ENDPROC
  NEXT
  PROCkill_all
  PROCoutput_results
ENDPROC

DEF PROCget_parameters
  MODE 12:CLS
  LOCAL dummy
  dummy=RND(-TIME): REM seed random number generator
  PRINT progname$;", by FM/RNC, ";version_date$;
  IF debug%=1 THEN
    COLOUR 3:PRINT" -- debugging!":COLOUR7
  ELSE
    PRINT
  ENDIF
  exp_title$ = FNget_str_param("Experiment title: ","???")
  session_number% = FNget_num_param("Session number",0,0,1000)
  nbins% = FNget_num_param("Number of bins",nbins%,1,50)
  bintime% = FNget_num_param("Bin length (cs)",bintime%,500,360000)

  LOCAL box%
  PRINT
  FOR box%=1 TO nboxes%
    COLOUR3:PRINT"________________ BOX ";box%
    COLOUR 7
    rat$(box%) = FNget_str_param("Rat name: ","???")
    cocaine_lever%(box%) = FNget_num_param("Cocaine lever (0=left, 1=right)",left%,left%,right%)
    sucrose_lever%(box%) = 1 - cocaine_lever%(box%)
  NEXT

  PRINT''
  PRINT
  OSCLI("CAT")
  PRINT
  datafile$ = FNget_filename("DATA FILE - enter filename (no spaces etc.)")
  logfile$ = FNget_filename("TEXT LOG - enter filename (no spaces etc.)")
  date_time$ = FNdate_time_code
ENDPROC


DEF PROCfelicity_boxes
  nboxes% = 6
  nlines% = 10

  houselight_line% = 0
  dipper_line% = 1
  pump_line% = 2
  nosepoke_line% = 3
  leftlevercontrol_line% = 4
  rightlevercontrol_line% = 5
  leftlever_line% = 6
  rightlever_line% = 7
  leftlight_line% = 8
  rightlight_line% = 9

  REM Global variables defined.
  DIM nosepoke%(nboxes%), leftlever%(nboxes%), rightlever%(nboxes%)
  DIM houselight%(nboxes%)
  DIM leftlight%(nboxes%), rightlight%(nboxes%)
  DIM dipper%(nboxes%)
  DIM pump%(nboxes%)
  DIM leftlevercontrol%(nboxes%), rightlevercontrol%(nboxes%)

  LOCAL box%
  FOR box% = 1 TO nboxes%
    REM Assign switch lines to arrays
    nosepoke%(box%) = FNswitch_number(box%,nosepoke_line%,nboxes%)
    leftlever%(box%) = FNswitch_number(box%,leftlever_line%,nboxes%)
    rightlever%(box%) = FNswitch_number(box%,rightlever_line%,nboxes%)
    houselight%(box%) = FNswitch_number(box%,houselight_line%,nboxes%)
    leftlight%(box%) = FNswitch_number(box%,leftlight_line%,nboxes%)
    rightlight%(box%) = FNswitch_number(box%,rightlight_line%,nboxes%)
    dipper%(box%) = FNswitch_number(box%,dipper_line%,nboxes%)
    pump%(box%) = FNswitch_number(box%,pump_line%,nboxes%)
    leftlevercontrol%(box%) = FNswitch_number(box%,leftlevercontrol_line%,nboxes%)
    rightlevercontrol%(box%) = FNswitch_number(box%,rightlevercontrol_line%,nboxes%)

    REM Take control of output lines; watch input lines
    PROCfree_switch(nosepoke%(box%),E%)
    PROCfree_switch(leftlever%(box%),E%)
    PROCfree_switch(rightlever%(box%),E%)
    PROCgovn_switch(houselight%(box%),E%)
    PROCgovn_switch(dipper%(box%),E%)
    PROCgovn_switch(pump%(box%),E%)
    PROCgovn_switch(leftlevercontrol%(box%),E%)
    PROCgovn_switch(rightlevercontrol%(box%),E%)
    PROCgovn_switch(leftlight%(box%),E%)
    PROCgovn_switch(rightlight%(box%),E%)
  NEXT
ENDPROC


DEF PROCoutput_results
  IF printer_dead%=no% THEN VDU 2    :REM turn on printer
  CLS
  OSCLI("SPOOL "+logfile$)  :REM output to logfile
  PRINT"**********************************************************"
  PRINT"Results from !";progname$;" on ";TIME$
  PRINT"Experiment: ";exp_title$
  PRINT"Session number: ";session_number%
  PRINT"Date/time code: ";date_time$
  PRINT"Log filename: ";logfile$
  PRINT"Data filename: ";datafile$
  PRINT"Using ";nbins%;" bins of ";bintime%/6000;" min each."
  PRINT"**********************************************************"'

  LOCAL box%, bin%
  FOR box%=1 TO nboxes%
    PRINT
    PRINT"Box ";box%;". Rat: ";rat$(box%)
    PRINT"Cocaine total = ";cocaine_total%(box%);". Sucrose total = ";sucrose_total%(box%)
    PRINT"---------------------------------------------------------"
    PRINT"     Bin   Cocaine#   Sucrose#"
    REM   012345678901234567890123456789
    FOR bin%=1 TO nbins%
      PRINT TAB(5);bin%;TAB(11);cocaine_responses%(box%,bin%);TAB(22);sucrose_responses%(box%,bin%)
    NEXT
  NEXT
  OSCLI("SPOOL")
  OSCLI("SETTYPE "+logfile$+" TEXT")
  VDU 3                            :REM printer off, close file

  REM Now output raw data for importing into Access/Excel
  REM Times in seconds
  ch% = OPENOUT(datafile$)
  PROCprint_line(ch%,"PROGNAME,EXP_TITLE,RAT,SESSION_NUM,BOX,BIN,BINTIME,COCAINE,SUCROSE")
  FOR box%=1 TO nboxes%
    FOR bin%=1 TO nbins%
      PROCprint_string(ch%,progname$+","+exp_title$+","+rat$(box%)+","+STR$(session_number%)+","+STR$(box%)+","+STR$(bin%))
      PROCprint_line(ch%,","+STR$(bintime%)+","+STR$(cocaine_responses%(box%,bin%))+","+STR$(sucrose_responses%(box%,bin%)))
    NEXT
  NEXT
  CLOSE#ch%

  PRINT'"Finished at ";TIME$
ENDPROC

REM ****************
REM Rehashed version of FNdate_time_code
REM *************
DEF FNdate_time_code
  LOCAL t$
  t$ = TIME$
= MID$(t$,1,3)+"-"+MID$(t$,5,2)+MID$(t$,8,3)+MID$(t$,12,4)+"-"+MID$(t$,17,2)+MID$(t$,20,2)


REM ***********************************************
REM Rudolf's library code lives below.
REM ***********************************************

REM ========================================================================
DEF FNswitch_number(box%, line%, nboxes%)
REM ========================================================================
  REM use if boxes are wired
  REM all houselights/all traylights/...
= line%*nboxes% + box% - 1


REM ========================================================================
DEF PROCprint_line(channel%, string$)
REM ========================================================================
    PROCprint_string(channel%, string$)
    BPUT #channel%, 13         :REM finish with a new line.
    BPUT #channel%, 10         :REM PCs use CR, LF
ENDPROC


REM ========================================================================
DEF PROCprint_string(channel%, string$)
REM ========================================================================
    LOCAL i%
    IF LEN(string$)=0 THEN ENDPROC
    FOR i%=1 TO LEN(string$)
        BPUT #channel%, ASC(MID$(string$,i%,1))
    NEXT
ENDPROC

REM ========================================================================
DEF FNget_filename(prompt$)
REM ========================================================================
  LOCAL filename$
  REPEAT
    PRINTprompt$;
    INPUT filename$
  UNTIL FNfilename_valid(filename$)=1
=filename$

DEF FNfilename_valid(filename$)
  LOCAL X,Y

  IF LEN(filename$)=0 THEN =0

  IF LEN(filename$)>8 THEN
    PRINT "- 8 character maximum for ADFS->PC floppies, I'm afraid."
    REM I've had a nasty incident with this already and don't want another.
    =0
  ENDIF

  IF INSTR(filename$," ") <> 0 THEN
    PRINT "- Dozy today? I said no spaces."
    =0
  ENDIF

  X = OPENIN(filename$)
  IF X <> 0 THEN
    CLOSE#X:PRINT "- File exists, choose another."
    =0
  ENDIF

  LOCAL Y
  Y = OPENOUT(filename$)
  IF Y=0 THEN =0
  CLOSE#Y:OSCLI("DELETE "+filename$)
  REM A bad filename will crash the program, but never mind,
  REM it's not a crucial stage. Professional programming
  REM requires an ON ERROR statement. Oh well.
  REM 29-Jan-99: deleted the file (fed up with clearing up after
  REM programs that use this function and then are aborted).
=1


REM ========================================================================
DEF FNget_num_param(prompt$, default, min, max)
REM ========================================================================
  REM Allows default to be outside min-max range
  LOCAL x%,y%,r$,val
  PRINTprompt$;" [";default;"]: ";
  x%=POS:y%=VPOS
  REPEAT
    PRINTTAB(x%,y%);SPC(80-x%);TAB(x%,y%);
    INPUT""r$
    IF r$="" THEN =default ELSE val=VAL(r$)
  UNTIL val>=min AND val<=max
=val

REM ========================================================================
DEF FNget_str_param(prompt$, default$)
REM ========================================================================
  LOCAL r$
  PRINTprompt$;
  INPUT""r$
  IF r$="" THEN =default$ ELSE =r$

REM ========================================================================
DEF FNask_yes_no(prompt$)
REM ========================================================================
  REM Returns 1 for yes (rather than -1); 0 for no
  LOCAL g%
  PRINTprompt$;
  REPEAT
    g%=GET
    IF g%>=ASC"a" AND g%<=ASC"z" THEN g%-=32
  UNTIL g%=ASC"Y" OR g%=ASC"N"
  VDU g%
  IF g%=ASC"Y" =1
=0