; --- New Bitplane Scrollroutine !
; --- written by Duke of T.L.C
; --- with many helps from the Mad Thinker
org= $38000
load= $38000

ScrPlane1:  equ  $45000

; ---- Special AMIGA Equates
AbsExecBase=4      ; the only absolute address !
Level3Int=$6c
; ---- Exec Library Vector Offsets
Permit=-138
Forbid=-132
OpenLibrary=-408
CloseLibrary=-414
; ---- Graphics Library Vector Offsets
Text=-60
SetFont=-66
CloseFont=-78
InitRastPort=-198
InitBitMap=-390
MovePen=-240
; ---- Diskfont Library Vectors
OpenDiskFont=-30
DMACON=$dff096
; 
;  Initialize the libraries for system calls
;
   move.l sp,initialSP  

   
  
   move.l AbsExecBase,a6         ; ExecLib Base
   lea  GfxName,a1               ; addr. of library name
   jsr  OpenLibrary(a6)          ; open it
   move.l d0,GfxBase             ; store base pointer for use
   move.l d0,d6                  ; save for use
;
; Open the Diskfont library
;
   lea  FontLName,a1             ; name of library
   jsr  OpenLibrary(a6)          ; do a open
   move.l d0,DiskfontBase        ; store pointer
   beq  FontErr
;
; Load the special font to in ram
;
   move.l d0,a6            ; move library pointer
   lea  TextAttr,a0        ; discription of font
   jsr  OpenDiskFont(a6)
   move.l d0,FontBase      ; addr of TextFont structure
   beq  FontErr
;
;  Print the text in bit plane
;
   move.l GfxBase,a6        ;  copy library base pointer
   lea  BitMap,a0           ; addr of BitMap
   moveq #1,d0              ; Depth of BitMap
   move.l #480,d1           ; Width of BitMap
   move.l #40,d2            ; Height of BitMap
   jsr  InitBitMap(a6)      ; setup the structure

   move.l #ScrPlane1,a0     ; pointer to memory
   move.l a0,Plane1         ; install in BitMap
   move.l #8000/4-4,d0        ; clear memory 
lok1:   clr.l (a0)+
   dbra d0,lok1

   lea  RastPort,a1         ; my RastPort structure
   jsr  InitRastPort(a6)
   move.l #BitMap,R_BitMap  ; install pointer to BitMap

   lea  RastPort,a1   
   move.l FontBase,a0       ; addr of TextFont
   jsr  SetFont(a6)         ; install new font in RastPort

; ---- Put text...

;
; setup the new copper list (will be performed in next VBlank)
;
   move.l AbsExecBase,a6
   jsr  Forbid(a6)   ; stop multitasking

   move.l GfxBase,a0
   add.l #$32,a0    ; point to LOFlist in GfxBase

   move.w #$0080,DMACON  ; stop Copper DMA
   move.l (a0),OldCopper  ; pointer to old copper list
   move.l #CopList,(a0)  ; my own Coppers..
   move.w #$8080,DMACON   
;
;  blitter scrolling
;
   move.l #str,c_ptr
next:
   bsr  put_char

akt:   btst   #14,$dff002
   bne    akt

   move.l #$ffffffff,$dff044   ; first/last word mask
   
   move.l #$45002,$dff050      ; source A
   move.l #buffer,$dff054      ; destination D

   move.w #02,$dff064
   move.w #00,$dff066          ;  modulos

   move.w #$00,$dff042
   move.w #$09f0,$dff040

   bsr    sync
   move.w #25,d0
   lsl.w  #6,d0
   ori.w #29,d0               ; 30 words
   move.w d0,$dff058

   move.w #$f,d7
fine:
akt2:  btst   #14,$dff002
   bne    akt2
   move.l #buffer,$dff050      ; source A
   move.l #$45000,$dff054      ; destination D

   move.w #00,$dff064
   move.w #02,$dff066          ;  modulos

   move.w #$00,$dff042
   move.w d7,d6
   lsl.w  #8,d6
   lsl.w  #4,d6
   ori.w  #$9f0,d6
   move.w d6,$dff040

   bsr    sync
   move.w #25,d0
   lsl.w  #6,d0
   ori.w #29,d0               ; 30 words
   move.w d0,$dff058
again:
   move.b $bfe001,d0   ; wait until mouse button
   move.b d0,d1
   and.l #$40,d0
   beq  raus

   move.l #$1000,d1
