#include <stddef.h>
#include <gadtools.h>
#include <intuition.h>
#include <exec.h>
#include <tagitem.h>
#include <asl.h>
#include <fexists.h>
#include <modplayerACE.h>

{**     MPLAYER 2.0
*
*       Written by Lauri Lehmus
*
**}

DECLARE FUNCTION SHORTINT DisplayAlert(LONGINT ANumber, STRING AMsg, SHORTINT AHeight) LIBRARY intuition

IF SYSTEM < 37 THEN
  STRING AStr
  RECOVERY_ALERT = &H00000000
  AStr = "Sorry, needs KS2.x OR greater"
  res = DisplayAlert(RECOVERY_ALERT,AStr,30)
  LIBRARY CLOSE
  STOP
END IF


{* GADGET ID's *}

CONST GAD_LISTVIEW  = 1
CONST GAD_LOAD      = 2
CONST GAD_PLAY      = 3
CONST GAD_STOP      = 4
CONST GAD_CONT      = 5
CONST GAD_PREFS     = 6
CONST GAD_ABOUT     = 7
CONST GAD_INFO      = 8

{*  SHARED LIBRARY functions... *}
LIBRARY "intuition.LIBRARY"
LIBRARY "gadtools.LIBRARY"
LIBRARY "graphics.LIBRARY"
LIBRARY "utility.LIBRARY"
LIBRARY "exec.LIBRARY"
LIBRARY "dos.LIBRARY"
LIBRARY "medplayer.LIBRARY"
LIBRARY "asl.LIBRARY"

'..intuition.LIBRARY
DECLARE FUNCTION SHORTINT ModifyIDCMP(ADDRESS wdw, LONGINT flags) LIBRARY intuition
DECLARE FUNCTION SHORTINT AddGList(ADDRESS wdw, ADDRESS gad, ~
                                   SHORTINT position, SHORTINT numGad, ~
                                   ADDRESS req) LIBRARY intuition

DECLARE FUNCTION RefreshGadgets(ADDRESS gad, ADDRESS wdw, ~
                                ADDRESS req) LIBRARY intuition
DECLARE FUNCTION LONGINT EasyRequestArgs(ADDRESS wdw,~
                                         ADDRESS EStr,~
                                         LONGINT EIDCMP,~
                                         ADDRESS ArgList) LIBRARY intuition

'..gadtools.library
DECLARE FUNCTION ADDRESS CreateContext(ADDRESS glistPtr) LIBRARY gadtools
DECLARE FUNCTION FreeGadgets(ADDRESS glist) LIBRARY gadtools
DECLARE FUNCTION ADDRESS GetVisualInfoA(ADDRESS scrn, ADDRESS tags) LIBRARY gadtools
DECLARE FUNCTION FreeVisualInfo(ADDRESS visualInfo) LIBRARY gadtools
DECLARE FUNCTION ADDRESS CreateGadgetA(LONGINT kind, ADDRESS prevGad, ~
                                       ADDRESS newGad, ADDRESS tags) LIBRARY gadtools
DECLARE FUNCTION GT_RefreshWindow(ADDRESS wdw,ADDRESS requester) LIBRARY gadtools
DECLARE FUNCTION ADDRESS GT_GetIMsg(ADDRESS userPort) LIBRARY gadtools
DECLARE FUNCTION GT_ReplyIMsg(ADDRESS intuiMsg) LIBRARY gadtools
DECLARE FUNCTION GT_BeginRefresh(ADDRESS wdw) LIBRARY gadtools
DECLARE FUNCTION GT_EndRefresh(ADDRESS wdw, SHORTINT complete) LIBRARY gadtools
DECLARE FUNCTION GT_SetGadgetAttrsA(ADDRESS gad, ADDRESS wdw, ADDRESS req, ~
                                    ADDRESS tags) LIBRARY gadtools

'..utility.library
DECLARE FUNCTION ADDRESS AllocateTagItems(LONGINT numTags) LIBRARY utility
DECLARE FUNCTION FreeTagItems(ADDRESS tagArrayPtr) LIBRARY utility

'..exec.library
DECLARE FUNCTION AddTail(ADDRESS theList,ADDRESS theNode) LIBRARY exec
DECLARE FUNCTION WaitPort(ADDRESS userPort) LIBRARY exec
DECLARE FUNCTION ADDRESS RemTail(ADDRESS theList) LIBRARY exec

'..ami.lib
DECLARE FUNCTION NewList(ADDRESS theList) EXTERNAL


'..medplayer.LIBRARY
DECLARE FUNCTION GetPlayer(midi) LIBRARY medplayer
DECLARE FUNCTION ADDRESS LoadModule(STRING theMedFile) LIBRARY medplayer
DECLARE FUNCTION PlayModule(ADDRESS medPtr) LIBRARY medplayer
DECLARE FUNCTION UnLoadModule(ADDRESS medPtr) LIBRARY medplayer
DECLARE FUNCTION SetTempo(SHORTINT medTmp) LIBRARY medplayer
DECLARE FUNCTION ContModule(ADDRESS medPtr) LIBRARY medplayer
DECLARE FUNCTION StopPlayer() LIBRARY medplayer
DECLARE FUNCTION FreePlayer() LIBRARY medplayer
       
' ..graphics.LIBRARY
DECLARE FUNCTION Move LIBRARY graphics
DECLARE FUNCTION Text LIBRARY graphics
DECLARE FUNCTION TextLength LIBRARY graphics
DECLARE FUNCTION EraseRect LIBRARY graphics

' ..asl.LIBRARY
DECLARE FUNCTION ADDRESS AllocAslRequest(LONGINT reqType, ADDRESS tags) LIBRARY asl
DECLARE FUNCTION SHORTINT AslRequest(ADDRESS requester, ADDRESS tags) LIBRARY asl
DECLARE FUNCTION FreeAslRequest(ADDRESS requester) LIBRARY asl

' ..dos.LIBRARY
DECLARE FUNCTION Examine LIBRARY dos
DECLARE FUNCTION ExNext LIBRARY dos
DECLARE FUNCTION Lock LIBRARY dos
DECLARE FUNCTION UnLock LIBRARY dos

' .. my structures
STRUCT MPlayer
  STRING   theMod SIZE 50
  STRING   modDir SIZE 50
  SHORTINT NumEntries
  SHORTINT RFListView
END STRUCT

struct FileInfoBlock
   LONGINT        fib_DiskKey
   LONGINT        fib_DirEntryType
   STRING         fib_FileName SIZE 108
   LONGINT        fib_Protection
   LONGINT        fib_EntryType
   LONGINT        fib_Size
   LONGINT        fib_NumBlocks
   ADDRESS        DateStamp
   STRING         fib_Comment SIZE 80
   SHORTINT       fib_OwnerUID
   SHORTINT       fib_OwnerGID
   STRING         fib_Reserved SIZE 32
END STRUCT    

STRUCT EasyStruct
    LONGINT es_StructSize
    LONGINT es_Flags
    ADDRESS es_Title
    ADDRESS es_TextFormat
    ADDRESS es_GadgetFormat
END STRUCT
                
CONST SHARED_LOCK = -2
DECLARE STRUCT MPlayer PlayerConfig
DECLARE STRUCT MMD0 *Med
DECLARE STRUCT EasyStruct es

DIM STRING ModuleList(150) SIZE 50

' SUB declarations
DECLARE SUB ModMsg(STRING theMsg)
DECLARE SUB PlayerMsg(STRING PlaMsg)
DECLARE SUB gadtools_window
DECLARE SUB handle_gadget(ADDRESS msg)
DECLARE SUB do_window_refresh(ADDRESS wdw)
DECLARE SUB GetModule(ADDRESS msg)
DECLARE SUB AskModuleDir
DECLARE SUB LModule
DECLARE SUB PModule
DECLARE SUB SModule
DECLARE SUB CModule
DECLARE SUB About
DECLARE SUB INFO
DECLARE SUB ReadDir(STRING theDir)

' SUBs

SUB ModMsg(mes$)

  EraseRect(WINDOW(8),5,5,243,12)
  Move(WINDOW(8),7,12)
  le% = LEN(mes$)
  Text(WINDOW(8),mes$,le%)

END SUB

SUB PlayerMsg(STRING PlaMsg)

  EraseRect(WINDOW(8),5,33,160,44)
  Move(WINDOW(8),11,42)
  le% = LEN(PlaMsg)
  Text(WINDOW(8),PlaMsg,le%)

END SUB


SUB gadtools_window

SHARED GTLV_Labels, GTLV_ShowSelected, GTLV_Selected, LISTVIEWIDCMP    
SHARED ModuleList
SHARED PlayerConfig

DECLARE STRUCT ScreenStruct *mysc
DECLARE STRUCT TextAttr *scrFont
DECLARE STRUCT WindowStruct *mywin
DECLARE STRUCT IntuiGadget *glist, *gad, *listview
DECLARE STRUCT NewGadget ng
DECLARE STRUCT TagItem *gadTags, *tag
DECLARE STRUCT ExecList myList
DECLARE STRUCT Node *theNode
DECLARE STRUCT TextAttr gadFont
DECLARE STRUCT IntuiMessage *imsg
LONGINT terminated, class

ADDRESS vi

  glist = NULL
  
  mysc = SCREEN(1)
  IF mysc <> NULL THEN
    vi = GetVisualInfoA(mysc, NULL)
    IF vi <> NULL THEN
      '..GadTools always requires this step to be taken.
      gad = CreateContext(@glist)

     {* Create Exec list of items to be displayed in listview gadget *}
     NewList(myList)  
     FOR i=0 TO PlayerConfig->NumEntries -1
       theNode = ALLOC(SIZEOF(Node))
       theNode->ln_Name = @ModuleList(i)
       AddTail(myList,theNode)
     NEXT


     gadFont->ta_Name  = SADD("topaz.font")
     gadFont->ta_YSize = 8
     gadFont->ta_Style = 0
     gadFont->ta_Flags = 0
                             

     ng->ng_LeftEdge     = 256
     ng->ng_TopEdge      = 1
     ng->ng_Width        = 180
     ng->ng_Height       = 72
     ng->ng_GadgetText   = NULL
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_LISTVIEW
     ng->ng_Flags        = NULL

     gadTags = AllocateTagItems(3)
     IF gadTags <> NULL THEN
       tag = gadTags
       tag->ti_Tag = GTLV_Labels : tag->ti_Data = myList
       tag = tag + SIZEOF(TagItem)
       tag->ti_Tag = GTLV_Selected : tag->ti_Data = 0
       tag = tag + SIZEOF(TagItem)
       tag->ti_Tag = TAG_DONE
     END IF

     gad = CreateGadgetA(LISTVIEW_KIND, gad, ng, gadTags)
     listview = gad
     FreeTagItems(gadTags)

     ng->ng_LeftEdge     = 6
     ng->ng_TopEdge      = 17
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("LOAD")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_LOAD
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     ng->ng_LeftEdge     = 68
     ng->ng_TopEdge      = 17
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("PLAY")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_PLAY
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     ng->ng_LeftEdge     = 130
     ng->ng_TopEdge      = 17
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("STOP")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_STOP
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng , NULL)

     ng->ng_LeftEdge     = 192
     ng->ng_TopEdge      = 17
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("CONT")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_CONT
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     ng->ng_LeftEdge     = 192
     ng->ng_TopEdge      = 30
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("PREFS")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_PREFS
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     ng->ng_LeftEdge     = 192
     ng->ng_TopEdge      = 43
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("ABOUT")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_ABOUT
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     ng->ng_LeftEdge     = 192
     ng->ng_TopEdge      = 56
     ng->ng_Width        = 61
     ng->ng_Height       = 13
     ng->ng_GadgetText   = SADD("INFO")
     ng->ng_TextAttr     = gadFont
     ng->ng_VisualInfo   = vi
     ng->ng_GadgetID     = GAD_INFO
     ng->ng_Flags        = NULL

     gad = CreateGadgetA(BUTTON_KIND, gad, ng, NULL)

     IF gad <> NULL THEN
       WINDOW 1,"MPLAYER 2.0",(130,40)-(578,125),10
       FONT "topaz.FONT",8
       IF ERR = 0 THEN
         mywin = WINDOW(7)
         BEVELBOX (2,2)-(249,15),2
         BEVELBOX (2,32)-(170,45),2

         ModifyIDCMP(mywin,mywin->IDCMPFlags OR LISTVIEWIDCMP)

         AddGList(mywin,glist,0,-1,NULL)
         RefreshGadgets(glist,mywin,NULL)
         GT_RefreshWindow(mywin,NULL)

         WHILE NOT terminated
           WaitPort(mywin->UserPort)

           REPEAT
             imsg = GT_GetIMsg(mywin->UserPort)
             class = imsg->Class
             CASE
               class = GADGETUP : handle_gadget(imsg)
               class = CLOSEWINDOW : terminated = true
               class = REFRESHWINDOW : do_window_refresh(mywin)
             END CASE

           GT_ReplyIMsg(imsg)

           IF PlayerConfig->RFListView = 1 THEN
             '..Detach list before modifying.
             gadTags = AllocateTagItems(2)
             IF gadTags <> NULL THEN
                tag = gadTags
                tag->ti_Tag = GTLV_Labels : tag->ti_Data = NOT 0  '.. ~0 in RKM
                tag = tag + SIZEOF(TagItem)
                tag->ti_Tag = TAG_DONE
             END IF
             GT_SetGadgetAttrsA(listview, mywin, NULL, gadTags) 
             FreeTagItems(gadTags)

             REPEAT
               theNode = RemTail(myList)
             UNTIL theNode = NULL

             ReadDir(PlayerConfig->modDir)

             FOR i = 0 TO PlayerConfig->NumEntries - 1
               theNode = ALLOC(SIZEOF(Node))
               theNode->ln_Name = @ModuleList(i)
               AddTail(myList,theNode)
             NEXT

             '..Reattach list and select first item.
             gadTags = AllocateTagItems(3)
             IF gadTags <> NULL THEN
                tag = gadTags
                tag->ti_Tag = GTLV_Labels : tag->ti_Data = myList
                tag = tag + SIZEOF(TagItem)
                tag->ti_Tag = GTLV_Selected : tag->ti_Data = 0
                tag = tag + SIZEOF(TagItem)
                tag->ti_Tag = TAG_DONE
             END IF
             GT_SetGadgetAttrsA(listview, mywin, NULL, gadTags) 
             FreeTagItems(gadTags)

             PlayerConfig->RFListView = 0
           END IF

           UNTIL terminated OR imsg = null
         WEND
       END IF
     END IF
    END IF
  END IF

  FreeGadgets(glist)
  FreeVisualInfo(vi)


