PROGRAM DeskTopCDPlayer;

{********************************************
 **         DESKTOP CD PLAYER 1.1          **
 **                                        **
 **             by D. Amor '92             **
 **                                        **
 **       written in KICK-PASCAL v2.1      **
 ********************************************}

{$opt q}

USES ExecIO,Intuition;

CONST CD_RESET    = 1;
      CD_MOTOR    = 9;
      CD_CNUM     =13;
      CD_CSTATE   =14;
      CD_ISROM    =37;
      CD_PLAYTRACK=43;
      CD_TOCMSF   =49;
      CD_SUBQMSF  =51;
      CD_PAUSE    =52;
      CD_STOPPLAY =53;
      CD_FADE     =57;
      nTOC        =100;

TYPE Bord_Type = ARRAY [01..10] OF INTEGER;
     Scro_Type = ARRAY [01..20] OF INTEGER;
     Port_Type = ARRAY [00..01] OF ^MsgPort;
     ioRq_Type = ARRAY [00..01] OF ^IOStdReq;
     Stri_Type = ARRAY [00..02] OF STRING[20];
     Thre_Type = STRING[3];

VAR BorderDatA              : ARRAY [0..4] OF Bord_Type; STATIC;
    ITxt                    : ARRAY [1..12] OF IntuiText; STATIC;
    BorderA                 : ARRAY [0..7] OF Border;    STATIC;
    GadgetA                 : ARRAY [1..12] OF Gadget;    STATIC;
    cdStatus                : ARRAY [0..40] OF BYTE;     STATIC;
    TOCArray                : ARRAY [0..8*nTOC] OF BYTE; STATIC;
    Win                     : ^Window;                   STATIC;
    Rp                      : ^RastPort;                 STATIC;
    ReplyPort               : Port_Type;                 STATIC;
    ioReq                   : ioRq_Type;                 STATIC;
    TAttr0                  : TextAttr;                  STATIC;
    channel,command,max,
    watch,song,display      : BYTE;                      STATIC;
    Laenge,OffSet,Act,
    Fehler1,Fehler2         : LONG;                      STATIC;
    ioError                 : INTEGER;                   STATIC;
    ende,pause,fade,play,
    single,repeet,removed   : BOOLEAN;                   STATIC;
    Msg                     : ^IntuiMessage;             STATIC;
    AktGad                  : ^Gadget;                   STATIC;
    MDat                    : ^Scro_Type;                STATIC;
    MImage1                 : Image;                     STATIC;
    PropInfo1               : PropInfo;                  STATIC;
    GadID                   : WORD;                      STATIC;
    MyText                  : Stri_Type;                 STATIC;
    con                     : PTR;                       STATIC;
    ErrorMessage            : STRING[180];               STATIC;

PROCEDURE Print(t: Stri_Type; x,y: BYTE);

VAR it: IntuiText;
    i : BYTE;

BEGIN
  FOR i:=0 TO 2 DO
  BEGIN
    it:=IntuiText(1,0,1,0,0,NIL,t[I],NIL);
    PrintIText(Rp,^it,x,y+i*9);
  END;
END;

PROCEDURE CD_Action(command: BYTE; offSet, laenge: LONG; data: PTR;
                    channel: BYTE);

  FUNCTION SetioReq(command: BYTE; offSet, laenge: LONG; data: PTR;
                    channel: BYTE): INTEGER;

  BEGIN
    WITH ioReq[channel]^ DO
    BEGIN
      io_Command:=command;
      io_Flags:=0;
      io_Length:=laenge;
      io_Data:=data;
      io_OffSet:=offset;
    END;
    IF command=CD_PLAYTRACK THEN
    BEGIN
      SendIO(ioReq[channel]);
      SetioReq:=0
    END
    ELSE SetioReq:=DoIO(ioReq[channel]);
  END;

BEGIN
  ioError:=SetioReq(command,offset,laenge,data,channel);
  IF ioError=-6 THEN
  BEGIN
    MyText:=Stri_Type("0 Tracks  ",
                      "00:00     ",
                      "No Disc   ");
    Print(MyText,178,42);
  END;
END;

PROCEDURE ClearArea;

BEGIN
  MyText:=Stri_Type("          ",
                    "          ",
                    "          ");
  Print(MyText,178,42);
END;

PROCEDURE ClearMiddle;

BEGIN
  MyText:=Stri_Type("","          ","");
  Print(MyText,178,42);
END;

