* GUI Atari ST program STEBAP
* STE background audio player

* By P. Putnik, March 2011.



* File format : WAV based, but ...

* Converted format :

* Header is 32 KB long - to maintain cluster align (on Falcon is biggest)
* Audio data is signed mono or stereo, 25033 or 50066 Hz samplerated
* This version supports only stereo, 50066 Hz, 8-bit signed direct from
* disk playback.

* Program will first convert to new format if not in ....










*First RSC object indices

; resource set indices for STEBAP
;
MAIND    equ 0 ; form/dialog
MAINB    equ 0 ; BOX in MAIND
TITLEBX  equ 1 ; BOXTEXT in MAIND
PLAYBU   equ 2 ; BUTTON in MAIND
QUITBU   equ 3 ; BUTTON in MAIND
REPBU    equ 4 ; BUTTON in MAIND
COLTXT   equ 5 ; TEXT in MAIND
VOLDBU   equ 6 ; BUTTON in MAIND
VOLDT    equ 7 ; TEXT in MAIND
VOLUBU   equ 8 ; BUTTON in MAIND
AUTHT    equ 9 ; TEXT in MAIND

ALERT1   equ 0 ; Alert string


* Devpac 3  !
  include gemdmacr.s 
  include aes2macr.s




progbeg

 

  lea    stack+564,sp

  bsr    AEScall
  dc.w 10 *APPL INIT

  move.w   intout(pc),ident


  

*Coordinate conversion-needed by integrated RSC
coordc
  moveq #0,d0

obfloop 
  move.w d0,obfia
  move.w d0,-(sp)

  rsrc_obfix
obfia  dc.w 0
  dc.l form1  *begin adress of objects

  move.w (sp)+,d0
  addq.b #1,d0
  cmp.b #rsc_obnum,d0 *
  bne.s obfloop


 *Calling some supervisor test at start by need
  pea supv(pc)
  move.w #38,-(sp)
  trap #14
  addq.l #6,sp 

   
  *Get aktuell drive 
  move.w #25,-(sp)
  trap #1
  addq.l #2,sp

  lea path(pc),a2  
  add.b #"A",d0
  move.b d0,(a2) 



  bsr AEScall
  dc.w 35 *Menu_register
ident  dc.w 0  *Here save
  dc.l    mename
  move.w   intout(pc),menuid


evm
  
  bsr AEScall
  dc.w 23 *Evnt message
emadr dc.l emb
  cmp.w #$28,emb 
  bne.s evm  
  move.w (emb+8)(pc),d1
  cmp.w menuid(pc),d1
  bne.s evm




mcontrl   bsr  mctrl *program takes maus controll
  lea form1(pc),a0
  bsr opdial
  bsr resscp *screen part reserve
  bsr drdial
  bsr mafing

*Main loop of dialog    
mcont
*  bsr mafing *needed if is PRG (PRG startet with bee)
  bsr fodial

  move.w excod(pc),d0

  *Here come actions by button press


  cmp.w #PLAYBU,d0
  beq  loadfil

  cmp.w #REPBU,d0
  beq  toglRep

  cmp.w #VOLDBU,d0
  beq  volDown

  cmp.w #VOLUBU,d0
  beq  volUp


  cmp.w #QUITBU,d0
  beq cl2


menu
*  bsr mafing
  bsr exobdes  
  bra mcont

cl2  
  bsr mctab *vrati kontrolu

  bsr noredr *deselect exit button

   bsr backsp

    bra  evm



redrdial   


     bsr mafing
     bsr drdial
     bra menu  *back to dialog



mename  dc.b "  STEBAP",0
  even




volDown
   lea   setVol(pc),a1
   tst.b   (a1)
   beq.s   volExit
   subq.b  #1,(a1)
   bra.s   volCom


volUp  
   lea   setVol(pc),a1
   cmp.b  #40,(a1)
   beq.s   volExit
   addq.b  #1,(a1)

volCom 
* Set in HW and show db

   pea   volSupv(pc)
   move.w  #38,-(sp)
   trap  #14
   addq.l   #6,sp

   bsr  volConv

   moveq  #VOLDT,d0
   bsr   obdr







volExit   bra  menu















loadfil

* If play on then stop it if clicked !

   tst.b   playOn
   beq.s   loadfilW

   pea  stopPlay(pc)
   move.w  #38,-(sp)
   trap   #14
   addq.l   #6,sp



  
   bra   menu





loadfilW   

  bsr mabee
  lea initst(pc),a1
  bsr putext  *put initial extension
*Call fileselector:
pfilesel
  lea fsloadm(pc),a1
  bsr filesel
  tst.b buffr+100
  beq redrdial  *dialog if nothing selected

*  bsr mabee
*  bsr drdial


* According to selected file extension 
* convert    or    load & play :


   lea   buffr+100(pc),a1
   move.w  #180,d1
endSl2  tst.b  (a1)+
   beq.s   foundE2
   dbf   d1,endSl2
   bra   filerr

foundE2   subq.l  #2,a1
   cmp.b  #"E",(a1)
   beq     playIt    *



* Load org WAV file and convert it 

