-> Metronome E source file
-> View with EE to get folded procedures.
-> This source is not well commented and some names are in
-> Dutch, sorry for that.

OPT OSVERSION=37

MODULE 'intuition/intuition','intuition/screens','gadtools',
       'libraries/gadtools','exec/ports','exec/io','devices/timer',
       'graphics/text','exec/tasks','tools/easygui','dos/dos',
       'amigalib/io','devices/audio','exec/memory','exec/nodes',
       'graphics/gfxbase','*metronome_locale','locale','libraries/locale'

CONST RATE_MIN=40,RATE_MAX=216,RATE_DEFAULT=80
CONST RATE_MAX1=RATE_MAX+1

-> There is no E support in CatComp :-(
ENUM STR_ERR_LIB,STR_ERR_CRMP,STR_ERR_CRIO,STR_ERR_DEV,STR_ERR_ARGS,
     STR_ERR_FILE,STR_ERR_MEM,STR_WINDOW_TITLE=100,STR_MM_GAD,STR_TEMPO_GAD,
     STR_DELAY_GAD,STR_QUIT_GAD,STR_DEF_TEMPO_FILE=200

ENUM ERR_NONE,ERR_LIB,ERR_CRMP,ERR_CRIO,ERR_DEV,ERR_ARGS,ERR_FILE

RAISE ERR_LIB  IF OpenLibrary()=NIL,
      ERR_CRMP IF CreateMsgPort()=NIL,
      ERR_CRIO IF CreateIORequest()=NIL,
      ERR_FILE IF FileLength()<=0

DEF openerr=-1,timerMP=NIL:PTR TO mp,timerIO=NIL:PTR TO timerequest,
    complete=TRUE
DEF aOpenErr=-1,audMP=NIL:PTR TO mp,audIO=NIL:PTR TO ioaudio,aUnit
DEF sFile[256]:STRING,sRate=10000,sPeriod,sLen,sBuffer=NIL,sRight

DEF rate=80,dSecs,dMicro
DEF tStr[80]:STRING,dtStr[80]:STRING

DEF tempofile[256]:STRING,tname[RATE_MAX1]:ARRAY OF LONG

DEF catalog=NIL,locale=NIL:PTR TO locale,rate_str[40]:STRING

DEF gh=NIL:PTR TO guihandle
DEF prop=NIL,text=NIL,dtext=NIL,button=NIL

PROC main() HANDLE
  DEF rda,a[5]:ARRAY OF LONG,in
  gadtoolsbase:=OpenLibrary('gadtools.library',0)
  -> For GT_SetGadgetAttrsA(); EasyGUI doesn't give GadToolsBase.
  openlocale()
  timerMP:=CreateMsgPort()
  timerIO:=CreateIORequest(timerMP,SIZEOF timerequest)
  openerr:=OpenDevice('timer.device',UNIT_VBLANK,timerIO,0)
  IF openerr THEN Raise(ERR_DEV)
  a[0]:=[RATE_DEFAULT]
  a[1]:='PROGDIR:Metronome.SND'
  a[2]:=[10000]
  a[3]:=FALSE
  a[4]:=string(STR_DEF_TEMPO_FILE)
  IF rda:=ReadArgs('R=RATE/N,SF=SOUNDFILE,SR=SOUNDRATE/N,RIGHT/S,TF=TEMPOFILE',a,NIL)
    rate:=Bounds(Long(a[0]),RATE_MIN,RATE_MAX)
    StrCopy(sFile,a[1])
    sRate:=Long(a[2])
    sPeriod:=audioPeriod(sRate)
    sRight:=a[3]
    StrCopy(tempofile,a[4])
    FreeArgs(rda)
  ELSE
    Raise(ERR_ARGS)
  ENDIF
  readtempofile()
  sLen:=FileLength(sFile)
  sBuffer:=NewM(sLen,MEMF_CHIP OR MEMF_PUBLIC)
  IF in:=Open(sFile,MODE_OLDFILE)
    Read(in,sBuffer,sLen)
    Close(in)
  ELSE
    Raise(ERR_FILE)
  ENDIF
  audioInit()
  calcdelay()
  openwindow()
  processMsg()
EXCEPT DO
  closewindow()
  audioUnInit()
  IF sBuffer THEN Dispose(sBuffer)
  IF openerr=0
    IF complete=FALSE
      AbortIO(timerIO)
      WaitIO(timerIO)
    ENDIF
    CloseDevice(timerIO)
  ENDIF
  IF timerIO THEN DeleteIORequest(timerIO)
  IF timerMP THEN DeleteMsgPort(timerMP)
  closelocale()
  IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  SELECT exception
    CASE ERR_LIB;  WriteF(string(STR_ERR_LIB))
    CASE ERR_CRMP; WriteF(string(STR_ERR_CRMP))
    CASE ERR_CRIO; WriteF(string(STR_ERR_CRIO))
    CASE ERR_DEV;  WriteF(string(STR_ERR_DEV))
    CASE ERR_ARGS; PrintFault(IoErr(),string(STR_ERR_ARGS))
    CASE ERR_FILE; WriteF(string(STR_ERR_FILE),sFile)
    CASE "MEM";    WriteF(string(STR_ERR_MEM))
->    CASE ERR_SCR;  WriteF('Error: LockPubScreen() failed.\n')
->    CASE ERR_WND;  WriteF('Error: couldn''t open window.\n')
->    CASE ERR_VISU; WriteF('Error: GetVisualInfoA() didn't.\n')
->    CASE ERR_CGAD; WriteF('Error: couldn''t create gadget.\n')
  ENDSELECT
ENDPROC IF exception THEN 10 ELSE 0

-> The program should run without locale.library and there is an automatic
-> exception on OpenLibrary().
PROC openlocale() HANDLE
  localebase:=OpenLibrary('locale.library',0)
  IF localebase
    locale:=OpenLocale(NIL)
    catalog:=OpenCatalogA(locale,'metronome.catalog',[0])
  ENDIF
EXCEPT -> Dummy exception handler
ENDPROC

PROC closelocale()
  IF localebase
    IF catalog THEN CloseCatalog(catalog)
    IF locale THEN CloseLocale(locale)
    CloseLibrary(localebase)
  ENDIF
ENDPROC

-> Timer
PROC sendreq()
  timerIO.io.command:=TR_ADDREQUEST
  timerIO.time.secs:=dSecs
  timerIO.time.micro:=dMicro
  SendIO(timerIO)
  complete:=FALSE
ENDPROC

PROC calcdelay()
  DEF m
  m:=Div(60000000,rate)
  dSecs:=Div(m,1000000)
  dMicro:=m-Mul(dSecs,1000000)
->  WriteF('RATE=\d, SECS=\d, MICRO=\d\n',rate,dSecs,dMicro)
ENDPROC

PROC openwindow()
  StrCopy(rate_str,string(STR_MM_GAD))
  StrAdd(rate_str,'    ')
  gh:=guiinit(string(STR_WINDOW_TITLE),
    [ROWS,
      prop:=[SLIDE,{aSlider},rate_str,FALSE,RATE_MIN,RATE_MAX,rate,10,'\d[3]'],
      text:=[TEXT,tStr,string(STR_TEMPO_GAD),TRUE,30],
      dtext:=[TEXT,dtStr,string(STR_DELAY_GAD),TRUE,8],
      button:=[SBUTTON,1,string(STR_QUIT_GAD)]
    ])
  setTempoText()
  setslide(gh,prop,rate)
ENDPROC

PROC closewindow()
  IF gh THEN cleangui(gh)
  gh:=NIL
ENDPROC

PROC aSlider(nop,new)
  rate:=new
  calcdelay()
  setTempoText()
ENDPROC

PROC setTempoText()
  DEF t:PTR TO CHAR,tgad,dtgad
  IF tname[RATE_MIN]
    t:=tname[rate]
  ELSE
    SELECT RATE_MAX1 OF rate
->      CASE RATE_MIN TO 40; t:='Zeer langzaam'
->      CASE 41 TO 50; t:='Langzaam'
->      CASE 51 TO 70; t:='Ongeveer 1x per seconde'
->      CASE 71 TO 90; t:='Normaal tempo'
->      CASE 91 TO 140; t:='Snel'
->      CASE 141 TO RATE_MAX; t:='Zeer snel'
      CASE 40 TO 60; t:='Slow'
      CASE 61 TO 90; t:='Moderately slow'
      CASE 91 TO 120; t:='Moderate'
      CASE 121 TO 160; t:='Moderately fast'
      CASE 161 TO RATE_MAX; t:='Fast'
  ENDSELECT
  ENDIF
  StrCopy(tStr,t)
  tgad:=findgadget(gh,text)
  Gt_SetGadgetAttrsA(tgad,gh.wnd,NIL,[GTTX_TEXT,tStr,0])
  StringF(dtStr,'\d\s\z\d[6]s',dSecs,decimalpoint(),dMicro)
  dtgad:=findgadget(gh,dtext)
  Gt_SetGadgetAttrsA(dtgad,gh.wnd,NIL,[GTTX_TEXT,dtStr,0])
ENDPROC

PROC readtempofile() HANDLE
  DEF in,l[80]:STRING,num,read,s:PTR TO CHAR,i
  FOR i:=RATE_MIN TO RATE_MAX DO tname[i]:=NIL
  in:=Open(tempofile,MODE_OLDFILE)
  WHILE Fgets(in,l,80)
    num,read:=Val(l)
    IF num>=RATE_MIN AND (num<=RATE_MAX) THEN tname[num]:=dupstr_rtf(TrimStr(l+read))
  ENDWHILE
  FOR i:=RATE_MIN+1 TO RATE_MAX
    IF tname[i]=NIL THEN tname[i]:=tname[i-1]
  ENDFOR
EXCEPT DO
  Close(in)
ENDPROC

PROC dupstr_rtf(str)
  DEF new:PTR TO CHAR
  new:=NewR(StrLen(str)+1)
  AstrCopy(new,str,StrLen(str))
ENDPROC new

PROC processMsg()
  DEF sigs,going=TRUE,rcvd
  sigs:=gh.sig OR Shl(1,timerMP.sigbit) OR SIGBREAKF_CTRL_C
  sendreq()
  WHILE going
    rcvd:=Wait(sigs)
    IF GetMsg(timerMP)
      sendreq()
      tik()
    ENDIF
    IF guimessage(gh)>=0 THEN going:=FALSE
    IF rcvd AND SIGBREAKF_CTRL_C THEN going:=FALSE
  ENDWHILE
ENDPROC

PROC tik()
->  WriteF('*')
  audioSound(sBuffer,sLen,sPeriod)
ENDPROC

PROC audioInit()
  audMP:=CreateMsgPort()
  audIO:=CreateIORequest(audMP,SIZEOF ioaudio)
  audIO::ln.pri:=0
  audIO.allockey:=0
  IF sRight
    audIO.data:=[%0100,%0010,%1000,%0001]:CHAR
  ELSE
    audIO.data:=[%1000,%0001,%0100,%0010]:CHAR
  ENDIF
  audIO.length:=4
  aOpenErr:=OpenDevice('audio.device',0,audIO,0)
  IF aOpenErr THEN Raise(ERR_DEV)
  aUnit:=audIO.io.unit
ENDPROC

PROC audioPeriod(rate)
  DEF gfx:PTR TO gfxbase
  gfx:=gfxbase
  IF gfx.displayflags AND PAL
    sPeriod:=Div(3546895,rate)
  ELSE
    sPeriod:=Div(3579547,rate)
  ENDIF
ENDPROC sPeriod

PROC audioSound(data,len,period)
  audIO.io.unit:=aUnit
  audIO.io.command:=CMD_WRITE
  audIO.io.flags:=ADIOF_PERVOL
  audIO.data:=data
  audIO.length:=len AND $FFFFFFFE
  audIO.period:=period
  audIO.volume:=64
  audIO.cycles:=1
  beginIO(audIO)
  WaitIO(audIO)
  GetMsg(audMP)
ENDPROC

PROC audioUnInit()
  IF aOpenErr=0
    audIO.io.command:=ADCMD_FREE
    audIO.io.unit:=aUnit
    DoIO(audIO)
    CloseDevice(audIO)
  ENDIF
  IF audIO THEN DeleteIORequest(audIO)
  IF audMP THEN DeleteMsgPort(audMP)
ENDPROC

PROC string(num)
  DEF li[2]:ARRAY OF LONG
  li[0]:=localebase
  li[1]:=catalog
  MOVE.L li,A0
  MOVE.L num,D0
ENDPROC getString()

PROC decimalpoint() IS IF locale THEN locale.decimalpoint ELSE '.'

PROC vers() IS '$VER: Metronome 1.0 (18-May-1996) by Jilles Tjoelker'
/*EE folds
-1
44 65 49 6 52 5 56 5 59 5 62 11 65 2 68 3 71 24 74 12 77 3 80 12 83 2 86 13 89 7 92 11 95 8 98 5 
EE folds*/