           ; *****************************************
           ; *     UltraColorMode 1989 by R.Beck     *
           ; *      Abbruch mit linker Maustaste     *
           ; *                                       *
           ; * Assemblieren mit Kick-Ass             *
           ; * Abspeichern mit Write/Link als UCM.l  *
           ; * Linken mit: Blink UCM.l to UCM        *
           ; *****************************************

           ;Customchip-Register
           ;-------------------
DMACON     = $96
COLOR00    =$180 ;Hintergrundfarbe
COP1LC     = $80 ;Adresse der 1. Copperlist
COPJMP1    = $88 ;Beschreiben des Sprungregisters bewirkt
           ;      Ausführung der Copperlist

CIAAPRA    =$BFE001 ;CIA-A Portregister A (Maustaste)

           ;Exec-Library

ExecBase   = 4
OpenLibrary = -30-522
CloseLibrary = -30-414
Forbid     = -30-102
Permit     = -30-108
AllocMem   = -30-168
FreeMem    = -30-180

           ;Konstanten
           ;----------
StartList  = 38
MEMF_CHIP  = 2

CLsize     =136+136  ;Speicherplatz für 2 Copperlisten

           ;Programm:
           ;---------
Start:     move.l ExecBase.s,a6

           lea graphics,a1
           clr.l d0
           jsr OpenLibrary(a6)       ;GraphicsLibrary öffnen
           move.l d0,a1              ;Adresse von GfxBase nach a1
           move.l  StartList(a1),OldCopList  ;normale Coplist retten
           jsr     CloseLibrary(a6)  ;GraphicsLibrary wieder schließen

           move.l #CLsize,d0
           moveq #MEMF_CHIP,d1
           jsr AllocMem(a6)          ;Speicher für Copperlist
           move.l d0,MyCopList
           beq Ende                  ;Fehler ?

           ;nun die Copperlist in ihren Speicher eintragen

           lea $DFF000,a5            ;Basisadresse der Register
           jsr Forbid(a6)            ;Taskwechsel sperren

           move.w  #$0FFF,d0         ;Farbcode für grau
           move.w  #$0111,d1         ;Farbdifferenz
           bsr   SetList             ;Copperlist erstellen
Wait1:     btst #6,CIAAPRA           ;linke Maustaste gedrückt =>
           bne.s Wait1               ;=> Bit gelöscht
           move.w #$0F00,d0          ;diesmal rot
           move.w #$0100,d1
           bsr.s SetList
Wait2:     btst #6,CIAAPRA           ;nun auf Loslassen der Maustaste
           beq.s Wait2               ;warten
           move.w #$00F0,d0          ;grün
           move.w #$0010,d1
           bsr.s SetList
Wait3:     btst #6,CIAAPRA           ;drücken
           bne.s Wait3
           move.w #$000F,d0
           move.w #$0001,d1          ;blau
           bsr.s SetList
Wait4:     btst #6,CIAAPRA           ;loslassen
           beq.s Wait4

           move.l OldCopList,COP1LC(a5) ;Adresse der Startlist laden
           clr.w COPJMP1(a5)            ;und Copperlist starten
           move.w #$83E0,DMACON(a5)     ;DMA wieder einschalten
           jsr Permit(a6)

           move.l MyCopList,a1
           move.l #CLsize,d0
           jsr FreeMem(a6)           ;CopperList-Speicher zurückgeben
Ende:      clr.l d0                  ;DOS-Fehlercode löschen
           rts


           ;UNTERPROGRAMME
           ;--------------

SetList:   ;Erstellt 2-fache Copperlist
           ;d0.w: Grundfarbe
           ;d1.w: Farbdifferenz

           move.l MyCopList,a0     ;Adresse der CopList
           move.w  d0,d2;          ;Grundfarbe kopieren
           move.w  #$270F,d3       ;erste Wait-Position nach d3
           move.w  #$1000,d4       ;Wait-Differenz nach d4
           move.w  #COLOR00,d5     ;Registeradresse
           move.w  #$FFFE,d6       ;Maskenbits für Wait-Befehl
           moveq   #14,d7          ;Schleifenzähler
SetLop1:   move.w  d5,(a0)+        ;MOVE-Befehl, Register
           move.w  d2,(a0)+        ;MOVE-Befehl, Wert
           move.w  d3,(a0)+        ;WAIT-Befehl, Position
           move.w  d6,(a0)+        ;WAIT-Befehl, Maske
           sub.w   d1,d2           ;neue Farbe
           add.w   d4,d3           ;und Position
           dbra    d7,SetLop1
           move.w  d5,(a0)+        ;ein letztes Mal Farbe ändern
           move.w  d2,(a0)+
change:    move.w  #COP1LC,(a0)+   ;Befehl, um Hi-Word der CopList zu ändern
           move.l  MyCopList,d7    ;Adr. der 2. CopList
           add.l   #136,d7         ;errechnen
           swap    d7              ;zunächst Hi-Word der 2. Coplist speichern
           move.w  d7,(a0)+
           move.w  #COP1LC+2,(a0)+ ;Adresse für Lo-Word
           swap d7
           move.w  d7,(a0)+        ;Lo-Word eintragen
           move.l #$FFFFFFFE,(a0)+ ;END-Befehl
           move.w  #$2F0F,d3       ;Register neu initialisieren
           moveq   #14,d7
SetLop2:   move.w  d5,(a0)+        ;MOVE-Befehl, Register
           move.w  d0,(a0)+        ;MOVE-Befehl, Wert
           move.w  d3,(a0)+        ;WAIT-Befehl, Position
           move.w  d6,(a0)+        ;WAIT-Befehl, Maske
           sub.w   d1,d0           ;neue Farbe
           add.w   d4,d3           ;und Position
           dbra    d7,SetLop2
           move.w  d5,(a0)+        ;ein letztes Mal Farbe ändern
           move.w  d0,(a0)+
change2:   move.w  #COP1LC,(a0)+   ;Befehl, um Hi-Word der CopList zu ändern
           move.l  MyCopList,d7    ;Adr. der 1. CopList
           swap    d7              ;zunächst Hi-Word
           move.w  d7,(a0)+
           move.w  #COP1LC+2,(a0)+ ;Adresse für Lo-Word
           swap d7
           move.w  d7,(a0)+        ;Lo-Word eintragen
           move.l #$FFFFFFFE,(a0)
           move.w #$0100,DMACON(a5);DMA sperren
           move.l MyCopList,COP1LC(a5)   ;eigene Copperlist eintragen
           clr.w COPJMP1(a5)       ;Programmzähler des Coppers laden
           move.w #$8280,DMACON(a5);DMA einschalten
           rts                     ;fertig !

           ;Speicher für CopList-Adressen

MyCopList: dc.l 0
OldCopList: dc.l 0

           ;Library-Name

graphics:  dc.b 'graphics.library',0











