;           InterferenzMuster
               ;
               ;      (w) by Daniel Gembris in 1989
               ;
               ;Aufruf: InterferenzMuster <Delay> <Divisor1> <Divisor2>
               ;
OpenLib        =       -552
CloseLib       =       -414
Delay          =       -198
Output         =       -60
Write          =       -48
CloseScreen    =       -66
OpenScreen     =       -198
SetRGB4        =       -288
ScreenToFront  =       -252
ViewPort       =       $2C

               ;**** Main-Programm ***
main:          jsr     para(pc)                    ;Übergabe-Parameter auswerten
               lea     dosname(pc),a1
               moveq   #0,d0
               move.l  $4.s,a6
               jsr     OpenLib(a6)
               move.l  d0,dosbase
               move.l  wb(pc),d0
               cmp.w   #0,d0
               beq.s   mw0                     ;keine Meldung ausgeben
               move.l  dosbase(pc),a6
               jsr     Output(a6)
               move.l  d0,d1
               move.l  #message,d2
               moveq   #mend-message,d3
               jsr     Write(a6)
mw0:           jsr     scropen(pc)
               move.l  screenhd(pc),screenhd1      ;2 Screens öffnen
               jsr     scropen(pc)
               move.l  screenhd(pc),screenhd2
mloop:         move.l  intbase(pc),a6
               move.l  screenhd1(pc),a0
               jsr     ScreenToFront(a6)
               move.l  screenhd2(pc),screenhd
               jsr     calc(pc)
               move.w  divisor2(pc),d0
               cmp.w   divisor(pc),d0
               beq.s   last1                   ;letztes Bild anzeigen
               addq.w  #1,divisor
               jsr     wait(pc)
               move.l  intbase(pc),a6
               move.l  screenhd2(pc),a0
               jsr     ScreenToFront(a6)
               move.l  screenhd1(pc),screenhd
               jsr     calc(pc)
               move.w  divisor2(pc),d0
               cmp.w   divisor(pc),d0
               beq.s   last2                   ;letztes Bild anzeigen
               addq.w  #1,divisor
               jsr     wait(pc)
               jmp     mloop(pc)
last1:         move.l  screenhd2(pc),a0
               jmp     mw(pc)
last2:         move.l  screenhd1(pc),a0
mw:            move.l  intbase(pc),a6
               jsr     ScreenToFront(a6)
               jsr     wait(pc)
               jsr     cleanup(pc)
               rts

para:          move.l  d0,wb                   ;wenn 0, dann wurde Prg von WB gestartet
               move.l  a0,a1                   ;Übergabe-Parameter zählen
               clr.l   d1
               cmp.l   #1,d0
               bls.s   ex
               addq.l  #1,d1
loopa:         cmp.l   #0,d0
               beq.s   ex
               subq.l  #1,d0
               cmp.b   #$20,(a1)+
               bne.s   loopa
               addq.l  #1,d1
               jmp     loopa(pc)
ex:
               move.l  d1,d7                   ;Übergabe-Parameter auswerten
               cmp.w   #0,d1
               beq.s   ex0                     ;keine Parameter!
loopy:         clr.l   d1
loopx:         clr.l   d0                      ;Ziffer umwandeln
               move.b  (a0)+,d0
               sub.w   #'0',d0
               cmp.w   #10,d0
               bhs.s   we1
               mulu    #10,d1
               add.w   d0,d1
               jmp     loopx(pc)
we1:           cmp.w   #2,aga
               beq.s   we3
               cmp.w   #1,aga
               bne.s   we2
               move.w  d1,time
               cmp.w   #2,d7
               blt.s   ex0                     ;wert<2
               move.w  #0,aga
               jmp     loopy(pc)
we2:           move.w  d1,divisor
               cmp.w   #3,d7
               bne.s   ex0
               move.w  #2,aga
               jmp     loopy(pc)
we3:           move.w  d1,divisor2
ex0:           cmp.w   #2,d7
               bne.s   exit
               move.w  divisor(pc),divisor2
exit:          rts

scropen:
               move.l  $4.s,a6                   ;Screen öffnen
               lea     intname(pc),a1
               moveq   #0,d0
               jsr     OpenLib(a6)
               move.l  d0,intbase
               move.l  d0,a6
               lea     screen_defs(pc),a0
               jsr     OpenScreen(a6)
               move.l  d0,screenhd
               move.l  d0,a0                   ;Farben setzen
               lea     ViewPort(a0),a0
               move.l  a0,vport
               move.l  $4.s,a6
               lea     gfxname(pc),a1
               moveq   #0,d0
               jsr     OpenLib(a6)
               move.l  d0,gfxbase
               move.l  d0,a6
               move.l  #$F,counter
