* LargeTextVScroll by AMY PRODUCTIONS
*
* Based upon Final Vertical Scrolling Example
* by (C) Marc Duponcheel
*
         opt       c+,d+               case dep and debug

ExecBase           equ       $00000004

Permit             equ       -138      Exec Offsets
Forbid             equ       -132
AllocMem           equ       -198
FreeMem            equ       -210
OpenLibrary        equ       -552
CloseLibrary       equ       -414

Text               equ       -60       Graphics Offsets
Move               equ       -240
InitRastPort       equ       -198
InitBitMap         equ       -390

CIAPRA             equ       $bfe001
FIRE0              equ       6

CUSTOM             equ       $dff000

DMACON             equ       $0096
INTENA             equ       $009a

BPLCON0            equ       $0100
BPLCON1            equ       $0102
BPL1PTH            equ       $00e0
BPL1PTL            equ       $00e2
BPL1MOD            equ       $0108

DDFSTRT            equ       $0092
DDFSTOP            equ       $0094

DIWSTRT            equ       $008e
DIWSTOP            equ       $0090

SPR0PTH            equ       $0120

COLOR00            equ       $0180
COLOR01            equ       $0182

COPSTOP            equ       $0080
COPSTRT            equ       $8080
SPRSTOP            equ       $0020
SPRSTRT            equ       $8020
INTSTOP            equ       $4000
INTSTRT            equ       $c000

CHIPCLEAR          equ       $00010002

CopperList         equ       $32       Current Copper Instructions

PlaneDepth         equ       1
PlaneWidth         equ       80        80*8=640
ScreenHeight	   equ	     256
PlaneHeight        equ       3*ScreenHeight
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

PlaneMem
         move.l    ExecBase,a6
         move.l    #PlaneSize,d0       Bytes  600*80 => 640 Pixels h
         move.l    #CHIPCLEAR,d1                        600 Pixels v
         jsr       AllocMem(a6)
         move.l    d0,PlaneAddr        Plane
         beq       NoPlaneMem

         move.l    PlaneAddr,d5
         lea       ClistStart,a4       install Plane 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    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    PlaneAddr,Plane     install Plane in BitMap

         move.l    GfxBase,a6
         lea       RastPort,a1
         jsr       InitRastPort(a6)
         move.l    #BitMap,RastBitMap

         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    PlaneAddr,a1
         jsr       FreeMem(a6)
NoPlaneMem

         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,Delay   Scroll Completed ?
         ble       Scroll              Yes ! => Reset ; No ! => Scroll
Reset
         move.l    #0,Delay
         bra       Exit

Scroll
         add.l     #LineLenght,Delay           one line

         move.l    ClistAddr,a4        install Vertical Scroll value
         move.l    PlaneAddr,d5

         add.l     Delay,d5
         add.l     #6,a4
         move.w    d5,(a4)
         sub.l     #4,a4
         swap      d5
         move.w    d5,(a4)

Exit
         movem.l   (sp)+,a0-a6/d0-d7   Restore Environment

OldIrq
         jmp       $00000000           continue normal VB

         even
ClistAddr
         dc.l      0
OldclAddr
         dc.l      0
PlaneAddr
         dc.l      0
ClistStart
         dc.w      BPL1PTH,$0000       dynamically updated
         dc.w      BPL1PTL,$0000       for scrolling

         dc.w      BPLCON0,$1200       NO HIRES ($9200) does the trick !
*                                      1 bit plane & color on  !
         dc.w      BPL1MOD,$0000

         dc.w      DIWSTRT,$3081       normal
         dc.w      DIWSTOP,$30c1       normal

         dc.w      DDFSTRT,$3c         normal
         dc.w      DDFSTOP,$d4         normal

         dc.w      COLOR00,$0000
         dc.w      COLOR01,$0f22

	dc.w	$b011,$fffe,$180,$ff7
	dc.w	$fe11,$fffe,$180,$000
	dc.w	$ffd5,$fffe,$180,$000
	dc.w	$0a11,$fffe,$180,$055
	dc.w	$0b11,$fffe,$180,$505
	dc.w	$0c11,$fffe,$180,$550
	dc.w	$0d11,$fffe,$180,$f55
	dc.w	$0e11,$fffe,$180,$f55
	dc.w	$2511,$fffe,$180,$55f
	dc.w	$2611,$fffe,$180,$055
	dc.w	$2711,$fffe,$180,$505
	dc.w	$2811,$fffe,$180,$550

         dc.w      $ffff,$fffe
ClistSize          equ       *-ClistStart

ScrollText
     dc.b          'AMY PRODUCTIONS                         '
     dc.b          'Presents : ...                          '
     dc.b          '                                        '
     dc.b          '100 % Assembler                         '
     dc.b          'Vertical Blanking Driven                '
     dc.b          'Text PAL VScrolling                     '
     dc.b          'Specially developed for my friend       '
     dc.b          'LEDYSOFT                                '
     dc.b          '                                        '
     dc.b          169
     dc.b           ' AMY PRODUCTIONS 1988 BELGIUM          '
EndOfText

         even
GfxBase
         dc.l      0
GfxName
         dc.b      "graphics.library",0
         even
CharAddr
         dc.l      0
Delay
         dc.l      0         Vertical Scroll Control

BitMap
BytesPerRow        dc.w      0
Bytes              dc.w      0
Flags              dc.b      0
Depth              dc.b      0
Pad                dc.w      0
Plane              dc.l      0
Planes             ds.l      7

RastPort           dc.l      0
RastBitMap         dc.l      0
                   ds.b      96