Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/C/Snippets/NewDynamic 1.0.1/original source/DYNAMIC.pas

Pascal/Delphi Source File | 1995-12-01 | 12.3 KB | 510 lines | [TEXT/PJMM]

{$X-}
program Dynamic;
    uses
   {$U Obj/MemTypes    }
        Types,
   {$U Obj/QuickDraw   }
        QuickDraw,
   {$U Obj/OSIntf      }
        OSUtils,
   {$U Obj/ToolIntf    }
        ToolUtils,
   {$U Obj/PackIntf    }
        Packages,
   {$U Obj/MacPrint    }
        PrintTraps;
   {$U Obj/PasLibIntf  }
  {$U Obj/WritelnWindow   }

    const
        lastMenu = 3; { number of menus }
        appleMenu = 1; { menu ID for desk accessory menu }
        fileMenu = 256; { menu ID for File menu }
        editMenu = 257; { menu ID for Edit menu }

        maxvalue = 512;
        maxvectsize = 8;
        vscaling = 1;
        hscaling = 1;
    type
        matrixtype = array[1..maxvectsize, 1..maxvectsize] of real;
        vectortype = array[1..maxvectsize] of real;
        titletype = string[20];

        optiontype = record
                start: boolean;
                quit: boolean;
                edit: boolean;
                newfile: boolean;
                debug: boolean;
            end;

    var
        Trect, dragRect: Rect;
        myevent: eventRecord;
        code: integer;
        MyWindow, whichWindow: WindowPtr;
        wRecord: WindowRecord;
        FamilyID: integer;
        myMenus: array[1..lastMenu] of MenuHandle; {Handles to all of the menus}
        theDialog: DialogPtr;
        options: optiontype;

        need, deltaneed, response, deltaresponse: vectortype;
        alphavector, stimulation, consumvector, tempvct1, tempvct2: vectortype;
        generalization, consumation, excitation, inhibition, tempmatrix, ident: matrixtype;
        vectsize, loop, stimuli: integer;
        alpha, personality: real;
        answer: char;

{ procedure InitScreen;}
{ begin}
{  HideAll;}
{  GetPort(dPort);}
{  GetDrawingRect(dRect);}
{  GetTextRect(TRect);}
{  SetRect(TextRect, 250, 30, 530, 250);}
{  SetRect(DrawRect, 5, 40, 700, 380);}
{  SetTextRect(TextRect);}
{  SetDrawingRect(DrawRect);}
{  ShowDrawing;}
{  ShowText;}
{ end;}

    procedure SetUpMenus;     {adapted from Inside Mac example/edit}
        var
            i: integer;
    begin
        InitMenus;
        mymenus[1] := GetMenu(applemenu);
        AddResMenu(mymenus[1], 'DRVR');  {add desk accessories}
        myMenus[2] := GetMenu(filemenu);
        myMenus[3] := GetMenu(editmenu);   {not really used,  but just for practice}
        for i := 1 to lastMenu do
            InsertMenu(mymenus[i], 0);
        DrawMenuBar;
    end;  {setupMenus}


    procedure Startup;           {basic initialization of MAC tools}
    begin
        InitGraf(@thePort);        {start initialization sequence}
        InitFonts;
        InitWindows;
        TEInit;
        InitDialogs(nil);

        SetupMenus;  {throw menu bar up on the screen and insert menu items}
        InitCursor;  {make cursor an arrow}
        FlushEvents(everyEvent, 0);

        myWindow := GetNewWindow(256, @wRecord, POINTER(-1));{show this one}
        SetPort(mywindow);   {graphics will go into my window}
        SetPort(mywindow); {Writelns and Readlns text will go to my window}

