-- Thomas Gamper, CH-Diessenhofen Dec 2009/Jan 2010 -- This is a winsock TCP server. It is programmed for the very simple -- ProfiLab/RealView telegram, which essentially exchanges 80bit extended float values. -- It implements the transponder mode "ProfiLab mode" and the active sender mode "RealView mode" -- This server results for ProfiLab as a "Euphoria-in-the-loop" appliction. -- It can be used to process the received floats and to send processed values back to ProfiLab. -- As a formal processing environment, it extends ProfiLabs graphical programming features and can be a great add-on value. --with trace include win32lib.ew include misc.e include H:\\ablage\\euphoria\\networking\\eunet.1.3.2\\eunet.e -- this library has been modified by tga include machine.e object junk without warning constant Win = create( Window, "Server to ProfiLab and RealView", 0, 20, 20, 800, 310, 0 ), status_bar = create(StatusBar, "", Win, 0, {60,-1}, 0, 0, 0), -- two status fields, the first holding 50 pixels ConnButton = create( PushButton, "server mode", Win, 20, 20, 90, 30, 0 ), SendTextEdit = create( EditText, "00 0000 0000", Win, 20, 80, 150, 25, 0 ), ResultText = create( EditText, "", Win, 20, 180, 150, 25, 0 ), SendButton = create( PushButton, "puts text", Win, 20, 120, 90, 30, 0), ClearButton = create( PushButton, "clear", Win, 250, 235, 90, 20, 0), MonitorButton = create( PushButton, "monitor", Win, 400, 235, 90, 20, 0), server_text_out = create(RichEdit, "", Win, 250, 30, 300, 200, ES_AUTOHSCROLL), status_out = create(RichEdit, "", Win, 550, 30, 200, 200, ES_AUTOHSCROLL) atom hserver_name, hConv, htopic_name, idInstance, hitem_1_name, count, hitem_1_data, hadv_data atom RealView_sel, t, status_tab, status_line, asel_flag, monitor hConv = 0 count = 0 hadv_data = 0 RealView_sel = 0 t = 1 status_tab = 1 status_line = 1 monitor = 0 sequence variable_1 --variable_1 = {1.23,21.34,3.5,5.98,7.76,9.999} sequence client_to_server_var, server_to_client_var, server_to_client_var_sel, status_txt, server_txt, client_txt client_to_server_var = repeat(0,256) -- these sequences hold the Euphoria <-> ProfiLab State Variables server_to_client_var = repeat(0,256) server_to_client_var_sel = {1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} -- these bits enable sending from server to client status_txt = {} server_txt = {} client_txt = {} atom WSAstatus, listen_socket, i sequence inet_address inet_address = "127.0.0.1: 30000" -- all clients must connect to -- this server directive sequence new_socket new_socket = {} sequence connections connections = {} -- list of all connected clients -- clears the GUI displays -- ***************************************************************** procedure status_clr( integer id, integer event,sequence params) asel_flag = autoSelect(status_out, w32True) clear(status_out) asel_flag = autoSelect(server_text_out, w32True) clear(server_text_out) setFocus(server_text_out) end procedure -- switches monitor on/off: monitoring can load CPU considerably ! -- ***************************************************************** procedure monitor_toggle( integer id, integer event,sequence params) if monitor = 1 then monitor = 0 status_txt = "monitor off\n" appendText(status_out, status_txt) else monitor = 1 status_txt = "monitor on\n" appendText(status_out, status_txt) end if setFocus(server_text_out) end procedure -- toggle "RealView Mode" from GUI: start/stop timer, which calls "periodic_server()" -- ***************************************************************** procedure RealView_mode( integer id, integer event,sequence params) if length(connections) > 0 then -- make sure at least one client is connected if RealView_sel = 0 then RealView_sel = 1 setTimer( Win, 1, 100 ) -- time base for auto send of data to RealView (calling "periodic_server") setText({status_bar,1}, "RealView") status_txt = "RealView mode selected\n" appendText(status_out, status_txt) else killTimer(Win, 1) RealView_sel = 0 setText({status_bar,1}, "ProfiLab") status_txt = "ProfiLab mode selected\n" appendText(status_out, status_txt) end if end if end procedure -- ProfiLab TCP-Protocol: analyzed with TCPViewer -- every transaction is 16 bytes constant in length, LSB first -- Transactions are triggered dynamically: only on value change -- for "analog mode": 10 bytes = 80bit extended float (as represented in Delphi) -- "channel" nr is coded in byte 12 (0..255) for the same port and IP address -- example: CD CC CC CC CC CC CC CC FB 3F 00 07 00 00 00 00 (adresses channel 7) -- byte 11 is used by client to toggle between 0 and 1 while connecting to server: (not needed) -- 32 bytes are sent to the server or two 16byte messages (not needed) -- for "digital mode": the 16bit coded equivalent is transmitted via extended float. Range:[0.1 up to 65535.1] -- I have not made out the reason for the decimal fraction (0.1) while sending digital equivalents -- As strings are not handled via TCP up to date: digital transmission mode may be used to xfer 4 chars at the time -- if using this application in "RealView mode": -- RealView is a "silent" client, so the server must actively send a series of packets. -- Keep in mind: the timebase of the Euphoria application becomes the signal sample rate ! -- However, RealView resamples incoming data with its own setting. -- Unappropriate setting of RealView sampling rate may cause aliasing to the signal ! -- "RealView mode" can be used in ProfiLab, when the client does not use its TX input (then it does not actively -- sends own data), so active sending from server to the client is necessary -- The pen amplitudes are passed to RealView as extended floats (10bytes) plus 4 additional bytes -- The pen numbers in RealView are adressed with byte12 of each 16byte packet -- The present Euphoria application is a single server, -- yet multiple clients can connect to the server (not limited only to ProfiLab) -- Data response is specific to the clients requests -- Every client requests (forwards) data to this application, which is saved into a sequence. -- It is specific to an application, if some computation takes place between each transaction (receiving from a client and -- responding to the server), or if all existent client requests are awaited, and all answers are sent after computation -- 08.01.2010 11:51:43.312; 564: Client connected; 127.0.0.1:1876 -- 08.01.2010 11:51:43.312; 564: Connecting to Server -- 08.01.2010 11:51:43.546; 564: Client to Server (16 bytes) -- 0000 00 00 00 00 00 00 00 00 00 00 00 07 00 00 00 00 ................ -- 08.01.2010 11:51:43.546; 564: Client to Server (16 bytes) -- 0000 00 00 00 00 00 00 00 00 00 00 01 07 00 00 00 00 ................ -- 08.01.2010 11:51:43.765; 564: Connected to Server -- 08.01.2010 11:51:43.765; 564: Server to Client (16 bytes) -- 0000 CD CC CC CC CC CC CC CC FB 3F 00 07 00 00 00 00 .........?...... -- 08.01.2010 11:52:19.890; 564: Server to Client (48 bytes) -- 0000 CD CC CC CC CC CC CC 8C FF 3F 00 07 00 00 00 00 .........?...... -- 0010 00 00 00 00 00 00 00 A0 01 40 00 06 00 00 00 00 .........@...... -- 0020 00 00 00 00 00 00 00 A0 01 40 00 03 00 00 00 00 .........@...... -- for three servers at the same port: the same socket is used but three adressed messages are sent ! -- -- TCPViewer lists 80bits = 10bytes formatted as: 00 B0 B1 9C 9B 6E CD 8F FF 3F LSB first ! (+386) -- 123456789 -- 0123456789 -- 0123456789 -- 0 -- -- task: 80bit, formatted as extended float, must be reformatted to 64bits, equally with IEC754 format -- slice the ten hex chars into 3 blocks with 4 bytes (2 bytes), restore MSB left aligned format -- bitConverter as described by: http://www.codeproject.com/KB/cs/longdouble.aspx -- tnx to Nathan Baulch --................................................................................................... -- 80 bit Example LSB left adjusted -- 00 B0 B1 9C 9B 6E CD 8F FF 3F -- xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx -- 12345678 9 -- 0123456 789 -- 01234 56789 -- 012 3456789 -- 0 12345678 9 -- 0123456 789 -- 01234 56789 -- 012 3456789 -- 0 -- ffffffff ffffffff ffffffff ffffffff ffffffff ffffffff ffffffff fffffff -- j -- eeeeeeee eeeeeee -- s -- e must be bias compensated: e(80bit) 2^14-1 = 16383 --................................................................................................... -- 64 bit compressed "equivalent" takes parts of the 80 bit original (j as 1) -- 00000000 000fffff ffffffff ffffffff ffffffff ffffffff ffffffff fffffff -- 1 eeeeeeee eee0000 -- s -- and realignes them = resultant 64bit float: (no j) -- ffffffff ffffffff ffffffff ffffffff ffffffff ffffffff ffff -- eeee eeeeeee -- s nnnnnnnn nnnnnnnn -- e must be bias compensated: e(64bit) 2^10-1 = 1023 --................................................................................................... -- convert 80bit extended floats to 64bit double floats (atoms) with this bit converter -- ProfiLab (Delphi) represents its floats in extended format, Euphoria (C) however, can only handle double format -- tnx Matthew Lewis ! -- ***************************************************************** function float80_to_atom( sequence e ) atom mydouble, ptr, small integer mysign, adj_exp if e[10] > 127 then mysign = 1 else mysign = 0 end if adj_exp = e[9] + and_bits(e[10],127) * 256 - 16414 mydouble = 0 ptr = allocate(10) poke(ptr, e) mydouble = peek4u(ptr+4) * power(2,adj_exp) adj_exp -= 32 small = peek4u(ptr) * power(2,adj_exp) mydouble += small if mysign then mydouble = -mydouble end if free(ptr) return mydouble end function -- complementary bit conversion: convert double to extended float -- doubles are represented in Euphoria with atoms -- This routine produces 10 bytes (80bits), which represent a extended double float to ProfiLab -- subnormal is not supported -- ***************************************************************** function Double_to_LongDouble(atom val) atom ok sequence byte_seq_64, bits_seq_64 , bits_seq_80, fraction_64, fraction_80, exponent_80, exponent_64, byte80_seq bits_seq_64 = {} bits_seq_80 = repeat(0,80) byte80_seq = repeat(0,10) --val = 88.5534 byte_seq_64 = atom_to_float64(val) -- build sequence of 8 bytes from var_1 (float value) for i = 1 to 8 do bits_seq_64 = bits_seq_64 & int_to_bits(byte_seq_64[i], 8) -- now build the 64bit array end for exponent_64 = bits_seq_64[53..63] -- extract 11 exponent bits ok = bits_to_int(exponent_64) - 1023 + 16383 -- compensate for the biases --exponent_80 = int_to_bits(ok, 15) -- this is the new exponent bits_seq_80[65..79] = int_to_bits(ok, 15) -- insert the 15 bit exponent -- bit 64 is j bits_seq_80[64] = 1 -- set to 1 ?? bits_seq_80[12..63] = bits_seq_64[1..52] -- extract 52 fraction bits and shift them up by 2^11 bits_seq_80[80] = bits_seq_64[64] -- insert the sign -- for crosscheck byte80_seq[1] = bits_to_int(bits_seq_80[1..8]) byte80_seq[2] = bits_to_int(bits_seq_80[9..16]) byte80_seq[3] = bits_to_int(bits_seq_80[17..24]) byte80_seq[4] = bits_to_int(bits_seq_80[25..32]) byte80_seq[5] = bits_to_int(bits_seq_80[33..40]) byte80_seq[6] = bits_to_int(bits_seq_80[41..48]) byte80_seq[7] = bits_to_int(bits_seq_80[49..56]) byte80_seq[8] = bits_to_int(bits_seq_80[57..64]) byte80_seq[9] = bits_to_int(bits_seq_80[65..72]) byte80_seq[10] = bits_to_int(bits_seq_80[73..80]) return byte80_seq end function -- complete the information for a ProfiLab packet (16 bytes) -- ***************************************************************** function make_PL_packet(atom channel, sequence byte80 ) sequence buffer buffer = repeat(0,16) buffer[12] = channel buffer[1..10] = byte80[1..10] return buffer end function -- if using this application with RealView: -- RealView is "passive" client (does not actively request data), the server must actively send packets -- The pen amplitudes are passed to RealView as extended floats (10bytes) plus 4 additional bytes -- The pen numbers in RealView are adressed with byte12 of each 16byte packet -- This routine is called by Windows Timer 1 event, if "RealView mode" is selected -- This routine sends a series of packets according to an enable list (server_to_client_var_sel bits) -- it takes the values out of the server_to_client_var[adr] sequence -- for the moment: only the first connected client is served -- ***************************************************************** procedure compute_out_server_data() server_to_client_var[7] = 1 + rand(2000)/1000 -- ch 7: noise: do some data processing here or in another time slice... server_to_client_var[4] = sin(t/20*PI)/t -- ch 4: sin x/x t = t + 1 -- used with sin x/x if t>3600 then t = 1 end if end procedure -- sends only enabled pens to the connected clients (used for RealView) -- the enable bits must be set in accordance to RealView link setup -- ***************************************************************** procedure periodic_active_server( integer id, integer event,sequence params) sequence tx_buf atom ok if params[1] = 1 then -- if Timer 1 shot --________________________________________________________________________________________________ compute_out_server_data() --________________________________________________________________________________________________ if length(connections) > 0 then -- make sure at least one client is connected asel_flag = autoSelect(server_text_out, w32True) clear(server_text_out) -- clear anything in the text_out object for i= 1 to length(server_to_client_var_sel) do -- test all variable enables, in order to selectively send data if server_to_client_var_sel[i] = 1 then -- if a variable is selected tx_buf = make_PL_packet(i,Double_to_LongDouble(server_to_client_var[i])) for n = 1 to length(connections) do ok = eunet_send(connections[n][1], tx_buf,0) -- send the data to all connected clients end for --ok = eunet_send(connections[1][1], tx_buf,0) -- then send the data to the first connected client server_txt = " Ch " & sprintf("%d",i) & ": " & sprintf("%5.5f", server_to_client_var[i]) & "\n" appendText(server_text_out, server_txt) end if end for end if end if end procedure -- user task upon input and output data -- remember in order to use -- ***************************************************************** procedure compute_in_out_server_data(atom adr) atom var if adr = 4 then -- compute on IO data of adr = 4 t = client_to_server_var[adr] -- t is time base from ProfiLab if t != 0 then -- prevent division by zero server_to_client_var[adr] = sin(t)/t -- ch 4: sin x/x end if elsif adr = 7 then t = client_to_server_var[adr] if t != 0 then var = cos(t)/t if var >= 0 then server_to_client_var[adr] = var else server_to_client_var[adr] = - var end if end if else end if end procedure -- ***************************************************************** procedure onEvent_Win(atom id, atom event, sequence params) atom event_code, socket, mem_addr, var, adr sequence rx_buf, tx_buf -- command (and optional raw data) tx_buf = {} rx_buf = {} var = 0 if params[1] = WM_SOCKET then -- if a WM_SOCKET message on listen_socket is received socket = params[2] -- which socket has propagated the message ? event_code = lo_word(params[3]) -- get event code from WM_SOCKET message ---- signal and account for new client connections if event_code = FD_ACCEPT then -- if there is a new client trying to connect new_socket = eunet_accept(socket) -- then accept and define a new socket for this client connection connections = append(connections, new_socket) setText({status_bar,2}, "server socket: " & sprintf("%d",socket) & " " & sprintf("%d",length(connections))& " clients connected" ) status_txt = "new client has joined: " & sprintf("%d",new_socket) & 10 appendText(status_out, status_txt) ---- Data exchange portion: if a client sends data, the server usually responds with data. ---- Usually, a client <-> server system uses simple or up to very complex proprietary or normalized commands to exchange data ---- However, present system is very simple: ProfiLab just sends an adressed extended float, which is read here into its ---- data sequence (client_to_server_var[adr]). ---- The server then simply sends back another extended float for the same adress (server_to_client_var[adr]) ---- In fact, the two data sequences are just input-output data turntables. ---- Their content can be manipulated by user code executed anywhere in this application. ---- The example does some computing "on the fly" in here (triggered by the "FD_read" event) between reading and responding) ---- This makes sense, when ProfiLab client TX and client RX data is to keep "synchronized", with the least possible time latency ---- Applying this, ProfiLab remains the timebase master ! ---- If computation is done in another time slice instead and not triggered by the "FD_read" event, ---- the input/output data is "resampled" by the Euphoria application. The result is input/output aliasing ! ---- The user can decide to compute this kind of data in here, and to compute other non time-critical data elsewhere. ---- Usually the user will then want to trigger data computation periodically by a timer event in a specific procedure elsif event_code = FD_READ then -- data waiting to be read rx_buf = eunet_recv(socket, 0) -- every send block causes an event: read and then reply -- ............................................................................................................ if ((length(rx_buf) = 16) and (RealView_sel = 0)) then -- was it a 16byte packet AND not ProfiLab mode? -- read client TX data and convert it for use in Euphoria (double float) -- put the var into a var sequence adr = rx_buf[12] client_to_server_var[adr] = float80_to_atom(rx_buf) --________________________________________________________________________________________________ -- do some processing on client/server data in here or in another routine for low IO latency compute_in_out_server_data(adr) --________________________________________________________________________________________________ -- copy the var out of a var sequence tx_buf = make_PL_packet(adr,Double_to_LongDouble(server_to_client_var[adr])) -- write client RX data and convert it to extended float if monitor = 1 then -- conditionally display client and server data status_txt = " Ch " & sprintf("%d",adr) & ": " & sprintf("%5.5f", client_to_server_var[adr]) status_txt = status_txt & " " & "Ch " & sprintf("%d",adr) & ": " & sprintf("%5.5f", server_to_client_var[adr]) & 10 appendText(server_text_out, status_txt) end if end if -- ............................................................................................................ for n = 1 to length(connections) do i = eunet_send(connections[n][1], tx_buf,0) -- send the data to all connected clients end for ---- account for quit of a client elsif event_code = FD_CLOSE then -- connections is the list of connected clients, it must be held actualized i = 0 for n= 1 to length(connections) do if socket = connections[n][1] then i = n end if end for connections = w32removeIndex(i, connections) -- remove the leaving client off the connections list setText({status_bar,2}, "client " & sprintf("%d",socket) & " has quit") status_txt = "client " & sprintf("%d",socket) & " has quit" & "\n" status_tab = 0 status_line = status_line + 1 -- new line appendText(status_out, status_txt) end if end if end procedure ---------------------------------------------------------------- -- ***************************************************************** -- initialize server procedure onOpen_ControlWindow( integer id, integer event,sequence params) WSAstatus = WSA_startup() -- is required when using WinSock API listen_socket = eunet_new_socket(PF_INET, SOCK_STREAM, 0) -- create a listen socket on which this server receives the clients i = eunet_bind(listen_socket, inet_address) -- bind this socket to IP-Adress:port i = eunet_listen(listen_socket, 0) -- put this socket into listen mode i = event_on_socket(listen_socket, getHandle(Win)) -- prepare for sending WM_SOCKET messages through the OS end procedure setHandler(ConnButton,w32HClick, routine_id("RealView_mode")) setHandler(SendButton,w32HClick, routine_id("float_convert")) setHandler(ClearButton,w32HClick, routine_id("status_clr")) setHandler(MonitorButton,w32HClick, routine_id("monitor_toggle")) setHandler(Win,w32HOpen,routine_id( "onOpen_ControlWindow" )) --setHandler(Win, w32HTimer, routine_id("DDE_client")) --setHandler(Win, w32HTimer, routine_id("DDE_server")) setHandler(Win, w32HTimer, routine_id("periodic_active_server")) setHandler(Win, w32HEvent, routine_id("onEvent_Win")) WinMain( Win, Normal ) if length(new_socket)!=0 then i = eunet_close_socket(new_socket[1]) end if i = eunet_close_socket(listen_socket) WSAstatus = WSA_cleanup()