*Open selected file
  move.w #0,-(sp)
  pea buffr+100(pc)
  move.w #61,-(sp) *open file
  trap #1
  addq.l #8,sp
*Error check
  tst.w d0
  bmi filerr
*  bmi redrdial  *no error message so!
  move.w d0,handl


* Load WAV header and do some checks :

   pea    headbuf(pc)
  pea   44    * WAV Header len
  move.w handl(pc),-(sp)
  move.w #63,-(sp)
  trap #1
  lea 12(sp),sp
  tst.l d0
  bmi filerrCl    

* Test for format, samplerate, etc :


* todo





  * Get filelen with fseek
* not really necessary ?

  move.w #2,-(sp)  *from end mode
  move.w handl(pc),-(sp) *handle
  clr.l -(sp)  *end
  move.w #66,-(sp)
  trap #1
  lea 10(sp),sp

  move.l d0,filelen  

*Back to audio data begin :
  clr.w -(sp)  *from start mode
  move.w handl(pc),-(sp) *handle
*  clr.l -(sp)  *start
  pea   44
  move.w #66,-(sp)
  trap #1
  lea 10(sp),sp


* Create output file :

* Name :

   lea   buffr+100(pc),a0
   lea   buffr+300(pc),a1
   moveq   #45,d1
namCl   move.l  (a0)+,(a1)+
   dbf    d1,namCl

* Replace V at end with E :

   lea   buffr+300(pc),a1
   move.w  #180,d1
endSl  tst.b  (a1)+
   beq.s   foundE
   dbf   d1,endSl
   bra   filerrCl

foundE   subq.l  #2,a1
   move.b  #"E",(a1)


 
   clr.w  -(sp)
   pea    buffr+300(pc)
   move.w   #60,-(sp)
   trap   #1
   addq.l    #8,sp
   tst.w d0
   bmi filerrCl

   move.w   d0,Ohan

* First goes 32K long header
* Size serves cluster align purpose

* Fill header with proper data :

   



  pea    buf1(pc)
  pea   $8000    * Header len
  move.w Ohan(pc),-(sp)
  move.w #64,-(sp)
  trap #1
  lea 12(sp),sp
  tst.l d0
  bmi filerrCl2    
   cmp.l  #$8000,d0  *check for loaded len
  bne filerrCl2
  

   move.l   filelen(pc),d1
   sub.l   #44,d1
   move.l  d1,oLen
   move.l  d1,remLen







* Conv loop :

convLoop

  move.l   #$10000,d7
  move.l   remLen(pc),d1
  sub.l   #$10000,d1
  bpl.s   notMinus
  clr.l    d1
  move.l   remLen(pc),d7

notMinus 
  move.l   d1,remLen     


* Load frame :
  pea    buf1(pc)
  move.l    d7,-(sp) 
  move.w handl(pc),-(sp)
  move.w #63,-(sp)
  trap #1
  lea 12(sp),sp
  tst.l d0
  bmi filerrCl2    
  cmp.l d7,d0  *check for loaded len
  bne filerrCl2


* Do conversion and padding by need :

   move.l    d7,d2
   addq.l    #3,d2
   and.b     #$FC,d2   * Make dividable by 4
   move.l   #$10000,d1
   sub.l       d2,d1   * see for padding size
   
   move.l  #$80808080,d4
   lea     buf1(pc),a1


convLl
   eor.l   d4,(a1)+   * Change bits 7 in all bytes
   subq.l   #4,d2
   bne.s   convLl

   tst.l   d1
   beq.s   noPad

paDl   clr.l   (a1)+    * Insert silence at end
   subq.l	#4,d1
   bne.s  paDl


noPad



* Save frame :

  pea       buf1(pc)
  pea	$10000    * Always whole frame ! 
  move.w  Ohan(pc),-(sp)
  move.w #64,-(sp)
  trap #1
  lea 12(sp),sp
  tst.l d0
  bmi filerrCl2
  cmp.l  #$10000,d0  *check for saved len
  bne filerrCl2


  tst.l   remLen
  bne   convLoop

   bsr   closFile2
   bsr   closFile



   bra redrdial
*   bra menu

filerrCl2
  bsr  closfile2
filerrCl
  bsr closfile
filerr
  lea alertde(pc),a0
  bsr doalert
*  bra menu 


  bra redrdial





toglRep    * toggle Repeat button check state

    lea    flag3(pc),a1 
    eor.b   #5,(a1)
    bsr      obdr
    bra    mcont




* Concept :
* Watching all BIOS, XBIOS, GEMDOS trap usage ...



* Playback control :

timCen    * Timer-C interrupt entry point

     tst.l    tcFlag    * 4 bytes in block !
     bne    OrgTimC   * if busy skip following

* Depending on phase :

* If  phase=0   playing frame 1, so load frame 2 needed

* But start load only when in frame 1 really
* DMA counter must be in first half


    move.l   d0,-(sp)
    
*getDma pos. :

    moveq   #0,d0
    move.b  $FFFF8909.w,d0
    swap    d0
    move.b   $FFFF890B.w,d0
    lsl.w   #8,d0
    move.b   $FFFF890D.w,d0
   

    tst.b    phase
    bne    phas2   

    cmp.l  #buf2,d0
    bcc     BOrgTimC

    
