MODULE ITERMAND2
public::mandel
CONTAINS

FUNCTION  mandel(zre,zim,maxiter) RESULT (MANDEL2)
INTEGER::MANDEL2
REAL, INTENT(IN)                         :: zre
REAL, INTENT(IN)                         :: zim
INTEGER, INTENT(IN)                      :: maxiter



REAL :: x,y,tmp,betrag
INTEGER :: iter

x=0.0
y=0.0
iter=0
betrag=0.0

MANITER: DO

tmp = x*x-y*y+zre
y = 2*x*y+zim
x = tmp
betrag = x*x + y*y
iter = iter + 1

IF(betrag > 4.0) EXIT MANITER
IF(iter > maxiter)  EXIT MANITER
END DO MANITER
20  CONTINUE
mandel2=iter
END FUNCTION  mandel

END MODULE ITERMAND2

PROGRAM JMANDEL2!       Example mandel2.f

! Code converted using TO_F90 by Alan Miller
! Date: 2001-03-15  Time: 11:37:26

USE JAPI
USE ITERMAND2

INTEGER :: breite,hoehe
INTEGER :: x,y,it
REAL :: zre,zim
REAL :: xstart,ystart,xend,yend
REAL :: lxs,lxe,lys,lye
INTEGER,dimension(1:4096) :: r,g,b
LOGICAL :: do_work

INTEGER :: frame,menubar
INTEGER :: FILE,calc
INTEGER :: PRINT,quit,start,STOP,reset
INTEGER :: canvas,obj,pressed,dragged
integer :: mxs,mys,mxe,mye

breite = 320
hoehe  = 240

lxs = -1.8
lxe =  0.8
lys = -1.0
lye =  1.0

IF( .NOT. j_start()) THEN
  PRINT*, "can't connect to server"
  GO TO 20
END IF

frame   = j_frame("Mandelbrot")
CALL j_setborderlayout(frame)

menubar = j_menubar(frame)
FILE    = j_menu(menubar,"File")
calc    = j_menu(menubar,"Calc")
PRINT   = j_menuitem(FILE,"Print")
quit    = j_menuitem(FILE,"Quit")
start   = j_menuitem(calc,"Start")
STOP    = j_menuitem(calc,"Stop")
reset   = j_menuitem(calc,"Reset")

canvas  = j_canvas(frame,breite,hoehe)

pressed  = j_mouselistener(canvas,j_pressed)
dragged  = j_mouselistener(canvas,j_dragged)

CALL j_show(frame)
CALL j_pack(frame)

x=-1
y=-1
do_work = .false.
obj=0
NEXTACTION: DO

IF(do_work) THEN
  obj=j_getaction()
ELSE
  obj=j_nextaction()
END IF

IF((obj == quit) .OR. (obj == frame)) EXIT NEXTACTION

IF(obj == reset) THEN
  lxs = -1.8
  lxe =  0.8
  lys = -1.0
  lye =  1.0
  xstart = -1.8
  xend   =  0.8
  ystart = -1.0
  yend   =  1.0
  x=-1
  y=-1
  CALL j_setnamedcolorbg(canvas,j_white)
END IF

IF(obj == start) THEN
  xstart = lxs
  xend   = lxe
  ystart = lys
  yend   = lye
  x=-1
  y=-1
  do_work = .true.
  CALL j_setnamedcolorbg(canvas,j_white)
END IF

IF(obj == STOP) do_work = .false.

IF(obj == PRINT) CALL j_print(canvas)

IF(obj == canvas) THEN
  breite = j_getwidth(canvas)
  hoehe  = j_getheight(canvas)
  x=-1
  y=-1
  CALL j_setnamedcolorbg(canvas,j_white)
END IF

IF(do_work) THEN
  y=y+1
  IF(y == hoehe) THEN
    y = 0
    do_work = .false.
  ELSE
    DO x=0,breite
      zre = xstart + x*(xend-xstart)/breite
      zim = ystart + y*(yend-ystart)/hoehe
      it = mandel(zre,zim,512)
      r(x)=it*11
      g(x)=it*13
      b(x)=it*17
    END DO
    CALL j_drawimagesource(canvas,0,y,breite,1,r,g,b)
  END IF
END IF

IF(obj == pressed) THEN
  CALL j_setxor(canvas, .true. )
  CALL j_setnamedcolor(canvas,j_black)
  CALL j_drawrect(canvas,mxs,mys,mxe-mxs,mye-mys)
  CALL j_getmousepos(pressed,mxe,mye)
  mxs=mxe
  mys=mye
END IF

IF(obj == dragged) THEN
  CALL j_setxor(canvas, .true. )
  CALL j_drawrect(canvas,mxs,mys,mxe-mxs,mye-mys)
  CALL j_getmousepos(dragged,mxe,mye)
  CALL j_drawrect(canvas,mxs,mys,mxe-mxs,mye-mys)
  CALL j_setxor(canvas, .false.)
  lxs = xstart+(xend-xstart)*mxs/breite
  lxe = xstart+(xend-xstart)*mxe/breite
  lys = ystart+(yend-ystart)*mys/hoehe
  lye = ystart+(yend-ystart)*mye/hoehe
END IF

END DO NEXTACTION

20      CONTINUE
CALL j_quit()
END PROGRAM JMANDEL2