PROCEDURE AddNill(VAR mins,secs: Thre_Type; VAR min,sec: BYTE);

BEGIN
  mins:=INTSTR(min);
  secs:=INTSTR(sec);
  IF min<10 THEN mins:="0"+mins;
  IF sec<10 THEN secs:="0"+secs;
END;

PROCEDURE InitText;

BEGIN
  MyText:=Stri_Type("CD-Audio:",
                    "Playtime:",
                    "Status  :");
  Print(MyText,98,42);
END;

PROCEDURE StopText(max,min,sec: BYTE);

VAR mins,secs: STRING[3];

BEGIN
  ClearArea;
  AddNill(mins,secs,min,sec);
  MyText:=Stri_Type(INTSTR(max)+" Tracks",mins+":"+secs,"Stop");
  Print(MyText,178,42);
END;

PROCEDURE ShowAll(VAR min,sec: BYTE; VAR song: BYTE; VAR play: BOOLEAN;
                  scan: BOOLEAN);

VAR tracks,mins,secs: STRING[3];
    StopPlaying     : STRING[15];

BEGIN
  tracks:=INTSTR(song);
  StopPlaying:="Stop       ";
  AddNill(mins,secs,min,sec);
  IF play THEN StopPlaying:="Playing    ";
  IF scan THEN StopPlaying:="Scanning   ";
  MyText:=Stri_Type("Track "+tracks+"  ",mins+":"+secs+" ",StopPlaying);
  Print(MyText,178,42);
END;

PROCEDURE CheckSec(VAR sec,sec2,min: BYTE);

BEGIN
  sec:=sec-sec2
  IF sec>59 THEN
  BEGIN
    sec:=sec+60;
    DEC(min);
  END
END;

PROCEDURE GetTime(VAR max,min,sec: BYTE);

VAR song2,min2,sec2: BYTE;

BEGIN
  min2:=TOCArray[(song SHL 3)+5];
  sec2:=TOCArray[(song SHL 3)+6];
  IF song<max THEN song2:=(SUCC(song) SHL 3)+5
              ELSE song2:=5;
  min:=TOCArray[song2];
  sec:=TOCArray[SUCC(song2)];
  min:=min-min2;
  CheckSec(sec,sec2,min);
END;

PROCEDURE ShowTrack(VAR song: BYTE; VAR play: BOOLEAN);

VAR min,sec: BYTE;

BEGIN
  ClearArea;
  GetTime(max,min,sec);
  ShowAll(min,sec,song,play,FALSE);
END;

PROCEDURE ShowNothing;

BEGIN
  MyText:=Stri_Type("","No Display","");
  Print(MyText,178,42);
END;

PROCEDURE StartPlayer(VAR play,Single: BOOLEAN; VAR Song: BYTE);

VAR NumberOfSongs: BYTE;

BEGIN
  IF Single THEN NumberOfSongs:=0
            ELSE NumberOfSongs:=SUCC(Max);
  CD_Action(CD_PLAYTRACK,Song,NumberOfSongs,NIL,0);
  play:=TRUE;
  DELAY(10);
END;

PROCEDURE PausePlayer(VAR Pause: BOOLEAN);

BEGIN
  MyText:=Stri_Type("","","Pause     ");
  Print(MyText,178,42);
  IF Pause THEN CD_Action(CD_PAUSE,0,1,NIL,1)
           ELSE CD_Action(CD_PAUSE,0,0,NIL,1);
  Pause:=NOT Pause;
END;

PROCEDURE StopPlayer(VAR play: BOOLEAN);;

VAR a: LONG;

BEGIN
  AbortIO(ioReq[0]);
  a:=WaitIO(ioReq[0]);
  CD_Action(CD_STOPPLAY,0,0,NIL,0);
  play:=FALSE;
END;

PROCEDURE DimOffPlayer(VAR Fade: BOOLEAN);

VAR I: INTEGER;

BEGIN
  IF Fade THEN CD_Action(CD_FADE,0,150,NIL,1)
          ELSE CD_Action(CD_FADE,32767,150,NIL,1);
  Fade:=NOT Fade
END;

PROCEDURE Scroll_Fade(VAR PropInfo1: PropInfo);

VAR Zahl: INTEGER;

BEGIN
  WITH PropInfo1 DO
  BEGIN
    Zahl:=32767-VertPot DIV (SUCC(VertBody) SHL 1);
    CD_Action(CD_FADE,Zahl,0,NIL,1);
  END;
