REBOL []

;do %rebcode.r

img: make image! 601x601

gradient: load 64#{
iVBORw0KGgoAAAANSUhEUgAACAAAAAABCAIAAADFdtmlAAAAE3RFWHRTb2Z0d2Fy
ZQBSRUJPTC9WaWV3j9kWeAAADLBJREFUeJyt12ewFFW/hfG19+45OecIh0NQUTBi
DoiYc8AEKghGFBQFE6goggqIoIAiImBGRTCBIiZUQEBQUcnxkHMOHda793/O8FJX
r+WtulO/empNT1dPV3+aAf4PL6WgAWMpJxankaSQbGmkaKQmpGmka2RoZCZkWQY5
ItfykGeQ7yHfOAUeCj0UeShOKLFiKPVQGkNZDOWiIobKJNSJi6EqyamXhOpkVCeh
frLTIMlpmIxGyTjESsGhyTg0BYeJxsk4PMU5QjRJRdMUHGmlOkeJo9NwTKpznJVW
q1kajk/DCeLEdJxkpeHkdJwiTs3AqdLT03F6Bs5IxxkZaC7OzECLDJwlWmaiZQbO
zsQ5mTg3LgvnZeL8LOeCLFwoLhIXZ+OSrFqXZjuXxWXh8uxaV4grD3JVNlrloNVB
vVpck3Ctlet6nZXrer2V69o6F61z0MbKrXVDXB5uzMVNcXm12uaibR7aiZsT2h+Q
jw556JCPW/JwS75za8Jt+bjdtsA17o583BlvATrmo2NBrbvE3QfpJDoXonMB7pFh
e2/hf3UR9yXcn2jXItduRW7YdivEA0XOg4k+VIyHipyHrWLXR+ItQvdit7vL6FGM
RxMeE49bJQnF6FmCJ0R8PJnQSzxVil6lrr1LRGL0KcXT4plE454VfcvQtxT9ymr1
L0X/sv96Tgwow/OJPl+OgWUYKB1U7rxwkBfjKlwHl2NIBYaUO0MrMDTeCrwkXk4Y
VolhFc4rlRheIWS8WolXKzAi4bWEkRVqZDlGlatR5Rhdrl4vs/CGo2zfFG/VUrbv
lKq4d0vVGAfxvleC90tU3AdibAnGFuNDR9mOK1LjitX4IjW+WH1U5HwsPrEKXT+1
CtVnCRMK9YQCNbFATyxQn4svHG07KV9NKtCT8vXkfCX0V/nqq3z9dZ7+Ol+55qlv
89Q3rtr6Lk9NydNTcvX3CT+IH60cWzU1V0/L0VNzXKdl6+k5enq2/ilHz8h2ZopZ
rubnLB03O8vMts3Uc7KcXzL1r5nG+i1D/5Zp5loZ5nfxR4b+I8P8aaWbeY6en26s
BVaaWZimrUVpZrGVapakOUtTnWVxKWZ5qlmRYlYm1KSYVVay5a1ONmsS1iaZdclm
XZKzPslbn2Q2JJmNMc/aFDPW5pjZEueZrTFvq2e2ed424233vO3G2yF2il3G2y32
aLNH23p7tbdP7LeU54tAhHAiJ8ZaSUQykUKkEmlEOpEhMokskU3kELlEHpEvCkUR
UUyUEKVEGVFOVIg6oi5RJeoR1UR9ooFoRBxCHCoOIxqLw4kjiCZEU+JIcTRxTMKx
RDPieOKEhJPEKcSp4jRxBtGcOFO0IM4iWoqziXOIc8X5xAXiQuIi4mLiEnEpcRlx
ubiSuEq0Iq4mriGuFdeL1kQb4gbiRnET0ZZoR9xMtBcdiFuIW8Xt4g7iTqIjcRdx
N9GJ6CzuIboQ9xNdiW7Eg8RDxMNEd6IH8SjxONGTeJLoRTxF9Cb6EM8QfUV/4jli
ADGQGES8SAwmhhAvES8TrxDDiVeJEcRIYhQxmniDeJN4W7xLjCHeJ8YSHxLjiPHE
x+JTYgIxkficmER8SUwmviK+Ib4T3xM/EFOJacR0YgYxk5hF/EzMIX4hfiXmEr8T
fxLzrAjzrRALAsz3xT4s2Cv2YMFuLNyFBTuxcAcWbhfbsHCrs2gzFm0SG7FoAxav
F2uxaC0Wr8Hi1ViyCotrsGSlWI4ly8RSLFniLF2EpQvFAiybL+Zh2R/idyyfi2W/
YfmvYg6WzxY/Y8UsLJ+FFTOxYgZWTMdKaxpWThU/YuX3qJmCldZ3qPkWNd+Ir7Fq
MmomY9WXqJmEVdbnYiJWT8Dqz8SnWP0JVn+MNR9h9XisHoc11lis+QBr3sea95y1
Y7D2XfG2s+4trHsjYTTWjRIjsf41rB8hhothzoaXseElbBiKjUOwYbB4ERtfwMZB
2DjQ2fQ8Ng7Apv7Y1E/0xeZnsekZbH4am/tgc29s6Y3NvbDFehKbn8CWntjyOLY8
hq2PYmsPbOmBrd2x7WFstR7C1gewrZvoim33Y/t92NYF2+7F9nuwvTN2dML2Tthx
N7bfhR0dseNO7LjD2Xkbdt4qOmBne+xqj503Y1c77GqLXTc5u2/A7jbOrtbYfT12
XyuuwZ6rsaeVuBJ7rnD2XubsuRR7L8Hei7HvInEB9p6Pfda5zv5zsO9s7GuJ/Wdh
fwv4Z2K/1Rz+6fBPE6eIkxGchOBEBCcgON4JmyE8FsGxCI9BeDTCI52oKaIm4nCw
MaLDQOsQ0UizkWFDj41ibJgsUtkwjQ3T2SCDDTPZMIsNslk/h/VzWT+PDfJZv5AN
ilhdwvolrC5jdTmrK1hdyeo6rFeX9apYrx7r1We9BqxqyKpGrDqE9Q5l1WGsOpxV
R7CqCauasu6RrHsU6x7NusewznGs04x1jmedE1jnRNY5iZUns/IUVp7KytNYeQYr
m7OiOStbsKKlOIcV57L8PHEByy8SF7PsUnEZy65g2ZUsu4qlrVh6NUuvYel1LL2e
pa1Z2oYlN7DkRpbcxOK2LGnHkvYs7sDiW1h8K4tuY9HtLLqDRR1ZdBcL72ZhJxZ2
ZtE9LOrCwvucgq4s7MaCB1jwIAseFo+woDvzH2XBY8x/jHk9mW89wbxe4inm9WZe
H+Y+zdxnmPss8/oyt594zskZwJznmTuQOYOY86IYzJwhzB7KnJeYbQ1j9ivMHs7s
V8UIZo0Uo5g5mpmvM+sNZr7JzLeY+TYz32Hmu8wYw4z3mPk+M6wPmDGWGR8yfRzT
xzP9I6Z/zPRPmP6pkzaB6ROYNpFpnzPtC6ZNYtqXTJvMtK+Yan3D1G/FFKZYP4gf
mTKVKdOYPJ0pM5zkmUyexeSfmTybSbOZPIfJvzpJc8XvTPqDSX8yNo+x+YwtYGwh
Y4sYW8zYEsaW0rOW0VtOb6VjamhW0VtNbw3NWrHe0RuoN4nN1FuotlJvo95OtYN6
J5W1m9jjqL1U+6h8wtofwT8gFMEByvfh7Md+X+3fB3+f8vdh/1474NvuSTRut9hl
KSn8nfB3JGptP0D52+BvtZSAv0X5W+BsjlP+JvibpBtlbERgxwax3lKB7bqDrBVr
4pSzGv4qBKuUH1eDoAZ+jQpWwneU6wr4y22Vv1z5y2AFy5S/FP5S5SxRwRLYOost
OItUsMjVXygWIBC+COarYD78ecoK5sH/U/l/WJAq/3cV1II/VwVz4fxmKf83WMGv
KvjFgm/NUf4cBHNUMNvtYLb42YJU+bOUP1MFM5U/QwUz4M9A4IYKflL+T65uTFfB
NBXEa01VvvWjDFvrB/G9q287RflTXJ3vEr4V3zi+7dcJX8Wrg8kqzp+sgy9VrUmW
Dr5QzueJTrS0VAUTEj5L+FR8EqdtQzs+jtPBR044XgfjlTMu4UPpWEu7fuCEH2g3
3rdbB+/p8D0VCDfG6GCM9F0VF77jBNbbOnirVvimDhxl1e7XdfiGsq01WoejdTBK
BaN0aDtSByNdw9csFdiO0MEIHb6qg4RwuAqGq3C4Dl5xwmG2Khgm42UVvKxrvaSD
obXCoSocop3BOhhsq4IXtRUKN15QwQu2Ohikw0EqsAbqcKC2DZ7XwQDXcICM55yw
vw6EG/102E85fXUgwmdV8KwOn7GUVIdP67CPDvrI6C2jd8JTOuyVqPVkreAJHVo9
XYOeMqzHTfC4rXhMh4/qsIcOeriG3XXQ3YSP6PBhy7g+JB7U4QOim2XCrjrsasL7
dXifCe+TdtFhFxPeq8N7TK3OopO424R3OVFHcacOrTuMc7uObjfhbTq8zYS3Wjq6
RUcdTNRBhx1M2F6HNxunnQ7bmbCtidrq0LpJhzcaK7rBhG1M1MZWh60tE12vneuM
c62JrnHCq01ktdJRKxNeZSLryoQrdHS5CS830WWWDq1LdHSJiS52QtuLEi4w0YVS
63wTnSfONdE5CWeLliY6ywltW5iwhYmam+hMWy86w0Snx3nRaSY6zYtONc4p4mQv
OtlEJ3nRicY5weHxJrKaeRabmeg4z+KxJjrGE4ZHO9FRJjrSRE09NjVREy9q4soj
vOgIEx1u2NiLGntsbHiYFx0qDrFM1MhjQ1sT2d9WDUzUwIvqG4vVXlRtWM/yWOVF
Vl2Pdb2ojrFY6UWVJqrwLJZ7LPMiq9Sw1LOiEo/FTmRb5EVWoccCwwKP+SLPi/I8
5npRrsccL8r2GJflMdOJMjymW7EoXUaax1SPKQnJCUkeYzF6nhXZGitG7TnKsn+/
PXFgHCz2l48OHPnrwb89///LP9/n/zjzH24v9r9c9q9v/82T+eeD/+ZW//Zp//tv
/Hv/AcR9udAISn4gAAAAAElFTkSuQmCC
}

