Subject: scrolling SHR screen

From: [email-masked] (Richard A Simm)
Date: Mon, 21 Dec 92 12:04:51 EST

Someone asked for code to scroll the SHR screen using PEI in bank 01. Well,
the code follows. There are two versions of the code. The routine called
scroll_up uses page aligned DP (i.e. the scroll is hardcoded to the width
and height of the window). I haven't written a program yet to generate this
code but will eventually. The second routine uses non page aligned DP and
works regardless of the width/height of the window (i.e. it automatically
configures to the width/height). Enjoy.

Albert

                lst    off

* window graphics routines

                rel
                xc
                xc
                mx     %00

scroll          mac
                pei    ]1
                pei    ]1-2
                pei    ]1-4
                pei    ]1-6
                pei    ]1-8
                eom

@scroll         ent                     ;data for window scroll routines
:scroll_up      adrl   0                ;address of compiled scroll up routine
:scroll_down    adrl   0                ;address of compiled scroll down routine
:stack1         dw     $2e4f,$334f,$384f,$3d4f,$424f,$474f,$4c4f,$514f
                dw     $564f,$5b4f,$604f,$654f,$6a4f,$6f4f,$744f,$794f
                dw     $7e4f,$834f,$884f,$8d4f,$924f,$974f,$9c4f,$a14f
:stack2         dw     $2eef,$33ef,$38ef,$3def,$42ef,$47ef,$4cef,$51ef
                dw     $56ef,$5bef,$60ef,$65ef,$6aef,$6fef,$74ef,$79ef
                dw     $7eef,$83ef,$88ef,$8def,$92ef,$97ef,$9cef,$a1ef
:stack3         dw     $2f8f,$348f,$398f,$3e8f,$438f,$488f,$4d8f,$528f
                dw     $578f,$5c8f,$618f,$668f,$6b8f,$708f,$758f,$7a8f
                dw     $7f8f,$848f,$898f,$8e8f,$938f,$988f,$9d8f,$a28f
:stack4         dw     $302f,$352f,$3a2f,$3f2f,$442f,$492f,$4e2f,$532f
                dw     $582f,$5d2f,$622f,$672f,$6c2f,$712f,$762f,$7b2f
                dw     $802f,$852f,$8a2f,$8f2f,$942f,$992f,$9e2f,$a32f
:stack5         dw     $30cf,$35cf,$3acf,$3fcf,$44cf,$49cf,$4ecf,$53cf
                dw     $58cf,$5dcf,$62cf,$67cf,$6ccf,$71cf,$76cf,$7bcf
                dw     $80cf,$85cf,$8acf,$8fcf,$94cf,$99cf,$9ecf,$a3cf
:stack6         dw     $316f,$366f,$3b6f,$406f,$456f,$4a6f,$4f6f,$546f
                dw     $596f,$5e6f,$636f,$686f,$6d6f,$726f,$776f,$7c6f
                dw     $816f,$866f,$8b6f,$906f,$956f,$9a6f,$9f6f,$a46f
:stack7         dw     $320f,$370f,$3c0f,$410f,$460f,$4b0f,$500f,$550f
                dw     $5a0f,$5f0f,$640f,$690f,$6e0f,$730f,$780f,$7d0f
                dw     $820f,$870f,$8c0f,$910f,$960f,$9b0f,$a00f,$a50f
:dp1            dw     $3200,$3700,$3c00,$4100,$4600,$4b00,$5000,$5500
                dw     $5a00,$5f00,$6400,$6900,$6e00,$7300,$7800,$7d00
                dw     $8200,$8700,$8c00,$9100,$9600,$9b00,$a000,$a500
:dp2            dw     $3300,$3800,$3d00,$4200,$4700,$4c00,$5100,$5600
                dw     $5b00,$6000,$6500,$6a00,$6f00,$7400,$7900,$7e00
                dw     $8300,$8800,$8d00,$9200,$9700,$9c00,$a100,$a600
:dp3            dw     $3400,$3900,$3e00,$4300,$4800,$4d00,$5200,$5700
                dw     $5c00,$6100,$6600,$6b00,$7000,$7500,$7a00,$7f00
                dw     $8400,$8900,$8e00,$9300,$9800,$9d00,$a200,$a700
