DEFINITION MODULE StartupCode;

(** ------------------------------------------------------------------

                    Handles Workbench and CLI startups

        Copyright (c) 1987 Vertex Associates.  All Rights Reserved

    ------------------------------------------------------------------ **)


(* VERSION FOR COMMODORE AMIGA

     Original Author : Martin Taillefer.  06-Jul-87

     Version         : 1.00a  06-Jul-87  Martin Taillefer, Vertex Associates.
                         Original.

  *)

(*$S-,$T-,$Q+*)

FROM DOSFiles      IMPORT FileLock;
FROM DOSExtensions IMPORT ProcessPtr;


VAR
  myproc      : ProcessPtr;    (* Pointer to current Process *)
  processlock : FileLock;      (* FileLock associated with the directory from
                                  which the current process was started.
                                  Allows to set the CurrentDir. This lock
                                  is only valid when the process was started
                                  from Workbench, otherwise it equals 0 *) 


PROCEDURE StartUp;

(* Include this at the start of your programs. It will handle being started
   either from CLI or from WB and will prepare the parameter list to be read *)



PROCEDURE CloseUp;

(* Include this as the last statement in your programs. It will handle the
   termination process wheter the program was started from CLI or WB.*)



PROCEDURE GetNextArgument(VAR name:ARRAY OF CHAR;VAR lock:FileLock):BOOLEAN;

(* Will provide the next argument in sequence wheter the program was started
   from CLI or WB. If started from WB, the lock variable will hold the
   FileLock associated with the parameter (WBStartUp.waLock). If started from
   CLI the lock variable will hold 0. The procedure returns FALSE when there
   are no more arguments. *)



END StartupCode.
------------------------------------------------------------------------------
IMPLEMENTATION MODULE StartupCode;

(** ------------------------------------------------------------------

                    Handles Workbench and CLI startups

        Copyright (c) 1987 Vertex Associates.  All Rights Reserved

    ------------------------------------------------------------------ **)


(* VERSION FOR COMMODORE AMIGA

     Original Author : Martin Taillefer.  06-Jul-87

     Version         : 1.00a  06-Jul-87  Martin Taillefer, Vertex Associates.
                         Original.

  *)

(*$S-,$T-,$Q+*)

FROM SYSTEM         IMPORT ADR, ADDRESS, NULL;
FROM Ports          IMPORT GetMsg, ReplyMsg, WaitPort, MessagePtr;
FROM Strings        IMPORT Assign;
FROM DOSFiles       IMPORT FileLock;
FROM Workbench      IMPORT WBStartup, WBArgPtr; 
FROM Interrupts     IMPORT Forbid;
IMPORT AMIGAX;
 

VAR
  wb      : BOOLEAN;
  wbmsg   : POINTER TO WBStartup;
  args    : WBArgPtr;
  numargs : LONGINT;
  charptr : POINTER TO CHAR;


PROCEDURE StartUp;
BEGIN
  myproc:=AMIGAX.ProcessPtr;
  IF myproc^.prCLI=NULL THEN
    wb:=TRUE;
    wbmsg:=WaitPort(ADR(myproc^.prMsgPort));
    wbmsg:=GetMsg(ADR(myproc^.prMsgPort));
    args:=wbmsg^.smArgList;
    numargs:=wbmsg^.smNumArgs-1;
    processlock:=args^.waLock;
    INC(args,SIZE(args^));
  ELSE
    wb:=FALSE;
    charptr:=AMIGAX.CLinePtr+ADDRESS(AMIGAX.CLineLen)-1;
    charptr^:=0C;
    charptr:=AMIGAX.CLinePtr;
  END;
END StartUp;


PROCEDURE CloseUp;
BEGIN
  IF wb THEN
    Forbid;
    ReplyMsg(MessagePtr(wbmsg));
  END;
END CloseUp;


PROCEDURE GetNextArgument(VAR name:ARRAY OF CHAR;VAR lock:FileLock):BOOLEAN;
VAR
  i           : CARDINAL;
  specialchar : CHAR;
