home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Basic / OTL-BBU3.DMS / in.adf / BlitzBlank / SOURCES / BB.Mosaic < prev    next >
Encoding:
Text File  |  1993-10-07  |  5.3 KB  |  248 lines
  1. ;BB.Mosaic - Blanker-module for BlitzBlank
  2. ;Copyright 1993 by Thomas Boerkel
  3.  
  4. CloseEd
  5. NoCli
  6.  
  7. NEWTYPE.table
  8. r.l
  9. g.l
  10. b.l
  11. End NEWTYPE
  12.  
  13. NEWTYPE.tags
  14. a.l
  15. b
  16. c
  17. d
  18. e
  19. f
  20. End NEWTYPE
  21.  
  22. DEFTYPE.Screen *fs,*myscreen
  23. DEFTYPE.ViewPort *vp
  24. DEFTYPE.RastPort *rp
  25. DEFTYPE.ColorMap *cm
  26. DEFTYPE.NewScreen newscreen
  27. DEFTYPE.Message *msg
  28. DEFTYPE.table tab
  29. DEFTYPE.MsgPort *port
  30. DEFTYPE.tags tags
  31. DEFTYPE.l
  32.  
  33. Statement stringborder{x,y,w,h}
  34. Wline x+1,y+h+2,x+1,y,x+w+8,y,1
  35. Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
  36. Wline x,y+h+3,x,y,1
  37. Wline x+w+11,y-1,x+w+11,y+h+4,1
  38. Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
  39. Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
  40. Wline x-2,y+h+4,x-2,y-1,2
  41. Wline x+w+8,y+1,x+w+8,y+h+2,2
  42. End Statement
  43.  
  44. Select Par$(1)
  45.   Case "BLANK"
  46.     name$="BB.BlankModule"+Chr$(0)
  47.     *port=CreateMsgPort_()
  48.     *port\mp_Node\ln_Name=&name$
  49.     *port\mp_Node\ln_Pri=1
  50.     AddPort_ *port
  51.     SetTaskPri_ FindTask_(0),Val(Par$(8))
  52.     Gosub readconfig
  53.     speed+30
  54.     lib$="intuition.library"+Chr$(0)
  55.     *ibase.IntuitionBase=OpenLibrary_(&lib$,39)
  56.     CloseLibrary_(*ibase)
  57.  
  58.     If *ibase
  59.       v39=1
  60.     Else
  61.       *ibase.IntuitionBase=OpenLibrary_(&lib$,37)
  62.       CloseLibrary_(*ibase)
  63.     EndIf
  64.  
  65.     *fs=*ibase\FirstScreen
  66.  
  67.  
  68.  
  69.     left=*fs\LeftEdge
  70.     top=*fs\TopEdge
  71.     width=*fs\Width
  72.     height=*fs\Height
  73.     modeid=GetVPModeID_(*fs\ViewPort)
  74.  
  75.     depth=*fs\BitMap\Depth
  76.  
  77.     title$="BB.Mosaic.Screen"+Chr$(0)
  78.     newscreen\LeftEdge=left,top,width,height,depth
  79.     newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title$
  80.     tags\a=#SA_DisplayID
  81.     tags\b=modeid
  82.     tags\c=0
  83.     *myscreen=OpenScreenTagList_(newscreen,tags)
  84.     If *myscreen
  85.       *vp=*myscreen\ViewPort
  86.       *rp=*myscreen\RastPort
  87.       BltBitMap_ *fs\BitMap,0,0,*myscreen\BitMap,0,0,width,height,$C0,$FF,0
  88.       *cm=*fs\ViewPort\ColorMap
  89.       For i=0 To 2^depth
  90.         If v39
  91.           GetRGB32_ *cm,i,1,tab
  92.           SetRGB32_ *vp,i,tab\r,tab\g,tab\b
  93.         Else
  94.           c=GetRGB4_(*cm,i)
  95.           SetRGB4_ *vp,i,(c LSR 8) AND 15,(c LSR 4) AND 15,c AND 15
  96.         EndIf
  97.       Next i
  98.       ScreenToFront_ *myscreen
  99.       sizex=size
  100.       sizey=sizex*height/width
  101.       sizex2=sizex/2
  102.       sizey2=sizey/2
  103.       Repeat
  104.         VWait
  105.         For i=1 To speed
  106.           x=Rnd(width-sizex)+sizex2
  107.           y=Rnd(height-sizey)+sizey2
  108.           c=ReadPixel_(*rp,x,y)
  109.           If 1
  110.             SetAPen_ *rp,c
  111.             RectFill_ *rp,x-sizex2,y-sizey2,x+sizex2,y+sizey2
  112.             a+1
  113.           EndIf
  114.         Next i
  115.         If a>500000
  116.           BltBitMap_ *fs\BitMap,0,0,*myscreen\BitMap,0,0,width,height,$C0,$FF,0
  117.           a=0
  118.         EndIf
  119.  
  120.         *msg=GetMsg_(*port)
  121.       Until *msg
  122.  
  123.       CloseScreen_ *myscreen
  124.     EndIf
  125.     RemPort_ *port
  126.     DeleteMsgPort_ *port
  127.  
  128.   Case "INFO"
  129.     title$="Mosaic"+Chr$(0)
  130.     reqtext$="Mosaic - Module for BlitzBlank"+Chr$(10)
  131.     reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(10)+Chr$(10)
  132.     reqtext$+"Your actual screen will be turned into a mosaic."+Chr$(10)+Chr$(10)
  133.     reqtext$+"Choose the speed and size in the config-window."+Chr$(0)
  134.  
  135.     gadget$="OK"+Chr$(0)
  136.     easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
  137.     easy\es_Title=&title$
  138.     easy\es_TextFormat=&reqtext$
  139.     easy\es_GadgetFormat=&gadget$
  140.     EasyRequestArgs_ 0,easy,0,0
  141.   Case "CONFIG"
  142.     *myscreen=LockPubScreen_(0)
  143.     width=*myscreen\Width
  144.     height=*myscreen\Height
  145.     font=*myscreen\Font\ta_YSize
  146.     Gosub readconfig
  147.     WbToScreen 0
  148.     BorderPens 0,0
  149.     StringGadget 0,100,25,0,0,4,40
  150.     StringGadget 0,100,50,0,1,4,40
  151.     SetString 0,0,Str$(speed)
  152.     SetString 0,1,Str$(size)
  153.     Window 0,width/2-90,height/2-40,180,80,$100e,"Mosaic",1,2,0
  154.     stringborder{100,25,40,8}
  155.     stringborder{100,50,40,8}
  156.     WColour 2
  157.     WLocate 30,24-font
  158.     Print "Speed:"
  159.     WLocate 30,24-font+8
  160.     Print "(1-150)"
  161.     WLocate 30,49-font
  162.     Print "Size:"
  163.     WLocate 30,49-font+8
  164.     Print "(3-100)"
  165.     ActivateString 0,0
  166.     Repeat
  167.       ev=WaitEvent
  168.       If ev=$40
  169.         Select GadgetHit
  170.           Case 0
  171.             ActivateString 0,1
  172.           Case 1
  173.             e=1
  174.         End Select
  175.       EndIf
  176.     Until ev=$200 OR e
  177.     speed=Val(StringText$(0,0))
  178.     size=Val(StringText$(0,1))
  179.     Free Window 0
  180.     Gosub writeconfig
  181.     UnlockPubScreen_ 0,*myscreen
  182. End Select
  183.  
  184. End
  185.  
  186. .readconfig
  187. path$=Par$(9)
  188. For i=10 To NumPars
  189.   path$=path$+" "+Par$(i)
  190. Next i
  191. If ReadFile(0,path$+"BB.Modules.config")
  192.   FileInput 0
  193.   While NOT Eof(0)
  194.     If Edit$(100)="*** Mosaic ***"
  195.       speed=Val(Edit$(5))
  196.       size=Val(Edit$(5))
  197.     EndIf
  198.   Wend
  199.   DefaultInput
  200.   CloseFile 0
  201. EndIf
  202. Gosub checkval
  203. Return
  204.  
  205.  
  206. .writeconfig
  207. Gosub checkval
  208. If ReadFile(0,path$+"BB.Modules.config")
  209.   If WriteFile(1,path$+"BB.Modules.temp")
  210.     FileInput 0
  211.     FileOutput 1
  212.     While NOT Eof(0)
  213.       f$=Edit$(100)
  214.       If f$="*** Mosaic ***"
  215.         Repeat
  216.           f2$=Edit$(100)
  217.         Until Eof(0) OR Left$(f2$,3)="***"
  218.         If NOT Eof(0) Then NPrint f2$
  219.       Else
  220.         NPrint f$
  221.       EndIf
  222.     Wend
  223.     CloseFile 1
  224.   EndIf
  225.   CloseFile 0
  226. EndIf
  227. KillFile path$+"BB.Modules.config"
  228. f$=path$+"BB.Modules.temp"+Chr$(0)
  229. f2$=path$+"BB.Modules.config"+Chr$(0)
  230. Rename_ &f$,&f2$
  231. If OpenFile(0,path$+"BB.Modules.config")
  232.   FileOutput 0
  233.   FileSeek 0,Lof(0)
  234.   NPrint "*** Mosaic ***"
  235.   NPrint speed
  236.   NPrint size
  237.   CloseFile 0
  238. EndIf
  239. Return
  240.  
  241. .checkval
  242. If speed<1 Then speed=100
  243. If speed>150 Then speed=100
  244. If size<3 Then size=8
  245. If size>100 Then size=8
  246. Return
  247.  
  248.