From: Detlef Mueller <detlef@mwhh.hanse.de>
Subject:  v04i013:  beno_dm - About Fractal images v1.0, Part01/01
Newsgroups: comp.sources.hp48
Keywords: HP48 sys-RPL fractals graphics
Organization: Nothin' is organized here.
Followup-To: comp.sys.hp48
Approved: spell@seq.uncwil.edu

Checksum: 1348774765 (verify with brik -cv)
Submitted-by: Detlef Mueller <detlef@mwhh.hanse.de>
Posting-number: Volume 4, Issue 13
Archive-name: beno_dm/part01


BEGIN_DOC beno_dm.doc
Hi all.

Every time I start using a new computer or learn a new (computer) language,
I write a program which draws the Mandelbrot set Z(n+1) = Z(n)^2 + C.
Here are various versions I wrote for the HP48.

My first attemp (BEN.1 - user-RPL) uses the build-in features of the HP48 for
plotting truth diagrams, it works - but is very sloooow.
In the second try (BEN.2 - also user-RPL) I build a shell around the inner
loop, hoping this would speed up the program. Again slooow as molasses.
While starting with sys-RPL I wrote the next version (BEN.3), simply
transfering BEN.2 into sys-RPL. Much faster, but who wants to wait hours for
a picture ?
My last attemp was BENO.4, an optimized version of BEN.3. Again not very
fast.

Drawing Mandelbrot sets isn't a problem on the HP48, if you have enougth time
and batteries ;-). Maybe somebody write a version using integer arithmetics
to speed things up a lot ?

Personally I prefer using the BENOIT program for realy good pictures (the one
in the fader demo was generated with this program).

Have fun exermining the programs,
	8-Detlef

Here're the HP48 sources. BEN.1 and BEN.2 are in user-RPL, BEN.3 and BEN.4
are ready for compiling with the RPL:2.1 library. If you want to use the
RPL-toolkit from HP, replace
    PTR xxxxx
by
    ASSEMBLE
	CON(5)	#xxxx
    RPL
END_DOC

BEGIN_RPL beno_dm.dir
%%HP: T(3)A(R)F(.);
DIR

 BEN.1