BEGIN
  lock:=0;
  IF wb THEN
    IF numargs>0 THEN
      Assign(name,args^.waName^);
      lock:=args^.waLock;
      INC(args,SIZE(args^));
      DEC(numargs);
      RETURN TRUE;
    END;
    RETURN FALSE;
  END;

  WHILE charptr^=" " DO
    INC(charptr);
  END;

  specialchar:=" ";
  IF charptr^=0C THEN
    RETURN FALSE;
  ELSIF charptr^=42C THEN
    INC(charptr,1);
    specialchar:=42C;
  END;

  i:=0;
  WHILE (charptr^ # 0C) & (charptr^ # specialchar) DO
    IF i<=HIGH(name) THEN
      name[i]:=charptr^;
      INC(i);
    END;
    INC(charptr);
  END;
  IF charptr^ # 0C THEN
    INC(charptr);
  END;

  name[i]:=0C;
  RETURN TRUE;
END GetNextArgument;


(*$P-*)
END StartupCode.
------------------------------------------------------------------------------
DEFINITION MODULE TrackInterface;


(*==========================================================================*)
(*                             TrackInterface                               *)
(*     A library module that performs full track read/writes/verify         *)
(*==========================================================================*)
(*                   Written for TDI Modula-2/Amiga V3.00a                  *)
(*==========================================================================*)
(*                                                                          *)
(*   Original Author : Martin Taillefer.  11-Dec-87                         *)
(*                                                                          *)
(*   Version         : 1.00a  11-Dec-87  Martin Taillefer                   *)
(*                        Original.                                         *)
(*                                                                          *)
(*==========================================================================*)


(*$S-,$T-,$Q+*)

FROM SYSTEM          IMPORT ADDRESS;
FROM TrackDiskDevice IMPORT IOExtTD;


CONST
  TrackSize = 512*11;


PROCEDURE ReadTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;buffer:ADDRESS):BOOLEAN;

PROCEDURE WriteTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;buffer:ADDRESS):BOOLEAN;

PROCEDURE VerifyTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;
                      original,buffer:ADDRESS):CARDINAL;
  (* This function compares the contents of a disk track with a memory resident
   * track buffer. A return value of 0 indicates validity, any other value
   * indicates an error. The values returned are:
   *   0: the tracks are the same
   *   1: Bad checksum, disk has an error.
   *   20+: Bad disk, this corresponds to the error returned by the trackdisk
   *        device
   *)

PROCEDURE DiskMotor(VAR diskreq:IOExtTD;turniton:BOOLEAN);

PROCEDURE GetChangeCount(VAR diskreq:IOExtTD);


END TrackInterface.
------------------------------------------------------------------------------
IMPLEMENTATION MODULE TrackInterface;


(*==========================================================================*)
(*                             TrackInterface                               *)
(*     A library module that performs full track read/writes/verify         *)
(*==========================================================================*)
(*                   Written for TDI Modula-2/Amiga V3.00a                  *)
(*==========================================================================*)
(*                                                                          *)
(*   Original Author : Martin Taillefer.  11-Dec-87                         *)
(*                                                                          *)
(*   Version         : 1.00a  11-Dec-87  Martin Taillefer                   *)
(*                        Original.                                         *)
(*                                                                          *)
(*==========================================================================*)


(*$S-,$T-,$Q+*)

FROM SYSTEM          IMPORT ADDRESS;
FROM IO              IMPORT DoIO;
FROM TrackDiskDevice IMPORT ETDClear, TDMotor, IOExtTD, ETDRead, ETDWrite,
                            TDChangeNum, TDFormat;


PROCEDURE ReadTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;buffer:ADDRESS):BOOLEAN;
BEGIN
  WITH diskreq.iotdReq DO
    ioReq.ioCommand := ETDRead;
    ioLength := TrackSize;
    ioData   := buffer;
    ioOffset := 512*LONG(11*head+22*track);
  END;
  RETURN (DoIO(diskreq.iotdReq.ioReq)=0);
END ReadTrack;


PROCEDURE WriteTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;buffer:ADDRESS):BOOLEAN;
BEGIN
  WITH diskreq.iotdReq DO
    ioReq.ioCommand := TDFormat;
    ioLength := TrackSize;
    ioData   := buffer;
    ioOffset := 512*LONG(11*head+22*track);
  END;
  RETURN (DoIO(diskreq.iotdReq.ioReq)=0);
END WriteTrack;


PROCEDURE VerifyTrack(VAR diskreq:IOExtTD;track,head:CARDINAL;
                      original,buffer:ADDRESS):CARDINAL;
VAR
  i         : CARDINAL;
  x         : LONGINT;
  buf1,buf2 : POINTER TO LONGCARD;
  tot1,tot2 : LONGCARD;
