/packages/amunits/examples/otherlibs/openpip.pas

 1Program OpenPIP;
 2
 3
 4{ ***********************************************************************
 5  * This is an example that shows how to open a p96 PIP Window
 6  * to get input events and how to paint in that window.
 7  *
 8  *********************************************************************** }
 9
10{
11    Translated to fpc pascal.
12    3 Mars 2001.
13
14    Updated for fpc 1.0.7
15    08 Jan 2003.
16
17    nils.sjoholm@mailbox.swipnet.se
18}
19
20uses exec, amigados, graphics, intuition, picasso96api, utility,strings;
21
22
23Const
24    WB          :   Pchar = 'Workbench';
25    template    :   Pchar = 'Width=W/N,Height=H/N,Pubscreen=PS/K';
26    vecarray    :   Array[0..2] of long = (0,0,0);
27    ltrue       :   longint = 1;
28Var
29    PubScreenName   :   Array [0..80] Of Char;
30    height,
31    width           :   longint;
32    wd              :   pWindow;
33    imsg            :   pIntuiMessage;
34    goahead         :   Boolean;
35    rp              :   pRastPort;
36    x,
37    y               :   Word;
38    rda             :   pRDArgs;
39
40Begin
41    width := 256;
42    height := 256;
43    StrCopy(@PubScreenName,WB);
44
45    rda:=ReadArgs(template,@vecarray,Nil);
46    If rda<>Nil Then Begin
47       If vecarray[0] <> 0 then width := long(@vecarray[0]);
48       If vecarray[1] <> 0 then height := long(@vecarray[1]);
49       If vecarray[2] <> 0 then StrCopy(@PubScreenName,@vecarray[2]);
50       FreeArgs(rda);
51    End;
52
53
54    wd := p96PIP_OpenTags([P96PIP_SourceFormat, long(RGBFB_R5G5B5),
55                           P96PIP_SourceWidth,256,
56                           P96PIP_SourceHeight,256,
57                           WA_Title,'Picasso96 API PIP Test',
58                           WA_Activate,lTRUE,
59                           WA_RMBTrap,lTRUE,
60                           WA_Width,Width,
61                           WA_Height,Height,
62                           WA_DragBar, lTRUE,
63                           WA_DepthGadget,lTRUE,
64                           WA_SimpleRefresh,lTRUE,
65                           WA_SizeGadget,lTRUE,
66                           WA_CloseGadget,lTRUE,
67                           WA_IDCMP,IDCMP_CLOSEWINDOW,
68                           WA_PubScreenName,@PubScreenName,
69                           TAG_DONE]);
70
71    If wd <> Nil Then Begin
72        goahead:=True;
73        rp:=Nil;
74
75        p96PIP_GetTags(wd,[P96PIP_SourceRPort, @rp, TAG_END]);
76        If rp<>Nil Then Begin
77            For y:=0 To (Height-1) Do
78            For x:=0 To (Width-1) Do
79               p96WritePixel (rp,x,y,(x*256+y)*256);
80        End Else Writeln ('No PIP rastport.');
81        While goahead Do Begin
82            WaitPort (wd^.UserPort);
83            imsg := pIntuiMessage(GetMsg (wd^.UserPort));
84            While imsg<>Nil Do Begin
85                If imsg^.IClass=IDCMP_CLOSEWINDOW Then goahead:=False;
86                ReplyMsg (pMessage(imsg));
87                imsg:=pIntuiMessage(GetMsg (wd^.UserPort));
88            End;
89        End;
90        p96PIP_Close(wd);
91    End Else Writeln ('Unable to open PIP.');
92End.