
print "dim.pl go\n";
#
# build backwards-bit lookup table: $backwards[11000100b] = 00100011b
#
for( 0..255 ) {
    $i=$_;
    $b=0;
    for(0..7) {
	if( 2**(7-$_)<=$i ) {
	    $i-=2**(7-$_);
	    $b+=2**$_;
	}
    }
    $backwards[$_] = $b;
}

#require 'yscall.ph';
#foreach (0x280,0x2a0,0x2c0) {
#  die("Can't get port $_") if syscall(ioperm,$_,4,1);
#}

@devs = (ow,iw,ob,ib,da,fd,su,r1,r2,r3,r4,fr,lf,rf,s1,s2,s3,s4);

$_2c=0;
$_3a=0;

sub _repl {
    my($byte,$pos,$newval) = @_;
    return ($byte & 255-(1<<$pos)) | $newval<<$pos;
}

sub action {
    my($bit,$val) = @_; # ow,xx = enable outer white; lf,0 = left fire mot off
                        # don't need value on the enables, just the effect bits
    $_=lc $bit;
# dimmer B
    /ow/ and $_3a = _repl($_3a,2,0);
    /r1/ and do { $_3a = _repl($_3a,2,1); 
                 $_3a = _repl($_3a,0,0); };
    /fr/ and do { $_3a = _repl($_3a,2,1); 
                 $_3a = _repl($_3a,0,1); };
#dimmer C
    /ob/ and $_3a = _repl($_3a,4,0);
    /r3/ and $_3a = _repl($_3a,4,1);
#dimmer D
    /ib/ and $_3a = _repl($_3a,1,0);
    /r2/ and $_3a = _repl($_3a,1,1);
#dimmer E
    /da/ and $_3a = _repl($_3a,5,0);
    /fd/ and do { $_3a = _repl($_3a,5,1); 
                 $_3a = _repl($_3a,3,0); };
    /r4/ and do { $_3a = _repl($_3a,5,1); 
                 $_3a = _repl($_3a,3,1); };
# sun
    /su/ and $_2c = _repl($_2c,7,$val);
# fire motors
    /lf/ and $_2c = _repl($_2c,0,$val);
    /rf/ and $_2c = _repl($_2c,5,$val);
# stepper - only one bit on max, use 's0' to turn off
    /s[0-4]/ and $_2c = $_2c & (128+64+32+1); # clear all bits
    /s1/ and $_2c = _repl($_2c,1,1);
    /s2/ and $_2c = _repl($_2c,2,1);
    /s3/ and $_2c = _repl($_2c,3,1);
    /s4/ and $_2c = _repl($_2c,4,1);
    `bits 2 c $_2c`;
    `bits 3 a $_3a`;
}

sub bits { 
    my ($chip,$bank,$val) = @_; # chip=1-3 bank=a-c val=0-255
    #my($base,$off);
    #$base = (zero,0x280,0x2a0,0x2c0)[$chip];
    #$off = ord(lc $bank)-ord("a");
    #syscall(outb,$val,$base+$off);
    `bits $chip $bank $val`;
}

foreach(a,b,c,d,e) {
  $dimstate{$_}=0;
}

sub getlevel {
  $_=shift;
  return $dimstate{a} if /iw/;

  return $dimstate{b} if /ow/ && !($_3a & 1<<2);
  return $dimstate{b} if /r1/ && ($_3a & 1<<2) && !($_3a & 1<<0);
  return $dimstate{b} if /fr/ && ($_3a & 1<<2) && ($_3a & 1<<0);

  return $dimstate{c} if /ob/ && !($_3a & 1<<4);
  return $dimstate{c} if /r3/ && ($_3a & 1<<4);

  return $dimstate{d} if /ib/ && !($_3a & 1<<1);
  return $dimstate{d} if /r2/ && ($_3a & 1<<1);

  return $dimstate{e} if /da/ && !($_3a & 1<<5);
  return $dimstate{e} if /fd/ && ($_3a & 1<<5) && !($_3a & 1<<3);
  return $dimstate{e} if /r4/ && ($_3a & 1<<5) && ($_3a & 1<<3);
  return ($_2c & 1<<0)!=0 if /lf/;
  return ($_2c & 1<<5)!=0 if /rf/;
  return ($_2c & 1<<1)!=0 if /s1/;
  return ($_2c & 1<<2)!=0 if /s2/;
  return ($_2c & 1<<3)!=0 if /s3/;
  return ($_2c & 1<<4)!=0 if /s4/;
  
  return "-";
}


sub dim {
    my($dl,$lev) = @_; # dimmer letter a-e, level 0-255 
    # change two-letter-names to a-e
#print "dim $dl to $lev\n";
    for (ow,r1,fr) { $dl=~s/$_/b/ }
    for (iw)       { $dl=~s/$_/a/ }
    for (ob,r3) { $dl=~s/$_/c/ }
    for (ib,r2)    { $dl=~s/$_/d/ }
    for (da,fd,r4) { $dl=~s/$_/e/ }
    return if length($dl) == 2; # couldn't get an a-e name
    $dimstate{$dl} = $lev;
    $lev = int($lev);
    if( $dl ne "a" && $dl ne "d" ) {
	$lev = $backwards[$lev];
    }

    $chipnum = 1; $chipnum = 2 if $dl eq "d" || $dl eq "e";
    $chiplet = $dl; $chiplet =~ tr/de/ab/;
    `bits $chipnum $chiplet $lev`;
}




