# --------------------------------------------------------------------------
# Initialization script for testing SICS
#
# Started: Dr. Mark Koennecke, July 2006
#---------------------------------------------------------------------------
#                        O P T I O N S

# --------------- Initialize Tcl internals --------------------------------

# first all the server options are set

ServerOption ReadTimeOut  10
# timeout when checking for commands. In the main loop SICS checks for
# pending commands on each connection with the above timeout, has 
# PERFORMANCE impact!

ServerOption AcceptTimeOut  10 
# timeout when checking for connection req.
# Similar to above, but for connections

ServerOption ReadUserPasswdTimeout  500000 
# time to wiat for a user/passwd to be sent from a client. Increase this
# if there is a problem connecting to a server due to network overload\

ServerOption ServerPort 2911
# the port number the server is going to listen at. The client MUST know
# this number in order to connect. It is in client.ini

ServerOption InterruptPort 2913
# The UDP port where the server will wait for Interrupts from clients.
# Obviously, clients wishing to interrupt need to know this number.


#---------------------------------------------------------------------------
#                        U S E R S

# than the SICS users are specified
# Syntax: SicsUser name password userRightsCode
SicsUser Mugger Mugger  1
SicsUser User   User      2
#SicsUser Spy    Spy       3
SicsUser Spy    007       1

#----------------- SICS Variable
VarMake lotte Text User

#----------------- Motors ---------------------------------------------------
Motor brumm regress
MakeDrive
#----------------- Alias ----------------------------------------------------
SicsAlias brumm miau
#----------------- Counters -------------------------------------------------
MakeCounter aba regress
MakeCounter hugo SIM -1.
MakeCounter lieselotte SIM -1.
#------------------------------
proc SICSValue {command} {
	set txt [eval $command]
	set l [split $txt =]
	return [string trim [lindex $l 1]]
}
#-----------------------------
proc multitransfer {} {
    append res [SICSValue "aba gettime"] " "
    for {set i 0} {$i < 7} {incr i} {
	append res [SICSValue "aba getmonitor $i"] " "
    } 
    return $res
}
#-----------------------------------
MakeMultiCounter multi aba hugo lieselotte
multi transferscript multitransfer

#------------- For Scanning ---------------------------------------------
# This is with the tricky bit set: we use a multicounter and use the 
# scantransfer function to return values of a gaussian for a4 positions.
# This gives nice scan data which can be used to test all sorts of things.
#-------------------------------------------------------------------------
MakeDataNumber SicsDataNumber ./DataNumber
VarMake SicsDataPath Text Mugger
SicsDataPath ./
SicsDataPath lock
VarMake SicsDataPrefix Text Mugger
SicsDataPrefix regression
SicsDataPrefix lock
VarMake SicsDataPostFix Text Mugger
SicsDataPostFix .dat
SicsDataPostFix lock

Motor a1 SIM   -2 180 -.1 10
Motor a2 SIM  30  150 -.1 10
Motor a3 SIM -360 360 -.1 10
Motor a4 SIM -180 180 -.1 10
Motor a5 SIM -180 180 -.1 10
Motor a6 SIM -180 180 -.1 10
Motor sgu SIM -20 20 -.1 10
Motor sgl SIM -20  20 -.1 10
MakeMultiCounter scanCter aba

proc scantransfer {} {
    set FWHM 1.5
    set pos 5.33
    set height 700
    set stddev [expr $FWHM/2.354]
    set ftmp [expr ([SICSValue a4] - $pos)/$stddev]
    set count [expr 10 + $height*0.4*exp(-.5*$ftmp*$ftmp)]
    set counti [expr int($count)]
    append res [SICSValue "lieselotte gettime"] " "
    append res $counti " "
    for {set i 1} {$i < 7} {incr i} {
	append res [SICSValue "lieselotte getmonitor $i"] " "
    } 
    return $res
}
scancter transferscript scantransfer

MakeScanCommand xxxscan scancter test.hdd recover.bin
MakePeakCenter  xxxscan
source scancommand.tcl
MakeOptimise opti scancter
MakeMaximize scancter

