home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of A1200
/
World_Of_A1200.iso
/
programs
/
emulator
/
appleonamiga
/
txt
/
applecomm.mod
< prev
next >
Wrap
Text File
|
1995-02-27
|
23KB
|
733 lines
MODULE AppleComm;
FROM SYSTEM IMPORT ADDRESS,ADR,CAST,LONGSET,SHORTSET,TAG;
FROM Base37 IMPORT A,B,N;
IMPORT
ACASLReq,ACGadgets,a:Audio,d:DosD,D:DosL,e:ExecD,E:ExecL,ES:ExecSupport,Hardware,Heap
,G:GraphicsL,i:IntuitionD,I:IntuitionL,R,s:Serial;
CONST
errNoChipMem="Not enough chip memory for audio";
errSetParms="Error setting serial parameters";
errNoMsgPort="Error creating MsgPort";
errNoRequest="Error creating IORequest";
errNoDevice="Error opening device";
errClear="Error clearing device";
errReset="Error resetting device";
errRead="Error reading from device";
errQuery="Error querying device";
windowTitle="AppleComm";
screenTitle="AppleComm V0.1, 03-Jan-1993";
errNoWindow="Error opening window";
trackStatus="Track: %2ld Length: %5ld";
writeStatus="Writing %8ld byte";
sendStatus="Sending AmigaComm(%5ld)";
clearStatus=" ";
romStatus="Receiving ROMs ";
diskRequest="Receive Disk File";
errNoFile="Error opening file";
gadRetryCancel="Retry|Cancel";
errWriteFile="Error writing file";
errDiskTooLarge="Disk does not fit in buffer";
gadOk="Ok";
errReceive="ReceiveError";
basicRomFile="PROGDIR:BASIC";
diskPromFile="PROGDIR:DISK";
errNoBasic="Error opening "+basicRomFile;
errWriteBasic="Error writing "+basicRomFile;
errNoDisk="Error opening "+diskPromFile;
errWriteDisk="Error writing "+diskPromFile;
errNoDiskMem="Not enough contiguous memory";
alreadyPlaying="Already sending AmigaComm";
errStop="Error stopping device";
errStart="Error starting device";
CONST
numTracks=35;
statusL=20; statusH=90;
VAR
serIOR:s.IOExtSerPtr;
serPortR:e.MsgPortPtr;
PROCEDURE SetBaud(baud:LONGCARD);
BEGIN
serIOR^.ioSer.command:=s.setParams;
serIOR^.baud:=baud;
serIOR^.rBufLen:=8192;
INCL(serIOR^.serFlags,s.radBoogie);
E.DoIO(serIOR);
A(serIOR^.ioSer.error=0,errSetParms);
END SetBaud;
PROCEDURE OpenSer;
BEGIN
serIOR:=NIL; serPortR:=NIL;
(*
create first a port for the serial.device to communicate with
*)
serPortR:=E.CreateMsgPort();
N(serPortR,errNoMsgPort);
(*
create a request block,appropriate to serial.device
*)
serIOR:=E.CreateIORequest(serPortR,SIZE(s.IOExtSer));
N(serIOR,errNoRequest);
(*
open the serial device
*)
serIOR^.serFlags:=s.SerFlagSet{};
E.OpenDevice(ADR(s.serialName),0,serIOR,LONGSET{});
A(serIOR^.ioSer.error=0,errNoDevice);
(*
Initialize serial port
*)
serIOR^.ioSer.command:=e.clear;
E.DoIO(serIOR);
A(serIOR^.ioSer.error=0,errClear);
serIOR^.ioSer.command:=e.reset;
E.DoIO(serIOR);
A(serIOR^.ioSer.error=0,errReset);
SetBaud(9600);
END OpenSer;
PROCEDURE QueueRead(adr:ADDRESS; len:LONGINT);
BEGIN
serIOR^.ioSer.command:=e.read;
serIOR^.ioSer.length:=len;
serIOR^.ioSer.data:=adr;
E.SendIO(serIOR);
END QueueRead;
PROCEDURE GetQueued;
BEGIN
E.WaitIO(serIOR);
END GetQueued;
PROCEDURE Read(adr:ADDRESS; len:LONGINT);
BEGIN
serIOR^.ioSer.command:=e.read;
serIOR^.ioSer.length:=len;
serIOR^.ioSer.data:=adr;
E.DoIO(serIOR);
A(serIOR^.ioSer.error=0,errRead);
END Read;
PROCEDURE QueryReadBuffer(VAR len:LONGINT);
BEGIN
serIOR^.ioSer.command:=s.query;
E.DoIO(serIOR);
A(serIOR^.ioSer.error=0,errQuery);
len:=serIOR^.ioSer.actual;
END QueryReadBuffer;
CONST
allChannels="\x0F"; (* Allocate all channels, we don't want any interference *)
VAR
audioPort:e.MsgPortPtr;
audioIO:ARRAY [0..3] OF a.IOAudioPtr;
playing:BOOLEAN;
PROCEDURE Play(adr:ADDRESS; size:CARDINAL);
VAR
channel:[0..3];
unit:ADDRESS;
BEGIN
audioIO[0]^.request.command:=e.stop;
unit:=15;
audioIO[0]^.request.unit:=unit; (* stops all channels *)
E.DoIO(audioIO[0]);
A(audioIO[0]^.request.error=0,errStop);
FOR channel:=0 TO 3 DO
audioIO[channel]^.request.command:=e.write;
audioIO[channel]^.request.flags:=a.pervol;
CASE channel OF
|0: unit:=1;
|1: unit:=2;
|2: unit:=4;
|3: unit:=8;
END;
audioIO[channel]^.request.unit:=ADDRESS(unit);
audioIO[channel]^.data:=adr;
audioIO[channel]^.length:=size;
audioIO[channel]^.period:=E.execBase^.eClockFrequency DIV 800;
audioIO[channel]^.volume:=64;
audioIO[channel]^.cycles:=1;
ES.BeginIO(audioIO[channel]);
END;
audioIO[0]^.request.command:=e.start;
unit:=15;
audioIO[0]^.request.unit:=unit; (* starts all channels *)
E.DoIO(audioIO[0]);
A(audioIO[0]^.request.error=0,errStart);
playing:=TRUE;
END Play;
PROCEDURE CloseAudio;
VAR
channel:[0..3];
unit:ADDRESS;
BEGIN
IF audioIO[0]#NIL THEN
IF audioIO[0]^.request.device#NIL THEN
IF playing THEN
audioIO[0]^.request.command:=e.reset;
unit:=15;
audioIO[0]^.request.unit:=unit; (* reset all channels *)
E.DoIO(audioIO[0]);
A(audioIO[0]^.request.error=0,errReset);
playing:=FALSE;
END;
E.CloseDevice(audioIO[0]);
END;
FOR channel:=0 TO 3 DO
E.DeleteIORequest(audioIO[channel]); audioIO[channel]:=NIL;
END;
END;
IF audioPort#NIL THEN E.DeleteMsgPort(audioPort); audioPort:=NIL; END;
END CloseAudio;
PROCEDURE OpenAudio;
VAR
channel:[0..3];
BEGIN
FOR channel:=0 TO 3 DO audioIO[channel]:=NIL; END;
audioPort:=NIL; playing:=FALSE;
(*
create first a port for the audio.device to communicate with
*)
audioPort:=E.CreateMsgPort();
N(audioPort,errNoMsgPort);
(*
create a request block,appropriate to audio.device
*)
FOR channel:=0 TO 3 DO
audioIO[channel]:=E.CreateIORequest(audioPort,SIZE(a.IOAudio));
N(audioIO[channel],errNoRequest);
END;
(*
Open the audio device and allocate all left channels with highest
priotity. We have to block out any interference, otherwise our
data transmission will be disturbed.
*)
audioIO[0]^.length:=SIZE(allChannels);
audioIO[0]^.data:=ADR(allChannels);
audioIO[0]^.request.command:=a.allocate;
audioIO[0]^.request.flags:=a.noWait;
audioIO[0]^.request.message.node.pri:=127;
E.OpenDevice(ADR(a.audioName),0,audioIO[0],LONGSET{});
A(audioIO[0]^.request.error=0,errNoDevice);
FOR channel:=1 TO 3 DO (* clone IORequests *)
audioIO[channel]^.allocKey:=audioIO[0]^.allocKey;
audioIO[channel]^.request.device:=audioIO[0]^.request.device;
END;
END OpenAudio;
CONST
tagEnd=0;
VAR
window:i.WindowPtr;
PROCEDURE OpenWindow;
VAR
tagBuffer:ARRAY [1..19] OF LONGCARD;
BEGIN
(* Window öffnen *)
window:=I.OpenWindowTagList(
NIL,TAG(tagBuffer
,i.waTitle,ADR(windowTitle)
,i.waScreenTitle,ADR(screenTitle)
,i.waTop,50,i.waInnerHeight,110,i.waLeft,100,i.waInnerWidth,240
,i.waFlags,i.WindowFlagSet{
i.windowDrag,i.windowDepth,i.windowClose,i.activate,i.noCareRefresh,i.gimmeZeroZero
}
,i.waIDCMP,i.IDCMPFlagSet{i.gadgetUp,i.closeWindow}
,i.waGadgets,ACGadgets.gadgets
,tagEnd
));
A(window#NIL,errNoWindow);
END OpenWindow;
TYPE
DiskBuffer=ARRAY [0..250000] OF SHORTCARD;
VAR
receiveState:(idle,trkLength,trkRead,receiveRoms);
currentTrack:SHORTCARD;
trackLength:INTEGER;
buffer:POINTER TO DiskBuffer;
bufferIndex:LONGINT;
PROCEDURE Request(text,gadgets:ARRAY OF CHAR; parms:ADDRESS):LONGINT;
VAR
easy:i.EasyStruct;
idcmp:i.IDCMPFlagSet;
BEGIN
easy.structSize:=SIZE(i.EasyStruct);
easy.flags:=LONGSET{};
easy.title:=ADR(windowTitle);
easy.textFormat:=ADR(text);
easy.gadgetFormat:=ADR(gadgets);
idcmp:=i.IDCMPFlagSet{};
RETURN I.EasyRequestArgs(window,easy,idcmp,parms);
END Request;
TYPE
String=RECORD
s:ARRAY [0..99] OF CHAR;
i:SHORTCARD;
END;
StringPtr=POINTER TO String;
PROCEDURE PutCh(str{R.A3}:StringPtr; ch{R.D0}:CHAR);
BEGIN
str^.s[str^.i]:=ch; INC(str^.i);
END PutCh;
PROCEDURE TrkStatus(trk,len:LONGCARD);
VAR
buf:ARRAY [1..2] OF LONGCARD;
line:String;
BEGIN
line.s:=""; line.i:=0;
E.RawDoFmt(
ADR(trackStatus),TAG(buf,trk,len)
,ADR(PutCh),ADR(line)
);
G.Move(window^.rPort,statusL,statusH);
G.Text(window^.rPort,ADR(line.s),line.i-1);
END TrkStatus;
PROCEDURE WrtStatus(len:LONGCARD);
VAR
buf:ARRAY [1..2] OF LONGCARD;
line:String;
BEGIN
line.s:=""; line.i:=0;
E.RawDoFmt(
ADR(writeStatus),TAG(buf,len)
,ADR(PutCh),ADR(line)
);
G.Move(window^.rPort,statusL,statusH);
G.Text(window^.rPort,ADR(line.s),line.i-1);
END WrtStatus;
PROCEDURE ClrStatus;
BEGIN
G.Move(window^.rPort,statusL,statusH);
G.Text(window^.rPort,ADR(clearStatus),24);
END ClrStatus;
PROCEDURE RomStatus;
BEGIN
G.Move(window^.rPort,statusL,statusH);
G.Text(window^.rPort,ADR(romStatus),24);
END RomStatus;
PROCEDURE SendStatus(len:LONGCARD);
VAR
buf:ARRAY [1..2] OF LONGCARD;
line:String;
BEGIN
line.s:=""; line.i:=0;
E.RawDoFmt(
ADR(sendStatus),TAG(buf,len)
,ADR(PutCh),ADR(line)
);
G.Move(window^.rPort,statusL,statusH);
G.Text(window^.rPort,ADR(line.s),line.i-1);
END SendStatus;
PROCEDURE SaveDisk;
VAR
f:d.FileHandlePtr;
name:ARRAY [0..99] OF CHAR;
ret:LONGINT;
save:BOOLEAN;
BEGIN
name:="";
LOOP
save:=ACASLReq.FileReq(name,diskRequest,"",TRUE);
IF save THEN
f:=D.Open(ADR(name),d.newFile);
IF f=NIL THEN
ret:=Request(errNoFile,gadRetryCancel,NIL);
ELSE
WrtStatus(bufferIndex);
IF D.Write(f,ADR(buffer^[0]),bufferIndex)#bufferIndex THEN
(* Error writing *)
ClrStatus;
ret:=Request(errWriteFile,gadRetryCancel,NIL);
ELSE
ClrStatus;
ret:=0; (* all done, we can exit. *)
END;
D.Close(f);
END;
IF ret=0 THEN EXIT; END;
ELSE
EXIT;
END;
END;
END SaveDisk;
PROCEDURE ReceiveDisk;
BEGIN
currentTrack:=0; bufferIndex:=0; trackLength:=0;
receiveState:=trkLength;
(*
Queue a read for the length field preceeding the first track.
*)
TrkStatus(currentTrack,trackLength);
QueueRead(ADR(buffer^[0]),2);
END ReceiveDisk;
PROCEDURE StartTrackRead;
VAR
len:CARDINAL;
BEGIN
E.WaitIO(serIOR);
trackLength:=buffer^[bufferIndex]+256*buffer^[bufferIndex+1];
INC(bufferIndex,2);
A(bufferIndex+trackLength+2<=SIZE(DiskBuffer),errDiskTooLarge);
(*
Queue a read for the buffer size plus the two following length bytes.
*)
receiveState:=trkRead;
TrkStatus(currentTrack,trackLength);
QueueRead(ADR(buffer^[bufferIndex]),trackLength+2);
END StartTrackRead;
PROCEDURE ToNextTrack;
VAR
dummy:LONGINT;
BEGIN
E.WaitIO(serIOR);
INC(bufferIndex,trackLength);
IF trackLength#INTEGER(buffer^[bufferIndex]+256*buffer^[bufferIndex+1]) THEN
(* transmission error, finals length and intial length do not match *)
dummy:=Request(errReceive,gadOk,NIL);
ClrStatus;
ELSE
INC(bufferIndex,2); (* position past final length information *)
INC(currentTrack);
IF currentTrack<numTracks THEN
(* queue for length of next track *)
receiveState:=trkLength; trackLength:=0;
TrkStatus(currentTrack,trackLength);
QueueRead(ADR(buffer^[bufferIndex]),2);
ELSE
(* we got all tracks *)
receiveState:=idle;
ClrStatus;
SaveDisk;
END;
END;
END ToNextTrack;
PROCEDURE SaveRoms;
VAR
f:d.FileHandlePtr;
name:ARRAY [0..99] OF CHAR;
ret:LONGINT;
save:BOOLEAN;
BEGIN
receiveState:=idle;
name:=basicRomFile;
f:=D.Open(ADR(name),d.newFile);
IF f=NIL THEN
ret:=Request(errNoBasic,gadOk,NIL);
ELSE
WrtStatus(03000H);
IF D.Write(f,ADR(buffer^[4]),03000H)#03000H THEN
(* Error writing *)
ClrStatus;
ret:=Request(errWriteBasic,gadOk,NIL);
ELSE
ClrStatus;
END;
D.Close(f);
END;
name:=diskPromFile;
f:=D.Open(ADR(name),d.newFile);
IF f=NIL THEN
ret:=Request(errNoDisk,gadOk,NIL);
ELSE
WrtStatus(0100H);
IF D.Write(f,ADR(buffer^[03008H]),0100H)#0100H THEN
(* Error writing *)
ClrStatus;
ret:=Request(errWriteDisk,gadOk,NIL);
ELSE
ClrStatus;
END;
D.Close(f);
END;
END SaveRoms;
PROCEDURE ReceiveRoms;
BEGIN
RomStatus; receiveState:=receiveRoms;
QueueRead(ADR(buffer^[0]),12552);
END ReceiveRoms;
TYPE
AmigaCommArray=ARRAY [1..0587H] OF SHORTCARD;
CONST
amigaComm=AmigaCommArray{
020H,058H,0FCH,0ADH,058H,0C0H,020H,064H,085H,020H,001H,00DH,009H,007H,001H,003H
,00FH,00DH,00DH,020H,016H,030H,02EH,031H,02CH,020H,031H,039H,039H,032H,020H,002H
,019H,020H,003H,00CH,001H,015H,004H,009H,00FH,020H,00EH,009H,005H,004H,005H,012H
,020H,000H,0A9H,005H,085H,024H,0A9H,008H,020H,05BH,0FBH,020H,064H,085H,0D2H,0A0H
,0ADH,0A0H,0D3H,0C5H,0CEH,0C4H,0A0H,0C2H,0C1H,0D3H,0C9H,0C3H,0AFH,0C4H,0C9H,0D3H
,0CBH,0A0H,0A8H,0D0H,0A9H,0D2H,0CFH,0CDH,000H,0A9H,005H,085H,024H,0A9H,00AH,020H
,05BH,0FBH,020H,064H,085H,0C4H,0A0H,0ADH,0A0H,0D3H,0C5H,0CEH,0C4H,0A0H,0C4H,0C9H
,0D3H,0CBH,000H,0A9H,005H,085H,024H,0A9H,00EH,020H,05BH,0FBH,020H,064H,085H,0C8H
,0A0H,0ADH,0A0H,0C8H,0C5H,0CCH,0D0H,000H,0A9H,005H,085H,024H,0A9H,012H,020H,05BH
,0FBH,020H,064H,085H,0D1H,0A0H,0ADH,0A0H,0D1H,0D5H,0C9H,0D4H,000H,0ADH,000H,0C0H
,010H,0FBH,02CH,010H,0C0H,0C9H,0D2H,0F0H,015H,0C9H,0C4H,0F0H,069H,0C9H,0C8H,0F0H
,00AH,0C9H,0D1H,0D0H,0E8H,020H,058H,0FCH,04CH,0D0H,003H,04CH,04BH,081H,0A9H,000H
,085H,024H,0A9H,002H,020H,05BH,0FBH,020H,042H,0FCH,0A9H,005H,085H,024H,0A9H,009H
,020H,05BH,0FBH,020H,064H,085H,0D4H,0D2H,0C1H,0CEH,0D3H,0C6H,0C5H,0D2H,0D2H,0C9H
,0CEH,0C7H,0A0H,0C2H,0C1H,0D3H,0C9H,0C3H,0A0H,0D2H,0CFH,0CDH,0A0H,0C1H,0CEH,0C4H
,000H,0A9H,005H,085H,024H,0A9H,00BH,020H,05BH,0FBH,020H,064H,085H,0C4H,0C9H,0D3H
,0CBH,0A0H,0D0H,0D2H,0CFH,0CDH,0A0H,0D4H,0CFH,0A0H,0C1H,0CDH,0C9H,0C7H,0C1H,000H
,020H,0F7H,082H,04CH,000H,080H,0A9H,000H,085H,024H,0A9H,002H,020H,05BH,0FBH,020H
,042H,0FCH,0A9H,005H,085H,024H,0A9H,009H,020H,05BH,0FBH,020H,064H,085H,0D4H,0D2H
,0C1H,0CEH,0D3H,0C6H,0C5H,0D2H,0A0H,0C4H,0C9H,0D3H,0CBH,0A0H,0D4H,0CFH,0A0H,0C1H
,0CDH,0C9H,0C7H,0C1H,000H,020H,039H,083H,04CH,000H,080H,0A9H,000H,085H,024H,0A9H
,002H,020H,05BH,0FBH,020H,042H,0FCH,020H,064H,085H,08DH,08DH,0D7H,0C9H,0D4H,0C8H
,0A0H,0D4H,0C8H,0C9H,0D3H,0A0H,0D0H,0D2H,0CFH,0C7H,0D2H,0C1H,0CDH,0A0H,0D9H,0CFH
,0D5H,0A0H,0C3H,0C1H,0CEH,0A0H,0D4H,0D2H,0C1H,0CEH,0D3H,0CDH,0C9H,0D4H,0A0H,0D4H
,0C8H,0C5H,08DH,0C3H,0CFH,0CEH,0D4H,0C5H,0CEH,0D4H,0D3H,0A0H,0CFH,0C6H,0A0H,0D4H
,0C8H,0C5H,0A0H,0C2H,0C1H,0D3H,0C9H,0C3H,0AFH,0CDH,0CFH,0CEH,0C9H,0D4H,0CFH,0D2H
,0A0H,0D2H,0CFH,0CDH,0A0H,0C1H,0CEH,0C4H,08DH,0D9H,0CFH,0D5H,0D2H,0A0H,0C4H,0C9H
,0D3H,0CBH,0D3H,0A0H,0D4H,0CFH,0A0H,0C8H,0C5H,0A0H,0C1H,0CDH,0C9H,0C7H,0C1H,0ACH
,0A0H,0D3H,0CFH,0A0H,0D9H,0CFH,0D5H,0A0H,0C3H,0C1H,0CEH,0A0H,0D5H,0D3H,0C5H,08DH
,0D4H,0C8H,0C5H,0A0H,0C1H,0D0H,0D0H,0CCH,0C5H,0A0H,0B2H,0A0H,0C5H,0CDH,0D5H,0CCH
,0C1H,0D4H,0CFH,0D2H,0A0H,0D4H,0C8H,0C5H,0D2H,0C5H,0AEH,08DH,08DH,0D2H,0A9H,0A0H
,0C5H,0D8H,0D0H,0C5H,0C3H,0D4H,0D3H,0A0H,0D9H,0CFH,0D5H,0A0H,0C8H,0C1H,0D6H,0C5H
,0A0H,0C1H,0A0H,0C4H,0C9H,0D3H,0CBH,0A0H,0C3H,0CFH,0CEH,0D2H,0CFH,0CCH,0CCH,0C5H
,0D2H,0A0H,0C9H,0CEH,08DH,0A0H,0A0H,0A0H,0D3H,0CCH,0CFH,0D4H,0A0H,0B6H,0ACH,0A0H
,0C1H,0CEH,0C4H,0A0H,0D4H,0D2H,0C1H,0CEH,0D3H,0CDH,0C9H,0D4H,0D3H,0A0H,0A4H,0C3H
,0B6H,0B0H,0B0H,0ADH,0A4H,0C3H,0B6H,0C6H,0C6H,08DH,0A0H,0A0H,0A0H,0C1H,0CEH,0C4H
,0A0H,0A4H,0C4H,0B0H,0B0H,0B0H,0ADH,0A4H,0C6H,0C6H,0C6H,0C6H,0A0H,0D4H,0CFH,0A0H
,0D4H,0C8H,0C5H,0A0H,0C1H,0CDH,0C9H,0C7H,0C1H,08DH,08DH,0C4H,0A9H,0A0H,0D4H,0D2H
,0C1H,0CEH,0D3H,0CDH,0C9H,0D4H,0D3H,0A0H,0D4H,0C8H,0C5H,0A0H,0C3H,0CFH,0CEH,0D4H
,0C5H,0CEH,0D4H,0D3H,0A0H,0CFH,0C6H,0A0H,0D4H,0C8H,0C5H,0A0H,0C4H,0C9H,0D3H,0CBH
,08DH,0A0H,0A0H,0A0H,0C9H,0CEH,0A0H,0D4H,0C8H,0C5H,0A0H,0C3H,0D5H,0D2H,0D2H,0C5H
,0CEH,0D4H,0A0H,0C4H,0D2H,0C9H,0D6H,0C5H,0A0H,0D4H,0CFH,0A0H,0D4H,0C8H,0C5H,0A0H
,0C1H,0CDH,0C9H,0C7H,0C1H,08DH,0A0H,0A0H,0A0H,0D9H,0CFH,0D5H,0A0H,0C3H,0C1H,0CEH
,0A7H,0D4H,0A0H,0C3H,0C8H,0C1H,0CEH,0C7H,0C5H,0A0H,0D3H,0CCH,0CFH,0D4H,0AFH,0C4H
,0D2H,0C9H,0D6H,0C5H,08DH,08DH,08DH,0D0H,0D2H,0C5H,0D3H,0D3H,0A0H,0C1H,0CEH,0D9H
,0A0H,0CBH,0C5H,0D9H,0A0H,0D4H,0CFH,0A0H,0D2H,0C5H,0D4H,0D5H,0D2H,0CEH,0A0H,0D4H
,0CFH,0A0H,0CDH,0C1H,0C9H,0CEH,0A0H,0CDH,0C5H,0CEH,0D5H,000H,02CH,000H,0C0H,010H
,0FBH,02CH,010H,0C0H,04CH,000H,080H,0A9H,000H,085H,0FAH,0A9H,030H,085H,0FBH,0A9H
,000H,085H,0FCH,0A9H,0D0H,085H,0FDH,020H,024H,083H,020H,0D3H,084H,0A9H,000H,085H
,0FCH,0A9H,0C6H,085H,0FDH,0A9H,000H,085H,0FAH,0A9H,001H,085H,0FBH,020H,024H,083H
,020H,0D3H,084H,060H,0A5H,0FCH,020H,03FH,085H,0A5H,0FDH,020H,03FH,085H,0A5H,0FAH
,020H,03FH,085H,0A5H,0FBH,020H,03FH,085H,060H,020H,0A3H,084H,0A9H,000H,085H,0F7H
,0A9H,002H,085H,024H,0A9H,00CH,020H,05BH,0FBH,020H,042H,0FCH,020H,064H,085H,0D2H
,0C5H,0C1H,0C4H,0A0H,0D4H,0D2H,0C1H,0C3H,0CBH,0A0H,0A4H,000H,0A5H,0F7H,020H,0DAH
,0FDH,020H,06CH,084H,0A9H,002H,085H,024H,0A9H,00CH,020H,05BH,0FBH,020H,09CH,0FCH
,0A5H,0F7H,020H,0DAH,0FDH,020H,0ACH,083H,0A9H,002H,085H,024H,0A9H,00CH,020H,05BH
,0FBH,020H,09CH,0FCH,020H,064H,085H,0D4H,0D2H,0C1H,0CEH,0D3H,0CDH,0C9H,0D4H,0A0H
,0D4H,0D2H,0C1H,0C3H,0CBH,0A0H,0A4H,000H,0A5H,0F7H,020H,0DAH,0FDH,020H,0D3H,084H
,0E6H,0F7H,0A5H,0F7H,0C9H,023H,0F0H,003H,04CH,040H,083H,060H,0A9H,000H,085H,0FEH
,0A9H,040H,085H,0FFH,020H,034H,084H,0A5H,0FEH,085H,0FCH,0A5H,0FFH,085H,0FDH,018H
,0A5H,0FEH,069H,07CH,085H,0FEH,0A5H,0FFH,069H,015H,085H,0FFH,018H,0A5H,0FEH,069H
,001H,085H,0FEH,0A5H,0FFH,069H,000H,085H,0FFH,020H,034H,084H,020H,025H,084H,0D0H
,0EBH,038H,0A5H,0FEH,0E5H,0FCH,085H,0FAH,0A5H,0FFH,0E5H,0FDH,085H,0FBH,018H,0A5H
,0FEH,069H,001H,085H,0FEH,0A5H,0FFH,069H,000H,085H,0FFH,038H,0A5H,0FCH,0E9H,001H
,085H,0FCH,0A5H,0FDH,0E9H,000H,085H,0FDH,0A0H,000H,0A5H,0FAH,091H,0FCH,091H,0FEH
,0C8H,0A5H,0FBH,091H,0FCH,091H,0FEH,018H,0A5H,0FAH,069H,004H,085H,0FAH,0A5H,0FBH
,069H,000H,085H,0FBH,060H,0A0H,003H,0A2H,008H,0C8H,0B1H,0FCH,0D1H,0FEH,0D0H,003H
,0CAH,0D0H,0F6H,060H,0A0H,000H,0E6H,0FEH,0D0H,007H,0E6H,0FFH,010H,003H,04CH,02DH
,0FFH,0B1H,0FEH,0C9H,0FFH,0D0H,0EDH,0C8H,0B1H,0FEH,0C9H,0D5H,0D0H,0E6H,0C8H,0B1H
,0FEH,0C9H,0AAH,0D0H,0DFH,0C8H,0B1H,0FEH,0C9H,096H,0D0H,0D8H,0A0H,00CH,0B1H,0FEH
,0C9H,0DEH,0D0H,0D0H,0C8H,0B1H,0FEH,0C9H,0AAH,0D0H,0C9H,060H,0A5H,0F7H,0A0H,004H
,091H,0F8H,0A9H,000H,0A0H,00CH,091H,0F8H,020H,0B1H,084H,0A0H,001H,0B1H,0F8H,0AAH
,0BDH,089H,0C0H,0BDH,08EH,0C0H,0A9H,000H,085H,0FEH,0A9H,040H,085H,0FFH,0A0H,000H
,0BDH,08CH,0C0H,010H,0FBH,091H,0FEH,0E6H,0FEH,0D0H,0F5H,0E6H,0FFH,010H,0F1H,0BDH
,088H,0C0H,060H,020H,0E3H,003H,084H,0F8H,085H,0F9H,0A0H,003H,0A9H,000H,091H,0F8H
,060H,0A4H,0F8H,0A5H,0F9H,020H,0D9H,003H,008H,0A0H,001H,0B1H,0F8H,0AAH,0C8H,0B1H
,0F8H,0A0H,010H,091H,0F8H,08AH,088H,091H,0F8H,0A0H,00EH,0B1H,0F8H,0A0H,003H,091H
,0F8H,028H,060H,0A5H,0FCH,085H,0FEH,0A5H,0FDH,085H,0FFH,0A9H,000H,085H,024H,0A9H
,016H,020H,05BH,0FBH,020H,064H,085H,0C2H,0D9H,0D4H,0C5H,0D3H,0A0H,0D4H,0CFH,0A0H
,0D4H,0D2H,0C1H,0CEH,0D3H,0C6H,0C5H,0D2H,0A0H,0A4H,000H,0A5H,024H,048H,0A6H,0FAH
,0A5H,0FBH,020H,041H,0F9H,068H,085H,024H,0A0H,000H,0B1H,0FEH,020H,03FH,085H,018H
,0A5H,0FEH,069H,001H,085H,0FEH,0A5H,0FFH,069H,000H,085H,0FFH,038H,0A5H,0FAH,0E9H
,001H,085H,0FAH,0A5H,0FBH,0E9H,000H,085H,0FBH,0A5H,0FAH,0D0H,0DBH,0A5H,024H,048H
,0A5H,0FBH,0A2H,000H,020H,041H,0F9H,068H,085H,024H,0A5H,0FBH,0D0H,0CAH,060H,0A2H
,00AH,049H,0FFH,02CH,059H,0C0H,04CH,05BH,085H,04AH,090H,008H,0A4H,000H,02CH,059H
,0C0H,04CH,05BH,085H,0EAH,02CH,058H,0C0H,04CH,05BH,085H,0A0H,011H,088H,0D0H,0FDH
,0CAH,0D0H,0E6H,060H,068H,085H,0F5H,068H,085H,0F6H,098H,048H,0A0H,000H,0E6H,0F5H
,0D0H,002H,0E6H,0F6H,0B1H,0F5H,0F0H,006H,020H,0EDH,0FDH,04CH,06EH,085H,068H,0A8H
,0A5H,0F6H,048H,0A5H,0F5H,048H,060H
};
CONST
audioSize=65000;
TYPE
AudioBuffer=ARRAY [0..audioSize-1] OF SHORTINT;
VAR
audioBuffer:POINTER TO AudioBuffer;
sendACStatus:(acIdle,setup,transmit,cleanup);
PROCEDURE SendAmigaComm;
CONST
headerSize=4000;
trailerSize=100;
VAR
bit:[0..7];
check,data:SHORTSET;
dummy:LONGINT;
i,n:CARDINAL;
BEGIN
IF sendACStatus=acIdle THEN
sendACStatus:=setup;
Heap.AllocMem(audioBuffer,SIZE(AudioBuffer),TRUE);
N(audioBuffer,errNoChipMem);
(*
Write Header
*)
FOR i:=0 TO headerSize-1 DO
audioBuffer^[6*i]:=127;
audioBuffer^[6*i+1]:=127;
audioBuffer^[6*i+2]:=127;
audioBuffer^[6*i+3]:=-128;
audioBuffer^[6*i+4]:=-128;
audioBuffer^[6*i+5]:=-128;
END;
(*
Start Mark
*)
i:=headerSize*6;
audioBuffer^[i]:=127; audioBuffer^[i+1]:=-128; INC(i,2);
(*
Data
*)
check:=SHORTSET{0..7};
FOR n:=1 TO SIZE(AmigaCommArray) DO
data:=CAST(SHORTSET,amigaComm[n]);
check:=check/data;
FOR bit:=7 TO 0 BY -1 DO
IF bit IN data THEN
audioBuffer^[i]:=127; audioBuffer^[i+1]:=127;
audioBuffer^[i+2]:=-128; audioBuffer^[i+3]:=-128; INC(i,4);
ELSE
audioBuffer^[i]:=127; audioBuffer^[i+1]:=-128; INC(i,2);
END;
END;
END;
(*
Checksum
*)
FOR bit:=7 TO 0 BY -1 DO
IF bit IN check THEN
audioBuffer^[i]:=127; audioBuffer^[i+1]:=127;
audioBuffer^[i+2]:=-128; audioBuffer^[i+3]:=-128; INC(i,4);
ELSE
audioBuffer^[i]:=127; audioBuffer^[i+1]:=-128; INC(i,2);
END;
END;
(*
Trailer (except the first transition not really needed)
*)
FOR n:=1 TO trailerSize DO
audioBuffer^[i]:=127; audioBuffer^[i+1]:=127; audioBuffer^[i+2]:=127;
audioBuffer^[i+3]:=-128; audioBuffer^[i+4]:=-128; audioBuffer^[i+5]:=-128;
INC(i,6);
END;
sendACStatus:=transmit;
INCL(Hardware.ciaa.pra,Hardware.led);
Play(audioBuffer,i);
SendStatus(i);
ELSE
dummy:=Request(alreadyPlaying,gadOk,NIL);
END;
END SendAmigaComm;
PROCEDURE EndAmigaComm;
VAR
channel:[0..3];
BEGIN
sendACStatus:=cleanup;
IF playing THEN
FOR channel:=0 TO 3 DO E.WaitIO(audioIO[channel]); END;
END;
EXCL(Hardware.ciaa.pra,Hardware.led);
Heap.Deallocate(audioBuffer);
ClrStatus;
sendACStatus:=acIdle;
END EndAmigaComm;
VAR
id:INTEGER;
msg:i.IntuiMessagePtr;
quit:BOOLEAN;
audBit,serBit,winBit:SHORTCARD;
signals,waitSignals:LONGSET;
BEGIN
Heap.Allocate(buffer,SIZE(DiskBuffer));
N(buffer,errNoDiskMem);
OpenWindow;
OpenSer;
OpenAudio;
quit:=FALSE;
audBit:=audioPort^.sigBit;
serBit:=serPortR^.sigBit;
winBit:=window^.userPort^.sigBit;
waitSignals:=LONGSET{audBit,serBit,winBit};
REPEAT
signals:=E.Wait(waitSignals);
IF serBit IN signals THEN
CASE receiveState OF
| trkLength: StartTrackRead;
| trkRead: ToNextTrack;
| receiveRoms: SaveRoms;
END;
END;
IF winBit IN signals THEN
LOOP
msg:=E.GetMsg(window^.userPort);
IF msg=NIL THEN EXIT END;
IF i.closeWindow IN msg^.class THEN quit:=TRUE; id:=0; END;
IF i.gadgetUp IN msg^.class THEN
id:=i.GadgetPtr(msg^.iAddress)^.gadgetID;
ELSE
id:=0;
END;
E.ReplyMsg(msg);
CASE id OF
| 0: (* no gadget pressed *)
| 1: ReceiveDisk;
| 2: ReceiveRoms;
| 3: SendAmigaComm;
END;
END;
END;
IF audBit IN signals THEN
IF sendACStatus=transmit THEN EndAmigaComm; ELSE HALT; END;
END;
UNTIL quit;
CLOSE
CloseAudio;
IF serIOR#NIL THEN
E.AbortIO(serIOR); E.WaitIO(serIOR);
E.CloseDevice(serIOR);
E.DeleteIORequest(serIOR);
serIOR:=NIL;
END;
IF serPortR#NIL THEN E.DeleteMsgPort(serPortR); serPortR:=NIL; END;
IF window#NIL THEN I.CloseWindow(window); window:=NIL; END;
IF buffer#NIL THEN Heap.Deallocate(buffer); END;
END AppleComm.