* Now load   frame 2 in buf2 :

   st   tcFlag
   st   phase
   move.l   #buf2,d0   * Prep address
   bra.s   saveMany

phas2   
    cmp.l  #buf2,d0
   bcs    BOrgTimC


* Now load   frame1 in buf1 :

   st   tcFlag
   sf   phase
   move.l   #buf1,d0   * Prep address


saveMany
   move.w   sr,srSto2

   move.w  4(sp),srSto   * sr state of interrupted - d0 is pushed in meantime
   
   move.l   sp,Orgsp
   lea   stack2+756,sp
   movem.l   d1-d7/a0-a6,-(sp)
    


   * Allow Timer-C to work normal :
   move.b   #$DF,$FFFFFA11.w

* IRQ level to level at IRQ moment :
   move.w  srSto(pc),d1

   or.w  #$2000,d1   * Supervisor 
   move.w  d1,sr    


* Check is Current App changed
* if yes, need to reopen file

* This means lot of unclosed files
* in case of many APP start/exit !
* Possible to add code to solve it
* By remembering more stuff.
* maybe later ....

 
   move.l   curApPo(pc),a1
   move.l   (a1),d1
   cmp.l   OpenfAp(pc),d1
   bne.s   reOpenF   



LoadFrame
  move.l   d0,-(sp)
framLoad  pea    $10000
  move.w   handl(pc),-(sp)
  move.w  #63,-(sp)
  trap    #1    
  
retOwT
   lea     12(sp),sp
   bra  frameSub   


reOpenF
  move.l  d0,-(sp)
  clr.w  -(sp)
  pea buffr+100(pc)
  move.w #61,-(sp) *open file
  trap #1
  addq.l #8,sp
  move.w d0,handl

* Remember CurApp BP pointer :

   move.l   curApPo(pc),a1
   move.l  (a1),OpenfAp

* Set pos : 

   clr.w -(sp)  *from start mode
   move.w handl(pc),-(sp) *handle
   move.l   curPos(pc),-(sp)
   move.w #66,-(sp)
   trap #1
   lea 10(sp),sp

   move.l  (sp)+,d0
   bra     LoadFrame

 

frameSub    * sub 1 frame and see is last 

   add.l   #$10000,curPos
   subq.w  #1,frameLeft
   bne.s   waitTc

* End of file reached :

* Repeat  on ?

    btst     #2,flag3
    beq.s   PlayBoff

* Fseek to audio data begin, reload frameLeft :

   move.w  frameCnt(pc),frameLeft

   clr.w -(sp)  *from start mode
   move.w handl(pc),-(sp) *handle
   pea    $8000
   move.w #66,-(sp)
   trap #1
   lea 10(sp),sp

   move.l  #$8000,curPos

   bra.s  waitTc


* Playback off - just set loop off
PlayBoff
   and.b  #$FD,$FFFF8901.w

   bsr   closfile   
  
   bsr  restTimC   * Deactivate this Timer-C handler 
   sf   PlayOn

waitTc

* Some corrections in own stack top, for correct Timer-C exec :
* 14 regs on stack currently !

* Ensure ret in sp restorer :
   move.l     #timCReta,58(sp)
   move.w   #$84,62(sp)   * for  68030 case
   move.w   srSto(pc),d1
   or.w 	  #$2000,d1    * Supervisor ret needed
   move.w   d1,56(sp)

 

   movem.l   (sp)+,d1-d7/a0-a6

* Keep still own stack for case of nested Timer-C IRQ !


   move.w   srSto2(pc),sr   * Back increased sr
   bra.s  OrgTimC


BOrgTimC    move.l  (sp)+,d0   * Only from after testing DMA pos !
OrgTimC    jmp   0     *  Will be set


timCReta
    move.l   OrgSp(pc),sp
    move.l  (sp)+,d0
    clr.b    tcFlag  
    rte
  



stopPlay
   
   and.b  #$FC,$FFFF8901.w    * Loop off , play off


   bsr   closfile 
   bsr  restTimC   * Deactivate this Timer-C handler 
       

   sf   PlayOn
   
   rts








srSto   dc.w   0
srSto2   dc.w   0


tcFlag   dc.b   0
BiosF   dc.b  0   * This 4 makes long !
XbiosF   dc.b  0
GemDF   dc.b  0    * Keep together them !

phase   dc.b   0
  even
frameLeft   dc.w    0   * Max 65535 frames
* It means about : many hours :-)

frameCnt   dc.w   0

curPos    dc.l   0

curApPo   dc.l  0
OpenfAp   dc.l  0

orgSp     dc.l   0





restTimC
   move.l  orgTimC+2(pc),$114.w
  
   rts






playIt     * Playback of WAE  file :

* 1 load header and do some checks, settings ...
* todo ...

   
*Open selected file
  move.w #0,-(sp)
  pea buffr+100(pc)
  move.w #61,-(sp) *open file
  trap #1
  addq.l #8,sp
*Error check
  tst.w d0
  bmi filerr
  move.w d0,handl

* Remember CurApp BP pointer :

   move.l   curApPo(pc),a1
   move.l  (a1),OpenfAp


