****************************************************************************
****************************************************************************
**                                                               
**  Phoenix (Basic "library" routines)
**
**  Copyright 2004 by Patrick Davidson.  This software may be freely
**  modified and/or copied with no restrictions.  There is no warranty.
**
**  by Patrick Davidson (pad@calc.org, http://pad.calc.org/)
**
**  Last updated September 14, 2004
**
****************************************************************************
****************************************************************************

******************************************** DIVIDE D2 (WORD) BY 4
*
* This routine divides D2 by 4 with rounding of fractional values up or
* down decided by the cycle counter.  If the fraction is 1/4, it will be
* rounded up 1/4 of the time, 1/2 is rounded up 1/2 of the time, and 3/4
* is rounded up 3/4 of the time.  This is used for moving objects with
* fractional velocities in such a way that (over many frames) the velocity
* averages out to the specified fraction.  If the fraction is 1/2, the
* distance will every other frame, rather than having two frames in a row
* of each value, as this gives smoother motion.
*
* Returns result in D2.  Modified D2, D3, and D4.
*
********

Div_D2_By_4:
        move.w  d2,d3
        asr.w   #2,d2
        and.w   #3,d3
        lsl.w   #3,d3
        move.w  cycle_counter+2(a5),d4
        and.w   #3,d4
        jmp     round_table(pc,d3.w)

round_table:
        rts
roundup:
        addq.w  #1,d2
        rts
        dc.w    31337

onefourth:
        beq.s   roundup
        rts
        dc.w    31337,31337

onehalf:
        lsr.w   #1,d4
        bcc.s   roundup
        rts
        dc.w    31337

threefourths:
        cmp.w   #3,d4
        bne.s   roundup
        rts

******************************************** SPEED ADJUSTMENT
*
* This routine sets the speed of the programmable interrupt to
*
* 1500 / (257 - D0.W) cycles per second
*
* This is equivalent to simple storing the value in D0 in the rate counter
* on a hardware version 1 calculator.  This routine checks if HW2 is being
* used and scales the value appropriately if it is.
*
* This code comes from the hardware check routine posted by Zeljko Juric
* on the assembly-89 mailing list.
*
********

    IFD  ti92
Set_Speed:
        move.w  d0,$600016
        rts
    ENDIF
    IFND ti92
Set_Speed:
        move.l  $C8,d1
        and.l   #$e00000,d1
        move.l  d1,a1
        move.l  260(a1),a0
        move.l  a0,d2
        sub.l   d1,d2
        cmp.l   #$FFFF,d2
        bhi.s   hw1
        cmpi.w  #$16,(a0)
        bls.s   hw1
        move.l  $16(a0),d1
        subq.w  #1,d1
        beq.s   hw1

hw2:    ext.w   d0
        add.w   d0,d0
        ext.l   d0
        divs    #3,d0
        and.w   #$ff,d0

hw1:    move.w  d0,$600016
        rts
    ENDIF

******************************************** TI-OS KEYBOARD READING

    IFND _nostub
Get_Key:
        lea     tios::kb_vars+$1c,a3    
        tst.w   (a3)                    ; See if a keypress is stored
        beq.s   Get_Key                 ; Continue waiting if not
        clr.w   (a3)                    ; Clear keypress counter
        move.w  2(a3),d0                ; Read keypress
        rts     

Test_Key:
        lea     tios::kb_vars+$1c,a3    
        tst.w   (a3)    
        beq.s   no_key  
        clr.w   (a3)    
        move.w  2(a3),d0        
        rts     
no_key: moveq   #0,d0
        rts     
    ENDIF

    IFD _nostub
Get_Key:
        bsr.s   Test_Key
        beq.s   Get_Key
        rts

Test_Key:
        moveq   #6,d0
        trap    #9                      ; Get pointer to keyboard queue in A0

        move.l  a0,-(sp)
        pea     _string_buffer(a5)
        move.l  ($c8).w,a0
        add.l   #$3aa*4,a0
        move.l  (a0),a0
        jsr     (a0)                    ; OSdequeue()
        addq.l  #8,sp
        tst.w   d0
        bne.s   no_key
        move.w  _string_buffer(a5),d0
        rts
no_key: moveq   #0,d0
        rts 
    ENDIF

******************************************** TI-89 KEYBOARD DELAY

    IFD ti89    
wait_keyport:
        moveq   #20,d1                  ; Increase this if there are
loop_keywait:
                                        ; keyboard reading errors.
        dbra    d1,loop_keywait 
        rts     
    ENDIF   

******************************************** RANDOM-NUMBER GENERATOR
*
* Returns a reandom number from 0 to D0 - 1.
* Modifies D0 and D1 only, preserving all other registers.
*
********

random: move.l  d1,-(sp)
        move.w  #31421,d1
        mulu    seed(a5),d1
        add.w   #6927,d1
        move.w  d1,seed(a5)
        mulu    d1,d0
        swap    d0
        move.l  (sp)+,d1
        rts

******************************************** MISC. ROM FUNCTIONS

    IFND _nostub
____sprintf:
        jmp     tios::sprintf
ST_showHelp equ tios::ST_showHelp
    ENDIF
    IFD _nostub
____sprintf:
        move.l  ($c8).w,a0
        add.l   #$53*4,a0
        move.l  (a0),a0
        jmp     (a0)
ST_showHelp:
        move.l  ($c8).w,a0
        add.l   #$e6*4,a0
        move.l  (a0),a0
        jmp     (a0)
    ENDIF

******************************************** BASIC TEXT DISPLAY ROUTINES

Set_Font:                               ; Set font to D0
        move.w  d0,-(sp)        
    IFND _nostub
        jsr     tios::FontSetSys 
    ENDIF
    IFD _nostub
        move.l  ($c8).w,a0
        add.l   #$18f*4,a0
        move.l  (a0),a0
        jsr     (a0)
    ENDIF
        addq.w  #2,sp   
        rts     

Display_String:                         ; Display (A0) at (D1,D0)
        move.w  #4,-(sp)        
        lea     _unpack_buffer(a5),a1   ; A1 -> output string built here
        pea     (a1)
        move.w  d0,-(sp)        
        move.w  d1,-(sp)

loop_unpack_string:
        move.b  (a0)+,d0                ; Get new character of packed string
        beq.s   unpack_done             ; 0 = end of string
        bmi.s   decode_word             ; >= 128 --> unpack word
        move.b  d0,(a1)+                
        bra.s   loop_unpack_string
unpack_done:
        clr.b   (a1)

    IFND _nostub
        jsr     tios::DrawStrXY 
    ENDIF
    IFD _nostub
        move.l  ($c8).w,a0
        add.l   #$1a9*4,a0
        move.l  (a0),a0
        jsr     (a0)
    ENDIF
        lea     10(sp),sp       
        rts     

decode_word:
        move.l  a0,-(sp)
        lea     String_Patterns(pc),a0  ; A4 -> string pattern table
        bclr    #7,d0
locate_word_loop:
        subq.b  #1,d0                   ; subtract one from words to scan
        blt.s   copy_word_loop          ; < 128 --> done    
word_end_scan:
        tst.b   (a0)+                   ; Find end of string at (A4)
        bne.s   word_end_scan
        bra.s   locate_word_loop
copy_word_loop:                         ; Copy string from (A4) to (A1)
        move.b  (a0)+,(a1)+
        bne.s   copy_word_loop
        subq.l  #1,a1
        move.l  (sp)+,a0
        bra.s   loop_unpack_string
                                        
******************************************** STRING PATTERNS

spc     set     128

STRING  MACRO
\1      set     spc
spc     set     spc+1
        ENDM

String_Patterns:
        STRING  THE
        dc.b    ' the ',0
        STRING  WEAPON
        dc.b    ' weapon',0
        STRING  HOWBACK
    IFND ti89d   
        dc.b    'Press [SPACE] to return...',0  
    ENDIF   
    IFD ti89d   
        dc.b    'Press [ENTER] to return...',0  
    ENDIF
        STRING  DASH
        dc.b    ' - ',0
        STRING  YOU
        dc.b    ' you',0
        STRING  PHOENIX
        dc.b    'Phoenix',0
        STRING  CANNON
        dc.b    ' Cannon ',0
        STRING  PLASMA
        dc.b    ' Plasma Cannon ',0
    IFND ti89
        STRING  _AND
        dc.b    ' and ',0
        STRING  INFO
        dc.b    ' Info',0
    ENDIF
        STRING  _TO
        dc.b    ' to ',0
        STRING  _IT
        dc.b    ' it.',0
        STRING  THIS
        dc.b    ' this',0

        EVEN