/packages/amunits/examples/otherlibs/openpip.pas
Pascal | 92 lines | 66 code | 12 blank | 14 comment | 0 complexity | fda0322eae847a0dbf0ebb34376525ed MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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.