{   WWINIT;}
 {initialize the WritelnWindow unit}
  {not used anymore}
{with Trect do}
{begin}
{top := 40;}
{right := 480;}
{bottom := 330;}
{left := 40;}
{end;}
{GetFNum('Geneva', familyID);}
{WWNew(Trect, 'Animals', false, true, 80, FamilyID, 9);}


    end; {startup}



    procedure matrixXvector (var a: vectortype; b: matrixtype; {A:= B C                  A is a m dimensional vector}
                                    c: vectortype;                                            {B is a m x n dimensional matrix}
                                    n, m: integer);                          {C is a n dimensional vector}
        var
            i, j: integer;
            aij: real;
    begin
        for i := 1 to n do   {rows}
            begin
                aij := 0.0;
                for j := 1 to m do  {columns}
                    begin
                        aij := aij + b[i, j] * c[j];
                    end;
                a[i] := aij;
            end;
    end;{matrixXvector}

    procedure vectoradd (var a: vectortype; b, c: vectortype; {A:=B+ C           A,B,C are n dimensional vectors}
                                    n: integer);
        var
            i: integer;
    begin
        for i := 1 to n do
            a[i] := b[i] + c[i];
    end;

    procedure vectorsubtract (var a: vectortype; b, c: vectortype; n: integer);
        var
            i: integer;
    begin
        for i := 1 to n do
            a[i] := b[i] - c[i];
    end;

    procedure vectorzero (var a: vectortype; n: integer);
        var
            i: integer;
    begin
        for i := 1 to n do
            if a[i] < 0.0 then
                a[i] := 0.0;
    end;

    procedure vectorinit (var a: vectortype; n: integer);
        var
            i: integer;
    begin
        for i := 1 to n do
            a[i] := 0.0;
    end;

    procedure vectordraw (a, b: vectortype; n, loop, offset, vscaling: integer);
        var
            i, v, dh, dv, idiv2: integer;
            OddorEven: Boolean;
    begin
        for i := 1 to n do
            begin
                if a[i] = 0.0 then      {look out for zeroed out responses}
                    begin
                        v := offset;
                        dv := 0;
                    end
                else                  { normal condition}
                    begin
                        v := offset - round(a[i] * vscaling);
                        dv := -round(b[i] * vscaling);
                    end;
                moveto(loop * hscaling, v);
                PenSize(i, i);  {change pen size to indicate which activity is occuring}
                line(hscaling, dv);

            end;{for i loop}
    end;

    procedure vectorread (var a: vectortype; n: integer; title: titletype);
        var
            i: integer;
    begin
        writeln('enter the ', title, ' vector');
        for i := 1 to n do
            read(a[i]);
        writeln;
    end;

    procedure scalarXvector (var a: vectortype; s: real; b: vectortype; n: integer);
        var
            i: integer;
    begin
        for i := 1 to n do
            a[i] := s * b[i];
    end;

    procedure scalarXmatrix (var a: matrixtype; s: real; b: matrixtype; n: integer);
        var
            i, j: integer;
    begin
        for i := 1 to n do
            for j := 1 to n do
                a[i, j] := s * b[i, j];
    end;

    procedure matrixread (var a: matrixtype; n: integer; title: titletype);
        var
            i, j: integer;
    begin
        writeln('enter the ', title, ' matrix');
        for i := 1 to n do
            begin
                for j := 1 to n do
                    read(a[i, j]);
                writeln;
            end;
    end;

    procedure matrixwrite (a: matrixtype; n: integer);
        var
            i, j: integer;
    begin
        for i := 1 to n do
            begin
                for j := 1 to n do
                    write(a[i, j] : 5 : 2);
                writeln;
            end;
    end;


    procedure identity (var temp: matrixtype; vectsize: integer);
        var
            i, j: integer;
    begin
        for i := 1 to vectsize do
            begin
                if i > 1 then
                    for j := 1 to i - 1 do
                        begin
                            temp[i, j] := 0.0;
                            temp[j, i] := 0.0;
                        end;
                temp[i, i] := 1.0;
            end;
    end;


    procedure DynamicSimulation; {the old program dynamic}
        var
            stimuli, loop: integer;

    begin {dynamic}

 {InitScreen;}
        writeln(' a model of reciprocal inhibition ');
{write('enter alpha, personality ');}
{readln(alpha, personality);}
        alpha := 0.2;
        personality := 1;

        writeln('do you want to specify the problem size? [no] ');
        readln(answer);
        if answer = 'y' then
            begin
                write('enter the problem size  ');
                readln(vectsize);
            end
        else
            vectsize := 3;
        identity(ident, vectsize);
        writeln('do you want to specify the stimulation vector? [no] ');
        readln(answer);
        if answer = 'y' then
            vectorread(stimulation, vectsize, 'stimulation')
        else
            for stimuli := 1 to vectsize do
                stimulation[stimuli] := stimuli * 0.5;
        writeln('do you want to specify the consummation matrix [no] ');
        readln(answer);
        if answer = 'y' then
            matrixread(consumation, vectsize, 'consummation')
        else
            scalarXmatrix(consumation, 0.2, ident, vectsize);
        writeln('do you want to specify the excitation matrix [no] ');
        readln(answer);
        if answer = 'y' then
            matrixread(excitation, vectsize, 'excitation')
        else
            scalarXmatrix(excitation, alpha, ident, vectsize);
        writeln('do you want to specify the inhibition matrix? [no] ');
        readln(answer);
        if answer = 'y' then
            matrixread(inhibition, vectsize, 'inhibition')
        else
            begin
                for loop := 1 to vectsize do
                    begin
                        for stimuli := 1 to vectsize do
                            inhibition[loop, stimuli] := 1.0;
                        inhibition[loop, loop] := 0.1;
                    end;
            end;
        vectorinit(need, vectsize);                                                {zero out initial values of need and response}
        vectorinit(response, vectsize);
        scalarXmatrix(generalization, personality, ident, vectsize);

        for loop := 1 to 25 do
            writeln; {clear the screen}

        SelectWindow(mywindow);

        MoveTo(0, 140);
        DrawString('Needs');
        MoveTo(0, 250);
        DrawString('Responses');
        MoveTo(100, 30);
        DrawString('Time -->');