#-------------------------------------------------------------------------
# Histogram Memory 
#------------------------------------------------------------------------
MakeHM hm regress
hm configure rank 1
hm configure dim0 23
hm configure testval 1
hm configure errortype 0
hm configure recover 1
hm configure init 1
hm init

MakeHM tof regress
tof configure rank 1
tof configure HistMode  TOF
tof configure dim0 23
tof configure testval 1
tof configure errortype 0
tof configure recover 1
tof genbin 10 12 100
tof configure init 1
tof init

#-------------------------------------------------------------------------
# NXscript
#-------------------------------------------------------------------------
MakeNXScript
#-------------------------------------------------------------------------
proc makearray {} {
    global ar
    for { set i 10} {$i < 20} {incr i} {
	set ar([expr $i - 10]) [expr $i*1.0]
    }
}
#------------------------------------------------------------------------
proc makeintarray {} {
    global ar
    for { set i 10} {$i < 20} {incr i} {
	set ar([expr $i - 10]) $i
    }
}
Publish makearray User
Publish makeintarray User
Publish parray User

#------------------------------------------------------------------------
# SicsData
#------------------------------------------------------------------------
sicsdatafactory new data
sicsdatafactory new duta
#-----------------------------------------------------------------------
# tasub 
#-----------------------------------------------------------------------
MakeTasUB tasub
#-----------------------------------------------------------------------
# MultiMotors
#----------------------------------------------------------------------
MakeMulti sa
sa alias  a3 om
sa alias  a4 stt
sa pos noeff a3 24 a4 48
sa endconfig

#-----------------------------------------------------------------------
# Hipadaba
#----------------------------------------------------------------------
InstallHdb
hmake /instrument spy none
hmake /instrument/sample spy none
hattach /instrument/sample a3 omega
hattach /instrument/sample qh qh
hmake /instrument/detector spy none
hattach /instrument/detector  hm data  
hattach /instrument  lotte title  

restore

