;           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                    ;Übergabe-Parameter auswerten
       lea     dosname,a1
       move.l  #0,d0
       move.l  $4,a6
       jsr     OpenLib(a6)
       move.l  d0,dosbase
       move.l  WB,d0
       cmp     #0,d0
       beq     mw0                     ;keine Meldung ausgeben
       move.l  dosbase,a6
       jsr     Output(a6)
       move.l  d0,d1
       move.l  #message,d2
       move.l  #mend-message,d3
       jsr     Write(a6)
mw0:   jsr     scropen
       move.l  screenhd,screenhd1      ;2 Screens öffnen
       jsr     scropen
       move.l  screenhd,screenhd2
mloop: move.l  intbase,a6
       move.l  screenhd1,a0
       jsr     ScreenToFront(a6)
       move.l  screenhd2,screenhd
       jsr     calc
       move.w  divisor2,d0
       cmp     divisor,d0
       beq     last1                   ;letztes Bild anzeigen
       addq.w  #1,divisor
       jsr     wait
       move.l  intbase,a6
       move.l  screenhd2,a0
       jsr     ScreenToFront(a6)
       move.l  screenhd1,screenhd
       jsr     calc
       move.w  divisor2,d0
       cmp     divisor,d0
       beq     last2                   ;letztes Bild anzeigen
       addq.w  #1,divisor
       jsr     wait
       jmp     mloop
last1: move.l  screenhd2,a0
       jmp     mw
last2: move.l  screenhd1,a0
mw:    move.l  intbase,a6
       jsr     ScreenToFront(a6)
       jsr     wait
       jsr     cleanup
       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     ex
       addq.l  #1,d1
loopa: cmp.l   #0,d0
       beq     ex
       subq.l  #1,d0
       cmp.b   #$20,(a1)+
       bne     loopa
       addq.l  #1,d1
       jmp     loopa
ex:    
       move.l  d1,d7                   ;Übergabe-Parameter auswerten
       cmp     #0,d1
       beq     ex0                     ;keine Parameter!
loopy: clr.l   d1
loopx: clr.l   d0                      ;Ziffer umwandeln
       move.b  (a0)+,d0
       sub     #"0",d0
       cmp     #10,d0
       bcc     we1
       mulu    #10,d1
       add     d0,d1
       jmp     loopx
we1:   cmp     #2,aga
       beq     we3
       cmp     #1,aga
       bne     we2
       move.w  d1,time
       cmp     #2,d7
       blt     ex0                     ;wert<2
       move.w  #0,aga
       jmp     loopy
we2:   move.w  d1,divisor
       cmp     #3,d7
       bne     ex0
       move    #2,aga
       jmp     loopy
we3:   move.w  d1,divisor2
ex0:   cmp     #2,d7
       bne     exit
       move.w  divisor,divisor2
exit:  rts

scropen:
       move.l  $4,a6                   ;Screen öffnen
       lea     intname,a1
       move.l  #0,d0
       jsr     OpenLib(a6)
       move.l  d0,intbase
       move.l  d0,a6
       lea     screen_defs,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,a6
       lea     gfxname,a1
       move.l  #0,d0
       jsr     OpenLib(a6)
       move.l  d0,gfxbase
       move.l  d0,a6
       move.l  #$f,counter
loop0: move.l  vport,a0
       move.l  counter,d0
       move.l  d0,d1
       move.l  d0,d2
       move.l  d0,d3
       jsr     SetRGB4(a6)
       subq.l  #1,counter
       bpl     loop0
       move.l  $4,a6
       move.l  gfxbase,a1
       jsr     CloseLib(a6)
       rts

calc:  move.w  #0,i                    ;y-Koordinate
       move.w  #0,j                    ;x-Koordinate
       move.l  screenhd,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,d7                    ; *** Berechnungsroutine ***
       mulu    j,d7
       move.w  i,d6
       mulu    i,d6
       add.l   d7,d6
       divu    divisor,d6
       lsr.l   #1,d6                   ;Punkt-"Pakete" zusammenstellen
       bcc     w1
       or.l    d4,d0
w1:    lsr.l   #1,d6
       bcc     w2
       or.l    d4,d1
w2:    lsr.l   #1,d6
       bcc     w3
       or.l    d4,d2
w3:    lsr.l   #1,d6
       bcc     w4
       or.l    d4,d3
w4:    lsr.l   #1,d4
       bcc     w5
       move.l  d0,(a0,d5)              ;Pakete ins RAM schreiben
       move.l  d1,(a1,d5)
       move.l  d2,(a2,d5)
       move.l  d3,(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     loop
       move.w  #0,j
       add.w   #1,i
       cmp.w   #400,i
       bne     loop
       rts

wait:  move.l  dosbase,a6              ;x 1/50-Sekunden warten
       clr.l   d1
       move.w  time,d1
       jsr     Delay(a6)
       rts
                                       
cleanup:                               ;Aufräumaktion
       move.l  dosbase,a1
       move.l  $4,a6
       jsr     CloseLib(a6)
       move.l  intbase,a6
       move.l  screenhd1,a0
       jsr     CloseScreen(a6)
       move.l  screenhd2,a0
       jsr     CloseScreen(a6)
       move.l  $4,a6
       move.l  intbase,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: ds.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
       end