;BB.Pyro - Blanker-module for BlitzBlank ;Copyright 1993 by Thomas Boerkel CloseEd NEWTYPE.spritedata a.w b c d e f End NEWTYPE NEWTYPE.tags a.l b c d e f End NEWTYPE DEFTYPE.spritedata *sprdata DEFTYPE.Screen *myscreen,*myscreen2 DEFTYPE.ColorMap *cm DEFTYPE.NewScreen newscreen DEFTYPE.Window *mywindow DEFTYPE.NewWindow newwindow DEFTYPE.Message *msg DEFTYPE.MsgPort *port DEFTYPE.tags tags Statement stringborder{x,y,w,h} Wline x+1,y+h+2,x+1,y,x+w+8,y,1 Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1 Wline x,y+h+3,x,y,1 Wline x+w+11,y-1,x+w+11,y+h+4,1 Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2 Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2 Wline x-2,y+h+4,x-2,y-1,2 Wline x+w+8,y+1,x+w+8,y+h+2,2 End Statement Select Par$(1) Case "BLANK" name$="BB.BlankModule"+Chr$(0) *port=CreateMsgPort_() *port\mp_Node\ln_Name=&name$ *port\mp_Node\ln_Pri=1 AddPort_ *port n=0 Gosub readconfig SetTaskPri_ FindTask_(0),Val(Par$(8)) Dim xf(n+1,9) Dim yf(n+1,9) Dim xk(2,n+1,9) Dim yk(2,n+1,9) Dim wg(9) Dim va(n+1) Dim xa(n+1) Dim t(n+1) Dim t2(n+1) Dim et(n+1) Dim sinwb(n+1) Dim coswb(n+1) Dim x(2,n+1) Dim y(2,n+1) Dim f(n+1) Dim c(n+1) *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR) newwindow\LeftEdge=0,0,1,1 newwindow\Flags=#WFLG_ACTIVATE newwindow\FirstGadget=0,0,0,0,0,-1,-1,-1,-1,#WBENCHSCREEN *mywindow=OpenWindow_(newwindow) VWait SetPointer_ *mywindow,*sprdata,0,0,0,0 width.l=Val(Par$(2)) height.l=Val(Par$(3)) mode.l=Val(Par$(4)) monitor.l=Val(Par$(5)) depth.w=Val(Par$(6)) colors.w=2^depth Dim *vp.ViewPort(2) Dim *rp.RastPort(2) title1$="BB.Pyro0"+Chr$(0) newscreen\LeftEdge=0,0,width,height,depth newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title1$ tags\a=#SA_DisplayID tags\b=$10000*monitor+mode tags\c=0 *myscreen=OpenScreenTagList_(newscreen,tags) If db title2$="BB.Pyro1"+Chr$(0) newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title2$ *myscreen2=OpenScreenTagList_(newscreen,tags) EndIf If *myscreen AND (db=0 OR *myscreen2) *vp(0)=*myscreen\ViewPort *rp(0)=*myscreen\RastPort If db *vp(1)=*myscreen2\ViewPort *rp(1)=*myscreen2\RastPort EndIf For i=0 To db SetRGB4_ *vp(i),0,0,0,0 SetRGB4_ *vp(i),1,15,15,0 If colors>2 SetRGB4_ *vp(i),2,0,10,15 SetRGB4_ *vp(i),3,15,7,0 If colors>4 SetRGB4_ *vp(i),4,0,15,0 SetRGB4_ *vp(i),5,15,3,8 SetRGB4_ *vp(i),6,15,5,15 SetRGB4_ *vp(i),7,5,15,8 If colors>8 SetRGB4_ *vp(i),8,15,0,0 SetRGB4_ *vp(i),9,0,15,0 SetRGB4_ *vp(i),10,0,0,15 SetRGB4_ *vp(i),11,0,7,15 SetRGB4_ *vp(i),12,8,15,3 SetRGB4_ *vp(i),13,15,10,0 SetRGB4_ *vp(i),14,7,0,15 SetRGB4_ *vp(i),15,3,8,15 EndIf EndIf EndIf SetAPen_ *rp(i),0 RectFill_ *rp(i),0,0,width-1,height-1 Next i If db=0 ScreenToFront_ *myscreen EndIf g=0.1 vamax=Sqr(2*(height-1)*g)/Sin(90*Pi/180) ve=vamax/4 For i=1 To 6 wg(i)=Pi/3*i Next i Dim si.q(631) Dim co.q(631) For i=0 To 630 f=i/100 si(i)=Sin(f) co(i)=Cos(f) Next i Repeat If db Else VWait EndIf For j=1 To n If f(j)=0 f(j)=1 wa=Rnd(40)+70 wb=wa*Pi/180 sinwb(j)=si(Int(wb*100)) coswb(j)=co(Int(wb*100)) xa(j)=width/2 va(j)=Rnd(vamax/3)+vamax/3*2 et(j)=Int(Rnd(40)+(va(j)*sinwb(j))/g) c(j)=Rnd(colors-1)+1 Else If t(j)15 For i=1 To 6 SetAPen_ *rp(s),0 WritePixel_ *rp(s),xk(s,j,i),yk(s,j,i) WritePixel_ *rp(s),xk(s,j,i)+1,yk(s,j,i) Next i If db For i=1 To 6 SetAPen_ *rp(1-s),0 WritePixel_ *rp(1-s),xk(1-s,j,i),yk(1-s,j,i) WritePixel_ *rp(1-s),xk(1-s,j,i)+1,yk(1-s,j,i) Next i EndIf t2(j)=0 t(j)=0 et(j)=0 f(j)=0 EndIf If t2(j)=15 t2(j)=16 EndIf EndIf Next j *msg=GetMsg_(*port) If db If s ScreenToFront_ *myscreen2 Else ScreenToFront_ *myscreen EndIf s=1-s EndIf Until *msg CloseScreen_ *myscreen If db CloseScreen_ *myscreen2 EndIf EndIf ClearPointer_ *mywindow CloseWindow_ *mywindow FreeMem_ *sprdata,SizeOf.spritedata RemPort_ *port DeleteMsgPort_ *port Case "INFO" title$="Pyro"+Chr$(0) reqtext$="Pyro - Module for BlitzBlank"+Chr$(10) reqtext$=reqtext$+Chr$(169)+" 1993 by Thomas Brkel + Wolfgang Brkel"+Chr$(0) gadget$="OK"+Chr$(0) easy.EasyStruct\es_StructSize=SizeOf.EasyStruct easy\es_Title=&title$ easy\es_TextFormat=&reqtext$ easy\es_GadgetFormat=&gadget$ EasyRequestArgs_ 0,easy,0,0 Case "CONFIG" *myscreen=LockPubScreen_(0) width=*myscreen\Width height=*myscreen\Height font=*myscreen\Font\ta_YSize Gosub readconfig WbToScreen 0 BorderPens 0,0 StringGadget 0,100,45,0,0,4,30 BorderPens 2,1 TextGadget 0,37,20,1,1,"Doublebuffer" If db Toggle 0,1,On EndIf Window 0,width/2-90,height/2-35,180,70,$100e,"Pyro",1,2,0 stringborder{100,45,30,8} WColour 2 WLocate 32,44-font Print "Flares:" WLocate 32,44-font+8 Print "(1-50)" SetString 0,0,Str$(n) ActivateString 0,0 Repeat ev=WaitEvent Until ev=$200 OR (ev=$40 AND GadgetHit=0) n=Val(StringText$(0,0)) If GadgetStatus(0,1) db=1 Else db=0 EndIf Free Window 0 Gosub writeconfig UnlockPubScreen_ 0,*myscreen End Select End .readconfig path$=Par$(9) For i=10 To NumPars path$=path$+" "+Par$(i) Next i If ReadFile(0,path$+"BB.Modules.config") FileInput 0 While NOT Eof(0) If Edit$(100)="*** Pyro ***" n=Edit(5) db=Edit(5) EndIf Wend DefaultInput CloseFile 0 EndIf Gosub checkval Return .writeconfig Gosub checkval If ReadFile(0,path$+"BB.Modules.config") If WriteFile(1,path$+"BB.Modules.temp") FileInput 0 FileOutput 1 While NOT Eof(0) f$=Edit$(100) If f$="*** Pyro ***" Repeat f2$=Edit$(100) Until Eof(0) OR Left$(f2$,3)="***" If NOT Eof(0) Then NPrint f2$ Else NPrint f$ EndIf Wend CloseFile 1 EndIf CloseFile 0 EndIf KillFile path$+"BB.Modules.config" f$=path$+"BB.Modules.temp"+Chr$(0) f2$=path$+"BB.Modules.config"+Chr$(0) Rename_ &f$,&f2$ If OpenFile(0,path$+"BB.Modules.config") FileOutput 0 FileSeek 0,Lof(0) NPrint "*** Pyro ***" NPrint n NPrint db CloseFile 0 EndIf Return .checkval If n<1 Then n=1 If n>50 Then n=50 If db<0 Then db=0 If db>1 Then db=1 Return