#-------------------------------------------------
proc farmFormat {par num} {
    hsetprop /sics/farm/$par lastError none
    return [format "$par %d" [string trim $num]] 
}
#-----------------------------------------------
proc farmRead {par } {
    hsetprop /sics/farm/$par lastError none
    hsetprop /sics/farm/$par replyCommand "farmReply $par"
    return $par
}
#-----------------------------------------------
proc farmReply {par reply} {
    set action [string trim [hgetpropval /sics/farm/$par status]]
    hsetprop /sics/farm/$par status idle
    if {[string first OK $reply] >= 0} {
	if {[string first get $action] >= 0} { 
	    set idx [string first : $reply]
	    if {$idx > 0} {
		set val [string trim [string range $reply [expr $idx +1] end]]
		hupdate /sics/farm/$par $val
	    }
	} else {
	    hget /sics/farm/$par
	}
    } else {
	if {[string first ERROR $reply] < 0} {
	    set reply "ERROR: $reply"
        }
	clientPut $reply
	error $reply
    }
}
#=============================================
proc schconset {val} {
    set com [farmFormat schnegge $val]
    hsetprop /sics/farm/schneggecon replyCommand schreply
    return $com
}
#----------------------------------------------
proc schreply {reply} {
    clientput "schreply $reply"
    if {[string first OK $reply] >= 0} {
	hsetprop /sics/farm/schneggerunning readCommand schrunget
	hget /sics/farm/schneggerunning
	hsetprop /sics/farm/schneggerunning readCommand \
	    "farmReply schneggerunning"
    } else {
	hsetprop /sics/farm/schneggecon status idle
	hsetprop /sics/farm/schneggecon lastError $reply
	clientput "ERROR: $reply on schnegge"
    }
}
#-----------------------------------------------
proc schrun {reply} {
    clientput "schrun $reply"
    hsetprop /sics/farm/schneggerunning status idle
    if {[string first OK $reply] >= 0} {
	set idx [string first : $reply]
	if {$idx > 0} {
	    set val [string trim [string range $reply [expr $idx +1] end]]
	    hupdate /sics/farm/schneggerunning $val
	    if {$val == 1} {
		clientput "schnegge creeping"
		hsetprop /sics/farm/schneggerunning readCommand schrunget
		hget /sics/farm/schneggerunning
		hsetprop /sics/farm/schneggerunning readCommand \
		    "farmReply schneggerunning"
	    } else {
		clientput "schnegge finished"
		hsetprop /sics/farm/schneggerunning readCommand \
		    "farmRead schneggerunning"
		hsetprop /sics/farm/schneggecon status idle
            }
        }
    } else {
	clientput "schnegge has error: $reply"
	hsetprop /sics/farm/schneggerunning readCommand \
		    "farmRead schneggerunning"
	hsetprop /sics/farm/schneggecon status idle
	hsetprop /sics/farm/schneggecon lastError $reply
	hsetprop /sics/farm/schneggerunning lastError $reply
    }
}
#----------------------------------------------
proc schget {} {
    hsetprop /sics/farm/schneggecon lastError none
    hsetprop /sics/farm/schneggecon replyCommand "farmReply schneggecon"
    return schnegge
}
#----------------------------------------------
proc schrunget {} {
    hsetprop /sics/farm/schneggerunning lastError none
    hsetprop /sics/farm/schneggerunning replyCommand schrun
    return schneggerunning
}
#-----------------------------------------------
set farm 0
if {$farm == 1} {
# Generic Controller
#-------------------------------------------------------------------
MakeAsyncProtocol norma
MakeAsyncQueue farmQueue norma localhost 9090
MakeGenController farm
genconfigure asynconnect farm farmQueue
#------------------------------------------------
genconfigure makepar farm hase int
hsetprop /sics/farm/hase priv user
hsetprop /sics/farm/hase writeCommand "farmFormat hase" 
hsetprop /sics/farm/hase readCommand   "farmRead hase"
hsetprop /sics/farm/hase replyCommand  "farmReply hase" 

genconfigure makepar farm schnegge int
hsetprop /sics/farm/schnegge priv user
hsetprop /sics/farm/schnegge writeCommand "farmFormat schnegge" 
hsetprop /sics/farm/schnegge readCommand   "farmRead schnegge"
hsetprop /sics/farm/schnegge replyCommand  "farmReply schnegge" 

genconfigure makepar farm schneggerunning int
hsetprop /sics/farm/schneggerunning priv internal
hsetprop /sics/farm/schneggerunning readCommand   "farmRead schneggerunning"
hsetprop /sics/farm/schneggerunning replyCommand  "farmReply schneggerunning" 

genconfigure makepar farm schneggecon int
hsetprop /sics/farm/schneggecon priv user
hsetprop /sics/farm/schneggecon writeCommand  schconset 
hsetprop /sics/farm/schneggecon readCommand   schget
hsetprop /sics/farm/schneggecon replyCommand  schreply
}

set farm 0