END SUB


SUB handle_gadget(ADDRESS msg)


DECLARE STRUCT IntuiMessage *imsg
DECLARE STRUCT IntuiGadget *gad
  imsg = msg
  gad = imsg->IAddress
  CASE
    gad->GadgetID = GAD_LISTVIEW : GetModule(imsg)
    gad->GadgetID = GAD_LOAD : LModule
    gad->GadgetID = GAD_PLAY : PModule
    gad->GadgetID = GAD_STOP : SModule
    gad->GadgetID = GAD_CONT : CModule
    gad->GadgetID = GAD_PREFS : AskModuleDir
    gad->GadgetID = GAD_ABOUT : About
    gad->GadgetID = GAD_INFO :  INFO
  END CASE
END SUB        


SUB do_window_refresh(ADDRESS wdw)
  GT_BeginRefresh(mywin)
  GT_EndRefresh(mywin,true)
END SUB

SUB AskModuleDir

SHARED PlayerConfig
SHARED ASLFR_DrawersOnly, ASLFR_TitleText, ASLFR_InitialDrawer

DECLARE STRUCT FileRequester *filereq
DECLARE STRUCT TagItem *reqTags, *tag

IF PlayerConfig->modDir <> "" THEN
  PlayerConfig->RFListView = 1
ELSE
  PlayerConfig->RFListView = 0