* Get filelen & calc frame count :

  move.w #2,-(sp)  *from end mode
  move.w handl(pc),-(sp) *handle
  clr.l -(sp)  *end
  move.w #66,-(sp)
  trap #1
  lea 10(sp),sp

  sub.l   #$8000,d0    * Header len less
  lsr.l   #8,d0
  lsr.l   #8,d0    * div by $10000

  
  move.w   d0,frameCnt   * 
  subq.w  #1,d0
  move.w   d0,frameLeft

* Back to file begin :
  clr.w -(sp)  *from start mode
  move.w handl(pc),-(sp) *handle
  clr.l -(sp)  *start
  move.w #66,-(sp)
  trap #1
  lea 10(sp),sp




  pea    buf1
  pea    $8000    * Header len
  move.w   handl(pc),-(sp)
  move.w  #63,-(sp)
  trap    #1
  lea     12(sp),sp


* Checks, settings according to header !


* todo !






* Preload frame 1 in buf1 :

  pea    buf1
  pea    $10000    * frame len
  move.w   handl(pc),-(sp)
  move.w  #63,-(sp)
  trap    #1
  lea     12(sp),sp



   move.l  #$18000,curPos



   clr.l    tcFlag
   clr.b   phase




* Now start DMA : 


   pea   dmaSupP(pc)
   move.w   #38,-(sp)
   trap   #14
   addq.l   #6,sp


   st  PlayOn    * flag

   bra redrdial   





dmaSupP

   bsr   sndinit

 
    move.b   #3,$FFFF8901.w    * start DMA, loop mode

   * Set Timer-C handler active :

   move.l   $114.w,orgTimC+2
   move.l  #TimCen,$114.w

   

   rts



* Must disable disk access etc. while background ld. active ?
* No need - just set flags and take care of nesting !


newTr1

   st   GemDF   * busy right now
    

* Pexec needs special processing :

* Test for command - is Pexec :

   btst   #5,(sp)    * Caller status ?
   bne.s  supTr1c
* User call :
   move.l   usp,a0
   bra.s   isPex

supTr1c  lea 6(sp),a0    *  8 for 68030 !

isPex   * But only modes 0 and 4 - where starts !
   cmp.w  #75,(a0)+
   bne.s   notPex
   tst.w   (a0)
   beq.s   pexecLoRu
   cmp.w  #4,(a0)
   bne.s  notPex

pexecLoRu
   move.l   nestPo(pc),a1
   move.l   2(sp),(a1)+
   move.l   a1,nestPo
   move.l   #retTfTrP1,2(sp)    * Here ret after APP exit 

   bra.s   orgTrap1


* Change reta in stack :

notPex   
   move.l  2(sp),tr1reta+2    
   move.l   #retTfTr1,2(sp)


* Only 1 level supported - and enough !
* So, back org Trap #1 value :

baOrTr1A
  move.l  orgTrap1+2(pc),$84.w  * For nested calls


orgTrap1   jmp   0    * Will be set

* Set own Trap #1 again :

retTfTr1
    lea    newTr1,a1   * a1,a2 random after Trap call !
    lea    $84.w,a2
    trap  #3     * Ensure supervisor mode while write !
*    clr.b   GemDF    * clr not good - some apps look Z flag after Trap ret !!!!

    sf  GemDF

tr1reta   jmp   0   * will be set


retTfTrP1  
   
    lea    newTr1,a1   * a1,a2 random after Trap call !
    lea    $84.w,a2
    trap  #3     * Ensure supervisor mode while write !
    
    sf  GemDF

tr1Pexreta  *  jmp   0   * This supports only 1 level of Pexec !
* More level support :

   move.l  nestPo(pc),a1
   move.l  -(a1),a2
   move.l   a1,nestPo
*   tst.l	d0      * For some cases, likely not needed after Pexec ...
   jmp   (a2)



nestPo   dc.l   nestBuf    * initial
* place for 10 level nested Pexecs



newTr13

  st    BiosF

* Change reta in stack :
  
   move.l   2(sp),tr13reta+2    
   move.l   #retTfTr13,2(sp)


* Here should be no nested calls  ?
* They are !
   * So, back org Trap #13 value :

   move.l  orgTrap13+2(pc),$B4.w  * For nested calls

orgTrap13   jmp   0    * Will be set

retTfTr13
    lea    newTr13,a1   * a1,a2 random after Trap call !
    lea    $b4.w,a2
    trap  #3     * Ensure supervisor mode while write !
*    clr.b   BiosF   * free it
   sf  BiosF

tr13reta    jmp   0   * will be set



trap3code   move.l  a1,(a2)
   rte





newTr14

  st    XBiosF

* Change reta in stack :
  
   move.l   2(sp),tr14reta+2    
   move.l   #retTfTr14,2(sp)

* Here should be no nested calls  ?
* They are !
   * So, back org Trap #14 value :

   move.l  orgTrap14+2(pc),$B8.w  * For nested calls

orgTrap14   jmp   0    * Will be set

retTfTr14
    lea    newTr14,a1   * a1,a12 random after Trap call !
    lea    $b8.w,a2
    trap  #3     * Ensure supervisor mode while write !
*    clr.b   XBiosF   * free it
   sf  XBiosF