:dp4            dw     $3400,$3900,$3e00,$4300,$4800,$4d00,$5200,$5700
                dw     $5c00,$6100,$6600,$6b00,$7000,$7500,$7a00,$7f00
                dw     $8400,$8900,$8e00,$9300,$9800,$9d00,$a200,$a700
:dp5            dw     $3500,$3a00,$3f00,$4400,$4900,$4e00,$5300,$5800
                dw     $5d00,$6200,$6700,$6c00,$7100,$7600,$7b00,$8000
                dw     $8500,$8a00,$8f00,$9400,$9900,$9e00,$a300,$a800
:dp6            dw     $3600,$3b00,$4000,$4500,$4a00,$4f00,$5400,$5900
                dw     $5e00,$6300,$6800,$6d00,$7200,$7700,$7c00,$8100
                dw     $8600,$8b00,$9000,$9500,$9a00,$9f00,$a400,$a900
:dp7            dw     $3700,$3c00,$4100,$4600,$4b00,$5000,$5500,$5a00
                dw     $5f00,$6400,$6900,$6e00,$7300,$7800,$7d00,$8200
                dw     $8700,$8c00,$9100,$9600,$9b00,$a000,$a500,$aa00

**************************************************
* compiled font code to scroll window up.        *
* ---------------------------------------------- *
* (input)                                        *
*  a - number of lines to scroll up.             *
**************************************************
scroll_up       ent

                sta    :lines_erase
                sec
                lda    ~max_lines
                sbc    :lines_erase
                sta    :lines_scroll

                sei
                tsc
                sta    :stack           ;save copy of stack register
                tdc
                sta    :dp              ;save copy of direct-page register
                shorta
                ldal   STATEREG         ;map stack/dp to bank 1
                ora    #$30
                stal   STATEREG
                longa
                clc

                lda    :lines_erase     ;number of lines to scroll
                dec
                asl
                tay                     ;offset to DP pointer
                ldx    #0               ;offset to stack pointer always 0