END IF

filereq = AllocAslRequest(ASL_FileRequest,NULL)

reqTags = AllocateTagItems(4)
if reqTags <> NULL then
        tag = reqTags
        '..Drawer requester.
        tag->ti_Tag = ASLFR_DrawersOnly : tag->ti_Data = TRUE
        tag = tag + SIZEOF(TagItem)
        '..Requester's title.
        tag->ti_Tag = ASLFR_TitleText : tag->ti_Data = SADD("Select Module Dir")
        tag = tag + SIZEOF(TagItem)
        '..Default directory.
        tag->ti_Tag = ASLFR_InitialDrawer : tag->ti_Data = SADD("sys:")
        tag = tag + SIZEOF(TagItem)
        '..Okay, we're done.
        tag->ti_Tag = TAG_DONE
END IF

success = AslRequest(filereq,reqTags)
FreeTagItems(reqTags)
IF CSTR(filereq->rf_Dir) <> "" THEN
  PlayerConfig->modDir = CSTR(filereq->rf_Dir)
END IF

FreeAslRequest(filereq)

IF PlayerConfig->RFListView = 1 THEN
  OPEN "O",#1,"s:MPlayer.config"
  PRINT #1,PlayerConfig->modDir
  CLOSE #1
END IF

END SUB

SUB GetModule(ADDRESS msg)