ti1: dbra d1,ti1
   sub.w #$1,d7
   bpl   fine
   bra   next
raus:
;
;  reset all resources used!
;
   move.l GfxBase,a0
   add.l #$32,a0    ; point to LOFlist in GfxBase

   move.w #$0080,DMACON  ; stop Copper and Sound
   move.l OldCopper,(a0)  ; restore pointer
   move.w #$8080,DMACON  ; start again ...

   move.l AbsExecBase,a6
   jsr  Permit(a6)   ; restart multitasking
;
;  Ready to give system back
;
   move.l GfxBase,a6
   move.l FontBase,a1   ; addr of font
   jsr  CloseFont(a6)  ; font memory back to system

   move.l AbsExecBase,a6  ; Exec-Master-Program
   move.l DiskfontBase,a1
   jsr  CloseLibrary(a6) ; no need for Libraries!!
   move.l GfxBase,a1
   jsr  CloseLibrary(a6)
ende:
   move.l initialSP,sp
   clr.l d0     ; E.T. phone home!!
   ILLEGAL
;   rts
;
; ---- syncronize blitter with raster beam
sync:
   move.w $dff006,d4
   lsr.w  #8,d4
   cmp.b #$50,d4
   bls   sync
   rts  
;
; ---- put character to screen
;
put_char:
   move.l GfxBase,a6
   move.l #448,d0             ; x pos
   move.l #15,d1              ; y pos
   lea  RastPort,a1       
   jsr  MovePen(a6)

   lea  RastPort,a1          ; addr of structure

   move.l c_ptr,a0
   move.l #2,d0              ; num of chars to put
   jsr  Text(a6);
   add.l  #2,c_ptr
   cmp.l #str+800,c_ptr       ;compare with text
   blo.s Duke                 ;jump out
   move.l #str,c_ptr
Duke:  rts

; ---- Error ... assume that you use Intuition's DisplayAlert()
;
FontErr:
   move.l initialSP,sp
   rts          ; try to escape (without hope!)

GfxName: DC.B 'graphics.library',0
   even
FontLName: DC.B 'diskfont.library',0
   even
;
;  DISPLAY COPROCCESSOR INSTRUCTION LIST
;
CopList:
  DC.W $008e,$9c81    ; DIW Start 
  DC.W $0090,$f4c1    ; DIW Stop 
  DC.W $0092,$38      ; DDF Start 
  DC.W $0094,$d0      ; DDF Stop 
  DC.W $00e0,$0004
  DC.W $00e2,$5002
  DC.W $0108,20
;##RASTER FARBEN###
  DC.W $0180,$0000  ; Hgrund Farben
  DC.W $8501,$FFFE  
  DC.W $0180,$0111
  DC.W $8701,$FFFE
  DC.W $0180,$0222
  DC.W $8901,$FFFE
  DC.W $0180,$0333  ;Hgrund Farben
  DC.W $8B01,$FFFE
  DC.W $0180,$0444
  DC.W $8D01,$FFFE
  DC.W $0180,$0666
  DC.W $8F01,$FFFE
  DC.W $0180,$0777
  DC.W $9101,$FFFE
  DC.W $0180,$0888  ;Hgrund Farben
  DC.W $9301,$FFFE
  DC.W $0180,$0999
  DC.W $9501,$FFFE
  DC.W $0180,$0AAA
  DC.W $9701,$FFFE
  DC.W $0180,$0BBB
  DC.W $9901,$FFFE
  DC.W $0180,$0CCC
  DC.W $9B01,$FFFE
  DC.W $0180,$0DDD
  DC.W $9D01,$FFFE
  DC.W $0180,$0EEE
  DC.W $9f01,$FFFE    ;hgrund colors
  DC.W $0180,$0FFF
  DC.W $A001,$FFFE
  DC.W $0180,$0000 
;.................
  DC.W $A201,$FFFE   ;Font colours
  DC.W $0182,$0d00  ;red
  DC.W $A301,$FFFE
  DC.W $0182,$0f80  ;orange
  DC.W $A401,$FFFE
  DC.W $0182,$0fb0  ;gold o
  DC.W $A501,$FFFE
  DC.W $0182,$0ff0  ;yellow
  DC.W $A601,$FFFE
  DC.W $0182,$0bf0  ;green
  DC.W $A701,$FFFE
  DC.W $0182,$00f0  ;green...Font Colours
  DC.W $A801,$FFFE
  DC.W $0182,$02c0  ;dark green
  DC.W $A901,$FFFE
  DC.W $0182,$00bb  ; blue green
  DC.W $AA01,$FFFE
  DC.W $0182,$01fb  ;aqau
  DC.W $AB01,$FFFE
  DC.W $0182,$000f  ;blue
  DC.W $B001,$FFFE  ;Font Colours
