From richard%fiu.edu@mail4.engin.umich.edu Mon Dec 21 12:09:12 1992
Received: from srvr2.engin.umich.edu by mail4.engin.umich.edu (5.64/1.35)
id 5d17aa1eb.000b141; Mon, 21 Dec 92 12:09:03 -0500
Received: from churchy.gnu.ai.mit.edu by srvr2.engin.umich.edu (5.64/1.35)
id AA06492; Mon, 21 Dec 92 12:09:00 -0500
Received: from serss0.fiu.edu by churchy.gnu.ai.mit.edu (5.65/4.0) with SMTP
id ; Mon, 21 Dec 92 12:04:59 -0500
Received: by fiu.edu (4.1/SMI/FIU-4.0.2)
id AA21208; Mon, 21 Dec 92 12:04:51 EST
Date: Mon, 21 Dec 92 12:04:51 EST
From: richard@fiu.edu (Richard A Simm)
Message-Id: <9212211704.AA21208@fiu.edu>
To: freetool-gs-programming-list@gnu.ai.mit.edu
Subject: scrolling SHR screen
Status: R
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