XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  PLAY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
                       The PLAY Program of COMPOSE
                     compiled and decompiled with JAZZ

                          General Description.

Arguments: Level3 TextString, Level2 TempoReal, Level1 NoteString.
NoteString may be BZ-compressed. Each single tune is a substring of 
NoteString of the form  "X n" where "X" is the Note symbol f0, g0, ...
called Note, and n is a real, called TuneLenght.   
PLAY may produce two types of Errors, both trapped with NOP:  
(a) NoteStr is not o.k. or too long, (b) performance is aborted.

PLAY has two three parts, the data preparation part, the performance part
and the "scrolling the notes" part. 
In the first part a list will be produced for each single tune, pause, or 
tactstroke. I would very much appreciate if this part could made still 
somewhat faster by translating its slowest routines into ML.
In the performance part, setbeep will act together with shifting 
ABUFF for note display. ABUFF may become very large but has always the same
hight of 64 pixels. Both parts are definite loops. In the last part the
user may or may not scroll the note picture of the whole music piece.

IF PLAY is executed from the PBOX-Browser, it will return to the Browser,
no matter whether it errors or not. The stack is left intact essentially
by means of SAVESTACK.

Program                     Comment
-------------               ---------------------------            
::
 ID AC                      ArgumentChecker (to be replaced by \130).
 NOT?SEMI                   Do nothing if the three components
 ERRSET                     of a music piece are not in the stack
 ::                         This part is normally compressed.
  SWAP                      LAM7: TempoReal
  #A5                       #A5 = 165 = BaseTune frequency of tune f0b (=e0).
  %2                        J.S.Bach's constant 12th root of 2
  %12                       is used for generating the frequencies 
  %NROOT                    for well-tempered tuning.
  DUP                       
  THIRTY                    Computing the list of all used 
  #1+_ONE_DO                well-tempered frequencies.
  DUP                       
  #A5                       
  UNCOERCE
  %*
  COERCE
  UNROTOVER
  %*
  LOOP
  2DROP
  THIRTYONE
  {}N                       LAM 6: list of the 31 frequencies in PLAY.
  FOUR
  SysITE                    Flag -4 set: performance in bass clef.
  %1                        Lam5: holds the multiplicator %1 or %2
  %2                        for bass or violin clef.
  FOURTEEN                  Lam4: holds X-position of the note graphic
  TRUE'                     LAM3: will later hold the NoteCode
  CODE
	GOSBVL	=POP#               Lam2: This ML-Code is a Stack manipulator
	GOSBVL	=SAVPTR
	A=A-1	A
	A=A-1	A
	C=A	A
	C=C+C	A
	C=C+C	A
	C=C+A	A
	AD1EX
	A=A+C	A
	AD1EX
	C=DAT1	A
	CD1EX
	D1=D1+	5
	C=DAT1	A
	C=C+1	A
	DAT1=C	A
	A=A+C	A
	GOVLNG	=PUSH#ALOOP
ENDCODE
  #ZERO#ONE
  {}N                       LAM1: will be TactStrokePositionList
  PTR 3306C                 List of 7 NULLLAMs. Must be replaced!!!
  BIND
  CkChr00                   Checks whether the NoteString is encoded
  ?SKIP                     Only BZ, no other compressor will be used!
  ID UBZE                   The BZ-decoder, mail attached.
  ZERO                      
  TOTEMPOB                  Important, belongs to the Stack arranger Lam2.
  UNROT                     
  ZEROSWAP
  BEGIN                     Begin of NoteStr decomposition into lines
  SEP$NL                    These are the tacts of the music piece.
  DUPLEN$
  #1=                       If line consist of a single symbol
  IT                        it will be assumed that this is a real n
  ::                        greater zero and smaller 10
   ROTDUP                   which repeats the setting of the
   ROT                      first n lines of NoteStr.
   DOSTR>
   COERCE
   #1+_ONE_DO
   SWAP#1+SWAP
   DUP
   #3+PICK
   4UNROLL
   LOOP
   DROP#1-
   SWAPROT
  ;
  UNROT
  SWAP#1+SWAP
  DUPNULL$?
  UNTIL
  DROP
  reversym                  The Metaobject of lines (=tacts) of Notestr.
  #1+_ONE_DO                Begin of the definite TactProcessingLoop
  BEGIN                     Begin of the indefinite NoteProcessingLoop 
  DUP                       The $Splitter.  "abc def" --> "abc" "def" 
  CHR_Space                                   "abc"   --> "abc"  #0
  ONE
  POS$
  DUP
  #0=?SKIP
  ::
   2DUP
   1_#1-SUB$
   UNROT
   #1+LAST$
  ;                         End of $Splitter
  SWAPDUP
  3PUTLAM                   Lam3 holds, e.g., "a2#t+", the first
  THREE                     part of a single tune string. 
  1_#1-SUB$
  $ "1f0g0a1b1h1c1d1e1f1g1a2b2h2c2d2e2f2g2a3"
  SWAPONE                   The sequence of Notes. The "1" at the
  POS$                      top is only for making computation of 
  #2/                       of position in it somewhat easier.
  ::
   DUP#0=csedrp             If no occurence in NoteCode sequence,
   ::                       it is assumed that it is one of the pause
    4GETLAM                 symbols P4,P8,P16. Only the bints of the
    #2+                     symbols "4", "8", "1" are kept and collected
    3GETLAM                 with the actual Xposition in a list of
    TWO                     size 2 for display in the performance part.
    SUB$1#
    TWO{}N
   ;
   CODE                     This Code yields Yposition of note graphic
	GOSBVL	=POP#               and -1 if a "#" has to put on the note and +1
	GOSBVL	=SAVPTR             if a "b" has to be put on the note. This is done
	A=A-1	A                    for adapting the frequencies of such notes.
	A=A+A	A
	A=A+A	A
	GOSUB	LA94B2
	NIBHEX	03CFD2EFA2007220722042301250E170B18081A051C021E021E0F0F0C0119031604130610081