loop0:         move.l  vport(pc),a0
               move.l  counter(pc),d0
               move.l  d0,d1
               move.l  d0,d2
               move.l  d0,d3
               jsr     SetRGB4(a6)
               subq.l  #1,counter
               bpl.s   loop0
               move.l  $4.s,a6
               move.l  gfxbase(pc),a1
               jsr     CloseLib(a6)
               rts

calc:          move.w  #0,i                    ;y-Koordinate
               move.w  #0,j                    ;x-Koordinate
               move.l  screenhd(pc),a5             ;Zeiger auf Bitplanes
               move.l  $C0(a5),a0
               move.l  $C4(a5),a1
               move.l  $C8(a5),a2
               move.l  $CC(a5),a3
               movem.l clear,d0-d5
               move.l  #$80000000,d4           ;Bit-Maske
loop:          move.w  j(pc),d7                    ; *** Berechnungsroutine ***
               mulu    j,d7
               move.w  i(pc),d6
               mulu    i,d6
               add.l   d7,d6
               divu    divisor,d6
               lsr.l   #1,d6                   ;Punkt-"Pakete" zusammenstellen
               bhs.s   w1
               or.l    d4,d0
w1:            lsr.l   #1,d6
               bhs.s   w2
               or.l    d4,d1
w2:            lsr.l   #1,d6
               bhs.s   w3
               or.l    d4,d2
w3:            lsr.l   #1,d6
               bhs.s   w4
               or.l    d4,d3
w4:            lsr.l   #1,d4
               bhs.s   w5
               move.l  d0,0(a0,d5)              ;Pakete ins RAM schreiben
               move.l  d1,0(a1,d5)
               move.l  d2,0(a2,d5)
               move.l  d3,0(a3,d5)
               movem.l clear,d0-d4
               move.l  #$80000000,d4
               addq.l  #4,d5
w5:            addq.w  #1,j
               cmp.w   #640,j
               bne.s   loop
               move.w  #0,j
               addq.w  #1,i
               cmp.w   #400,i
               bne     loop
               rts

wait:          move.l  dosbase(pc),a6              ;x 1/50-Sekunden warten
               clr.l   d1
               move.w  time(pc),d1
               jsr     Delay(a6)
               rts

cleanup:       ;Aufräumaktion
               move.l  dosbase(pc),a1
               move.l  $4.s,a6
               jsr     CloseLib(a6)
               move.l  intbase(pc),a6
               move.l  screenhd1(pc),a0
               jsr     CloseScreen(a6)
               move.l  screenhd2(pc),a0
               jsr     CloseScreen(a6)
               move.l  $4.s,a6
               move.l  intbase(pc),a1
               jsr     CloseLib(a6)
               rts

i:             dc.w    0
j:             dc.w    0
aga:           dc.w    1
wb:            dc.l    0
divisor:       dc.w    17                      ;Divisor : 17-20
divisor2:      dc.w    20
time:          dc.w    0                       ;nach Berechnung keine Pause (Angabe in 1/50sek)
 clear:        blk.l   6,0
intname:       dc.b    'intuition.library',0
               even
gfxname:       dc.b    'graphics.library',0
               even
dosname:       dc.b    'dos.library',0
               even
intbase:       dc.l    0
gfxbase:       dc.l    0
dosbase:       dc.l    0
screenhd:      dc.l    0
screenhd1:     dc.l    0
screenhd2:     dc.l    0
vport:         dc.l    0
counter:       dc.l    $F

screen_defs:
               dc.w    0
               dc.w    0
               dc.w    640                     ;Breite
               dc.w    400                     ;Höhe
               dc.w    4                       ;Anzahl Biplanes
               dc.b    0
               dc.b    1
               dc.w    $C006                   ;View-Modus
               dc.w    15
               dc.l    0
               dc.l    title
               dc.l    0
               dc.l    0

title:         dc.b    0
               even

message:       dc.b    27,'[3m',27,'[33m',27,'[1m','InterferenzMuster ',27,'[0m'
               dc.b    27,'[31m',27,'[1m','(w) by Daniel Gembris in 1989',13,10
               dc.b    27,'[0m'
mend:
               even