Initial commit of scLego

BrickBot · Mar 20, 2020 · 916eeb0 · 916eeb0
1 parent 854aa87
commit 916eeb0
Show file tree

Hide file tree

Showing 17 changed files with 1,527 additions and 0 deletions.
diff --git a/Lego/ContactInput.pm b/Lego/ContactInput.pm
@@ -0,0 +1,26 @@
+# Esterel input signal for contact sensor
+#----------------------------------------
+package ContactInput;
+require EsterelInput;
+@ISA = (EsterelInput);
+sub new {
+  # args: input_name type Lego_sensor
+  my $proto = shift;
+  my $self = EsterelInput->new(@_);
+  bless $self, $proto;
+  return $self;
+}
+
+sub PrintCall {
+  my $self = shift;
+  local(*OUT) = shift;
+  my $fnc = $self->FunctionName();
+  my $sensor = $self->LegoSensor();
+  print OUT <<C_CODE;
+    if ( $sensor < 0xf000 ) {
+      $fnc();
+    }
+C_CODE
+  ;
+}
+1;
diff --git a/Lego/EsterelFunction.pm b/Lego/EsterelFunction.pm
@@ -0,0 +1,55 @@
+package EsterelFunction;
+use EsterelType;
+
+sub new {
+  my $proto = shift;
+  my $self = {};
+  $self->{NAME} = shift;
+  $self->{ARGS} = shift;
+  $self->{TYPE} = shift;
+  $self->{CODE} = shift;
+  bless $self, $proto;
+  return $self;
+}
+
+sub Name {
+  my $self = shift;
+  return $self->{NAME};
+}
+
+sub Args {
+  my $self = shift;
+  return $self->{ARGS};
+}
+
+
+sub Type {
+  my $self = shift;
+  return $self->{TYPE};
+}
+
+sub Check {
+  my($self, $fnc, $args, $type) = @_;
+
+ CHECK: {
+    last CHECK if ( GetType($type) ne $self->Type() );
+    last CHECK if (@$args != @{$self->Args()});
+    for (my $i = 0; $i < @$args; $i++) {
+      last CHECK if GetType($args->[i]) ne $self->Args()->[$i];
+    }
+    return 1;
+  }
+  my $str_args = 
+  warn("*** Bad function prototype. Must be:\n    ",
+       $self->Name(), '(', (join (', ', @{$self->Args()})), ') : ',
+       $self->Type(), "\n");
+
+  return 0;
+}
+
+sub PrintCode {
+  my $self = shift;
+  local(*OUT) = shift;
+  print OUT $self->{CODE};
+}
+1;
diff --git a/Lego/EsterelInput.pm b/Lego/EsterelInput.pm
@@ -0,0 +1,35 @@
+# Esterel input signal class
+#---------------------------
+package EsterelInput;
+
+require EsterelSignal;
+
+@ISA = (EsterelSignal);
+
+sub new {
+  # args: input_name type Lego_sensor
+  my $proto = shift;
+  my $self = EsterelSignal->new($_[0], $_[1]);
+  $self->{SENSOR} = $_[2];
+  bless $self, $proto;
+  return $self;
+}
+
+sub LegoSensor {
+  my $self = shift;
+  return $self->{SENSOR};
+}
+
+sub FunctionName {
+  # Builds Esterel input function name
+  my $self = shift;
+  return $self->ModuleName() . '_I_' . $self->Name();
+}
+
+sub PrintInitialization {
+  # nothing
+}
+
+sub PrintCall {
+}
+1;
diff --git a/Lego/EsterelOutput.pm b/Lego/EsterelOutput.pm
@@ -0,0 +1,35 @@
+# Esterel output signal
+#----------------------
+package EsterelOutput;
+require EsterelSignal;
+@ISA = (EsterelSignal);
+sub new {
+  # args: name type
+  my $proto = shift;
+  my $self = EsterelSignal->new(@_);
+  bless $self, $proto
+}
+
+sub FunctionName {
+  my $self = shift;
+  return $self->ModuleName() . '_O_' . $self->Name();
+}
+
+sub PrintCode {
+  my $self = shift;
+  local(*OUT) = shift;
+  my $lego_api = lc $self->Name();
+  my $fnc = $self->FunctionName();
+  my $type = $self->Type();
+  print OUT <<C_CODE;
+int $fnc(val)
+$type val;
+{
+  $lego_api(val);
+  return 0;
+}
+
+C_CODE
+  ;
+}
+1;
diff --git a/Lego/EsterelSignal.pm b/Lego/EsterelSignal.pm
@@ -0,0 +1,70 @@
+package EsterelSignal;
+
+# Module name and accessors. Static member
+my $ModuleName = undef;
+
+sub SetModuleName {
+  shift;
+  $ModuleName = shift unless defined $ModuleName;
+}
+
+sub ModuleName {
+  return $ModuleName;
+}
+
+# constructor
+sub new {
+  # args: name type
+  my $proto = shift;
+  my $self = {};
+  $self->{NAME} = shift;
+  $self->{TYPE} = shift;
+  $self->{VARIDX} = undef;
+  bless $self, $proto;
+  return $self;
+}
+
+sub Name {
+  my $self = shift;
+  return $self->{NAME};
+}
+
+sub Type {
+  my $self = shift;
+  return $self->{TYPE};
+}
+
+
+sub SetVarIndex {
+  my $self = shift;
+  $self->{VARIDX} = shift;
+}
+
+sub VarIndex {
+  my $self = shift;
+  return $self->{VARIDX};
+}
+
+# Check type. 
+# argument : ref array of variable types
+sub CheckType {
+  my $self = shift;
+  my $var_to_type = shift;
+
+ ERROR: {
+    if ( $self->Type() eq 'pure' ) {
+      last ERROR if defined ($self->VarIndex())
+    }
+    else {
+      last ERROR if $self->Type() ne $var_to_type->[$self->VarIndex()];
+    }
+    return 0;
+  }
+
+  warn('*** signal ', $self->Name(), ' must be ', $self->Type(), "\n");
+  return 1;
+}
+
+sub PrintCode {
+}
+1;
diff --git a/Lego/EsterelType.pm b/Lego/EsterelType.pm
@@ -0,0 +1,17 @@
+package EsterelType;
+require Exporter;
+
+@ISA = qw(Exporter);
+
+@EXPORT = (GetType);
+
+my %Type = ('$0' => 'boolean',
+	    '$1' => 'integer',
+	    '$2' => 'string',
+	    '$3' => 'float',
+	    '$4' => 'double');
+
+sub GetType {
+  return (exists $Type{$_[0]} ? $Type{$_[0]} : "'$_[0]'");
+}
+1;
diff --git a/Lego/LegoDefs.pm b/Lego/LegoDefs.pm
@@ -0,0 +1,141 @@
+package LegoDefs;
+
+require EsterelSignal;
+require ContactInput;
+require MotorDirOutput;
+require MotorSpeedOutput;
+require LightInput;
+require LightSensor;
+require LightOutput;
+require EsterelFunction;
+
+require Exporter;
+@ISA  = (Exporter);
+@EXPORT =qw(true false %ValidInputs %ValidOutputs %ValidConstants %ValidFunctions);
+
+sub true {
+  return 1;
+}
+
+sub false {
+  return 0;
+}
+
+# Valid input signal. Mapped onto Legos API. 
+# Hash table. Values are signal objects.
+#-------------------------------------------
+%ValidInputs = ( 'TOUCH_1'      => ContactInput->new('TOUCH_1', 'pure', 'SENSOR_1'),
+		 'TOUCH_2'      => ContactInput->new('TOUCH_2', 'pure', 'SENSOR_2'),
+		 'TOUCH_3'      => ContactInput->new('TOUCH_3', 'pure', 'SENSOR_3'),
+		 'LIGHT_LOW_1'  => LightInput->new('LIGHT_LOW_1', 
+						   'pure', 
+						   'SENSOR_1',
+						   'LIGHT_1',
+						   0,
+						   true),
+		 'LIGHT_HIGH_1' => LightInput->new('LIGHT_HIGH_1', 
+						   'pure', 
+						   'SENSOR_1',
+						   'LIGHT_1',
+						   0,
+						   false),
+		 'LIGHT_1_VALUE' => LightSensor->new('LIGHT_1_VALUE', 
+						     'integer',
+						     'SENSOR_1',
+						     'LIGHT_1',
+						     0),
+		 'LIGHT_LOW_2'  => LightInput->new('LIGHT_LOW_2', 
+						   'pure', 
+						   'SENSOR_2',
+						   'LIGHT_2',
+						   1,
+						   true),
+		 'LIGHT_HIGH_2' => LightInput->new('LIGHT_HIGH_2', 
+						   'pure', 
+						   'SENSOR_2',
+						   'LIGHT_2',
+						   1,
+						   false),
+		 'LIGHT_2_VALUE' => LightSensor->new('LIGHT_2_VALUE', 
+						     'integer',
+						     'SENSOR_2',
+						     'LIGHT_2',
+						     1),
+		 'LIGHT_LOW_3'  => LightInput->new('LIGHT_LOW_3', 
+						   'pure', 
+						   'SENSOR_3',
+						   'LIGHT_3',
+						   2,
+						   true),
+		 'LIGHT_HIGH_3' => LightInput->new('LIGHT_HIGH_3', 
+						   'pure', 
+						   'SENSOR_3',
+						   'LIGHT_3',
+						   2,
+						   false),
+		 'LIGHT_3_VALUE' => LightSensor->new('LIGHT_3_VALUE', 
+						     'integer',
+						     'SENSOR_3',
+						     'LIGHT_3',
+						     2)
+	       );
+
+# Valid output signal. Mapped onto Legos API
+# Values are signal objects.
+#-------------------------------------------
+%ValidOutputs = ( 'MOTOR_A_DIR'   => MotorDirOutput->new('MOTOR_A_DIR', 'integer'),
+		  'MOTOR_A_SPEED' => MotorSpeedOutput->new('MOTOR_A_SPEED', 
+							   'integer'),
+		  'MOTOR_B_DIR'   => MotorDirOutput->new('MOTOR_B_DIR', 'integer'),
+		  'MOTOR_B_SPEED' => MotorSpeedOutput->new('MOTOR_B_SPEED', 
+							   'integer'),
+		  'MOTOR_C_DIR'   => MotorDirOutput->new('MOTOR_C_DIR', 'integer'),
+		  'MOTOR_C_SPEED' => MotorSpeedOutput->new('MOTOR_C_SPEED', 
+							   'integer'),
+		  'CPUTS'         => EsterelOutput->new('CPUTS', 'string'),
+		  'SET_LIGHT_1_THRESHHOLD' 
+		      => LightOutput->new('SET_LIGHT_1_THRESHHOLD',
+					  'integer',
+					  0),
+		  'SET_LIGHT_2_THRESHHOLD' 
+		      => LightOutput->new('SET_LIGHT_2_THRESHHOLD',
+					  'integer',
+					  1),
+		  'SET_LIGHT_3_THRESHHOLD' 
+		      => LightOutput->new('SET_LIGHT_3_THRESHHOLD',
+					  'integer',
+					  2));
+
+# Constants for motor direction
+#------------------------------
+%ValidConstants = (  MOTOR_OFF   	 	 => 0,
+		     MOTOR_FWD   	 	 => 1,
+		     MOTOR_REV   	 	 => 2,
+		     MOTOR_BRAKE 	 	 => 3,
+		     MAX_SPEED   	 	 => 255,
+		     TICKS_PER_SECOND 	         => 100,
+		     DEFAULT_LIGHT_THRESHHOLD    => 50
+	     );
+
+%ValidFunctions = ( CHANGE_MOTOR_DIR => EsterelFunction->new('CHANGE_MOTOR_DIR',
+							     ['integer'],
+							     'integer',
+<<CODE,
+integer CHANGE_MOTOR_DIR(val) 
+integer val;
+{
+  switch (val) {
+    case $ValidConstants{MOTOR_FWD}: 
+      val = $ValidConstants{MOTOR_REV};
+      break;
+    case $ValidConstants{MOTOR_REV}: 
+      val = $ValidConstants{MOTOR_FWD};
+      break;
+  }
+  return val;
+}
+CODE
+                                                            )
+                  );
+
+1;