← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to packages/extra/amunits/otherlibs/picasso/examples/openpip.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/extra/amunits/otherlibs/picasso/examples/openpip.pas
1
 
Program 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
 
 
20
 
uses exec, amigados, graphics, intuition, picasso96api, utility,strings;
21
 
 
22
 
 
23
 
Const
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;
28
 
Var
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
 
 
40
 
Begin
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.'); 
92
 
End.
93
 
 
94
 
{
95
 
  $Log
96
 
}
97