SHARED ModuleList
SHARED PlayerConfig
DECLARE STRUCT IntuiMessage *imsg

imsg = msg

PlayerConfig->theMod = ModuleList(imsg->Code)
ModMsg(PlayerConfig->theMod)

END SUB

SUB LModule

SHARED Med, PlayerConfig
STRING LoadString

IF PlayerConfig->theMod <> "" THEN
    IF RIGHT$(PlayerConfig->modDir,1) <> ":" THEN
      LoadString = PlayerConfig->modDir + "/" + PlayerConfig->theMod
    ELSE
      LoadString = PlayerConfig->modDir + PlayerConfig->theMod
    END IF
    StopPlayer()
    UnLoadModule(Med)
    Med = LoadModule(LoadString)
ELSE
    PlayerMsg("No MODULE selected")
    EXIT SUB
END IF

IF Med = NULL THEN
    PlayerMsg("NOT a MED MODULE")
    EXIT SUB
END IF

PlayerMsg("Module Loaded")

END SUB

SUB PModule

    SHARED Med
    IF Med = NULL THEN EXIT SUB
    PlayModule(Med)
    PlayerMsg("Playing...")

END SUB

SUB SModule

    StopPlayer()
    PlayerMsg("Stopped...")

END SUB

SUB CModule

    SHARED Med

    ContModule(Med)
    PlayerMsg("Playing...")