{begin the main loop}
        for loop := 1 to maxvalue do
            begin
   {if loop = 250 then}
{    ShowDrawing;}
                matrixXvector(tempvct1, generalization, stimulation, vectsize, vectsize);
                matrixXvector(consumvector, consumation, response, vectsize, vectsize);
                if button then
                    vectorread(stimulation, vectsize, 'new stimulation');
                vectorsubtract(deltaneed, tempvct1, consumvector, vectsize);
                matrixXvector(tempvct1, inhibition, response, vectsize, vectsize);
                matrixXvector(tempvct2, excitation, need, vectsize, vectsize);
                vectorsubtract(deltaresponse, tempvct2, tempvct1, vectsize);
                vectordraw(need, deltaneed, vectsize, loop, 125, vscaling);
                vectoradd(need, need, deltaneed, vectsize);
                vectordraw(response, deltaresponse, vectsize, loop, 300, vscaling);
                vectoradd(response, response, deltaresponse, vectsize);
                vectorzero(response, vectsize);
            end;
    end;  {dynamic}

    {the remaining code was added to allow for windows, menus, etc}

    procedure Message (dialognumber: integer);
                                 {Throw up a Dialog Box and wait for keypress}
        var
            theDialog: DialogPtr;
            myEvent: EventRecord;
            itemHit: integer;
            tempPort: GrafPtr;
    begin
        GetPort(tempPort);       {save the current status of the screen display}
        theDialog := GetNewDialog(dialognumber, nil, Pointer(-1)); {display dialog # }
        ModalDialog(nil, itemhit); {show the dialog and wait for a button}
        DisposDialog(theDialog);  {get rid of the dialog and show the screen}
        SetPort(tempPort);        {put back the original display}
    end; {Message}




    procedure DoCommand (mResult: Longint; var options: optiontype); {process menu selection}
        var
            name: str255;
            themenu, theitem, refnum: integer;
            AlertNum, AlertId: integer;

    begin
        AlertId := 1;
        themenu := HiWord(mResult);
        theItem := loWord(mResult);
        case theMenu of
            applemenu:
                begin
                    if theItem = 1 then
                        Message(1)  {throw up message window}
                    else   {do a desk accessory}
                        begin
                            GetItem(mymenus[1], theitem, name);
                            refnum := OpenDeskAcc(name);
                        end;
                end; {applemenu}
            Filemenu:
                begin
                    case theitem of
                        1:
                            options.start := true;
                        2:
                            options.debug := true;
                        3:
                            begin
                               { AlertNum:=CautionAlert(AlertId,nil);}
{                                If AlertNum=1 then}
{                                       initialize;}
                            end;
                        4:
                            options.quit := true;
                    end;
                end;
            Editmenu:
                options.edit := true;


        end; {case themenu}
    end;  {DoCommand}

    procedure WaitForCommand; {get options from menu bar until start}
        var
            theChar: Char;
            dummy: boolean;
    begin
        with options do
            begin
                start := false;
                debug := false;
                edit := false;
                newfile := false;
                quit := false;
            end;
        repeat
            begin
                SystemTask;
                dummy := GetNextEvent(everyevent, myevent);
                case myevent.what of
                    mousedown:
                        begin
                            code := FindWindow(myevent.where, whichwindow);
                            case code of
                                inmenubar:
                                    DoCommand(MenuSelect(myevent.where), options);
                                inSysWindow:
                                    SystemClick(myevent, whichwindow);
                                inDrag:
                                    DragWindow(whichwindow, myevent.where, dragRect);
                            end; {case code}
                        end; {mouse down}
                    keydown, autokey:
                        begin  {try processing a menu-key equivalent}
                            theChar := CHR(myevent.message mod 256); {the last byte}
                            if BitAnd(myevent.modifiers, CmdKey) <> 0 then
                                DoCommand(MenuKey(theChar), options);
                        end;

                end; {case myevent.what}

                if options.start then
                    begin
                        dynamicsimulation;
                        options.start := false;
                    end;
                if options.edit then
                    begin
                                  { editfile;}
                        options.edit := false;
                    end;
            end; {repeat loop}
        until options.quit or options.edit; {set in DoCommand}
    end; {waitfor command}

{=======================================================================================    }
    procedure InitMac;

    begin
        MaxApplZone;
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitCursor;
        InitMenus;
        TEInit;
        InitDialogs(nil);
    end;
    procedure PutUpWindow;
        var
            drawwindptr: WindowPtr;
            Screen: Rect;
            offSet: point;
    begin
        DrawWindPtr := NewCWindow(nil, ScreenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, longInt(nil));
        SetPort(DrawWindPtr);
    end;
begin          {dynamic}

    Startup;  {various MAC type initializations}
{PutUpWindow;}
    writeln;   {the screen initialization seems to start 1 line too high}

    WaitForCommand;{the Main Event Loop}


end.