* VScroll by AMY PRODUCTIONS * Based upon M. Duponcheels proggy's opt c+ case dep ExecBase equ $00000004 Permit equ -138 Exec Offsets Forbid equ -132 AllocMem equ -198 FreeMem equ -210 OpenLibrary equ -552 CloseLibrary equ -414 InitRastPort equ -198 Graphics Offsets InitBitMap equ -390 Text equ -60 Move equ -240 CIAPRA equ $bfe001 FIRE0 equ 6 CUSTOM equ $dff000 DMACON equ $0096 INTENA equ $009a DDFSTRT equ $0092 DDFSTOP equ $0094 DIWSTRT equ $008e DIWSTOP equ $0090 BPLCON0 equ $0100 BPLCON1 equ $0102 BPL1MOD equ $0108 BPL1PTH equ $00e0 BPL1PTL equ $00e2 BPL2PTH equ $00e4 BPL2PTL equ $00e6 SPR0PTH equ $0120 COLOR00 equ $0180 COLOR01 equ $0182 COLOR02 equ $0184 COLOR03 equ $0186 COPSTOP equ $0080 COPSTRT equ $8080 SPRSTOP equ $0020 SPRSTRT equ $8020 INTSTOP equ $4000 INTSTRT equ $c000 CHIP equ $00000002 CHIPCLEAR equ $00010002 CopperList equ $32 Current Copper Instructions PlaneDepth equ 2 PlaneWidth equ 80 ScreenHeight equ 256 PlaneHeight equ ScreenHeight*3 PlaneSize equ PlaneWidth*PlaneHeight LineLenght equ 80 HIRES ! movem.l a0-a6/d0-d7,-(sp) Save Environment Graphics move.l ExecBase,a6 lea GfxName,a1 jsr OpenLibrary(a6) move.l d0,GfxBase beq NoGraphics ClistMem move.l ExecBase,a6 move.l #ClistSize,d0 move.l #CHIPCLEAR,d1 jsr AllocMem(a6) move.l d0,ClistAddr beq NoClistMem Plane1Mem move.l ExecBase,a6 move.l #PlaneSize,d0 Bytes 3*256*80 => 640 Pixels h move.l #CHIPCLEAR,d1 3*256 Pixels v jsr AllocMem(a6) move.l d0,Plane1Addr Plane beq NoPlane1Mem Plane2Mem move.l ExecBase,a6 move.l #PlaneSize,d0 Bytes 3*256*80 => 640 Pixels h move.l #CHIPCLEAR,d1 3*256 Pixels v jsr AllocMem(a6) move.l d0,Plane2Addr beq NoPlane2Mem move.l Plane2Addr,a4 move.l #$00ff00ff,d5 move.l #PlaneWidth/4,d3 move.l #PlaneHeight,d4 Plane2Fill move.l d5,(a4)+ sub.l #$00000001,d3 bne Plane2Fill move.l #PlaneWidth/4,d3 rol.l #1,d5 sub.l #$00000001,d4 bne Plane2Fill move.l GfxBase,a6 lea BitMap,a0 move.l #PlaneDepth,d0 Depth move.l #PlaneWidth*8,d1 Width move.l #PlaneHeight,d2 Height jsr InitBitMap(a6) move.l GfxBase,a6 lea RastPort,a1 jsr InitRastPort(a6) move.l #BitMap,RastBitMap move.l Plane1Addr,Plane1 install Plane1 in BitMap * move.l Plane2Addr,Plane2 install Plane2 in BitMap move.l Plane1Addr,d5 lea Plane1Loc,a4 install Plane1 in Copper List move.w d5,6(a4) swap d5 move.w d5,2(a4) move.l Plane2Addr,d5 lea Plane2Loc,a4 install Plane2 in Copper List move.w d5,6(a4) swap d5 move.w d5,2(a4) lea ClistStart,a3 move.l ClistAddr,a4 ClistCopy move.l (a3),(a4)+ copy cmp.l #$fffffffe,(a3)+ Copper List bne ClistCopy to Chip Memory move.l #ScrollText,CharAddr initial value move.l #ScreenHeight+20,d5 initial y NextLine move.l GfxBase,a6 move.l #0,d0 x pos Outside move.l d5,d1 y pos Display Window lea RastPort,a1 jsr Move(a6) add.l #20,d5 next y move.l GfxBase,a6 move.l CharAddr,a0 lea RastPort,a1 move.l #40,d0 num of chars to put (1 line) jsr Text(a6) add.l #40,CharAddr next line of text move.l CharAddr,a3 lea EndOfText,a4 cmp.l a3,a4 bne NextLine move.l ExecBase,a6 jsr Forbid(a6) lea CUSTOM,a5 move.w #$00000000,SPR0PTH disable Intuition Pointer move.w #SPRSTOP,DMACON(a5) disable Sprites move.w #COPSTOP,DMACON(a5) disable Copper move.l GfxBase,a3 move.l CopperList(a3),OldclAddr install Copper List move.l ClistAddr,CopperList(a3) move.w #COPSTRT,DMACON(a5) enable Copper move.w #INTSTOP,INTENA(a5) disable Interrupts move.l $6c,OldIrq+2 move.l #NewIrq,$6c new Interrupt Routine move.w #INTSTRT,INTENA(a5) enable Interrupts GoOn btst #FIRE0,CIAPRA Left Mouse Button bne GoOn lea CUSTOM,a5 move.w #INTSTOP,INTENA(a5) move.l OldIrq+2,$6c old Interrupt Routine move.w #INTSTRT,INTENA(a5) move.w #COPSTOP,DMACON(a5) disable Copper move.l GfxBase,a4 move.l OldclAddr,CopperList(a4) restore Old Copper List move.w #COPSTRT,DMACON(a5) enable Copper move.w #SPRSTRT,DMACON(a5) enable Sprites move.l ExecBase,a6 jsr Permit(a6) move.l ExecBase,a6 move.l #PlaneSize,d0 move.l Plane2Addr,a1 jsr FreeMem(a6) NoPlane2Mem move.l ExecBase,a6 move.l #PlaneSize,d0 move.l Plane1Addr,a1 jsr FreeMem(a6) NoPlane1Mem move.l ExecBase,a6 move.l #ClistSize,d0 move.l ClistAddr,a1 jsr FreeMem(a6) NoClistMem move.l ExecBase,a6 move.l GfxBase,a1 jsr CloseLibrary(a6) NoGraphics movem.l (sp)+,a0-a6/d0-d7 Restore Environment rts NewIrq movem.l d0-d7/a0-a6,-(sp) Save Environment cmp.l #ScreenHeight*2*LineLenght,Delay1 Scroll Completed ? bcs Scroll Yes ! => Reset ; No ! => Scroll Reset move.l #0,Delay1 move.l #0,Delay2 bra Exit Scroll add.l #LineLenght,Delay1 1 line add.l #LineLenght,Delay2 1 line move.l ClistAddr,a4 install Vertical Scroll value move.l Plane1Addr,d5 add.l Delay1,d5 move.w d5,34(a4) swap d5 move.w d5,30(a4) move.l ClistAddr,a4 install Vertical Scroll value move.l Plane2Addr,d5 add.l Delay2,d5 move.w d5,42(a4) swap d5 move.w d5,38(a4) Exit movem.l (sp)+,a0-a6/d0-d7 Restore Environment OldIrq jmp $00000000 continue normal VB even ClistStart dc.w DIWSTRT,$3081 normal dc.w DIWSTOP,$30c1 normal dc.w DDFSTRT,$0038 normal dc.w DDFSTOP,$00d0 normal dc.w BPL1MOD,$0000 dc.w BPLCON0,$2200 NO HIRES does the trick! * 2 bit planes & color on dc.w BPLCON1,$0000 no scroll Plane1Loc dc.w BPL1PTH,$0000 filled dc.w BPL1PTL,$0000 later Plane2Loc dc.w BPL2PTH,$0000 filled dc.w BPL2PTL,$0000 later dc.w COLOR00,$0000 dc.w COLOR01,$0fff dc.w COLOR02,$000f dc.w COLOR03,$0ff0 dc.w $ffff,$fffe ClistSize equ *-ClistStart even GfxBase dc.l 0 GfxName dc.b "graphics.library",0 even ClistAddr dc.l 0 OldclAddr dc.l 0 Plane1Addr dc.l 0 Plane2Addr dc.l 0 BitMap BytesPerRow dc.w 0 Bytes dc.w 0 Flags dc.b 0 Depth dc.b 0 Pad dc.w 0 Plane1 dc.l 0 Plane2 dc.l 0 Plane3 dc.l 0 Plane4 dc.l 0 Plane5 dc.l 0 Planes ds.l 2 even RastPort dc.l 0 RastBitMap dc.l 0 ds.b 96 even ScrollText dc.b ' AMY PRODUCTIONS ' dc.b ' PRESENTS ' dc.b ' ' dc.b ' A ' dc.b ' Vertical Blanking Driven ' dc.b ' PAL VScrolling Routine ' dc.b ' ' dc.b ' Developped for ' dc.b ' the LEDYSOFT DEMODISK SERIES ' ' dc.b ' ' dc.b 169 dc.b ' AMY PRODUCTIONS 1988 [Belgium] ' EndOfText even CharAddr dc.l 0 Delay1 dc.l 0 Vertical Scroll Control Plane1 Delay2 dc.l 0 Vertical Scroll Control Plane2 even