🚀 go-pugleaf

In A. K. Dewdney's "Computer Recreations" column in the September 1986,
Scientific American he describes several Mandelbrot inspired programs.  I've
implemented the first of these, John E. Connett's CIRCLE2 in OSS Pascal.  It
draws the pattern in a small window in the upper right hand corner of the
screen.  A menu selection called "Commands" allows you to adjust the
parameters of the function as descibed in the "Computer Recreations" column,
as well as adjust the aspect ratio and number of colors used to draw the
patterns.  It has been tested on a color monitor, but I believe it will work
just fine on monochrome.

This message contains the source for my implementation of circle2 and the
following message contains the uuencoded binary (for those who don't have
OSS Pascal and are able to uudecode successfully...).

--Dwight Mckay, ECN Text & Workstation Software Support
[arpanet: mckay@ee.ecn.purdue.edu, usenet: ...ihnp4!pur-ee!mckay]
[Compu-serve: 75776,1521, office: EE 348B, phone: (317) 494-3561]

-------------------------------- Cut Here --------------------------------
program circle2;

(* written by Dwight D. McKay - September 1986                  *)
(* Circle2 - from SciAm Computer Recreations column, Sept. 86   *)

(* This is a public domain demo program.  Feel free to          *)
(* distribute it for free; please leave this message and the    *)
(* message which is displayed in the "desk" menu item in place  *)
(* as that message satisfys the license agreement with OSS.     *)

const
        {$I gemconst.pas}
        Desk_Title = 3; { index of "desk" item in the menu bar }
        MAX_X = 100;
        MAX_Y = 100;

type
        mode_type = (MONO, FOUR, SIXTEEN);
        {$I gemtype.pas}

var
        menu : Menu_Ptr;
        dummy, which, handle : integer;
        param_title, param0_item, param1_item, param2_item : integer;
        param3_item : integer;
        msg : Message_Buffer;
        wind_type : integer;
        title : Window_Title;

        clrs : array [0..15] of integer;
        cx, cy, sz : integer;
        win_x, win_y, y_fix : integer;
        color_mode : mode_type;

{$I gemsubs.pas}

procedure circle2;

{ run the circle2 loop with the specified parameters }

var
        i, ii, j, c, ix, iy, w, h : integer;
        x, y, z : real;

begin
        { get the window size, set clipping }

        Work_Rect(handle, ix, iy, w, h);
        Set_Clip(ix, iy, w, h);

        { clear display rectangle }

        Paint_Style(Solid);
        Paint_Color(White);
        Paint_Rect(ix, iy, w, h);

        if y_fix > 0 then w := trunc(w/2);
        for ii := 0 to w do begin
                i := ii * (y_fix + 1);
                for j := 0 to h do begin
                        x := cx + (sz * (ii/100));
                        y := cy + (sz * (j/100));
                        z := sqr(x) + sqr(y);
                        c := trunc(z);
                        case color_mode of
                                MONO :
                                        begin
                                                if not(odd(c)) then begin
                                                        Line_Color(Black);
                                            line(i+ix, j+iy, i+ix+y_fix, j+iy);
                                                end;
                                        end;
                                FOUR :
                                        begin
                                                Line_Color(clrs[(c mod 4)]);
                                            line(i+ix, j+iy, i+ix+y_fix, j+iy);
                                        end;
                                SIXTEEN :
                                        begin
                                                Line_Color(clrs[(c mod 16)]);
                                            line(i+ix, j+iy, i+ix+y_fix, j+iy);
                                        end;
                        end;
                end;
        end;
end;

procedure itos(num : integer; var t : Str255);

var
        i, j, k : integer;
        s : array [0..10] of char;

begin
        k := num;
        t := '';
        j := 0;
        if k < 0 then begin
                t := '-';
                k := -k;
        end;
        while not (k = 0) do begin
                i := k - (10 * trunc(k/10));
                k := trunc(k/10);
                s[j] := chr(ord('0') + i);
                j := j + 1;
        end; { while }
        for i:= j-1 downto 0 do
                t := concat(t, s[i]);
end;

function stoi(text : Str255) : integer;

var
        i, j, k : integer;

begin
        k := 1;
        j := 0;
        for i := 1 to length(text) do
                if text[i] = '-' then begin
                        k := -1;
                end else if (ord(text[i]) >= ord('0')) or
                            (ord(text[i]) <= ord('9')) then begin
      j := j + trunc(PwrOfTen(length(text) - i) * (ord(text[i]) - ord('0')));
                end;
        j := j * k;
        stoi := j;
end;

procedure param_dialog;

var
        param_box : Dialog_Ptr;
        cx_idx, cy_idx, sz_idx, exit_btn : integer;
        text : Str255;

