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

https://github.com/slibre/freepascal · Pascal · 92 lines · 66 code · 12 blank · 14 comment · 0 complexity · fda0322eae847a0dbf0ebb34376525ed MD5 · raw file

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