;BB.Fade - Blanker-module for BlitzBlank
;Copyright 1993 by Thomas Boerkel

CloseEd

NEWTYPE.spritedata
a.w
b
c
d
e
f
End NEWTYPE

NEWTYPE.tab
a.w
c
r.l
g
b
e
End NEWTYPE

NEWTYPE.rgb
r.l
g
b
End NEWTYPE

DEFTYPE.spritedata *sprdata
DEFTYPE.SimpleSprite spr

DEFTYPE.Screen *myscreen,*firstscreen
DEFTYPE.ViewPort *vp
DEFTYPE.ColorMap *cm
DEFTYPE.Message *msg
DEFTYPE.MsgPort *port
DEFTYPE.tab p
DEFTYPE.l



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



Statement set{n,r,g,b}
SHARED *vp.ViewPort,p.tab
p\a=1
p\c=n
p\r=r+256*r+65536*r+16777216*r
p\g=g+256*g+65536*g+16777216*g
p\b=b+256*b+65536*b+16777216*b
LoadRGB32_ *vp,p
End Statement

Select Par$(1)
  Case "BLANK"

    *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR)

    name$="BB.BlankModule"+Chr$(0)
    *port=CreateMsgPort_()
    *port\mp_Node\ln_Name=&name$
    *port\mp_Node\ln_Pri=1
    AddPort_ *port

    Gosub readconfig

    lib$="intuition.library"+Chr$(0)
    *ibase.IntuitionBase=OpenLibrary_(&lib$,39)
    CloseLibrary_(*ibase)
    If *ibase
      v39=1
    Else
      *ibase.IntuitionBase=OpenLibrary_(&lib$,37)
      CloseLibrary_(*ibase)
    EndIf
    *firstscreen=*ibase\FirstScreen

    VWait
    ChangeSprite_ 0,spr,*sprdata

    depth=*firstscreen\BitMap\Depth
    colors=2^depth
    *vp=*firstscreen\ViewPort
    *cm=*vp\ColorMap

    If v39
      Dim pal.rgb(colors)
      Dim col.l(colors*3+3)
      col(0)=colors LSL 16
      USEPATH pal(i)
    Else
      Dim pal37(colors)
    EndIf

    For i=0 To colors-1
      If v39
        GetRGB32_ *cm,i,1,pal(i)
        \r=\r AND 255
        \g=\g AND 255
        \b=\b AND 255
      Else
        pal37(i)=GetRGB4_(*cm,i)
      EndIf
    Next i


    For j=100 To final Step -(depth/3+1)
      For i=0 To colors-1
        If v39
          r=\r*j/100
          g=\g*j/100
          b=\b*j/100
          col(1+i*3)=r|r LSL 8|r LSL 16|r LSL 24
          col(2+i*3)=g|g LSL 8|g LSL 16|g LSL 24
          col(3+i*3)=b|b LSL 8|b LSL 16|b LSL 24
        Else
          SetRGB4_ *vp,i,(pal37(i)LSR8 AND 15)*j/100,(pal37(i)LSR4 AND 15)*j/100,(pal37(i) AND 15)*j/100
        EndIf
      Next i
      If v39
        LoadRGB32_ *vp,&col(0)
      EndIf
      *msg=GetMsg_(*port)
      If *msg
        j=0
      EndIf
      VWait
    Next j

    While *msg=0
      WaitPort_ *port
      *msg=GetMsg_(*port)
    Wend

    For i=0 To colors-1
      If v39
        col(1+i*3)=\r|\r LSL 8|\r LSL 16|\r LSL 24
        col(2+i*3)=\g|\g LSL 8|\g LSL 16|\g LSL 24
        col(3+i*3)=\b|\b LSL 8|\b LSL 16|\b LSL 24
      Else
        SetRGB4_ *vp,i,pal37(i)LSR8 AND 15,pal37(i)LSR4 AND 15,pal37(i) AND 15
      EndIf
    Next i

    If v39
      LoadRGB32_ *vp,&col(0)
    EndIf
    RemPort_ *port
    DeleteMsgPort_ *port
    FreeMem_ *sprdata,SizeOf.spritedata
    End

  Case "INFO"

    title$="Fade"+Chr$(0)
    reqtext$="Fade - Module for BlitzBlank"+Chr$(10)
    reqtext$=reqtext$+Chr$(169)+" 1993 by Thomas 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,25,0,0,3,30
    SetString 0,0,Str$(final)
    Window 0,width/2-90,height/2-25,180,50,$100e,"Fade",1,2,0
    stringborder{100,25,30,8}
    WColour 2
    WLocate 30,24-font
    Print "Fade to"
    WLocate 30,24-font+8
    Print "(0-99)"

    ActivateString 0,0
    Repeat
      ev=WaitEvent
    Until ev=$200 OR ev=$40
    final=Val(StringText$(0,0))
    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)="*** Fade ***"
      final=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$="*** Fade ***"
        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 "*** Fade ***"
  NPrint final
  CloseFile 0
EndIf
Return

.checkval
If final<0 Then final=0
If final>99 Then final=99
Return