LA94B2	C=RSTK
	C=C+A	A
	D1=C
	A=0	A
	C=0	A
	C=DAT1	B
	D1=D1+	2
	A=DAT1	B
	?ABIT=0	7
	GOYES	LA94D4
	A=0	A
	A=-A-1	A
	A=DAT1	B
LA94D4	GOVLNG	#3F0E
ENDCODE
   TOTEMPOB
   ROTDUP
   CHR_Space
   ONE
   POS$                     $Splitter again, 
   DUP                      splitting the TuneLength from NoteStr.
   #0=?SKIP
   ::
    2DUP
    1_#1-SUB$
    UNROT
    #1+LAST$
   ;
   4UNROLL
   DOSTR>
   UNROT
   4GETLAM
   #2+
   OVER
   FOUR
   SysITE
   #6+
   TOTEMPOB
   5PICK
   COERCE
   3GETLAM
   CODE                    This ML-code takes TuneLength as bint and the Note
	GOSBVL	=PopASavptr        and yields essentially the position number of Note
	C=DAT1	A                  in frequency list, and the NoteGrob, 
	CD1EX                     and a TRUE/FALSE as to whether the Note contains 
	D0=C                      a prolongation dot or not.
	D1=D1+	5                  This code should be revised!!!
	C=DAT1	A
	B=C	A
	D0=D0+	15
	C=DAT0	A
	D0=C
	D0=D0+	5
	C=DAT0	A
	RSTK=C
	C=A	A
	GOSBVL	=GetStrLenC
	D=C	A
	D=D-1	A
	R2=C
	C=DAT1	W
	R3=C
	A=B	A
	B=0	A
	C=0	A
	C=C+1	A
LA95AF	B=B+1	A
	C=C+C	A
	?C<=A	A
	GOYES	LA95AF
	B=B-1	A
	B=B-1	A
	GONC	LA9616
	GOSUB	LA9781
	NIBHEX	72F1F400001000D000000000000000000000000000000000000000000008700C800601028104C008700CD59572617691F400001000D000000100010001000100010001000100010001000108710C810601028104C008700CD59576017A31F400001000D000000100010001000100010001000100010001000108710CF10EF10EF10CF008700CD5957AA07ED0F400001000D000000100030007000D00091001100110011009100D08750CF10EF10EF10CF00870073507780F400001000D000000100030007000D000B1007100D100910091009087D0CF50EF10EF10CF008700
LA9781	C=RSTK
	RSTK=C
	D1=C
	D1=D1+	4
	C=DAT1	A
	C=C-CON	A,5
	GOSBVL	=MAKE$N
	D0=D0-	10
	LA(5)	=DOGROB
	DAT0=A	A
	D0=D0+	5
	CD0EX
	R1=C
	D1=C
	RTNCC
	C=RSTK
	D0=C
	C=DAT0	A
	GOSBVL	=MOVEDOWN
	C=RSTK
	A=C	A
	?A=0	A
	GOYES	LA97F4
	LC(2)	#1E
	?C=A	B
	GOYES	LA97F4
	LC(2)	#24
	?C=A	B
	GOYES	LA97F4
	LC(1)	#A
	?C=A	B
	GOYES	LA97F4
	LC(2)	#30
	?C#A	B
	GOYES	LA980B