:scroll         lda    @scroll+`stack7,x ;line 8
                tcs
                lda    @scroll+`dp7,y
                tcd

                pei    $0e
                pei    $0c
                pei    $0a
                pei    $08
                pei    $06
                pei    $04
                pei    $02
                pei    $00

                lda    @scroll+`dp6,y
                tcd

                pei    $fe
                pei    $fc
                pei    $fa
                pei    $f8
                pei    $f6
                pei    $f4
                pei    $f2
                scr    $f0
                scr    $e0
                scr    $d0
                scr    $c0
                scr    $b0
                scr    $a0
                scr    $90

                lda    @scroll+`stack6,x ;line 6
                tcs

                pei    $6e
                pei    $6c
                pei    $6a
                pei    $68
                pei    $66
                pei    $64
                pei    $62
                scr    $60
                scr    $50
                scr    $40
                scr    $30
                scr    $20
                scr    $10
                pei    $00

                lda    @scroll+`dp5,y
                tcd

                pei    $fe
                pei    $fc
                pei    $fa
                pei    $f8
                pei    $f6
                pei    $f4
                pei    $f2
                scr    $f0

                lda    @scroll+`stack5,x ;line 5
                tcs

                pei    $ce
                pei    $cc
                pei    $ca
                pei    $c8
                pei    $c6
                pei    $c4
                pei    $c2
                scr    $c0
                scr    $b0
                scr    $a0
                scr    $90
                scr    $80
                scr    $70
                scr    $60
                scr    $50

                lda    @scroll+`stack4,x ;line 4
                tcs

                pei    $2e
                pei    $2c
                pei    $2a
                pei    $28
                pei    $26
                pei    $24
                pei    $22
                scr    $20
                scr    $10
                pei    $00

                lda    @scroll+`dp4,y
                tcd

                pei    $fe
                pei    $fc
                pei    $fa
                pei    $f8
                pei    $f6
                pei    $f4
                pei    $f2
                scr    $f0
                scr    $e0
                scr    $d0
                scr    $c0
                scr    $b0

                lda    @scroll+`stack3,x ;line 3
                tcs

                pei    $8e
                pei    $8c
                pei    $8a
                pei    $88
                pei    $86
                pei    $84
                pei    $82
                scr    $80
                scr    $70
                scr    $60
                scr    $50
                scr    $40
                scr    $30
                scr    $20
                scr    $10

                lda    @scroll+`stack2,x ;line 2
                tcs
                lda    @scroll+`dp2,y
                tcd

                pei    $ee
                pei    $ec
                pei    $ea
                pei    $e8
                pei    $e6
                pei    $e4
                pei    $e2
                scr    $e0
                scr    $d0
                scr    $c0
                scr    $b0
                scr    $a0
                scr    $90
                scr    $80
                scr    $70

                lda    @scroll+`stack1,x ;line 1
                tcs

                pei    $4e
                pei    $4c
                pei    $4a
                pei    $48
                pei    $46
                pei    $44
                pei    $42
                scr    $40
                scr    $30
                scr    $20
                scr    $10
                pei    $00

                lda    @scroll+`dp1,y
                tcd

                pei    $fe
                pei    $fc
                pei    $fa
                pei    $f8
                pei    $f6
                pei    $f4
                pei    $f2
                scr    $f0
                scr    $e0
                scr    $d0

                inx
                inx
                iny
                iny
                dec    :lines_scroll
                beq    :erase
                brl    :scroll

:erase          ldy    #0               ;erase line
:erase_loop     lda    @scroll+`stack7,x ;line 7
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack6,x ;line 6
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack5,x ;line 5
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack4,x ;line 4
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack3,x ;line 3
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack2,x ;line 2
                tcs

                lup    $47
                phy
                --^

                lda    @scroll+`stack1,x ;line 1
                tcs

                lup    $47
                phy
                --^

                dec    :lines_erase
                beq    :end
                inx
                inx
                brl    :erase_loop

:end            shorta
                ldal   STATEREG         ;map stack/dp back to bank 00
                and    #$cf
                stal   STATEREG
                longa
                lda    :stack           ;restore stack pointer
                tcs
                lda    :dp              ;restore direct-page register
                tcd
                cli
                rtl

:stack          dw     0                ;stack pointer
:dp             dw     0                ;direct page pointer
:lines_scroll   dw     0                ;number of lines to scroll
:lines_erase    dw     0                ;number of lines to erase

**************************************************
* scroll window up. (thanks to chris mckinsey    *
* for the stack animation trick).                *
* ---------------------------------------------- *
* (input)                                        *
*  a - number of lines to scroll.                *
**************************************************
scroll_up_window ent
]grafport       =      $c0              ;window grafport
]vis_region     =      $c4              ;pointer to visible region
]vis_rect       =      $c8              ;visible rectangle
]width          =      $d0              ;number of words to copy
]source_image   =      $d2              ;source window pixel image
]dest_image     =      $d4              ;destination window pixel image
]num_lines      =      $d6              ;number of lines to scroll
]tmp_num_lines  =      $d8              ;original number of lines to scroll
]erase          =      $da              ;number of lines to erase (fast access)

                jsl    scroll_up
                rts

                sta    ]tmp_num_lines
                dec
                asl                     ;each line is 8 pixels high
                asl
                asl
                sta    ]num_lines

                ldx    @grafport
                ldy    @grafport+2
                stx    ]grafport
                sty    ]grafport+2
                ldy    #`visRgn
                lda    []grafport],y
                sta    ]vis_region
                ldy    #`visRgn+2
                lda    []grafport],y
                sta    ]vis_region+2
                ldy    #2
                lda    []vis_region],y
                tay
                lda    []vis_region]
                sta    ]vis_region
                sty    ]vis_region+2

                sec
                ldy    #`portRect+`x2   ;if leftmost byte to draw begins
                lda    []grafport],y    ;at scroll bar, end
                sbc    #MIN_X
                ldy    #`x1+2
                cmp    []vis_region],y
                bge    :1
                brl    :rts

:1              clc
                lda    #LINE_HEIGHT
                adc    ]num_lines
                sta    ]erase
                sta    :erase

                lda    #1
                sta    ]vis_rect+`y1
                sta    :draw_rect+`y1
                ldy    #`x1+2
                lda    []vis_region],y
                sta    :draw_rect+`x1
                sec
                ldy    #`portRect+`x2
                lda    []grafport],y
                sbc    #CHAR_WIDTH
                sta    :draw_rect+`x2
                ldy    #`y2+2
                lda    []vis_region],y
                sta    :draw_rect+`y2
                lsr
                lsr
                lsr
                pha
                asl
                asl
                asl
                sta    ]vis_rect+`y2
                sec
                lda    ~max_lines
                sbc    1,s
                beq    :3
                asl
                asl
                asl
                sta    1,s
                sec
                ldy    #`portRect+`y2
                lda    []grafport],y
                dec
                sbc    1,s
                sta    1,s
                ldy    #`y2+2
                lda    []vis_region],y
                sbc    1,s
                sta    1,s
                clc
                adc    ]vis_rect+`y2
                sta    ]vis_rect+`y2

