/[VRac]/Session.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /Session.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 159 - (show annotations)
Sun Aug 5 18:25:53 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 2594 byte(s)
new session format which enables you, the emulator use, to refactor your sessions
1 package Session;
2
3 # Dobrica Pavlinusic, <dpavlin@rot13.org> 08/05/07 14:27:15 CEST
4
5 use strict;
6 use warnings;
7
8 use Carp qw/confess croak/;
9 use Data::Dump qw/dump/;
10 use File::Slurp;
11 use POSIX qw/strftime/;
12
13 use base qw/Class::Accessor/;
14 __PACKAGE__->mk_accessors(qw(session_uuid));
15
16
17 =head1 NAME
18
19 Session - save or load emulator interactive session
20
21 =head1 DESCRIPTION
22
23 Sessions are simple perl programs using one function C<event>
24
25 event( $ticks_wait, 'name', $hash );
26
27 Using this, you can refactor your sessions or use perl constructs around
28 them.
29
30 =head1 FUNCTIONS
31
32 =head2 record_session
33
34 $self->record_session( 'name', $value );
35
36 =cut
37
38 my $path = 'session.pl';
39
40 my $last_tick = 0;
41
42 my $t = 0;
43 my @timeline;
44 my $s;
45
46 sub record_session {
47 my $self = shift;
48 my $name = shift || confess "need name";
49 my $value = shift || confess "need value";
50
51 if ( @timeline ) {
52 warn "INFO: Aborting recorderd session\n";
53 @timeline = ();
54 $t = 0;
55 $s = {};
56 }
57
58 my $t = $self->app->ticks;
59 my $dt = $t - $last_tick;
60 $last_tick = $t;
61
62 if ( ! $self->session_uuid ) {
63 my $uuid = strftime('%Y-%m-%d %H:%M:%S',localtime);
64 $self->append_to_file($path, "# $uuid\n");
65 $self->session_uuid( $uuid );
66 }
67
68 $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
69
70 }
71
72 sub event {
73 my $dt = shift || croak 'expected dt';
74 my $name = shift || croak 'expected name';
75 my $value = shift || croak 'expected value';
76
77 $t += $dt;
78 push @timeline, $t;
79 $s->{$t}->{$name} = $value;
80
81 warn "## created event($dt,$name,",dump($value),")\n";
82 }
83
84 =head2 load_session
85
86 $self->load_session( '/path/to/session.pl' );
87
88 =cut
89
90 sub load_session {
91 my $self = shift;
92 my $path = shift || confess "no path?";
93
94 if ( ! -r $path ) {
95 warn "WARNING: can't open session $path: $!\n";
96 return;
97 }
98
99 eval read_file( $path );
100 warn "session = ",dump( $s );
101
102 my ( $from, $to ) = @timeline[0,-1];
103 printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;
104 }
105
106 =head2 session_event
107
108 my $v = $self->session_event('key_pressed');
109
110 =cut
111
112 sub session_event {
113 my $self = shift;
114
115 return unless @timeline;
116
117 my $name = shift || confess "no name?";
118
119 my $t = $self->app->ticks;
120
121 # do we have events to trigger?
122 return if ( $t < $timeline[0] );
123
124 my $e_t = $timeline[0];
125
126 # do we have next event and should we take it?
127 if ( $#timeline > 0 && $t > $timeline[1] ) {
128 shift @timeline;
129 $e_t = $timeline[0];
130 warn "session_event $e_t $name ",dump( $s->{$e_t}->{$name} )," left ", $#timeline+1, " events\n";
131 }
132
133 return $s->{$e_t}->{$name};
134 }
135
136 =head1 SEE ALSO
137
138 L<VRac>
139
140 =cut
141
142 1;

  ViewVC Help
Powered by ViewVC 1.1.26