begin
        { user picked the parameter changer }
        param_box := New_Dialog(5,0,0,30,9);
        cx_idx := Add_Ditem(param_box, G_FText, Editable,
                        1, 1, 22, 1, 0, Black * 256 | 128);
        itos(cx, text);
        Set_Dedit(param_box, cx_idx, ' Lower Left X     ____ ', 'X999', text,
                        System_Font, TE_Left);
        cy_idx := Add_Ditem(param_box, G_FText, Editable,
                        1, 3, 22, 1, 0, Black * 256 | 128);
        itos(cy, text);
        Set_Dedit(param_box, cy_idx, ' Lower Left Y     ____ ', 'X999', text,
                        System_Font, TE_Left);
        sz_idx := Add_Ditem(param_box, G_FText, Editable,
                        1, 5, 22, 1, 0, Black * 256 | 128);
        itos(sz, text);
        Set_Dedit(param_box, sz_idx, ' Length of a side ____ ', '9999', text,
                        System_Font, TE_Left);
        exit_btn := Add_Ditem(param_box, G_Button,
                        Selectable|Default|Touch_Exit,
                        11, 7, 6, 1, 1, Black * 4096 | Black * 256);
        Set_Dtext(param_box, exit_btn, ' Done ', System_Font, TE_Center);
        Center_Dialog(param_box);
        dummy := DO_Dialog(param_box, cx_idx);
        Get_DEdit(param_box, cx_idx, text);
        cx := stoi(text);
        Get_DEdit(param_box, cy_idx, text);
        cy := stoi(text);
        Get_DEdit(param_box, sz_idx, text);
        sz := stoi(text);
        End_Dialog(param_box);
        Delete_Dialog(param_box);
end;

procedure aspect_dialog;

var
        aspect_box : Dialog_Ptr;
        inst_aspect_idx, one_btn, two_btn, exit_btn : integer;

begin
        { aspect ratio correction box }
        aspect_box := New_Dialog(5,0,0,18,7);
        inst_aspect_idx := Add_DItem( aspect_box, G_Text, None,
                                1, 1, 14, 1, 0, Black * 256);
        Set_DText(aspect_box, inst_aspect_idx,
                'Aspect Ratio', System_Font, TE_Center);
        one_btn := Add_DItem( aspect_box, G_Button, Selectable|Radio_Btn,
                                2, 3, 5, 1, 1, Black * 4096 | Black * 256);
        Set_DText(aspect_box, one_btn, '1:1', System_Font, TE_Center);
        two_btn := Add_DItem( aspect_box, G_Button, Selectable|Radio_Btn,
                                9, 3, 5, 1, 1, Black * 4096 | Black * 256);
        Set_DText(aspect_box, two_btn, '2:1', System_Font, TE_Center);
        exit_btn := Add_DItem( aspect_box, G_Button,
                                Selectable|Default|Touch_Exit,
                                5, 5, 6, 1, 1, Black * 4096 | Black * 256);
        Set_DText(aspect_box, exit_btn, ' Done ', System_Font, TE_Center);
        if y_fix = 0 then
                Obj_SetState(aspect_box, one_btn, Selected, false)
        else
                Obj_SetState(aspect_box, two_btn, Selected, false);
        Center_Dialog(aspect_box);
        dummy := Do_Dialog(aspect_box, 0);
        if Obj_State(aspect_box, one_btn) & Selected <> 0 then
                y_fix := 0
        else
                y_fix := 1;
        End_Dialog(aspect_box);
        Delete_Dialog(aspect_box);
end;

procedure color_dialog;

var
        color_box : Dialog_ptr;
        inst_color, two_btn, four_btn, sixteen_btn, exit_btn : integer;

begin
        { number of colors to use dialog }
        color_box := New_Dialog(5,0,0,18,7);
        inst_color := Add_DItem( color_box, G_Text, None,
                                1, 1, 16, 1, 0, Black * 256);
        Set_DText( color_box, inst_color, 'Number of Colors', System_Font,
                TE_Center);
        two_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
                                3, 3, 3, 1, 1, Black * 4096 | Black * 256);
        Set_DText( color_box, two_btn, '2', System_Font, TE_Center);
        four_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
                                7, 3, 3, 1, 1, Black * 4096 | Black * 256);
        Set_DText( color_box, four_btn, '4', System_Font, TE_Center);
        sixteen_btn := Add_DItem( color_box, G_Button, Selectable|Radio_Btn,
                                11, 3, 4, 1, 1, Black * 4096 | Black * 256);
        Set_DText( color_box, sixteen_btn, '16', System_Font, TE_Center);
        exit_btn := Add_DItem( color_box, G_Button,
                                Selectable|Default|Touch_Exit,
                                6, 5, 6, 1, 1, Black * 4096 | Black * 256);
        Set_DText( color_box, exit_btn, 'Done', System_Font, TE_Center);
        case color_mode of
                MONO: Obj_SetState( color_box, two_btn, Selected, false);
                FOUR: Obj_SetState( color_box, four_btn, Selected, false);
                SIXTEEN:Obj_SetState( color_box, sixteen_btn, Selected, false);
        end; { case }
        Center_Dialog( color_box );
        dummy := Do_Dialog( color_box, 0);
        if Obj_State( color_box, two_btn) & Selected <> 0 then
                color_mode := MONO
        else if Obj_State( color_box, four_btn) & Selected <> 0 then
                color_mode := FOUR
        else
                color_mode := SIXTEEN;
        End_Dialog( color_box );
        Delete_Dialog( color_box );