END;

PROCEDURE CheckPlayer;

BEGIN
  IF play THEN
  BEGIN
    StopPlayer(play);
    StartPlayer(play,single,song);
  END
  ELSE ShowTrack(song,play);
END;

PROCEDURE ShowTime(VAR song: BYTE; VAR play,single,repeet: BOOLEAN;
                   scan: BOOLEAN);

VAR min,sec,min2,sec2: BYTE;

BEGIN
  CD_Action(CD_SUBQMSF,0,0,^CDStatus,1);
  IF single THEN BEGIN
                   DELAY(10);
                   IF song<>CDStatus[2] THEN
                   BEGIN
                     StopPlayer(play);
                     IF Repeet THEN
                     BEGIN
                       CD_Action(CD_PLAYTRACK,song,0,NIL,0)
                       play:=TRUE;
                     END;
                   END;
                 END
                 ELSE song:=CDStatus[2];
  min:=CDStatus[9];
  sec:=CDStatus[10];
  CASE Display OF
    1: BEGIN
         GetTime(max,min2,sec2);
         min:=min2-min;
         CheckSec(sec2,sec,min);
         sec:=sec2;
       END;
    2..3: IF NOT single THEN
          BEGIN
            min2:=TOCArray[(song SHL 3)+5];
            sec2:=TOCArray[(song SHL 3)+6];
            min:=min2+min;
            sec:=sec2+sec
            IF sec>59 THEN
            BEGIN
              sec:=sec-60;
              INC(min);
            END
            IF Display=3 THEN
            BEGIN
              min:=TOCArray[5]-min;
              sec2:=TOCArray[6];
              CheckSec(sec2,sec,min);
              sec:=sec2;
            END;
          END
          ELSE
          BEGIN
            Display:=4;
            ShowNothing;
          END;
    OTHERWISE;
  END;
  DELAY(5);
  IF Display<4 THEN ShowAll(min,sec,song,play,scan);
END;

PROCEDURE ScanIntoCD;

VAR i,j: BYTE

  FUNCTION GetAnswer: BOOLEAN;

  VAR AktGad: ^Gadget;
      GadID : WORD;

  BEGIN
    ShowTime(i,play,single,repeet,TRUE);
    DELAY(40);
    msg:=Get_Msg(Win^.UserPort);
    AktGad:=Msg^.IAddress;
    GadID:=AktGad^.GadgetID;
    GetAnswer:=(GadID=5);
  END;

BEGIN
  FOR i:=1 TO max DO
  BEGIN
    CD_Action(CD_FADE,32767,0,NIL,1);
    StartPlayer(play,single,i);
    FOR j:=1 TO 9 DO IF GetAnswer THEN Exit;
    CD_Action(CD_FADE,0,150,NIL,1);
    FOR j:=1 TO 3 DO IF GetAnswer THEN Exit;
    StopPlayer(play);
  END;
END;

PROCEDURE WaitStartUp;

BEGIN
  Removed:=TRUE;
  MyText:=Stri_Type("0 Tracks  ","00:00     ","No Disc   ");
  Print(MyText,178,42);
END;

PROCEDURE StartUp;

BEGIN
  Removed:=FALSE;
  CD_Action(CD_ISROM,0,0,NIL,0);
  CD_Action(CD_TOCMSF,0,nTOC,^TOCArray,0);
  max:=TOCArray[3];
  StopText(max,TOCArray[5],TOCArray[6]);
END;

PROCEDURE DeviceCloser;

BEGIN
  IF play THEN StopPlayer(play);
  CloseDevice(ioReq[1]);
  CloseDevice(ioReq[0]);
  DeleteExtIO(ioReq[1]);
  DeleteExtIO(ioReq[0]);
  DeletePort(ReplyPort[1]);
  DeletePort(ReplyPort[0]);
END;