tr14reta    jmp   0   * will be set




PlayOn   dc.w  0


**  ????

orgHbl    dc.l    0


* Following works not on Falcon ! - must check it's TOS 


HblCod    
* Same as in TOS 2.06 :

   move.w   d0,-(sp)
   move.w   2(sp),d0
   and.w     #$700,d0
   bne.s   notZerHb
   or.w     #$0300,2(sp)

notZerHb   move.w  (sp)+,d0
* + clear GemDos busy flag
   clr.b   GemDF    *  otherwise stuck in PRG, TOS APP ...  
* But on Falcon it works not (TOS 4.0x) 

* + own trap #1 again
   move.l  #newTr1,$84.w   -  not good  ???

* Likely solution is to do support for nested Pexecs !
* Right !

   rte    



volConv
* convert chain 0-40 to -80 - 0 , step 2, respective

  clr.w   d2
  move.b  setVol(pc),d2
  lsl.b  #1,d2    * x 2
  moveq  #80,d1
  sub.b  d2,d1  * That's it
  move.b  d1,setDb   * Not really needed

* Show immed :
   lea   text8+1(pc),a1
   

*   rts    
* Ret via :


hexdec2  moveq #10,d2
  moveq #1,d4
hex2  moveq #10,d3
  move.b #-$10,d5 *Space code prepare
hdlp ext.l d1
  divu d2,d1
  beq.s less
  clr.b d5
  bra.s moretz
less tst.b d4  *If is 0!
  bne.s skip
  clr.b d5
skip  move.b d5,d1
moretz add.b #$30,d1
  move.b d1,(a1)+
  swap d1
  divu d3,d2
  dbf d4,hdlp
  rts










setDb   dc.b   10    * Initial value  - 10 db
setVol  dc.b  35




* Volume control, supervisor part 
* setting master volume, by calced value in byte



volSupv
   tst.b   isFalc
   bne   skipVof

   move.w $FFFF8922.w,old
   move.w $FFFF8924.w,om


   move.w #$7FF,$FFFF8924.w

   clr.w   d1
   move.b   setVol(pc),d1      * 6 bits, but max 40, so   $0 - $28
   or.w  #$04C0,d1
   move.w   d1,$FFFF8922.w  *master

wVol
   move.w    old(pc),d1
   cmp.w   $FFFF8922.w,d1
   nop
   bne.s     wVol

   move.w    om(pc),$FFFF8924.w




skipVof
   rts






sndinit

	tst.b  isfalc
	bne   setadma

  *Setting mixer, volumes:

   move.w $FFFF8922.w,old
   move.w $FFFF8924.w,om

   move.w #$7FF,$FFFF8924.w
   move.w #$401,$FFFF8922.w  *mixer - corrected PSG level !

w1
   move.w old(pc),d1
   cmp.w $FFFF8922.w,d1
   nop
   bne.s w1 

   move.w $FFFF8922.w,old
   
   move.w #$7FF,$FFFF8924.w

*   move.w #$4E8,$FFFF8922.w  *master
   clr.w   d1
   move.b   setVol(pc),d1      * 6 bits, but max 40, so   $0 - $28
   or.w  #$04C0,d1
   move.w   d1,$FFFF8922.w  *master


w2
   move.w old(pc),d1
   cmp.w $FFFF8922.w,d1
   nop
   bne.s w2

   move.w $FFFF8922.w,old
   
   move.w #$7FF,$FFFF8924.w
   move.w #$574,$FFFF8922.w  *left

w3
   move.w old(pc),d1
   cmp.w $FFFF8922.w,d1  
   nop
   bne.s w3

   move.w $FFFF8922.w,old
    
   move.w #$7FF,$FFFF8924.w
   move.w #$534,$FFFF8922.w   *right

w4
   move.w old(pc),d1
   cmp.w $FFFF8922.w,d1
   nop
   bne.s w4

   move.w  om(pc),$FFFF8924.w
  

*begin
setadma

   clr.b    $FFFF8901.w   * off

    * Writing DMA begin address
   lea           buf1(pc),a1
   move.l      a1,d1
   
   swap        d1
   move.b    d1,$FFFF8903.w   * Order important, first Hi-byte !
   swap        d1
   clr.l           d2
   move.b     d1,d2
   lsr.w          #8,d1
   move.b      d1,$FFFF8905.w
   move.b      d2,$FFFF8907.w


  *Writing DMA end address
  
  add.l       #$20000,a1 * 128KB long buffer 
  move.l     a1,d1
   
   swap        d1
   move.b     d1,$FFFF890F.w
   swap         d1
*   clr.l           d2
   move.b     d1,d2
   lsr.w         #8,d1
   move.b     d1,$FFFF8911.w
   move.b     d2,$FFFF8913.w

  *Mode set - later may need more choices !

*   or.b         #$81,$FFFF8921.w   *mono , 25033 Hz
   or.b     #$03,$FFFF8921.w   * 50066 Hz
   and.b   #$7F,$FFFF8921.w      *  stereo 

*   and.b     #$FD,$FFFF8921.w  *reset bit 1

   rts
	

old    ds.w 1
om    ds.w 1
isfalc   dc.w  0