end;

procedure do_menu(title, item : integer);

{ take care of what happens when the user hits a menu item }

var
        alert : Str255;

begin
        if title = Desk_Title then begin

                { user picked the "desk" item, show program info }

                alert := '[0][';
                alert := Concat(alert, '             Circle2|');
                alert := Concat(alert, '   Written by Dwight D. Mckay|');
                alert := Concat(alert, '  Portions of this product are|');
                alert := Concat(alert, 'Copyright (c) 1986, OSS and CCD.|');
                alert := Concat(alert, '   Used by Permission of OSS.]');
                alert := Concat(alert, '[ OK ]');
                dummy := Do_Alert(alert,1);

        end else if title = param_title then begin
            if item = param0_item then param_dialog
            else if item = param1_item then aspect_dialog
            else if item = param2_item then color_dialog
            else if item = param3_item then begin
                Hide_Mouse;
                Begin_Update;
                circle2;
                End_Update;
                Show_Mouse;
            end;
        end;

        { turn the selected menu off again }

        Menu_Normal(menu, title);
end; { procedure do_menu }

begin { circle2 }
        { set initial parameters }
        cx := -20;
        cy := -20;
        sz := 40;
        clrs[0] := White;
        clrs[1] := Black;
        clrs[2] := Red;
        clrs[3] := Green;
        clrs[4] := Blue;
        clrs[5] := Cyan;
        clrs[6] := Yellow;
        clrs[7] := Magenta;
        clrs[8] := L_White;
        clrs[9] := L_Black;
        clrs[10] := L_Red;
        clrs[11] := L_Green;
        clrs[12] := L_Blue;
        clrs[13] := L_Cyan;
        clrs[14] := L_Yellow;
        clrs[15] := L_Magenta;
        color_mode := MONO;
        y_fix := 0;

        if Init_Gem >= 0 then begin { we got a good GEM startup... }

                { first set up for a window }
                Set_Mouse(M_Bee);
                wind_type := G_Size|G_Move|G_Close|G_Name;
                title := ' Circle2 ';
                handle := New_Window(wind_type, title, 0, 0, 0, 0);

                { next set up for the menu bar }
                menu := New_Menu(6, '  About Circle2  ');
           param_title := Add_MTitle(menu, ' Commands ');
           param0_item := Add_MItem(menu, param_title, '   Parameters    ');
           param1_item := Add_Mitem(menu, param_title, '   Aspect Ratio  ');
           param2_item := Add_MItem(menu, param_title, '   Colors        ');
           param3_item := Add_Mitem(menu, param_title, '   Redraw        ');

                { OK, now do it... }
                Draw_Menu(menu);
                Open_Window(handle, 10, 20, MAX_X, MAX_Y);

                { now loop until the user closes the window, handling events }

                Set_Mouse(M_Arrow);

                repeat
                        { check for an event }
                        which := Get_Event(E_Message, 0, 0, 0, 2000,
                                false, 0, 0, 0, 0, false, 0, 0, 0, 0,
                                msg, dummy, dummy, dummy, dummy, dummy, dummy);

                        { if we got some message, deal with it }

                        if which & E_Message <> 0 then

                                case msg[0] of
                                        { redraw the window }
                                        WM_Redraw :
                                                begin
                                                        Hide_Mouse;
                                                        Begin_Update;
                                                        circle2;
                                                        End_Update;
                                                        Show_Mouse;
                                                end;

                                        { moved or sized, fix things up... }
                                        WM_Sized, WM_Moved :
                                                begin
                                                        win_x := msg[6];
                                                        win_y := msg[7];
                                                        Set_WSize(handle,
                                                                msg[4],
                                                                msg[5],
                                                                msg[6],
                                                                msg[7]);
                                                        Hide_Mouse;
                                                        Begin_Update;
                                                        circle2;
                                                        End_Update;
                                                        Show_Mouse;
                                                end;

                                        { some menu was hit... }
                                        MN_Selected :
                                                do_menu(msg[3], msg[4]);
                                end;
                until msg[0] = WM_Closed;

                { user hit the "close" box, so clean up and exit }

                Close_Window(handle);
                Delete_Window(handle);
                Erase_menu(menu);
                Exit_Gem;
        end;
end.