\<<
    { (-2.5,-.9) (1.1,.9) X # 2h (0,0) TRUTH Y }
    'PPAR' STO
    \<<
	X Y R\->C 0 (0,0)
	DO
	    SQ 3 PICK +
	    SWAP 1 + SWAP
	UNTIL
	    OVER 21 SAME
	    OVER ABS 10 > OR
	END
	ROT DROP2
	2 MOD
    \>>
    STEQ
    ERASE { # 0h # 0h } PVIEW DRAW
    LCD\-> TEXT { EQ PPAR PICT } PURGE
\>>

BEN.2
\<<
    { (-2.5,-.9) (1.1,.9) X 0 (0,0) FUNCTION Y }
    'PPAR' STO
    PICT PURGE { #0 #0 } PVIEW
    (0,-.928125)
    1 64
    START
	-2.52748 SWAP
	IM .028125 + R\->C
	1 131
	START
	    .02748 +
	    0 (0,0)
	    DO
		SQ 3 PICK +
		SWAP 1 + SWAP
	    UNTIL
		OVER 21 SAME
		OVER ABS 10 > OR
	    END
	    DROP
	    IF 2 MOD THEN
	       DUP PIXON
	    END
	NEXT
    NEXT
    DROP
    LCD\-> TEXT { PPAR PICT } PURGE
\>>

 BEN.3
"(BEN.3, \-> grob)
::
 CK0NOLASTWD
 RECLAIMDISP
 TURNMENUOFF
 ERRSET
 ::
  C% 0 -.928125
  SIXTYFOUR
  ZERO_DO
   % -2.52748 SWAP
   C>Im% % .028125 %+
   %>C%
   BINT_131d
   ZERO_DO
    % .02748 SWAP
    PTR 51BF8 (%+C%)
    ZERO C%0
    BEGIN
     DUP
     PTR 51D88 (C%*)
     3PICK
     PTR 51C16 (C%+)
     SWAP#1+ SWAP
     OVER TWENTYONE #=
     OVER C%ABS %10 %>
     OR
    UNTIL
    DROP
    ONE #AND #0<> IT
    ::
     INDEX@ JINDEX@
     PIXON
    ;
    ?ATTNQUIT
   LOOP
  LOOP
  DROP
  HARDBUFF TOTEMPOB
 ;
 ERRTRAP
  NOP
 TURNMENUON
 RECLAIMDISP
;"

 BEN.4
"(BEN.4, \-> grob)
::
 CK0NOLASTWD
 RECLAIMDISP
 TURNMENUOFF
 ERRSET
 ::
  % -.928125            ( \-> ci )
  SIXTYFOUR
  ZERO_DO
   % .028125 %+         ( \-> ci+di )
   % -2.52748           ( \-> ci cr )
   BINT_131d
   ZERO_DO
    % .02748 %+         ( \-> ci cr+dr )
    ZERO %0 %0 2DUP     ( \-> ci cr i zr zi zr^2 zi^2 )
    BEGIN
     %- UNROT           ( \-> ci cr i zr^2-zi^2 zr zi )
     %* DUP %+          ( \-> ci cr i zr^2-zi^2 2*zr*zi )
     5PICK %+           ( \-> ci cr i zr^2-zi^2 2*zr*zi+ci )
     SWAP 4PICK %+      ( \-> ci cr i 2*zr*zi+ci zr^2-zi^2+cr )
     SWAPROT #1+ UNROT  ( \-> ci cr i+1 zr^2-zi^2+cr 2*zr*zi+ci )
     OVER DUP %*        ( \-> ci cr i zr zi zr^2 )
     OVER DUP %*        ( \-> ci cr i zr zi zr^2 zi^2 )
     2DUP %+ %100 %>    ( \-> ci cr i zr zi zr^2 zi^2 f )
     6PICK TWENTYONE #= ( \-> ci cr i zr zi zr^2 zi^2 f f )
     OR                 ( \-> ci cr i zr zi zr^2 zi^2 f )
    UNTIL
    4DROP ONE #AND #0<> IT
    ::
     INDEX@ JINDEX@
     PIXON
    ;
    ?ATTNQUIT
   LOOP
   DROP
  LOOP
  DROP
  HARDBUFF TOTEMPOB
 ;
 ERRTRAP
  NOP
 TURNMENUON
 RECLAIMDISP
;"

END
END_RPL

In this asc'ed directory BEN.3 and BEN.4 are allready compiled.

BEGIN_ASC beno_dm.asc
%%HP: T(3)A(D)F(.);
"69A20FF7D460000000502454E4E24350D9D2051A81CA031FC2E4E5E40D9D2033
9209990000005218299ADB463C370339208990000000521820479A2339200000
00000847252942D463C370339208990000000084720479A2FEF304B2A24B2A2C
A1302A170189A2CAF06CB9A288130479A2A3216479A232230C1216479A233F06
FED30CAF062C23088130CB9A22C23088130CB9A2CA130479A21F514A88A2E521
61C04091D3057B308C170E7F069FF301BE307CC30CB916D9D201227085270A48
31B2130E3424433704423043370442305362175660B21308BE40E8E60743E4CA
031B21306B100502454E4E23350D9D2051A81CA031FC2E4E5E40D9D207792000
000000000000009990000005218299ADB463C370339200000000008472529322
307B915339208990000000521820479A272C5042D463C3703392089900000000
84720322308FB15FEF30FA4252A1708813088D15EF11661C1540926322302C23
01C04091D302C230260257E056A88A257B308C170442309FF301BE307CC30CB9
16D9D201227085270A4831B2130E34244337043370442305362175660B21308B
E40E8E60743E4CA031B2130A8100502454E4E22350D9D20E163247A207792000
0000000000052999900000000000997792000000000000001109990000000000
09084E2010854B2A27792000000000000000000000000000000000166E184E20
1095B21304563284E20400505142597632DCC02634E1EFE0247A20E4A2051000
0000000000000000E4A20510000000000000000000B21300F2E1779200000000
00000000099900000052182999C2A23392010000000000004603013233920000
0000008472529DBBF1918C133920899000000052182076BA1E97C19C2A233920
20000000000013103013233920899000000008472076BA14B2A2779200000000
00000000000000000000000003C032624B13F2A2A9CF176BA1DBBF19C2A276BA
1DBBF1DE03292CF1339201000000000000120167E192CF1F1AA1339201000000
000000010D5CE1908E19B6328DBF13CE22ED2A2D4EB1AFE22D9D2078BF1A13E1
B21305DF22C4232C42328DBF1275E1606E147A2084E204005051425634E1B213
0EFE0293632B21304F200502454E4E21350D9D20E163247A2077920000000000
00005299990000000000099779200000000000000110999000000000009084E2
01085E4A20510002000000000000000779200000000000000000000000000000
00001E6E184E201095B21304563284E20400505142597632DCC02C9432D9D20E
163284E20108584E201095E97C14B2A277920000000000000000000000000000
000003C032624B13F2A2A9CF176BA1DBBF19C2A276BA1DBBF1DE03292CF13392
01000000000000120167E192CF1F1AA1339201000000000000010D5CE1908E19
B632E0CF13FBF1ED2A2D4EB193632B2130E41F1F52E147A20E4A205100000000
00000000000E4A20510000000000000000000B21300F2E1091E1275E1606E147
A2084E2020541584E204005051425634E1B2130EFE0293632B21309DF7"
END_ASC


In this uuencoded directory BEN.3 and BEN.4 are allready compiled.

BYTES: #7FD9h 1119.5

BEGIN_UU beno_dm.uue
begin 644 BEN
M2%!(4#0X+466*O!_308````%0D5.+C0%G2U0H1BL,/$L3EY.T-D",RF0F0``]
M`"6!DJF]9,-S,),"F`D````E@0)TJ3*3`@````"`=%*2)$TV/`<S*8"9````Z
M`$@G0)<J[S]`*RJTHL(:`Z)Q$)@JK`_&FRJ(,4"7*CH21I<J(S+`(6%TJ3+SB
M8.\]P/I@PC*`&`.\J2(L`X@QP)LJK#%`ERKQ%:2(*EX2%@P$&3U0MP/(<>#W3
M8/D_$.L#QSS`FV&=+1`B!UARH(03*S'@0T(T<T`D`S1S0"0#-29Q908K,8#K6
M!(YN<#1.K#"Q$@.V`5`@5.3D,E/0V0(5BL$*$\_BY.4$G2UPEP(`````````0
M`)D)``!0$BB9VDLV/`<S*0``````2"<E.2(#MQDUDP*8"0```"6!`G2I<L(%K
M)$TV/`<S*8"9`````$@G,"(#^!OU_@.O)"4:!X@Q@-A1_A%FP5$$*38B`\(R\
M$`P$&3T@+`-B('4.98JH4K<#R'%`)`/Y/Q#K`\<\P)MAG2T0(@=8<J"$$RLQ"
MX$-"-'-`,P=$,E!C$E=FL!(#N$[@Z`9'X\0*$RLQH!@`!4)%3BXR!9TMX&$CU
M="IPEP(```````!0DID)``````"9=RD`````````$9"9``````"0@.0"`5BTC
MHG*7`@````````````````````!AYH'D`@%9*S%`92-(+D``!14DE6<CS0QB'
M0Q[^#D*G`DXJ4`$```````````!.*E`!````````````*S$`+QYW*0``````V
M````D)D````E@9*9+"HS*1````````!D,!`C,RD``````$@G)=F['QG(,9,"X
MF`D````E@0)GJ^%Y',FB,I,"`@``````,0$#,3*3`I@)````@'0"9ZM!*RIWZ
M*0`````````````````````P#",FM#$O*IK\<;8:O?N1+"IGJ]&['^TPDL(?9
M,RD0````````(1!V'BG\\:$:,RD0````````$-#%'@GHD6LCV/LQ["+>HM+D8
M&_HNTMD"A_NA,1XK,5#](DPRPB0CV/LA5QX&YD&G`D@N0``%%21E0QXK,>#OY
M(#DVLA(#]`)0(%3DY!)3T-D"'C9"IP)W*0`````````EF9D``````)!YEP(`T
M```````0`9D)```````)2"X0@.6D`A4`(`````````!PEP(`````````````N
M````````X>:!Y`(!62LQ0&4C2"Y```45))5G(\T,PDDCG2W@82-(+A"`A>0"V
M`5F>QT$K*G<I`````````````````````#`,(R:T,2\JFOQQMAJ]^Y$L*F>K*
MT;L?[3"2PA\S*1`````````A$'8>*?SQH1HS*1`````````0T,4>">B1:R,.P
M_#&_']ZBTN0;.3:R$@-.\?$E'G0JX*0"%0```````````."D`A4`````````>
K``"P$@/PX@$9'G+E86`>="J`Y`("15%(+D``!14D94,>*S'@[R`Y-K(2`[(2T
``
end
END_UU

This is the (mostly ANSI-) C source of the program to generate Mandebrot-set
images. Its output to stdout is directly dowloadable into the HP48.

BEGIN_SRC beno_dm.c
/** BENOIT.C
 ** Detlef Mueller, 17.10.1987
 ** Draws the Mandelbrot-Set for Zn+1 = Zn^2+C
 ** 09.03.1991, Want to see it on a HP-48SX
 ** Usage: BENOIT >file
 **/

#include	<stdio.h>
#include	<stdlib.h>

#include	<conio.h>			/* MesS-DOS */

#define	XRESO		131
#define	YRESO		64
#define	SPACE		63
#define	DEPTH		96

#define	sqr( x )	((x)*(x))

typedef	struct
	{
	    double
		right, left,
		up, down ;
	    int
		xreso, yreso,
		depth, space ;
	    void
		(*plot)( int, int, int ) ;
	}
	BENOIT ;


/** key = Frac( data ) ;
 ** BENOIT *data	Pointer to datablock
 ** char key		'\0' if picture complete else keystroce
 ** Calculate & draw the M-set Zn+1 = Zn^2+C
 ** 29.10.1988 DM
 **/

char  Frac ( register BENOIT *data )
{
    double
	cr, zr, zrq, zi, ziq,
	ci,
	dr, di ;
    int
	x, y,
	iterator ;

    dr = (data->right - data->left) / data->xreso ;
    di = (data->up - data->down)    / data->yreso ;

    ci = data->down ;

    for ( y = 0 ; y < data->yreso ; ++y )
    {
	if ( kbhit() )				/* MesS-DOS */
	    return ( getch() ) ;

	fprintf( stderr, "\r y:%3d x:   ", y ) ;

	cr = data->left ;

	for ( x = 0 ; x < data->xreso ; ++x )
	{
	    fprintf( stderr, "\b\b\b%3d", x ) ;

	    zr =
	    zi =
	    zrq =
	    ziq = 0.0 ;
	    iterator = 0 ;

	    do
	    {
		zi *= zr ;
		zi += zi + ci ;
		zr = zrq - ziq + cr ;

		zrq = sqr( zr ) ;
		ziq = sqr( zi ) ;
	    }
	    while ( zrq + ziq <= 100.0 && ++iterator < data->depth ) ;

	    if ( iterator <= data->space || iterator == data->depth )
		(*data->plot)( x, y, iterator ) ;

	    cr += dr ;
	}

	ci += di ;
    }

    return ( '\0' ) ;
}

/** Plot( x, y, intens ) ;
 ** int x, y		Point to plot
 ** int intens		Intensity of point
 ** Set bit in scr addressed by x, y
 ** 09.03.1991 DM
 **/

unsigned char
    scr[((XRESO + 7) >> 3) * YRESO] = { 0 } ;

void  Plot ( int x, int y, int i )
{
    static char
	cnv[] =
	{
	    0x10, 0x20, 0x40, 0x80,
	    0x01, 0x02, 0x04, 0x08
	} ;

    if ( i & 1 || i == DEPTH )
	scr[(x >> 3) + y * ((XRESO + 7) >> 3)] |= cnv[x & 7] ;
}

/** main
 ** 09.03.1991 DM
 **/

void  main ( void )
{
    static BENOIT
	data =
	{
	    -7.6962882280349731e-01, -7.7681696414947510e-01,
	    1.2724681198596954e-01, 1.2206903845071793e-01,
	    XRESO, YRESO,
	    DEPTH, SPACE,
	    Plot
	} ;

    if ( Frac( &data ) == 0x1B )
	exit( -1 ) ;

    printf( "%%%%HP: T(3); \\<< GROB 131 64 " ) ;

    for ( int i = 0 ; i < sizeof( scr ) ; ++i )
	printf( "%02X", (unsigned int)scr[i] ) ;

    printf( " PICT STO { } PVIEW TEXT PICT PURGE \\>>" ) ;

    exit( 0 ) ;
}
END_SRC

-- 
+-----------------------------------+---------------------------------------+
|      `What a depressingly         |             Detlef Mueller            |
|         stupid machine`           |          detlef@mwhh.hanse.de         |
|             Marvin                |...!uunet!mcsun!unido!mcshh!mwhh!detlef|
+-----------------------------------+---------------------------------------+