Библиотека Picasso96api freePascal 3.2.2 OS4.1 FE

[Smalovsky]

Немного освоил эту библиотеку. Написал небольшую программу:

Program P96_Window;
uses  exec, sysutils, utility, intuition,agraphics,picasso96api;
procedure Paint( AWin:PWindow;ci:TTrueColorInfo;x:LongWord;y:LongWord);
begin

        p96WriteTrueColorData(@ci,0,0,AWin^.RPort,x,y,600,400);

end;
var
        win:PWindow;
        done:Boolean=False;
        Msg:PIntuiMessage;
        Scr:PScreen;
        key:Word;
        error:LongWord;
        TCI:TTrueColorInfo;
        count:LongInt;
        colorcount1:Byte=0;
        colorcount2:Byte=0;
        colorcount3:Byte=0;
        offsetx:LongWord;
        offsety:LongWord;

begin
        Scr:=lockPubScreen('Workbench');
        win:=P96PIP_OpenTags([
        P96PIP_SourceFormat,RGBFF_R8G8B8,
        P96PIP_SourceWidth,AsTag(600),
        P96PIP_SourceHeight,AsTag(400),
        P96PIP_ErrorCode,LongWord(@error),
        WA_Title,asTag('Picasso Window'),
        WA_SimpleRefresh,asTag(True),
        WA_InnerWidth,asTag(600),
        WA_InnerHeight,asTag(400),
        WA_DragBar, asTag(True),
        WA_CustomScreen,LongWord(Scr),
        WA_FLAGS,WFLG_Closegadget or WFLG_ACTIVATE,
        WA_IDCMP,IDCMP_CLOSEWINDOW or IDCMP_REFRESHWINDOW or IDCMP_RAWKEY or IDCMP_CHANGEWINDOW,
        TAG_END,TAG_DONE]);
        unlockPubScreen(nil,Scr);
        Writeln('error code ',error);

        offsetx:=win^.borderleft;
        offsety:=win^.bordertop;


        TCI.PixelDistance:=1;//???
        TCI.BytesPerRow:=0;//???
        TCI.RedData:=AllocMem(120000); //600*400/2
        TCI.GreenData:=AllocMem(120000);
        TCI.BlueData:=AllocMem(120000);
        For count:=0 to 120000 do
        begin
                (TCI.RedData+count)^:=colorcount1;
                colorcount1:=colorcount1+1;
                (TCI.GreenData+count)^:=colorcount2;
                colorcount2:=colorcount2+5;
                (TCI.BlueData+count)^:=colorcount3;
                colorcount3:=colorcount3+3;

        end;
        Paint(win,TCI,offsetx,offsety);
        while done=False do
        begin
                key:=0;
                Msg:=p96PIP_GetIMsg(win^.UserPort);
                if Msg<>nil Then
                begin
                        case Msg^.IClass of
                        IDCMP_CloseWindow:
                                begin
                                        done:=True;
                                         continue;
                                end;
                        IDCMP_REFRESHWINDOW:
                                begin
                                        BeginRefresh(win);
                                        Paint(win,TCI,offsetx,offsety);
                                        EndRefresh(win,False);
                                end;
                        IDCMP_CHANGEWINDOW:
                                        Paint(win,TCI,offsetx,offsety);
                        IDCMP_RAWKEY:
                                key:=Msg^.code;
                        end;
                        p96PIP_ReplyIMsg(Msg);
                end;
                if key=$45 then done:=True;//ESC key

        end;
        p96PIP_Close(Win);
        freemem(TCI.RedData);
        freemem(TCI.GreenData);
        freemem(TCI.BlueData);
end.

Результат работы:

Скриншот

[свернуть]

Нашёл некоторые баги. Одна функция p96PIP_getTags неправильно работает с адресами записей.

[Advertiser]