LA97F4	A=R1
	C=0	A
	LC(2)	#43
	A=A+C	A
	D1=A
	LC(3)	#3FF
	DAT1=C	3
LA980B	C=R2
	D=C	A
	C=R3
	B=C	W
LA9816	A=0	A
	LC(2)	#23
	GOSUB	LA9840
	LC(2)	#62
	GOSUB	LA9840
	LC(2)	#74
	GOSUB	LA9840
	BSR	W
	BSR	W
	D=D-1	A
	GONC	LA9816
	A=0	A
	GOC	LA98BC
LA9840	A=A+1	A
	?B=C	B
	GOYES	LA9849
	RTNCC
LA9849	C=RSTK
	A=A-1	A
	C=A	A
	A=A+A	A
	A=A+A	A
	A=A+A	A
	A=A+A	A
	A=A+C	A
	GOSUB	LA9890
	NIBHEX	8683C683C282100004040C14242C1FFFFF4040C64242C200000
LA9890	C=RSTK
	C=C+A	A
	D0=C
	C=R1
	D1=C
	D1=D1+	15
	D1=D1+	12
	C=0	A
	LC(1)	5
LA98A8	A=DAT0	B
	DAT1=A	B
	D0=D0+	2
	D1=D1+	4
	C=C-1	A
	GONC	LA98A8
	A=DAT0	A
LA98BC	AR0EX
	C=R2
	D=C	A
	C=R3
	B=C	W
	LC(2)	#2E
	ST=1	2
LA98D1	?B=C	B
	GOYES	LA98E7
	BSR	W
	BSR	W
	D=D-1	A
	GONC	LA98D1
	ST=0	2
	GOC	LA990C
LA98E7	C=0	A
	LC(2)	#46
	C=C+A	A
	D0=C
	LC(2)	#18
	B=C	A
	P=	13
LA98FA	C=DAT0	B
	C=C!B	A
	DAT0=C	B
	D0=D0+	4
	P=P+1
	GONC	LA98FA
LA990C	GOSBVL	=D1=DSKTOP
	DAT1=A	A
	D1=D1+	15
	C=DAT1	A
	D1=C
	D1=D1+	5
	C=R0
	DAT1=C	A
	?ST=1	2
	GOYES	LA992D