if {$farm == 1} {
#-------------- Test new async protocol controller
makesctcontroller farmser std localhost:7070
MakeSICSObj farm TestObj
#---------------------------
proc farmparcom {par} {
    sct send $par
    return parread
}
#------------------------
proc farmparread {} {
    set rply [sct result]
    if {[string first ERR $rply] >= 0} {
	sct geterror $rply
	return idle
    }
    set data [string range $rply 3 end]
    set node [sct]
    sct update $data
    return idle
}
#--------------------------
proc farmcheck {} {
    set val [sct target]
    if {$val < -100 || $val > 100} {
	error "Value out of range"
    }
    return OK
}
#---------------------------
proc farmset {par} {
    set val [sct target]
    sct send "$par $val"
    return setreply
}
#-------------------------
proc farmsetreply {} {
    set rply [sct result]
    if {[string first ERR $rply] >= 0} {
	sct print $rply
    }
    return idle
}
#--------------------------
hfactory /sics/farm/hase plain spy int  
hsetprop /sics/farm/hase read farmparcom hase
hsetprop /sics/farm/hase parread farmparread

hsetprop /sics/farm/hase check farmcheck
hsetprop /sics/farm/hase write farmset hase
hsetprop /sics/farm/hase setreply farmsetreply

farmser poll /sics/farm/hase
farmser write /sics/farm/hase

hfactory /sics/farm/hugo plain spy int  
hsetprop /sics/farm/hugo read farmparcom hugo
hsetprop /sics/farm/hugo parread farmparread

hsetprop /sics/farm/hugo check farmcheck
hsetprop /sics/farm/hugo write farmset hugo
hsetprop /sics/farm/hugo setreply farmsetreply

farmser poll /sics/farm/hugo
farmser write /sics/farm/hugo

hfactory /sics/farm/schnegge plain spy float  
hsetprop /sics/farm/schnegge read farmparcom schnegge
hsetprop /sics/farm/schnegge parread farmparread

hsetprop /sics/farm/schnegge check farmcheck
hsetprop /sics/farm/schnegge write farmset schnegge
hsetprop /sics/farm/schnegge setreply farmsetreply

farmser poll /sics/farm/schnegge
farmser write /sics/farm/schnegge

hfactory /sics/farm/schneggerunning plain spy int  
hsetprop /sics/farm/schneggerunning read farmparcom schneggerunning
hsetprop /sics/farm/schneggerunning parread farmparread
farmser poll /sics/farm/schneggerunning

hfactory /sics/farm/stone plain spy int  
hsetprop /sics/farm/stone read farmparcom stone
hsetprop /sics/farm/stone parread farmparread
#farmser poll /sics/farm/stone

farmser debug -1

#----------------- drivable scriptcontext adapter
proc schneggechecklimits {} {
    return [farmcheck]
}
#-----------------------------
proc schneggestatus {} {
    farmser queue /sics/farm/schneggerunning progress read
    set status [sct writestatus]
    switch $status {
	commandsent {
	    set runtime [SICSValue "hgetprop /sics/farm/schneggerunning read_time"]
	    set starttime [sct write_time]
	    if {$runtime > $starttime} {
		sct writestatus evalcheck
	    }
	    return busy
	}
	evalcheck {
	    set tst [hval /sics/farm/schneggerunning]
	    if {$tst == 1} {
		return busy
	    } else {
		return idle
	    }
	}
	default {
	    error "schneggestatus called in bad state $status"
	}
    }
}
#---------------------------------------------
hsetprop /sics/farm/schnegge checklimits schneggechecklimits
hsetprop /sics/farm/schnegge checkstatus schneggestatus
#makesctdrive schnecke /sics/farm/schnegge farmser
makesctdriveobj schnecke /sics/farm/schnegge DriveAdapter farmser

}

#---------- test http
set httptest 1

if {$httptest == 1} {
makesctcontroller amorhmsct sinqhttp amorhm data 180 spy 007
#makesctcontroller amorhmsct sinqhttp localhost:8080 data 60 spy 007
MakeSICSObj amorhm HttpTest
amorhmsct debug -1
#------------------
proc statget {} {
    sct send "admin/textstatus.egi"
    return statrepl
}
#----------------- 
proc statreply {} {
    sct update [sct result]
    sct utime readtime
    return idle
}
#-----------------
proc readcollapse {} {
    sct send "admin/processhmdata.egi?bank=0&command=sum:2:0:400"
    return colread
}
#-----------------
proc colreply {} {
    sct utime readtime
    set data [sct result]
    return idle
}
#-------------------------
hfactory /sics/amorhm/status plain spy text
hsetprop /sics/amorhm/status read statget
hsetprop /sics/amorhm/status statrepl statreply
amorhmsct poll /sics/amorhm/status 10

hattach /sics/amorhm data intvarar collapse
hsetprop /sics/amorhm/collapse read readcollapse
hsetprop /sics/amorhm/collapse colread colreply
amorhmsct poll /sics/amorhm/collapse 20

}

#source sansdruck.tcl


#MakeRS232Controller sadu pc4639 4168
#MakeRS232Controller sadu localhost 4168
#sadu replyterminator 0x04
#sadu sendterminator  0x04
#sadu timeout 1000

#source ../sim/mars/julcho.tcl