supv   *move.l $42e.w,orgphyst

  

 *get TOS version too here
*Good because of different fileselector possible

  move.l 4.w,d1
  clr.b d1  *on round address always
  move.l d1,a1
  move.b 2(a1),d0  *TOS ver major
  move.b 3(a1),d1  *TOS ver minor

* Get cur APP basepage pointer :
   move.l  $28(a1),curApPo

   cmp.b #2,d0
   blt.s itstos1

* 68030  fix :

   cmp.b  #3,d0

   blt.s   not68030


   lea   supTr1c(pc),a1
   lea   FalcCor1(pc),a2
   move.l   (a2)+,(a1)+    * 4 bytes
*   move.w   (a2),(a1)




* Falcon snd init needed too   !
* At least on TOS 4.02 for sure
 
   cmp.b  #4,d0
   bne.s   notFalc
    
   st   isFalc

* Setting Falcon sound, so will have STE DMA audio  (TOS 4.02 only need it ? )

    move.w  #1,-(sp)
    clr.l   -(sp)
    move.w  #8,-(sp)
    clr.w  -(sp)
    move.w  #$8B,-(sp)
    trap   #14
    lea   12(sp),sp

* Here to disable Volume controls too ?



notFalc


not68030
  bra.s   setVecs

itstos1 cmp.b #4,d1
  blt.s under14
  bra.s  setVecs

under14   st oldtos


setVecs

* Vectors, H-blank permanently set :
  
    
* Install Trap #3 handler :

   move.l  #trap3code,$8C.w


*  By APP start H/blank activates - it is good
* to clear GemDos busy flag as no Trap #1 real exit !!!

   move.l   $68.w,orgHbl
   move.l   #HblCod,$68.w
   

* Trap #13  - must it too, as is used by hard disk access

   move.l   $B4.w,orgTrap13+2
   move.l  #newTr13,$B4.w

* Trap #14  -  too

   move.l   $B8.w,orgTrap14+2
   move.l  #newTr14,$B8.w



* Trap #1
   move.l   $84.w,orgTrap1+2
   move.l  #newTr1,$84.w
   
  
* Special protection against crash
* if user tries to change res.  :

* Seek string "Set Preferences" in RAM :


   lea   $8000,a1    * here start seek
   
   lea   progbeg(pc),a5    * limiter


slMain   
   cmp.l   a1,a5     
   ble.s    notFoMs
   lea   seekThis(pc),a2    * this
   move.l  a1,a3
   moveq   #14,d2    * need 15 successive matches

   move.b  (a1)+,d1
   cmp.b  (a2),d1
   bne.s   slMain

* first char matches   

   addq.l  #1,a2
fircm   move.b  (a1)+,d1
   cmp.b  (a2)+,d1  
   beq.s     moreMat
   addq.l   #1,a3
   move.l    a3,a1
   bra.s  slMain

moreMat  subq.b  #1,d2
  bne.s  fircm

* got It
* 2 bytes lower :

  subq.l  #2,a3

* Now must seek that long in a3 ...

  move.l  a3,d1

  move.l   d1,d2
  and.b  #$FC,d2
  move.l  d2,a1    * here start

* limit is still a5

seekAdrL

  cmp.l  (a1),d1
  beq.s   lookBA
seeACe  addq.l  #2,a1   * Step 2 only !
  cmp.l   a1,a5
  bne.s   seekAdrL
  bra.s   notFoMs

lookBA   * before and after must be word/long  0
   tst.w  4(a1)
   bne.s   seeACe
   tst.l    -4(a1)
   bne.s   seeACe

* must be it - 99.99 %

* Disable Menu item :

  move.w  #8,-2(a1)   * OK in TOS 2.06

* Unfortunately it works not
* in TOS 1.62, because it
* corrects Desktop menu items
* after starting ACC  





notFoMs
   rts



FalcCor1     lea 8(sp),a0   * 4 bytes


seekThis   dc.b  "Set Preferences",0
* Good only if English TOS !

   even







closfile2  move.w Ohan(pc),-(sp)
  move.w #62,-(sp)
  trap #1
  addq.l #4,sp
  rts
  


closfile  move.w handl(pc),-(sp)
  move.w #62,-(sp)
  trap #1
  addq.l #4,sp
  rts

	

*AES dialog subrutines


*DRAW DIALOG SUBRUTINE
*In parameter:a0-tree adress

opdial *put tree adress on all places where needed 
  lea fca(pc),a1 
  move.l a0,(a1)
*  move.l a0,oda-fca(a1)
  move.l a0,fda-fca(a1)
  move.l a0,oca-fca(a1)
  move.l a0,oda2-fca(a1)
  move.l a0,oda2f-fca(a1)
  move.l a0,oda3-fca(a1)
*  move.l a0,oboff+2-fca(a1)
*centre objekt
  
  form_center
fca ds.l 1
*Enter coords
  lea cost(pc),a1 
  lea intout+2(pc),a0
  bsr.s copint2
  bsr.s copints
*  lea odp(pc),a1 
*  bsr.s copints
  lea odp2+4(pc),a1
  bsr.s copints
  lea fdf+2(pc),a1
  bsr.s copints
  bsr.s copints
  lea obnu+4(pc),a1
  