END SUB

SUB About

SHORTINT theGadget, n
  WINDOW 9,"About...",(170,40)-(456,197),2
  FONT "topaz.font",11 : STYLE 6  : COLOR 1,0 : PENUP : SETXY 63,19
  PRINT "M P L A Y E R  2.0";
  FONT "topaz.font",8 : STYLE 2  : COLOR 2,0 : PENUP : SETXY 42,40
  PRINT "WRITTEN BY LAURI LEHMUS";
  STYLE 0 : COLOR 2,0 : PENUP : SETXY 86,52
  PRINT "19.07.1995";
  COLOR 2,0 : PENUP : SETXY 25,64
  PRINT "THANKS:";
  COLOR 2,0 : PENUP : SETXY 17,76
  PRINT "David Benn for ACE and helping";
  COLOR 2,0 : PENUP : SETXY 25,88
  PRINT "me through with this project.";
  BEVELBOX (4,2)-(269,141),1
  BEVELBOX (13,26)-(261,121),2
  FONT "topaz.font",8 : STYLE 0  : COLOR 2,0 : PENUP : SETXY 67,100
  PRINT "Teijo Kinnunen for";
  FONT "topaz.font",8 : STYLE 0  : COLOR 2,0 : PENUP : SETXY 71,113
  PRINT "MEDPLAYER.LIBRARY";
  GADGET 255,ON,"C O N T I N U E",(14,124)-(261,138),BUTTON
  GADGET WAIT 0
  theGadget = GADGET(1)
  GADGET CLOSE 255
  WINDOW CLOSE 9 
END SUB

SUB INFO

  SHARED Med,PlayerConfig

  DECLARE STRUCT WindowStruct *mywin
  DECLARE STRUCT EasyStruct es
  STRING WdwTitle, InfoMsg, GadTxt

  mywin = WINDOW(7)
  WdwTitle = PlayerConfig->theMod
  InfoMsg = WdwTitle + CHR$(10)
  InfoMsg = InfoMsg + "SIZE: "+str$(Med->modlen)
  GadTxt = "OK"

  es->es_StructSize = SIZEOF(EasyStruct)
  es->es_Flags      = 0
  es->es_Title      = @WdwTitle
  es->es_TextFormat = @InfoMsg
  es->es_GadgetFormat = @GadTxt

  res = EasyRequestArgs(mywin,es,NULL,NULL)

END SUB

SUB ReadDir(STRING theDir)

    SHARED ModuleList
    SHARED PlayerConfig
    DECLARE STRUCT FileInfoBlock FIB

    myLock = Lock(theDir, -2)
    IF myLock = 0 THEN EXIT SUB

    OolRait = Examine(myLock,FIB)
    IF OolRait = 0 THEN
      UnLock(myLock)
      EXIT SUB
    END IF

    Count% = 0
    Success = ExNext(myLock,FIB)
    WHILE Success <> 0
      IF FIB->fib_DirEntryType < 0 THEN
        IF RIGHT$(FIB->fib_FileName,5) <> ".info" THEN
          ModuleList(Count%) = FIB->fib_FileName
          Count% = Count% + 1
        END IF
      END IF
      Success = ExNext(myLock,FIB)
    WEND
    PlayerConfig->NumEntries = Count%

    UnLock(myLock)

END SUB


' Main...
IF fexists("s:MPlayer.config") THEN
  OPEN "I",#1,"s:MPlayer.config"
  INPUT #1,MPC$
  CLOSE #1
  PlayerConfig->modDir = MPC$
ELSE
  AskModuleDir
  OPEN "O",#1,"s:MPlayer.config"
  PRINT #1,PlayerConfig->modDir
  CLOSE #1
END IF

ReadDir(PlayerConfig->modDir)
gp = GetPlayer(0)

gadtools_window

UnLoadModule(Med)
FreePlayer()
LIBRARY CLOSE
WINDOW CLOSE 1
END