Unit ADDAModul;{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º T E C H N I S C H E U N I V E R S I T Ž T C H E M N I T Z º
º º
º Programm zur Ansteuerung des AD/DA-Wandlermoduls mit Einchip- º
º rechner 68HC11 º
º º
º UNIT zur Ansteuerung des AD/DA-Wandlermoduls º
º º
º Programmierer: Torsten Levin º
º 03 AET 89 º
º TU Chemnitz-Zwickau º
º º
º Chemnitz, Januar-April 1993 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
h#s 12/02}
INTERFACE
Uses Crt,Graph,dos,maus,image,bss,windows,Konstant,Diagramm;
Procedure InitModul;
Procedure InitCOM;
Procedure SendByte(x:byte);
Procedure SendWord(ch:word);
Function EmpfByte(var b:Byte):Boolean;
Function ModulVorhanden : Boolean;
function Modul(fkt:byte; var PrBuffer:PPuffer; PrSize,adr,wert:word;
KNr:Byte):Boolean;
function Kanalwahl(Kanal:Byte):Boolean;
function SStellenEinstellen(SStellWord:Word):Boolean;
function UrateEinstellen(Urate:Real):Boolean;
function DAUmsetzung(KanalNr:Byte):Boolean;
function ADUmsetzung:Boolean;
Procedure TransportStatus(X,Y:Integer;Richtung:Boolean);
Procedure UmsetzStatus(X,Y:Integer;Was:Boolean);
function MapBinaryData(FName:PChar; var data; var datalen:Word):Boolean;
function IsModulInit(const s1, s2: String):Boolean;
procedure FehlerReagiertNicht;
IMPLEMENTATION
uses WinDos,Strings;
function MapBinaryData(FName:PChar; var data; var datalen:Word):Boolean;
label exi;
var
Datei: file;
s: array[0..79] of Char;
begin
{$I-}
MapBinaryData:=false;
StrECopy(StrECopy(S,ProgDir),FName);
assign(Datei,s);
reset(Datei,1);
if IoResult<>0 then exit;
if FileSize(Datei)>1024 then goto exi; { max filelaenge ist 1024 bytes }
BlockRead(Datei,data,1024,datalen);
MapBinaryData:=true;
exi:
Close(Datei);
{$I+}
end;
function RetryAbort:Boolean;
{Abfrage Wiederholen (true) oder Abbrechen (false)}
begin
openwindow2(220,120,240,140,5,6,'Initialisierungsfehler',True);
putpicture('stop',233,160);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(300,170,'Das AD/DA-Modul an');
outtextxy(300,185,'COM'+Chr(Inst.COM+48)+' zeigt keine');
outtextxy(300,200,'Reaktion!');
knopf2(230,230,100,20,'Abbruch',1,3);
knopf2(350,230,100,20,'&Wiederholen',1,3);
Beep(500,100);
repeat
eingabe2;
if Hit(#27,230,230,100,20) then begin
RetryAbort:=false;
break;
end;
if Hit('W',350,230,100,20) then begin
RetryAbort:=true;
break;
end;
Until false;
closewindow;
end;
{ Initialisiert das AD/DA-Modul und l„dt die Programme----}
Procedure InitModul;
Var
i : Word;
Okay,
Ende : Boolean;
SStellmerk : Real;
Begin
Status(200,100,'Einen Moment bitte,','ich versuche, das ',
'AD/DA-Modul an COM'+Chr(Inst.COM+48),'zu initialisieren.');
Repeat
InitCOM;
If ModulVorhanden Then Begin
Okay:=MapBinaryData(SendData,AdPrPuffer,AdPrSize)
and modul(1,AdPrPuffer,AdPrSize,0,0,4) { Sende-Programm laden }
and MapBinaryData(EmpfData,DaPrPuffer,DaPrSize)
and modul(1,DaPrPuffer,DaPrSize,0,0,4) { Empf-Programm laden }
and MapBinaryData(AdPrName,AdPrPuffer,AdPrSize)
and MapBinaryData(DaPrName,DaPrPuffer,DaPrSize);
{--- Umsetzung ausl”sen um Hardware einschwingen zu lassen-}
{ If Okay Then UrateEinstellen(0.1,Okay); { Umsetzrate einstellen }
{ If Okay Then SStellenEinstellen(30,Okay); { St�tzstellen einstellen }
SStellMerk:=Daten.SStellen;
Daten.SStellen:=50;
Okay:=Okay
and modul(1,AdPrPuffer,AdPrSize,0,0,4) { AD-Programm laden }
and modul(2,AdPrPuffer,0,AdStartAdr,1,4) { AD-Programm starten }
and modul(1,DaPrPuffer,DaPrSize,0,0,4) { DA-Programm laden }
and modul(2,DaPrPuffer,0,DaStartAdr,1,4); { DA-Programm starten }
Okay:=modul(6,DaPrPuffer,0,0,0,4); { Unterbrechung senden }
If Okay Then begin
ModulInit:=True;
if UrateEinstellen(Daten.Urate)
then SStellenEinstellen(Round(Daten.SStellen));
break;
end else begin
Fehler(220,120,False,'Beim Laden der','Modul-Programme',
'[*.REC] trat ein','Fehler auf.');
Daten.SStellen:=SStellMerk;
ModulInit:=False;
end;
End {if ModulVorhanden};
SetWaitCursor(false);
Okay:=RetryAbort;
SetWaitCursor(true);
if not Okay then break;
until false;
CloseStatus;
End;
{---Initialisieren der seriellen Schnittstelle-------------}
Procedure InitCOM;
Var Regs :Registers;
begin
with regs do
begin
ah:=0; { Funktion 0 fuer Init }
al:=ParaByte; { Parameter fuer Init }
dx:=Inst.COM-1; { Schnittstellennummer }
end;
dos.intr($14,regs);
end;
{---Senden eines Bytes an die serielle Schnittstelle------}
procedure SendByte(x:byte); assembler;
asm mov ah,1
mov al,[x]
mov dh,0
mov dl,Inst.COM
dec dx
int 14h
end;
(*
Var Regs:Registers;
begin
repeat { warten, bis Zeichen abgeschickt (=SIO leer) }
regs.ah:=$03; { Funktion 3 fuer Status ermitteln }
regs.dx:=Inst.COM-1;
intr($14,regs);
regs.ah:= regs.ah and $60 ; { Bit 7 u. 6 maskieren }
until regs.ah = $60; { Sender leer }
with regs do
begin
ah:=01; { Funktion 1 fuer Senden }
al:=x; { "x" Zeichen senden }
dx:=Inst.COM-1;
end;
intr($14,regs);
end;
*)
{---Senden eines Datenwortes-------------------------------}
Procedure SendWord(ch:word);
begin
SendByte(hi(ch)); SendByte(lo(ch));
end;
{---Empfangen eines Bytes von der seriellen Schnittstelle---}
function EmpfByte(var b:Byte):Boolean;
const Timeout = 100;
var Zeit : Word;
Regs : Registers;
begin
zeit:=0;
EmpfByte:=True;
repeat { testen ob Zeichen vorhanden }
with regs do
begin
ah:=03; { Funktion 3 fuer Status ermitteln }
dx:=Inst.COM-1;
end;
dos.intr($14,regs);
inc(zeit);
until (zeit=Timeout) or ((regs.ah and $01)=$01); { Empf.-daten vorhanden }
if zeit=Timeout then EmpfByte:=False { kein Zeichen erhalten nach Timeout }
else begin
with regs do { Zeichen einlesen }
begin
ah:=02; { Funktion 2 fuer Empfangen }
dx:=Inst.COM-1;
end;
dos.intr($14,regs);
b:=regs.al; { empfangenes Byte wird zugewiesen }
end;
end;
{---Test ob das AD/DA-Modul vorhanden ist------------------}
Function ModulVorhanden:Boolean;
{ testet, ob Modul bereit ist durch Senden von "<SPACE><ENTER>" }
{ und Warten auf Prompt-Zeichen ">" }
const Timeout_init = 50;
Var Zeit : Word;
Zeichen : Byte;
Begin
ModulVorhanden:=False;
SendWord($200D); { $20=<SPACE> $0D=<ENTER> }
Zeit:=0;
Repeat {Fertigmeldung abwarten, bis Zeichen ">"=$3E (Prompt) kommt}
if not EmpfByte(Zeichen) then Zeichen:=255;
Inc(Zeit);
if Zeit>=Timeout_Init then exit;
Until zeichen=$3E;
if Zeit<Timeout_init Then ModulVorhanden:=True;
end;
function modul(fkt:byte; var PrBuffer:PPuffer; PrSize,adr,wert:word;
KNr:Byte): Boolean;
{ šbernimmt die Kommunikation mit dem Einchiprechnermodul �ber die }
{ serielle Schnittstelle. }
{ fkt = 1 --> Programm laden }
{ fkt = 2 --> Programm starten }
{ fkt = 3 --> Daten empfangen }
{ fkt = 4 --> Daten senden }
{ fkt = 5 --> ein Speicher-Byte manipulieren }
{ fkt = 6 --> Unterbrechung senden fuer DA-Programm }
const Timeout = 5;
type hexstr_4 = string[4];
var i,zeit : word;
zeichen : byte;
SendFolge : string[12];
aadr,eadr : hexstr_4;
text1 : string;
{======================================================}
function hex(deczahl:word):hexstr_4;
const hexziffer:array[0..15] of char = '0123456789ABCDEF';
begin
hex:=hexziffer[hi(deczahl) shr 4]+hexziffer[hi(deczahl) and 15]
+hexziffer[lo(deczahl) shr 4]+hexziffer[lo(deczahl) and 15];
end;
{======================================================}
function EmpfBlock(KurvenNr:Byte;Size:word):Boolean;
{ es wird versucht, die in "size" uebergebene Anzahl von Bytes }
{ zu empfangen und diese im Daten-Puffer abzulegen }
const Timeout = 1000;
var i : word;
zeit : word;
zeichen : byte;
begin
zeichen:=0;
{ warten, bis "$0A" fuer Block-Beginn kommt }
zeit:=0;
EmpfBlock:=false;
repeat {auf "$0A" warten }
if not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
if Zeit=timeout then exit;
until chr(zeichen)=#$0A;
zeit:=0;
i:=1;
repeat
if EmpfByte(zeichen) then begin
If KurvenNr<4 Then Kanal[KurvenNr,i]:=zeichen else DirektWert:=Zeichen;
inc(i);
end else inc(zeit);
if Zeit=TimeOut then exit; { Timeout beim Block holen }
until (zeit=Timeout) or (i=size+1);
EmpfBlock:=True;
end;
{======================================================}
procedure SendBlock(KurvenNr:Byte; size:word);
{ es werden die in "size" uebergebene Anzahl von Bytes }
{ des Daten-Puffers gesendet und im Modul abgeleget }
var
i: word;
zeichen: byte;
begin
for i:=1 to size do begin
If KurvenNr<4 Then zeichen:=Kanal[KurvenNr,i]
else Zeichen:=DirektWert;
SendByte(zeichen);
end;
end;
var
ok:Boolean;
{====================== M A I N von MODUL(! damn h#s) ================}
begin
InitCom;
Modul:=True;
If fkt in [1..5] Then Begin
if ModulVorhanden then case fkt of
1: begin { Programm laden }
SendFolge:=LoadProg+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
for i:=0 to PrSize-1 do SendByte(PrBuffer[i]); { Datei.laden }
zeit:=0;
delay(20);
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt }
if not EmpfByte(Zeichen) then zeichen:=255;
inc(zeit);
until (zeit=Timeout) or (chr(zeichen)=#$3E);
Modul:=zeit<>Timeout; { Timeout beim L. d. Prog. }
end;
2: begin { Programm starten }
SendFolge:=StartProg+hex(adr)+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
zeit:=0;
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt }
if not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
until (zeit=(5*Daten.SStellen*wert)+1) or (chr(zeichen)=#$3E);
Modul:=zeit<>(10*{Daten.SStellen*}wert)+1
{ Prog. meldet sich nicht zurueck }
end;
3: begin { Daten empfangen}
SendFolge:=StartProg+hex(SStartAdr)+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
ok:=EmpfBlock(KNr,wert);
delay(200);
if ok Then Begin
zeit:=0;
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt}
if not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
until (zeit=Timeout) or (chr(zeichen)=#$3E);
Modul:=Zeit<>TimeOut; { Daten empf. meldet sich n.}
end;
End;
4: begin { Daten senden }
SendFolge:=StartProg+hex(EStartAdr)+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
delay(10);
SendBlock(KNr,wert);
delay(100);
zeit:=0;
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt }
if Not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
until (zeit=Timeout) or (chr(zeichen)=#$3E);
if zeit=Timeout then Modul:=False; {Daten senden meldet sich n.}
end;
5 : begin { Memory Modify }
aadr:=hex(wert); delete(aadr,1,2);
SendFolge:=MemModify+hex(adr)+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
delay(20); { mind. 15ms braucht Modul zur Reaktion }
SendFolge:=aadr+#$0D;
for i:=1 to length(SendFolge) do SendByte(ord(SendFolge[i]));
zeit:=0;
delay(20); {}
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt }
if not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
until (zeit=Timeout) or (chr(zeichen)=#$3E);
Modul:=zeit<>Timeout; { Modify meldet sich nicht }
end;
end else Modul:=False
End
else begin { Unterbrechung senden }
SendByte($0D); { jedes Zeichen unterbricht }
zeit:=0;
delay(Round(Daten.SStellen/5)+200);
repeat { Fertigmeldung abwarten, bis ">"=$3E kommt }
if not EmpfByte(zeichen) then zeichen:=255;
inc(zeit);
until (zeit=Timeout) or (chr(zeichen)=#$3E);
Modul:=zeit<>Timeout; {Unterbrechung funktioniert n.}
end;
end;
{---Auswahl des aktiven Kanals-----------------------------}
function Kanalwahl(Kanal:Byte):Boolean;
Begin
Kanalwahl:=false;
{ Kanal am Modul einstellen }
if not Modul(5,ADPrPuffer,0,AdStartAdr+6,Kanal,4) then exit;
Delay(100);
{ Umsetzung ausl”sen um einzuschwingen }
Kanalwahl:=Modul(2,ADPrPuffer,0,ADStartAdr,1,4);
End;
function IsModulInit(const s1, s2: String):Boolean;
begin
if not ModulInit
then Hinweis(200,150,'Das Modul ist noch','nicht initialisiert.',s1,s2);
IsModulInit:=ModulInit;
end;
procedure FehlerReagiertNicht;
begin
Fehler(200,150,False,'Das AD/DA-Modul','reagiert nicht.',
'Initialisieren Sie','es bitte neu.');
end;
{---Einstellen der St�tzstellenzahl am Modul---------------}
function SStellenEinstellen(SStellWord:Word):Boolean;
Var i:Byte;
okay:Boolean;
Begin
okay:=true;
If IsModulInit('Der Wert kann nicht','�bergeben werden.') Then
For i:=1 To 2 Do okay:=okay
and modul(5,ADPrPuffer,0,ADStartAdr+3,Hi(SStellWord),4)
and modul(5,ADPrPuffer,0,ADStartAdr+4,Lo(SStellWord),4)
and modul(5,DAPrPuffer,0,DAStartAdr+3,Hi(SStellWord),4)
and modul(5,DAPrPuffer,0,DAStartAdr+4,Lo(SStellWord),4);
if not okay then FehlerReagiertNicht;
SStellenEinstellen:=true;
End;
{---Einstellen der Umsetzrate am Modul---------------------}
function UrateEinstellen(Urate:TReal):Boolean;
Begin
UrateEinstellen:=true;
If not IsModulInit('Der Wert kann nicht','�bergeben werden.') Then exit;
if not (modul(5,ADPrPuffer,0,ADStartAdr+5,Round(Urate*100-2),4)
and modul(5,DAPrPuffer,0,DAStartAdr+5,Round(Urate*100-2),4))
then FehlerReagiertNicht;
End;
{---DA-Umsetzung einschlieálich Datentransport-------------}
function DAUmsetzung(KanalNr:Byte):Boolean;
var
ok:Boolean;
Begin
DAUmsetzung:=true; {war so!}
if not IsModulInit('Eine Umsetzung ist','nicht m”glich.') then exit;
TransportStatus(200,150,True);
ok:=modul(4,DAPrPuffer,0,0,Round(Daten.SStellen),KanalNr);
CloseStatus;
UmsetzStatus(200,150,True);
If ok Then modul(2,DAPrPuffer,0,DAStartAdr,0,4);
If ok Then Repeat
Eingabe; {eigentlich mit Sanduhr - oder Abbruch-Knopf!}
Until ord(ta)=27;
if ok Then ok:=Modul(6,DAPrPuffer,0,0,0,4);
CloseStatus;
If Not ok Then FehlerReagiertNicht;
DAUmsetzung:=ok;
End;
{---AD-Umsetzung einschlieálich Datentransport-------------}
function ADUmsetzung:Boolean;
Var i,k : Byte;
C : String;
Okay:Boolean;
Begin
ADUmsetzung:=true;
If not IsModulInit('Eine Umsetzung ist','nicht m”glich.') Then exit;
If Daten.BetriebNr=Zyklisch Then Begin
openwindow2(400,5,220,45,5,6,'Zyklische AD-Umsetzung',True);
setcolor(Daten.Color[3]);
Outtextxy(430,35,'Abbruch mit >ESC<');
End;
Repeat
K:=0;
For i:=0 To 7 Do If Daten.KanalNr[i] Then Begin
UmsetzStatus(200,150,False);
Okay:=KanalWahl(i);
Okay:=Okay and modul(2,ADPrPuffer,0,ADStartAdr,1,4); { Umsetzung starten }
CloseStatus;
TransportStatus(200,150,False);
Okay:=Okay and modul(3,ADPrPuffer,0,0,Round(Daten.SStellen),k); { Daten holen }
CloseStatus;
If Not Okay Then Begin
FehlerReagiertNicht;
i:=7;
End;
If Okay Then Begin
KanalUsed[K]:=True;
KanalSS[k]:=Round(Daten.SStellen);
End;
Inc(K);
End;
If Okay Then Begin
MaleKurvenWin;
MaleKurve;
OutXAchse;
End;
If (Daten.BetriebNr=Zyklisch)
and (Ord(ta)<>27) and Keypressed Then Ta:=Readkey;
If (Daten.BetriebNr=Zyklisch)
and (Daten.Pause>0) and (Ord(Ta)<>27) and Okay Then Begin
openwindow2(200,150,240,100,2,4,'Zyklische AD-Umsetzung',True);
PutPicture('StopUhr',210,180);
setcolor(Daten.Color[3]);
Str(Daten.Pause,C);
Outtextxy(290,190,C+'ms Pause');
Outtextxy(290,205,'zwischen den');
Outtextxy(290,220,'Umsetzungen...');
Delay(Daten.Pause);
CloseWindow;
End;
If (Daten.BetriebNr=Zyklisch)
and (Ord(ta)<>27) and Keypressed Then Ta:=Readkey;
Until (Ord(Ta)=27) or (Daten.BetriebNr=Einmalig) or Not Okay;
If Daten.BetriebNr=Zyklisch Then Closewindow;
End;
{---Statusfenster w„hrend Datentransport-------------------}
Procedure TransportStatus(X,Y:Integer;Richtung:Boolean);
Const Status='Einen Moment bitte, es geht gleich weiter...';
Var C : String;
begin
openwindow2(x,y,240,140,2,4,'Status',True);
If Richtung Then putpicture('Schreibe',x+10,y+35) else putpicture('Lese',x+10,y+35);
StatusZeile(Status);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
str(Daten.SStellen:1:0,C);
If Richtung Then Begin
outtextxy(x+110,y+45,'Der Datentrans-');
outtextxy(x+110,y+60,'port vom PC zum');
outtextxy(x+110,y+75,'AD/DA-Modul ');
outtextxy(x+20,y+90,'l„uft. Es werden '+C);
outtextxy(x+20,y+105,'St�tzstellen �bertragen.');
End else Begin
outtextxy(x+110,y+45,'Der Datentrans-');
outtextxy(x+110,y+60,'port vom AD/DA-');
outtextxy(x+110,y+75,'Modul zum PC ');
outtextxy(x+20,y+90,'l„uft. Es werden '+C);
outtextxy(x+20,y+105,'St�tzstellen �bertragen.');
End;
SetWaitCursor(true);
End;
{---Statusfenster w„hrend der Umsetzung--------------------}
Procedure UmsetzStatus(X,Y:Integer;Was:Boolean);
Const DAStatus='Das AD/DA-Modul ist gerade beim DA-Umsetzen... >ESC< Abbruch';
ADStatus='Das AD/DA-Modul ist gerade beim AD-Umsetzen...';
Var C : String;
begin
openwindow2(x,y,240,140,2,4,'Status',True);
If Was Then putpicture('DAU',x+20,y+35) else putpicture('ADU',x+20,y+35);
If Was Then StatusZeile(DAStatus) else StatusZeile(ADStatus);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
str(Daten.SStellen:1:0,C);
If Was Then Begin
outtextxy(x+80,y+45,'Die DA-Umsetzung');
outtextxy(x+80,y+60,'l„uft gerade mit');
outtextxy(x+80,y+75,C+' St�tzstellen');
str(1000/Daten.Urate:1:0,C);
outtextxy(x+80,y+90,'und '+C+' Hz.');
outtextxy(x+80,y+105,'Abbruch mit >ESC<');
End else Begin
outtextxy(x+80,y+45,'Die AD-Umsetzung');
outtextxy(x+80,y+60,'l„uft gerade mit');
outtextxy(x+80,y+75,C+' St�tzstellen');
str(1000/Daten.Urate:1:0,C);
outtextxy(x+80,y+90,'und '+C+' Hz.');
outtextxy(x+80,y+105,'');
End;
SetWaitCursor(true);
End;
End.
| Detected encoding: ANSI (CP1252) | 4
|
|
|