copints lea cost(pc),a0
copint2 moveq #3,d0
copil move.w (a0)+,(a1)+
  dbf d0,copil
  rts



*Reserve screen part
resscp
  form_dial
  dc.w 0
cost ds.w 8 
  rts



drdial 
  moveq #0,d0
  bra obdr  *ret via


*Object exit rutine "Form do"
  
fodial
  form_do
  dc.w 0
fda ds.l 1
  move.w intout(pc),excod  *Save exit button
  rts

cldial  bsr.s noredr

*Back screenpart
backsp
  form_dial
fdf dc.w 3
  ds.w 8

  rts

obsel move.w d0,obnu
  move.w #1,status
  bra.s ochl
obdes move.w d1,obnu
  bra.s clrstat

noredr  clr.w status+2  *No redraw by leave dialog
exobdes
  move.w excod(pc),obnu
clrstat  clr.w status  *normal status
ochl 
  objc_change
obnu dc.w 0,0,0,0,0,0
status  dc.w 0,1
oca ds.l 1
  move.w #1,status+2 * redraw needed after again
  rts



doalert
  move.l a0,ala
  form_alert
  dc.w 1  *Default
ala  dc.l 0 
  move.w intout(pc),d0
  cmp.w #1,d0 *test pressed key
  rts



obdr move.w d0,odp2
  objc_draw
odp2 dc.w 0,3 *depth=3 used
  ds.w 4
oda2 ds.l 1
  rts


clobdr  *startobject is mainbox 
  objc_draw
odp3 dc.w 0,2 *depth=2 used
clip3  ds.w 4
oda3 ds.l 1
  rts

obdrf move.w d0,odp2f
  bsr AEScall
  dc.w 42
odp2f dc.w 0,0
  ds.w 4
oda2f ds.l 1
  rts


mctrl
  wind_update
  dc.w 3
  rts

mctab
  wind_update
  dc.w 2
  rts

mafing moveq #3,d1
  bra.s grafmo
maarr moveq #0,d1
  bra.s grafmo
mabee moveq #2,d1
grafmo move.w d1,mousf
  graf_mouse
mousf dc.w 3
  dc.l 20000 *not used
  rts    






*Central rutine for param. adress serve etc.
AEScall  move.l (sp),a1  *reta
  move.w (a1)+,d0 *function number, a1 now hold intinadr (or reta)
  lea AESct-5(pc),a3
funsrl addq.l #5,a3
  cmp.b (a3),d0
  bne.s funsrl
  moveq #4,d1
  clr.l d0
  lea contrl(pc),a2
  move.l a2,a0
fuccl move.b (a3)+,d0
  move.w d0,(a2)+
  dbf d1,fuccl  
  
  lea AESPB(pc),a2
  move.l a1,8(a2) *pintin
  move.w 2(a0),d0  *# of intin
  lsl.w #1,d0  
  add.l d0,a1  *adress of addrin
  move.w 6(a0),d0
  beq.s noadrin
  move.l a1,16(a2) *paddrin
  lsl.w #2,d0  *mult by 4
  add.l d0,a1 
noadrin  move.l a1,(sp)  *Skip datas! -prepare retadress
  move.l a2,d1
  move.w #200,d0
  trap #2  *Call AES function
  rts


AESPB dc.l contrl  * pcontrol
pglobal dc.l global
pintin ds.l 1
pintout dc.l intout
paddrin ds.l 1
paddrout dc.l addrout

*Tables with AES control blocks of (only) used functions
AESct *must contain all in prg. used functions
  dc.b 10,0,1,0,0  *APPL init
  dc.b 19,0,1,0,0  *APPL exit
  dc.b 21,3,5,0,0  *EVNT button
  dc.b 23,0,1,1,0  *Evnt message
  dc.b 24,2,1,0,0  * Evnt timer  
  dc.b 35,1,1,1,0  *Menu register
  dc.b 42,6,1,1,0  *Objc draw
  dc.b 43,4,1,1,0  *Objc find
  dc.b 44,1,3,1,0  *Objc offset
  dc.b 47,8,1,1,0  *Objc change
  dc.b 50,1,1,1,0  *Form do (dialog)
  dc.b 51,9,1,0,0  *Form dial
  dc.b 52,1,1,1,0  *Form alert
  dc.b 54,0,5,1,0  *Form center
  dc.b 78,1,1,1,0  *Graf mouse
  dc.b 79,0,5,0,0  *Graf mkstate
  dc.b 90,0,2,2,0  *Old Fsel for TOS 1.02 and 1.00
  dc.b 91,0,2,3,0  *Fsel input
  dc.b 107,1,1,0,0 *Wind update
  dc.b 114,1,1,1,0 *RSRC obfix
  dc.b 0
  even


filesel  clr.l buffr 
   
   tst.b oldtos
  bne.s fiselold

  move.l a1,fsmadr
  fsel_i  
*  bsr AEScall
*  dc.w 91,0,2,3,0 *Only for new TOS!!!
  dc.l path
  dc.l buffr
fsmadr ds.l 1  
  tst.w intout
  beq.s fisend
  tst.w intout+2
  beq.s fisend
  