LA992D	GOVLNG	=GPPushT/FLp
ENDCODE
   IT
   ::
    6ROLL
    % .66
    %*
    6UNROLL
    4GETLAM
    #4+
    4PUTLAM
   ;
   6GETLAM                 Frequency list
   6ROLL
   6ROLL
   #+
   #6+
   NTHCOMPDROP             Frequency is determined
   UNCOERCE
   5GETLAM                 Multiplicator for bass clef 
   %*
   7GETLAM
   6ROLL                   Start Actual TuneLength computation
   %/
   % .05
   %-
   % .01
   %MAX                    TuneLength as a real. Small corrections
   3GETLAM                 since a tune must not be too short. 
   CHR_t                   Asking for ThrillProcedure
   TWO
   POS$
   #0=?SKIP                If ThrillSymbol on Note then
   ::                      a list is made containing the two thrilled
    %10*                   frequencies and
    %1                     NumOfThr = Number of Thrill repetitions (in Bints).
    %MAX                   Thrill loop must be repeated at least once,
    COERCE                 otherwise mashine may crashes. 
    SWAPDUP                
    %2                     Bach's constant again, must not have its own
    %12                    NULLNAME since thrills are very seldom used. 
    %NROOT
    3GETLAM
    CHR_+                  Deciding whether a t+ or t- was part of Note.
    TWO
    POS$
    #0=?SKIP
    PTR 1B47B              real square function. Must be replaced!!!
    %*
    TWO{}N
   ;
   FIVE                    A list of the form 
   {}N                     {Xpos,Ypos, NoteGrob,frequency,durance}
  ;                        for a single tune, or a list the form
  4GETLAM                  {Xpos,Ypos,NoteGrob,NumOfThr,{freq1,freq2}}
  #12+                     in case of a thrill. Durance of the thrill will  
  4PUTLAM                  be computed in the performance.
  ISTOP-INDEX
  #4+
  2GETEVAL
  UNROLL
  DUP#0=
  UNTIL                    End of the NoteProcessingLoop
  4GETLAM
  #4+
  1GETLAM
  OVER
  >HCOMP                   Addition of actual Xpos to the XposList
  1PUTLAM
  #1+
  DUP4PUTLAM               Now begins computation of the 
  FOURFIVE                 WindowCorner adaption after ending a tact.
  #>                                       
  IT                                       
  ::                                       
   DROP                                    
   4GETLAM                                 
   FOURFIVE
   #-
  ;
  ISTOP-INDEX
  #3+                            
  2GETEVAL                 The Xpos of Window will be put at the stack at the
  UNROLL                   right place with the aide of the stack manipulator
  LOOP                     End of the TactProcessingLoop
  ABUFF                          
  4GETLAM
  #700                     Must be changed to # 700, the maximal
  OVER                     width of ABUFF. May perhaps be changed to # 800
  #<case                   provided the HP49 has sufficiently free Memory.      
  SETSIZEERR                     
  RECLAIMDISP              At this point the start screen of PLAY and the 
  TURNMENUOFF              start menu are erased.  
  EIGHTYONE                It follows the ABUFF size setting.
  #MAX                           
  EIGHTYONE
  #-
  PTR 12BB7                Enlarges ABUFF, must be changed!!!
  TEN
  FIFTYSIX
  ROT                      Text into picture. XYGROBDISP must be used since 
  $>grob                   Text may be longer as ABUFF size setting before. 
  XYGROBDISP               
  GARBAGE                  Good place for cleaning mem before performance.
  FOUR
  SysITE                   Violin or Bass clef grob
  GROB 5E 51000D0000000000000000000000008700CC00209130B1303030700070007000B100B108100C00060003008100C000
  GROB 96 32000D0000080008100830086008400840084008400860083008100C000E000B008900C8004C706EC03B8139013901380178016801C8818BC00E700800080008000900880088008D000700
  ABUFF                                    
  TWO                                      
  FIFTEEN
  GROB!
  FORTYFOUR
  NINETEEN
  DO                       Note lines into picture
  ONE                      MAKEGROB and GROB! are
  4GETLAM                  fast. No problem to put them inside
  MAKEGROB                 the loop
  INVGROB
  ABUFF
  ZERO                                     
  INDEX@                                   
  GROB!                                    
  SIX
  +LOOP
  1GETLAM                  TactStrokes into picture
  INNERCOMP
  #1+_ONE_DO
  TWENTYTHREE
  ONE
  MAKEGROB
  INVGROB
  ABUFF
  ROT
  TWENTY
  GROB!
  LOOP
  #1+_ONE_DO                Start of the PerformanceLoop   
  ::
   NOTLISTcase
   ::
    ZEROSWAP                WindowCorner adaption
    WINDOWXY
   ;
   INNERCOMP
   #>2case                  Distiction whether Note or Thrill list
   ::
    TRUE
    ABUFF
    5ROLL
    7ROLL
    7ROLL
    GROB+#                  NoteGrob into Picture
    DROP
    NOTLISTcase
    DOBEEP
    COMPEVAL
    ROT
    #1+_ONE_DO              Start of the Thrill performance loop
    OVER
    % .04
    DOBEEP
    DUP
    % .04
    DOBEEP
    LOOP
    2DROP
   ;
   ::
    FIFTYTWO                Start of the procedure to choose the right 
    #=casedrop              PauseGrob and to pause an adequate amont
    ::                      of time
     %25                    will later 0.25 sec
     GROB 4E 11000900000400060003008100C000C00081000300030081008000800080008100030006000C00
    ;
    FIFTYSIX
    #=case
    ::
     %12
     GROB 3A C0000900000000C100C1100B100E1008000C0004000600020003000100
    ;
    %5
    GROB 46 F0000B00000000E000E030E8308D100F1078007C00F600870002000300010081008000
   ;
   TRUE
   ABUFF
   ROT
   5ROLL
   TWENTYTHREE
   GROB+#                    PauseGrob into picture
   DROP
   %1
   %OF                       1% of the time amount 
   7GETLAM                   ultiplyed with 
   %*                        the TempoReal
   dowait                    pause.
  ;
  LOOP                       End of the PerformanceLoop
 ;
 ERRTRAP                     
 NOP                         No error condition. 
 undo                        Establish the original stack (undo demands
 ABND                        that UNDO was active. Otherwise one probably  
 JUMPLEFT                    must do a warmstart.  
 PTR 4CE83                   Jump to the left of the current ABUFF and step
 RECLAIMDISP                 into the ScrollPol. See below. Finally, 
;                            ABUFF resized and redrawn.      

PTR 4CE83 above is perhaps the most difficult in porting. I do not know
wether the HP49 ABUFF can easily be scrolled without creating an 
extra POL, but it should offer this possibility.