:3              pla
                stz    ]vis_rect+`x1
                clc
                tdc
                adc    #]vis_rect
                jsr    local_to_global_rect
                ldy    #`x1+2
                lda    []vis_region],y
                beq    :4
                stz    ]vis_rect+`x1

:4              sec
                ldy    #`portRect+`x2
                lda    []grafport],y
                sbc    #CHAR_WIDTH
                ldy    #`x2+2
                cmp    []vis_region],y
                blt    :5
                sec
                ldy    #`x2+2
                lda    []vis_region],y
                bra    :6
:5              sec
                ldy    #`x1+2
                sbc    []vis_region],y
:6              lsr
                lsr
                sta    ]width           ;number of bytes to erase
                sta    :width
                lsr    ]vis_rect+`x1
                lsr    ]vis_rect+`x1

                sec
                lda    ]vis_rect+`y2
                sbc    ]vis_rect+`y1
                sbc    ]num_lines
                sbc    #LINE_HEIGHT
                sta    :height          ;number of lines to scroll

                clc
                lda    ]vis_rect+`y1
                adc    #LINE_HEIGHT
                adc    ]num_lines
                asl
                tax
                clc
                lda    #ShrImage
                adc    ~shr,x
                adc    ]vis_rect+`x1
                sta    ]source_image

                lda    ]vis_rect+`y1
                asl
                tax
                clc
                lda    #ShrImage
                adc    ~shr,x
                adc    ]vis_rect+`x1
                adc    ]width
                sta    ]dest_image

                lda    ]width
                and    #%1111_1111_1111_1110 ;copy to word boundary
                sta    ]width

                pea    #^:draw_rect     ;hide cursor if drawing inside
                pea    #:draw_rect      ;rectangle
                jsl    ShieldCursor

                sei
                tsc
                sta    :stack           ;save copy of stack pointer
                tdc
                sta    :dp              ;save copy of direct-page pointer
                sec
                lda    #:scroll
                sbc    ]width
                sta    :scroll_addr
                lsr    ]width
                sec
                lda    #:zero
                sbc    ]width
                sta    :zero_addr
                lda    ]dest_image      ;map ]dest address to stack pointer
                tay
                tcs
                lda    ]source_image    ;map ]source address to dp register
                tcd
                shorta
                ldal   STATEREG         ;map stack/dp to bank 01
                ora    #$30
                stal   STATEREG
                longa
                clc

:7              hex    4c               ;jmp
:scroll_addr    ds     2

:8              tya
                adc    #160
                tay
                tcs

                tdc
                adc    #160
                tcd

                dec    :height
                bpl    :7

                adc    :width
                tay
                sec
                ldx    #0               ;color background black

:9              tya
                sbc    #160
                tay
                tcs

                hex    4c               ;jmp
:zero_addr      ds     2

:10             dec    :erase
                bne    :9

                shorta
                ldal   STATEREG         ;map stack/dp back to bank 00
                and    #$cf
                stal   STATEREG
                longa
                lda    :stack           ;restore stack pointer
                tcs
                lda    :dp              ;restore direct-page register
                tcd
                cli

                jsl    UnshieldCursor

:rts            jsr    init_tick        ;reset tick counter
                lda    ]tmp_num_lines
                jmp    update_scroll

                scroll 158
                scroll 148
                scroll 138
                scroll 128
                scroll 118
                scroll 108
                scroll 98
                scroll 88
                scroll 78
                scroll 68
                scroll 58
                scroll 48
                scroll 38
                scroll 28
                scroll 18
                pei    8
                pei    6
                pei    4
                pei    2
:scroll         pei    0
                brl    :8

                lup    78
                phx
                --^
:zero           phx
                brl    :10

:stack          ds     2                ;stack pointer
:dp             ds     2                ;direct-page pointer
:height         ds     2                ;number of lines to copy
:erase          ds     2                ;number of lines to erase
:width          ds     2                ;number of words to copy
:draw_rect      ds     8                ;rectangle drawing to