fsok  lea buffr+100(pc),a1
  lea path(pc),a0
  bsr.s pdcopy
*Now drop attributes of select
droat 
  subq.l #1,a0
  cmp.b #"\",-(a1)  *is subdir end marker
  bne.s droat
  addq.l #1,a1  *move forward
  lea 2(a0),a2  *store ext (with . ) begin from path

  lea buffr(pc),a0
  tst.b (a0) *check for nothing selected or written
  beq.s fis2
  bra.s pdcopy
  
fisend 
fis2  clr.l buffr+100
  rts


fiselold  *AES 90 for older TOS

  fsel_input
  dc.l path
  dc.l buffr

  tst.w intout
  beq.s fisend
  tst.w intout+2
  beq.s fisend
  bra.s fsok



pdcopy 
  tst.b (a0)
  beq.s pdret 
  move.b (a0)+,(a1)+
  bra.s pdcopy

pdret move.b (a0),(a1)  *For case that longer was there prior
  rts


*Insert extension on path end
*a1 - pointer
putext lea path(pc),a0
searz  tst.b (a0)+
  bne.s searz
*Now search back for \
searbs cmp.b #"\",-(a0)
  bne.s searbs
  addq.l #1,a0

  moveq #5,d1  *copy 4-5 chars and zero term.
initc move.b (a1)+,(a0)+
  dbf d1,initc
  clr.b (a0)
  rts  


*The RSC integrated - ASM source made with RSCTOASM


rsc_obnum equ 10


*rsc_obs	dc.w	9	* 10 objects in RSC *

form1	dc.w	-1,1,9
	dc.w	20,0,16		*0*
	dc.l	$21113
	dc.w	$302,$101,$520,$408

	dc.w	2,-1,-1
	dc.w	22,0,0		*1*
	dc.l	ted1
	dc.w	$701,$300,29,1

	dc.w	3,-1,-1
	dc.w	26,5
	dc.b	0
flag1	dc.b	0		*2*
	dc.l	text1
	dc.w	$604,$102,$709,$201

	dc.w	4,-1,-1
	dc.w	26,5
	dc.b	0
flag2	dc.b	0		*3*
	dc.l	text2
	dc.w	$716,$206,$608,$401

	dc.w	5,-1,-1
	dc.w	26,5
	dc.b	0
flag3	dc.b	0		*4*
	dc.l	text3
	dc.w	$712,$202,8,1

	dc.w	6,-1,-1
	dc.w	21,0,0		*5*
	dc.l	ted2
	dc.w	9,$104,7,1

	dc.w	7,-1,-1
	dc.w	26,5
	dc.b	0
flag4	dc.b	0		*6*
	dc.l	text4
	dc.w	$205,$405,3,$201

	dc.w	8,-1,-1
	dc.w	21,0,0		*7*
	dc.l	ted3
	dc.w	$409,$605,6,1

	dc.w	9,-1,-1
	dc.w	26,5
	dc.b	0
flag5	dc.b	0		*8*
	dc.l	text5
	dc.w	$610,$405,3,$201

	dc.w	0,-1,-1
	dc.w	21,32,0		*9*
	dc.l	ted4
	dc.w	$401,$307,$208,1

		* Tedinfo blocks *

ted1	dc.l	text6,null,null
	dc.w	3,6,2,$1180
	dc.w	0,0,30,1

ted2	dc.l	text7,null,null
	dc.w	3,6,0,$1180
	dc.w	0,-1,8,1

ted3	dc.l	text8,null,null
	dc.w	3,6,0,$1180
	dc.w	0,-1,7,1

ted4	dc.l	text9,null,null
	dc.w	5,6,0,$1180
	dc.w	0,-1,12,1

		* Free string / Alert data *

alert1t	dc.b	'[3][ |Invalid file][OK]',0

alertde	dc.b	'[3][Load error!][Damn!]',0 

		* Text data *

text1	dc.b	'Play/Stop',0
text2	dc.b	'E X I T',0
text3	dc.b	'  Repeat',0
text4	dc.b	'',0
text5	dc.b	'',0
text6	dc.b	' STE background audio player ',0
text7	dc.b	'Volume:',0
text8	dc.b	'-10 db',0
text9	dc.b	'By PP, 2011',0
null	dc.b	0,0



initst dc.b "*.WA*",0,0

  
fsloadm dc.b "LOAD WAE..",0



   even

oldtos dc.w 0
errflag ds.w 0

*Put here current drive.... :
path dc.b  "D:\*.*",0,0,0

  even

  SECTION BSS

  ds.b 512  *place for path

excod ds.w 1
menuid ds.w 1

contrl ds.w 5
global ds.l 16  
intout ds.w 7  *max 7
addrout ds.l 2  *max 2
emb ds.w 8  


filelen ds.l 1
handl ds.w 1
Ohan   ds.w 1
oLen   ds.l   1
remLen  ds.l  1


nestBuf   ds.b  40   *


*orgphyst ds.l 1
buffr ds.b 512
headbuf   ds.b  64

buf1    ds.b $10000  *for frame 1
buf2    ds.b $10000  *for frame 2

stack  ds.b 568

stack2  ds.b 768

fin



