Services provided:
do, used by local clients:
vc-httpd.setl (Section A.19 [vc-httpd.setl])
vc-jumper.setl (Section A.25 [vc-jumper.setl])
vc-mouse.setl (Section A.28 [vc-mouse.setl])
vc-mover.setl (Section A.29 [vc-mover.setl])
vc-ptz.setl (Section A.33 [vc-ptz.setl])
vc-zoomer.setl (Section A.43 [vc-zoomer.setl])
notice, used by local clients:
vc-evjump.setl (Section A.13 [vc-evjump.setl])
vc-evzoom.setl (Section A.14 [vc-evzoom.setl])
vc-ptz.setl (Section A.33 [vc-ptz.setl])
Client of service:
event (vc-event.setl, Section A.12 [vc-event.setl])
Called by parent program:
vc-toplev.setl (Section A.42 [vc-toplev.setl])
Calls child program:
vc-model.setl (Section A.27 [vc-model.setl])
Textually #includes:
vc-allowed.setl (Section A.2 [vc-allowed.setl])
vc-decode.setl (Section A.10 [vc-decode.setl])
vc-exit.setl (Section A.15 [vc-exit.setl])
vc-getname.setl (Section A.16 [vc-getname.setl])
vc-msg.setl (Section A.30 [vc-msg.setl])
vc-obtain.setl (Section A.31 [vc-obtain.setl])
vc-provide.setl (Section A.32 [vc-provide.setl])
Source code: *
const yhwh = `vc-do.setl';
-- This program provides the do and notice services.
--
-- The do service is a server interface to model, a pumping
-- co-process which maintains a high-level model of the videocamera
-- control state and supports ``mid-level'' commands (requests already
-- reduced to SETL maps) to alter that state. Besides routing such
-- commands from clients into the model subprocess, do also
-- implements a queuing policy which allows every client that cannot be
-- satisfied immediately to have a command pending, and also prevents
-- further commands from that client from being queued until the
-- pending one has been performed.
--
-- The notice service distributes ``mid-level'' events to all
-- interested clients. These originate as low-level events generated
-- by the event service and as responses to parameter-changing
-- commands issued to the model pump.
const model_pump = `exec setl vc-model.setl';
const sigterm_fd = open (`SIGTERM', `signal'); -- catch TERM signals
-- Performer of mid-level commands:
const model_fd = fileno open (model_pump, `pump');
-- Generator of low-level events:
const event_fd = fileno obtain_service (`event');
const do_server_fd = fileno provide_service (`do');
const notice_server_fd = fileno provide_service (`notice');
var notice_clients := {}; -- map from client fd to client record
var do_clients := {}; -- map from client fd to client record
var do_queue := [ ]; -- queue of fd's of do clients awaiting service
var do_pending := false; -- true when we await a reply from model
open (`SIGPIPE', `ignore'); -- as in when we write to closed observers
loop
nonwaiting := domain do_clients - {do_fd : do_fd in do_queue};
pool := if do_pending then {model_fd} else {} end if
+ {sigterm_fd, event_fd, do_server_fd, notice_server_fd}
+ nonwaiting;
[ready] := select ([pool]);
if sigterm_fd in ready then
msg (yhwh + ` (' + str pid + `) caught SIGTERM');
quit_gracefully;
end if;
for do_fd in ready * nonwaiting loop
-- New request from a do client.
reada (do_fd, request);
if eof then
do_clients(do_fd) := om;
close (do_fd);
else
do_client := do_clients(do_fd);
do_client.request := request;
do_clients(do_fd) := do_client;
do_queue with:= do_fd;
end if;
end loop;
if do_pending and model_fd in ready then
reada (model_fd, model_response);
if eof then
msg (`EOF from '+str model_pump+` - quitting');
quit_gracefully;
end if;
-- These notices can be created by the model pump to let us alert
-- all the observers to parameter changes and special events such
-- as initialization:
for message in model_response.notices ? [ ] loop
tell_observers (message); -- tell notice clients
end loop;
do_fd fromb do_queue;
do_client := do_clients(do_fd);
request := do_client.request;
if request.name = `Get' then
writea (do_fd, model_response.value);
else
printa (do_fd); -- a blank line to say the command has been done
end if;
flush (do_fd);
do_pending := false;
end if;
if event_fd in ready then
reada (event_fd, frame);
if eof then
msg (`EOF from '+filename event_fd+` - quitting');
quit_gracefully;
else
message := decode frame;
tell_observers (message); -- tell notice clients
end if;
end if;
if do_server_fd in ready then
do_fd := accept (do_server_fd);
if do_fdom then
name := getname do_fd;
if allowed (do_fd) then
do_client := {};
do_client.name := name;
do_clients(do_fd) := do_client;
else
close (do_fd);
msg (name+` denied access to "do" service');
end if;
end if;
end if;
if notice_server_fd in ready then
notice_fd := accept (notice_server_fd);
if notice_fd
name := getname notice_fd;
if allowed (notice_fd) then
notice_client := {};
notice_client.name := name;
notice_clients(notice_fd) := notice_client;
else
close (notice_fd);
msg (name+` denied access to "notice" service');
end if;
end if;
end if;
if #do_queue > 0 and not do_pending then
do_fd := do_queue(1);
do_client := do_clients(do_fd);
request := do_client.request;
writea (model_fd, request);
flush (model_fd);
do_pending := true;
end if;
end loop;
proc tell_observers (message);
for notice_client = notice_clients(notice_fd) loop
clear_error;
writea (notice_fd, message);
flush (notice_fd); -- eventually causes EPIPE if client closed
if last_error
close (notice_fd);
notice_clients(notice_fd) := om;
end if;
end loop;
end proc tell_observers;
proc quit_gracefully;
exit_gracefully ([[str model_pump, model_fd]]);
end proc;
#include ``vc-provide.setl''
#include ``vc-obtain.setl''
#include ``vc-getname.setl''
#include ``vc-allowed.setl''
#include ``vc-decode.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''