;................  
  DC.W $0180,$0FFF  ;Hgrund Colours I
  DC.W $B201,$FFFE
  DC.W $0180,$0EEE
  DC.W $B401,$FFFE
  DC.W $0180,$0DDD
  DC.W $B601,$FFFE
  DC.W $0180,$0CCC
  DC.W $B801,$FFFE
  DC.W $0180,$0BBB
  DC.W $BA01,$FFFE
  DC.W $0180,$0999
  DC.W $BC01,$FFFE
  DC.W $0180,$0888
  DC.W $BE01,$FFFE
  DC.W $0180,$0777
  DC.W $C001,$FFFE
  DC.W $0180,$0666
  DC.W $C201,$FFFE
  DC.W $0180,$0555
  DC.W $C501,$FFFE
  DC.W $0180,$0444
  DC.W $C701,$FFFE
  DC.W $0180,$0333
  DC.W $C901,$FFFE
  DC.W $0180,$0222
  DC.W $CB01,$FFFE
  DC.W $0180,$0111
  DC.W $CD01,$FFFE
  DC.W $0180,$0000
  ;---------------HIER ENDE DER GRAU TOENE !!!
  DC.W $0102,$000    ; Scroll delay 0
  DC.W $0100,$1200   ; 1 Bit Plane

  DC.W $ffff,$fffe


; ---- Demo Text
str: DC.B  '+ ATOM  IN  1987 + PRESENTS MY   FIRST  LETTER ON '
     DC.B  'A NEW DIMENSION LIKE THE AMIGA 1000 !!! SORRY FOR NO '
     DC.B  'ACTION BUT SEE MY NEXT DEMO OR WATCH OUT FOR MY   '
     DC.B  '*** INTRO DISK III ***    AND NOW MY GREETINGS :  '	
     DC.B  'SPECIAL HI AND THANKS TO  THE LIGHT CIRCLE (HELLO '
     DC.B  'DUKE & MAD THINKER) AND TO E.C.A (HELLO R.I.P & JE'
     DC.B  'SUS) ALSO GREETINGS TO DR.MABUSE,POWERSTATION (SPE'
     DC.B  'CIAL  »MR.TEST«),EXLPORER (CALL ME !!),A-TEAM,ECC,'
     DC.B  'INDY,THE NEW AGE,NEW STARS (HELLO TMC I HOPE YOU '
     DC.B  'ALIVE ) TFR,PHANTOM,HERM,SHARK-SOFT,ACS,HQC (I HOP'
     DC.B  'E I CAN CONTACT YOU ),1001 CREW,SCA,SNAKE AND ALL '
     DC.B  'I KNOW ... HYPER GREETINGS TO THE MEMBERS OF ATOM-'
     DC.B  'SOFT IN 1987 »» ERDNUSS,CAMEL,DWK ««  ---> THIS SC'
     DC.B  'ROLL ARE DESIGNED BY »ATOM«  THANKS TO DUKE FROM T'
     DC.B  'LC !!! IF YOU WANT TO CONTACT ME WATCH OUT FOR MY '
     DC.B  'PHONE NUMBER ON THIS DISK !!   »(C) BY ATOM «     '
     len: equ *
    even
FontName:  DC.B 'topaz.font',0
    even
TextAttr:
    DC.L FontName
    DC.W 11          ; hight of Font
    DC.W 0

DiskfontBase: blk.l 1,0
GfxBase: blk.l 1,0
initialSP: blk.l 1,0
OldCopper: blk.l 1,0
FontBase: blk.l 1,0
c_ptr:  blk.l 1,0
; Structures used by graphics.library

BitMap:
BytesPerRow: blk.w 1,0
Bytes:    blk.w 1,0
Flags:    blk.b 1,0
Depth:    blk.b 1,0
Pad:      blk.w 1,0
Plane1:   blk.l 1,0
Planes:   blk.l 7,0

RastPort:  blk.l 1,0
R_BitMap:  blk.l 1,0
    blk.b 96,0            ; space for laber unused data
buffer: blk.b 60*40,0