BEGIN
  Win:=Open_Window(50,0,300,87,1,_CLOSEWINDOW OR GADGETUP OR GADGETDOWN OR
                   MOUSEMOVE OR DISKREMOVED OR DISKINSERTED,WINDOWDRAG OR
                   WINDOWDEPTH OR WINDOWCLOSE OR ACTIVATE,
                   "CDTV-Player by D. Amor '92 ",NIL,0,0,0,0);
  Rp:=Win^.RPort;
  ReplyPort[0]:=CreatePort("CD-Port0",0);
  ReplyPort[1]:=CreatePort("CD-Port1",0);
  ioReq[0]:=CreateExtIO(ReplyPort[0],64);
  ioReq[1]:=CreateExtIO(ReplyPort[1],64);
  Fehler1:=OpenDevice("cdtv.device",0,ioReq[0],0);
  Fehler2:=OpenDevice("cdtv.device",0,ioReq[1],0);
  IF (Fehler1=0) AND (Fehler2=0) THEN
  BEGIN
    AddExitServer(DeviceCloser);
    TAttr0:=TextAttr("topaz.font",8,0,99);
    ITxt[1]:=IntuiText(1,0,0,32,3,^TAttr0,"REW",NIL);
    ITxt[2]:=IntuiText(1,0,0,28,3,^TAttr0,"PLAY",NIL);
    ITxt[3]:=IntuiText(1,0,0,36,3,^TAttr0,"FF",NIL);
    ITxt[4]:=IntuiText(1,0,0,24,3,^TAttr0,"PAUSE",NIL);
    ITxt[5]:=IntuiText(1,0,0,28,3,^TAttr0,"STOP",NIL);
    ITxt[6]:=IntuiText(1,0,0,28,3,^TAttr0,"FADE",NIL);
    ITxt[8]:=IntuiText(1,0,0,16,3,^TAttr0,"DISPLAY",NIL);
    ITxt[9]:=IntuiText(1,0,0,20,3,^TAttr0,"SINGLE",NIL);
    ITxt[10]:=IntuiText(1,0,0,20,3,^TAttr0,"REPEAT",NIL);
    ITxt[11]:=IntuiText(1,0,0,28,3,^TAttr0,"SCAN",NIL);
    ITxt[12]:=IntuiText(1,0,0,28,3,^TAttr0,"INFO",NIL);
    MDat:=PTR(Alloc_Mem(SIZEOF(Scro_Type),2));
    MDat^:=Scro_Type(8,24,24,3864,3096,3096,2072,24,24,32760,-16,-16384,
                     -16384,-16256,-16000,-16000,-14464,-16384,-16384,-32768);
    MImage1:=Image(0,0,13,10,2,MDat,3,0,NIL);
    BorderDatA[0]:=Bord_Type(1,1,1,12,0,13,0,0,86,0);
    BorderDatA[1]:=Bord_Type(86,13,86,1,87,0,87,13,1,13);
    BorderA[0]:=Border(0,0,2,0,0,5,^BorderDatA[0],^BorderA[1]);
    BorderA[1]:=Border(0,0,1,0,0,5,^BorderDatA[1],NIL);
    BorderA[2]:=Border(0,0,2,0,0,5,^BorderDatA[1],^BorderA[3]);
    BorderA[3]:=Border(0,0,1,0,0,5,^BorderDatA[0],NIL);
    BorderDatA[2]:=Bord_Type(92,41,92,69,93,68,93,41,268,41);
    BorderDatA[3]:=Bord_Type(269,69,269,41,268,42,268,69,93,69);
    BorderDatA[4]:=Bord_Type(272,11,272,84,273,83,273,11,290,11);
    BorderA[4]:=Border(0,0,2,0,0,5,^BorderDatA[2],^BorderA[5]);
    BorderA[5]:=Border(0,0,1,0,0,5,^BorderDatA[3],^BorderA[6]);
    BorderA[6]:=Border(0,0,2,0,0,5,^BorderDatA[4],NIL);
    PropInfo1:=PropInfo(FREEVERT,0,0,32767,0,0,0,0,0,0,0);
    FOR watch:=1 TO 3 DO
      GadgetA[watch]:=Gadget(^GadgetA[SUCC(watch)],4+PRED(watch)*90,11,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[watch],0,NIL,watch,0);
    GadgetA[4]:=Gadget(^GadgetA[5],4,26,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE+TOGGLESELECT,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[4],0,NIL,4,0);
    GadgetA[5]:=Gadget(^GadgetA[6],94,26,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[5],0,NIL,5,0);
    GadgetA[6]:=Gadget(^GadgetA[7],184,26,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE+TOGGLESELECT,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[6],0,NIL,6,0);
    GadgetA[7]:=Gadget(^GadgetA[8],274,11,21,74,GADGHBOX OR GADGIMAGE,GADGIMMEDIATE
                       OR RELVERIFY OR FOLLOWMOUSE,PROPGADGET,^MImage1,NIL,
                       NIL,0,^PropInfo1,7,0);
    GadgetA[8]:=Gadget(^GadgetA[9],4,41,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[8],0,NIL,8,0);
    GadgetA[9]:=Gadget(^GadgetA[10],4,56,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE+TOGGLESELECT,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[9],0,NIL,9,0);
    GadgetA[10]:=Gadget(^GadgetA[11],4,71,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE+TOGGLESELECT,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[10],0,NIL,10,0);
    GadgetA[11]:=Gadget(^GadgetA[12],94,71,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[11],0,NIL,11,0);
    GadgetA[12]:=Gadget(NIL,184,71,88,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,BOOLGADGET,^BorderA[0],^BorderA[2],^ITxt[12],0,NIL,12,0);
    watch:=AddGList(Win,^GadgetA[1],1,12,NIL);
    RefreshGList(^GadgetA[1],Win,NIL,12);
    DrawBorder(Rp,^BorderA[4],2,0);
    Ende:=FALSE;    Pause:=TRUE;
    Fade:=TRUE;     Repeet:=FALSE;
    play:=FALSE; Single:=FALSE;
    Song:=1;        Display:=0;
    InitText;
    CD_Action(CD_CSTATE,0,0,NIL,0);
    CD_Action(CD_FADE,32767,0,NIL,1);
    IF ioReq[channel]^.io_Actual=255 THEN WaitStartUp
                                     ELSE StartUp;
    REPEAT
      REPEAT
        IF (NOT play) OR (display=4) THEN Msg:=Wait_Port(Win^.UserPort);
        Msg:=Get_Msg(Win^.UserPort);
        IF (watch=255) AND play AND pause THEN ShowTime(song,play,single,repeet,FALSE);
        INC(watch);
      UNTIL Msg<>NIL;
      CASE Msg^.Class OF
        _CLOSEWINDOW: Ende:=TRUE;
        DISKREMOVED: BEGIN
                       CD_Action(CD_CSTATE,0,0,NIL,0);
                       IF ioReq[channel]^.io_Actual=255 THEN
                       BEGIN
                         WaitStartUp;
                         play:=FALSE;
                       END;
                     END;
        DISKINSERTED: BEGIN
                        CD_Action(CD_CSTATE,0,0,NIL,0);
                        IF (ioReq[channel]^.io_Actual=0) AND removed THEN Startup;
                      END;
        GADGETUP: IF NOT removed THEN
                  BEGIN
                    AktGad:=Msg^.IAddress;
                    CASE AktGad^.GadgetID OF
                      1: IF song>1 THEN
                         BEGIN
                           DEC(song);
                           CheckPlayer;
                         END;
                      2: IF NOT play THEN StartPlayer(play,single,song);
                      3: IF song<max THEN
                         BEGIN
                           INC(song);
                           CheckPlayer;
                         END;
                      4: PausePlayer(pause);
                      5: IF play THEN
                         BEGIN
                           StopPlayer(play);
                           StopText(max,TOCArray[5],TOCArray[6]);
                         END;
                      6: DimOffPlayer(fade);
                      7: IF NOT Fade THEN Scroll_Fade(PropInfo1)
                      8: BEGIN
                           INC(Display);
                           CASE Display OF
                             4: ShowNothing;
                             5: BEGIN
                                  ClearMiddle;
                                  display:=0;
                                END;
                             OTHERWISE;
                           END;
                         END;
                      9: single:=NOT single;
                      10: repeet:=NOT repeet;
                      11: IF NOT play THEN ScanIntoCD;
                      OTHERWISE
                    END;
                  END;
        MOUSEMOVE: IF GadID=7 THEN Scroll_Fade(PropInfo1);
        GADGETDOWN: BEGIN
                       AktGad:=Msg^.IAddress;
                       GadID:=AktGad^.GadgetID;
                    END;
        OTHERWISE
      END;
      Reply_Msg(Msg);
    UNTIL Ende
  END
  ELSE
  BEGIN
    con:=OpenConsole(win);
    ErrorMessage:="I'm sorry! Can't find "\e"33m'cdtv.device'!"\e"31m"\n"This machine doesn't look like a"\n\e"33mCDTV"\e"31m or an "\e"33mA570/A670"\e"31m! In case I'm"\n"wrong please write to me."\n"See Doc.File!"\n;
    WriteCon(con,ErrorMessage);
    CloseConsole(con);
    play:=FALSE;
    Msg:=Wait_Port(Win^.UserPort);
    Msg:=Get_Msg(Win^.UserPort);
  END;
END.