home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / misc / m2pica.lha / M2Picasso / Txt / Picatest.mod < prev    next >
Encoding:
Text File  |  1994-11-17  |  3.6 KB  |  133 lines
  1. (*******************************************************************************
  2.  : Program.         Picatest.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.99
  7.  : Date.            22.Feb.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.3d
  11.  : Contents.        24-Bit Demoprogramm.
  12. *******************************************************************************)
  13.  
  14. MODULE PicaTest ;
  15.  
  16.  
  17. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,BYTE ;
  18.  
  19. FROM UtilityD     IMPORT tagEnd,tagDone ;
  20.  
  21. FROM ExecL        IMPORT Forbid,Permit ;
  22.  
  23. FROM Arts         IMPORT Assert ;
  24.  
  25. FROM DosL         IMPORT Delay ;
  26.  
  27. FROM IntuitionD   IMPORT ScreenPtr ;
  28. FROM IntuitionL   IMPORT ScreenToFront ;
  29.  
  30. FROM RandomNumber IMPORT RND ;
  31.  
  32. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  33.                          LockVillageScreen,UnLockVillageScreen,VillageModeRequest,
  34.                          VillageBlitCopy,VillageRectFill,WaitVillageBlit,
  35.                          VillageScreenData ;
  36. FROM VilIntuiSupD IMPORT SetTrueColorPixel,LineTrueColor,
  37.                          VilFillRecord,VilCopyRecord,VilScrCopy,
  38.                          TavisTags,InvalidID,
  39.                          ScreenDataTags ;
  40.  
  41.  
  42.  
  43.  
  44. VAR scr    : ScreenPtr ;
  45.     start  : ADDRESS ;
  46.     x,y,ok,
  47.     size   : LONGINT ;
  48.     mode   : LONGCARD ;
  49.     tags   : ARRAY [0..40] OF LONGCARD ;
  50.     copy   : VilCopyRecord ;
  51.     fill   : VilFillRecord ;
  52.  
  53.  
  54.  
  55. BEGIN
  56.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,  24,
  57.                                            tagDone)) ;
  58.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  59.  
  60.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
  61.                                            tagDone)) ;
  62.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  63.  
  64.   FOR x:=0 TO 300 DO
  65.     LineTrueColor(scr,RND(scr^.width),RND(scr^.height),
  66.                       RND(scr^.width),RND(scr^.height),RND(255),RND(255),RND(255)) ;
  67.   END ;
  68.   Delay(2*50) ;
  69.  
  70.   start := LockVillageScreen(scr) ;
  71.   UnLockVillageScreen(scr) ;
  72.   FOR x:=0 TO 255 DO
  73.     FOR y:=0 TO 255 DO
  74.       SetTrueColorPixel(scr,x,y,x,y,0) ;
  75.     END ;
  76.   END ;
  77.   FOR x:=0 TO 255 DO
  78.     FOR y:=0 TO 255 DO
  79.       SetTrueColorPixel(scr,255+x,y,y,0,x) ;
  80.     END ;
  81.   END ;
  82.  
  83.   UnLockVillageScreen(scr) ;
  84.   Delay(1*50) ;
  85.  
  86.   Forbid() ;
  87.    ScreenToFront(scr) ;
  88.    start := LockVillageScreen(scr) ;
  89.   Permit() ;
  90.  
  91.   FOR y:=0 TO (scr^.height DIV 32) DO
  92.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  93.       copy.scrAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width) * (y*32) + x*32)*3) ;
  94.       copy.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  95.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*3) ;
  96.       copy.scrPitch := scr^.width ;
  97.       copy.dstPitch := scr^.width ;
  98.       copy.width    := 32 ;
  99.       copy.height   := 32 ;
  100.       copy.rop      := VilScrCopy ;
  101.  
  102.       ok := VillageBlitCopy(scr,ADR(copy)) ;
  103.       WaitVillageBlit ;
  104.     END ;
  105.   END ;
  106.   Delay(4*50) ;
  107.  
  108.   FOR y:=0 TO (scr^.height DIV 32) DO
  109.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  110.       fill.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  111.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*3) ;
  112.       fill.dstPitch := scr^.width ;
  113.       fill.width    := 32 ;
  114.       fill.height   := 32 ;
  115.       fill.color    := RND(16777216)  ;
  116.  
  117.       ok := VillageRectFill(scr,ADR(fill)) ;
  118.       WaitVillageBlit ;
  119.     END ;
  120.   END ;
  121.  
  122.   UnLockVillageScreen(scr) ;
  123.  
  124.   Delay(5*50) ;
  125.  
  126. CLOSE
  127.   IF scr#NIL THEN
  128.     UnLockVillageScreen(scr) ;
  129.     CloseVillageScreen(scr) ;
  130.   END ;
  131.  
  132. END PicaTest .
  133.