BEGIN
  diskreq.iotdReq.ioReq.ioCommand:=ETDClear;
  x:=DoIO(diskreq.iotdReq.ioReq);
  
  GetChangeCount(diskreq);

  IF ReadTrack(diskreq,track,head,buffer) THEN
    buf1:=buffer;
    buf2:=original;
    tot1:=0;
    tot2:=0;
    FOR i:=1 TO (TrackSize DIV 4) DO
      INC(tot1,buf1^);
      INC(tot2,buf2^);
      INC(buf1,4);
      INC(buf2,4);
    END;
    IF tot1=tot2 THEN
      RETURN 0;
    END;
    RETURN 1;
  END;
  RETURN CARDINAL(diskreq.iotdReq.ioReq.ioError);  (* pfeeeew... *)
END VerifyTrack;


PROCEDURE DiskMotor(VAR diskreq:IOExtTD;turniton:BOOLEAN);
VAR
  x : LONGINT;
BEGIN
  diskreq.iotdReq.ioReq.ioCommand:=TDMotor;
  diskreq.iotdReq.ioLength:=0;          (* motor off *)
  IF turniton THEN
    diskreq.iotdReq.ioLength:=1;        (* motor on *)
  END;

  x:=DoIO(diskreq.iotdReq.ioReq);
END DiskMotor;


PROCEDURE GetChangeCount(VAR diskreq:IOExtTD);
VAR
  x : LONGINT;
BEGIN
  diskreq.iotdReq.ioReq.ioCommand:=TDChangeNum;
  x:=DoIO(diskreq.iotdReq.ioReq);
  diskreq.iotdCount:=diskreq.iotdReq.ioActual;
END GetChangeCount;


END TrackInterface.
------------------------------------------------------------------------------
MODULE Beep;


(*==========================================================================*)
(*                                 Beep                                     *)
(*                 Simple program to "BEEP" the speaker                     *)
(*==========================================================================*)
(*                   Written for TDI Modula-2/Amiga V3.00a                  *)
(*==========================================================================*)
(*                                                                          *)
(*   Original Author : Martin Taillefer.  10-Dec-87                         *)
(*                                                                          *)
(*   Version         : 1.00a  10-Dec-87  Martin Taillefer                   *)
(*                        Original.                                         *)
(*                                                                          *)
(*==========================================================================*)


(*$S-,$T-,$A+*)

FROM SYSTEM      IMPORT ADR, BYTE, TSIZE, NULL;
FROM Ports       IMPORT MsgPortPtr;
FROM PortUtils   IMPORT CreatePort, DeletePort;
FROM Memory      IMPORT AllocMem, FreeMem, MemReqSet, MemChip;
FROM Devices     IMPORT OpenDevice, CloseDevice;
FROM IO          IMPORT BeginIO, WaitIO, ioFlagSet, CmdWrite;
FROM AudioDevice IMPORT AudioName, IOAudio;


VAR
  x        : LONGINT;
  ioa      : IOAudio;
  audport  : MsgPortPtr;
  buffer   : POINTER TO CARDINAL;
  allocchannel : BYTE;


BEGIN
  buffer:=AllocMem(2,MemReqSet{MemChip});   (* Chip mem buffer *) 
  IF buffer # NULL THEN
    buffer^:=046BAH;
    allocchannel:=BYTE(1);

    audport:=CreatePort("",0);
    IF audport # NULL THEN
      WITH ioa DO
        ioaRequest.ioMessage.mnNode.lnPri:=BYTE(85);
        ioaRequest.ioMessage.mnReplyPort:=audport;
        ioaData:=ADR(allocchannel);
        ioaLength:=1;
      END;
      IF OpenDevice(AudioName,0,ADR(ioa),0)=0 THEN
        WITH ioa DO
          ioaRequest.ioFlags:=ioFlagSet{4};
          ioaRequest.ioCommand:=CmdWrite;
          ioaPeriod:=1600;
          ioaVolume:=64;
          ioaCycles:=90;
          ioaLength:=2;
          ioaData:=buffer;
        END;
        BeginIO(ioa.ioaRequest);
        x:=WaitIO(ioa.ioaRequest);       (* This does the beeping *)
        CloseDevice(ADR(ioa));
      END;
      DeletePort(audport);
    END;
    FreeMem(buffer,2);
  END;
END Beep.
------------------------------------------------------------------------------