home *** CD-ROM | disk | FTP | other *** search
- ***********************************************************
- * *
- * FRACTALS for the Atari TT med resolution *
- * *
- * (C) 9/1990 by Uwe Seimet, MAXON Computer *
- * *
- * taken from 'ST Computer' Vol. 11/90, Heim Verlag *
- * *
- * - procedure KEYPRESS added by Markus Wenzel - *
- * *
- ***********************************************************
-
-
- GEMDOS = 1
- LOGBASE = 3
- XBIOS = 14
-
- iter_depth = 50
-
- text
-
- dc.w $a00a
-
- move #LOGBASE,-(sp)
- trap #XBIOS
- addq.l #2,sp
- move.l d0,a0
-
- fmove.x #-2,fp6
- fmove.x #-1.25,fp7
- fmove.x #1,fp4
- fmove.x #1.25,fp5
- fsub.x fp6,fp4
- fdiv.x #640,fp4
- fsub.x fp7,fp5
- fdiv.x #480,fp5
-
- fsub.x fp5,fp7
- fmove.x fp5,-(sp)
- moveq #4,d2
- clr d7
- loopi:
- fadd.x (sp),fp7
- fmove.x #-2,fp6
- fsub.x fp4,fp6
- clr d6
- loopk:
- moveq #0,d0
- moveq #0,d1
- clr d5
- loopj:
- fadd.x fp4,fp6
- fmovecr.x #$0f,fp0
- fmovecr.x #$0f,fp1
- moveq #0,d4
- moveq #0,d3
- looph:
- fmove.x fp0,fp2
- fmul.x fp0,fp2
- fmove.x fp1,fp3
- fmul.x fp1,fp3
- fmove.x fp3,fp5
- fadd.x fp2,fp5
- fcmp d2,fp5
- fblt else
- move.l d3,d4
- bra cont
- else:
- fmul.x fp0,fp1
- fadd.x fp1,fp1
- fadd.x fp7,fp1
- fmove.x fp2,fp0
- fsub.x fp3,fp0
- fadd.x fp6,fp0
- addq #1,d3
- cmp #iter_depth,d3
- bne looph
- cont:
- lsr #1,d4
- roxl #1,d0
- swap d0
- lsr #1,d4
- roxl #1,d0
- swap d0
- lsr #1,d4
- roxl #1,d1
- swap d1
- lsr #1,d4
- roxl #1,d1
- swap d1
- addq #1,d5
- cmp #16,d5
- bne loopj
- move.l d0,(a0)+
- move.l d1,(a0)+
- add #16,d6
- cmp #640,d6
- bne loopk
- addq #1,d7
- cmp #480,d7
- bne loopi
-
- keypress:
- move.w #$0B,-(sp)
- trap #GEMDOS
- addq.l #2,sp
- tst.b d0
- beq keypress
-
- fmove (sp)+,fp5
- dc.w $a009
- clr -(sp)
- trap #GEMDOS
-