;iterate: rebcode [x y n scale' ofsx' ofsy' /local x2 y2 x2-y2] [
iterate: [
    ; input: x y integer coords
    to-dec x x
    to-dec y y
    ; assume scale decimal!
    muld scale' 100.0
    divd x scale'
    divd y scale'
    ; assume ofsx' ofsy' decimal!
    divd ofsx' scale'
    divd ofsy' scale'
    subd x ofsx'
    subd y ofsy'
    negd y
    ; make x2 and y2 decimal! too
    set x2 1.0
    set y2 1.0
    set x2-y2 1.0
    while [
        gt n 0
    ] [
        setd x2 x
        muld x2 x2
        setd y2 y
        muld y2 y2
        setd x2-y2 x2
        subd x2-y2 y2
        subd x2-y2 0.75
        ;setd y2 y
        muld y x
        muld y 2.0
        setd x x2-y2
        addd x2 y2
        gtd x2 1E20
        ift [seti n 1]
        sub n 1
    ]
    ; x2 is x^2 + y^2 at this point
    sqrt x2
    divd x2 2097152.0
    gtd x2 2147483647.0
    either [
        set x2 2048
    ] [
        to-int x2 x2
        min x2 2047
        add x2 1
    ]
    ; returns x2
]

my-engage: func [f a e /local x y] [
    if a = 'up [
        x: e/offset/x - ofsx / 100.0 / scale
        y: ofsy - e/offset/y / 100.0 / scale
        scale: scale * 2.0
        ofsx: 301.0 - (x * 100.0 * scale)
        ofsy: y * 100.0 * scale + 301.0
        run
    ]
]

iter: 13
print "Julia set explorer"
view/new center-face layout [disp: image img feel [engage: :my-engage] field "13" [iter: to integer! face/text run]]

scale: 1.0
ofsx: ofsy: 301.0

run': rebcode [/local scale' ofsx' ofsy' x' y' x y n x2 y2 x2-y2 c] compose/deep [
    head img
    set n 1
    set c 1
    repeatz y' 601 [
        repeatz x' 601 [
            seti n iter
            set x x'
            set y y'
            set ofsx' ofsx
            set ofsy' ofsy
            set scale' scale
            (iterate)
            pick c gradient x2
            change img c
            next img
        ]
        set c y
        rem c 30
        eq c 0
        ift [do c [show disp]]
    ]
    do c [show disp]
]

do run: does [
    start: now/precise
    run'
    print difference now/precise start
]

do-events