.Demo
WBStartup

DEFTYPE.w
MCPU Processor
Mc2pCPUmode Processor

*ScrVP._ViewPort=0
IsAGA.b=True ; Defaults to AGA
Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)

PrefDisplayID.l=$0 ; Default ModeID (Pal:LowRes, or promotes to DoublePal:LowRes)
PrefDisplayWidth.w=320 ; Default Width
PrefDisplayHeight.w=240 ; Default Height
PrefDisplayBuffering.b=3 ; 1..3. 1=Singlebuffered, 2=Doublebuffered, 3=Triplebuffered
PrefDisplayMethod.b=1 ; 0=WritePixelArray8/WriteChunkyPixels, 1=MBlockScroll, 2=WritePixelArray(CGFX)
PrefCGFXLock.b=True ; Wether when Method=1, CGFX LockBitmap will be attempted for safety and to get base address
OSVersion.w=ExecVersion
CGFXAvail.b=False ; Default

#DTAG_DISP=$80000000
#DTAG_DIMS=$80001000
#DTAG_MNTR=$80002000
#DTAG_NAME=$80003000
#LBMI_BASEADDRESS=$84001007
#DIPF_IS_FOREIGN=$80000000
#DIPF_IS_ECS=$00000010
#DIPF_IS_AGA=$00010000

If Joyb(0)=0 AND Joyb(1)=0 Then Goto SkipSMR

NEWTYPE.SMode
  DID.l
  DWidth.l
  DHeight.l
  DDepth.w
  DType.w
End NEWTYPE

DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
myhook\h_Entry=?hook
MOVE.l a5,globalbase
funcret.l=0

Dim SMRtags.TagItem(17)
SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160 ; X coord of requester
SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0 ; Y coord of requester
SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300 ; Width of requester
SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,400 ; Height of requester
SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000 ; Default ModeID (Pal:LowRes)
SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8 ; Default depth (8-bit usually)
SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1 ; Default overscan type (Text)
SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1 ; Info window?
SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350 ; X coord of info window
SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50 ; Y coord of info window
SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0 ; Depth gadget? (Generally NO for chunky 8-bit)
SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,0 ; Overscan gadget?
SMRtags(14)\ti_Tag=#ASLSM_DoWidth,0 ; Width gadget?
SMRtags(15)\ti_Tag=#ASLSM_DoHeight,0 ; Height gadget?
SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook ; Address of callback hook routine
SMRtags(17)\ti_Tag=#TAG_DONE,0

*sreq.SMode=0
*sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)

If ok<>0
  PrefDisplayID.l=*sreq\DID
  PrefDisplayWidth.w=*sreq\DWidth
  PrefDisplayHeight.w=*sreq\DHeight
EndIf
If (*sreq) Then FreeAslRequest_(*sreq)

Goto SkipSMR

;*************************************************************************
; This is the statement that the hook will call.  Put the label before
; the statement you want to jump to.
Runerrsoff
hook_jump:
Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
  ; We're inside the hook, and supposedly we should be able to do whatever
  ; we want.
  ; Filter modeID's here
  SHARED funcret.l
  DEFTYPE.DisplayInfo DisInfoBuf
  DEFTYPE.DimensionInfo DimInfoBuf
  DEFTYPE.MonitorInfo MonInfoBuf
  DEFTYPE.NameInfo NamInfoBuf
  ;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
  IDhandle.l=FindDisplayInfo_(modeID)
  GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
  GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
  GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
  ;Do tests. True=Mode is valid, False=mode is invalid.
  ;See newtypes for DisplayInfo,DimensionInfo,MonitorInfo and NameInfo for things to further test
  If DimInfoBuf\MaxDepth<>8
    ;No true-colour modes, only 8-bit
    funcret=False
  Else
    funcret=True
  EndIf
End Statement

;**********************
; Hook
Macro goto_hook
  JSR `1+6
End Macro

globalbase: Dc.l 0

hook: ;This hook is called by the filter hook callback from screenmode requester, per item
; Store registers
MOVEM.l   d1-d7/a0-a6,-(a7) ; Not d0!

; Put parameters into dregs ready for a statement
MOVE.l    a0,d0
MOVE.l    a1,d1
MOVE.l    a2,d2

; Get global variable base
MOVE.l    globalbase,a5

; Goto hook statement
!goto_hook{hook_jump}

GetReg d0,funcret ; return accept/discard

; Restore registers
MOVEM.l   (a7)+,d1-d7/a0-a6 ; Not d0!

RTS
;**********************

Runerrson
.SkipSMR

Function.b CheckLib{Lib$,LibVer}
;Returns wether a specific library is available or not
  *lib.l=OpenLibrary_(&Lib$,LibVer)
  If *lib
    CloseLibrary_ *lib
    Function Return True
  Else
    Function Return False
  EndIf
End Function

Function.b InitDisplay{Title$}
;Creates a display for AGA or Graphics-Card output
;Title$=The screen title (not displayed)
  SHARED PrefDisplayWidth,PrefDisplayHeight,PrefDisplayBuffering
  SHARED *ScrVP,PrefDisplayID,IsAGA,PlanarBuf(),CGFXAvail

  ;Setup a test screen
  Dim ScrTags.TagItem(13)
  Rect.Rectangle\MinX=0,0,320,240 ; For test
  ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
  ScrTags(1)\ti_Tag=#SA_Height,240; For test
  ScrTags(2)\ti_Tag=#SA_Depth,8
  ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  ScrTags(4)\ti_Tag=#SA_Type,$F
  ScrTags(5)\ti_Tag=#SA_Quiet,True
  ScrTags(6)\ti_Tag=#SA_ShowTitle,False
  ScrTags(7)\ti_Tag=#SA_Behind,True
  ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
  ScrTags(9)\ti_Tag=#SA_Exclusive,False
  ScrTags(10)\ti_Tag=#SA_Draggable,False
  ScrTags(11)\ti_Tag=#SA_AutoScroll,False
  ScrTags(12)\ti_Tag=#TAG_DONE,0
  ScrTags(13)\ti_Tag=#TAG_DONE,0

  If CGFXAvail
    IsAGA=1-(IsCyberModeID_(PrefDisplayID))
  Else
    ; Need to do a test
    UsedChip.l=320*240 ; With test params (depth 8)
    FreeChip.l=AvailMem_(#MEMF_CHIP)
    Forbid_
    If ScreenTags(0,Title$,&ScrTags(0))
      NowChip.l=AvailMem_(#MEMF_CHIP)
      Permit_
      If FreeChip-NowChip<UsedChip
        IsAGA=False
      Else
        IsAGA=True
      EndIf
      VWait 5
      Free Screen 0
      VWait 5
    Else
      ; Failed to open, so resort to fixed AGA LowRes
      Permit_
      IsAGA=True
      PrefDisplayID=0
      PrefDisplayWidth=320
      PrefDisplayHeight=240
    EndIf
  EndIf

  If IsAGA
    PrefDisplayWidth AND $FFC0 ; Multiples of 64 for AGA
  Else
    PrefDisplayWidth AND $FFF0 ; Multiples of 16 for graphics card
  EndIf
  ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
  Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
  ScrTags(8)\ti_Tag=#SA_DClip,&Rect

  If IsAGA
    ; AGA display
    ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
    ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
    Forbid_
    For Loop.w=0 To PrefDisplayBuffering-1
      If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
      If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
        Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chipram bitmap
        Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
        If Memory
          CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,8,Memory ; Depth 8
          If Loop=0
            ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
            If ScreenTags(0,Title$,&ScrTags(0))=0
              Permit_
              Function Return False
            EndIf
          EndIf
If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
          Menus Off
        Else
          Permit_
          Function Return False
        EndIf
      Else
        Permit_
        Function Return False
      EndIf
      PlanarBuf(Loop)=Memory
    Next Loop
    Permit_
  Else
    ; Graphics-card display
    ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
    If ScreenTags(0,Title$,&ScrTags(0))
      For Loop.w=0 To PrefDisplayBuffering-1
        If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
        Menus Off
        ScreensBitMap 0,Loop
        *TmpBmp.bitmap=Addr BitMap(Loop)
        Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
        For DLoop.w=0 To 8-1 ; Depth of 8
          *TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
        Next DLoop
      Next Loop
    Else
      Function Return False
    EndIf
  EndIf

  If Peek.l(Addr Screen(0))
    DEFTYPE.DimensionInfo DimInfoBuf
    GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
    PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
    PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
    *Scr._Screen=Peek.l(Addr Screen(0))
    *ScrVP=ViewPort(0)
    *ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
    ScrollVPort_ *ScrVP
    RethinkDisplay_
    Menus Off
    If *ScrVP\DHeight<>PrefDisplayHeight
      Forbid_
      *Scr\Height=PrefDisplayHeight ; Enforce y clipping
      Permit_
    EndIf
    ScreenToFront_ *Scr
    Function Return True
  Else
    Function Return False
  EndIf
End Function

.Main
CGFXAvail.b=CheckLib{"cybergraphics.library",0}
If CGFXAvail=False AND PrefDisplayMethod=2 Then PrefDisplayMethod=0
InitPalette 0,256
For c=1 To 255 : AGAPalRGB 0,c,Rnd(255),Rnd(255),Rnd(255) : Next c
If InitDisplay{"Game"}=False Then Goto Finish
InitBank 0,320*240,$10000
CludgeBitMap 4,320,240,8,Bank(0)
LoadBitMap 4,"Snow.256",0
LoadRGB32_ *ScrVP,Peek.l(Addr Palette(0))
If PrefDisplayMethod=0 AND OSVersion<40
  MBitmap 5,PrefDisplayWidth,PrefDisplayHeight ; Temporary bitmap to allow WPA8 instead of WPL8's
EndIf

MBitmap 0,PrefDisplayWidth,PrefDisplayHeight
If IsAGA Then Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight
MPlanar16ToBitmap 0,Bank(0),320,240,320,240

.Table
;Set up movement table
#Objects=5000
Dim pnt.l(#Objects)
Dim direction.l(#Objects)
Dim old.b(#Objects)
For obj=0 To #Objects-1
  pnt(obj)=MBitmapPtr(0)+Rnd(PrefDisplayWidth-1)+(Rnd(PrefDisplayHeight-1)*MBitmapWidth(0))
  direction(obj)=Rnd(3)+2+((Rnd(3)+1)*MBitmapWidth(0))
Next obj
Dim rand.l(#Objects*2)
For obj=0 To #Objects*2-1
  rand(obj)=(-Rnd(3))+((-Rnd(2))*MBitmapWidth(0))
Next obj

MParticleFormat 1

.Loop
buf.b=0
its.l=0
cnt.b=0
ResetTimer
While Joyb(0)<>1 AND Joyb(1)=0

  If Joyb(0)=2 Then VWait

  MAddToParticles &pnt(0),#Objects,&direction(0),&rand(Rnd(#Objects))
  MWrapParticles &pnt(0),#Objects
  MGrabParticlesAndPlot &pnt(0),#Objects,&old(0),1;7;11

  ;Display
  If IsAGA
    Mc2p MBitmapPtr(0),PlanarBuf(buf)
    If PrefDisplayBuffering>1
      ShowBitMap buf
      buf+1
      If buf=PrefDisplayBuffering Then buf=0
    EndIf
  Else
    *RP0._RastPort=RastPort(0)
    Select PrefDisplayMethod

      Case 0 ; WritePixelArray8
      If PrefDisplayBuffering>1
        *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
        If OSVersion<40
          MUseBitmap 5
          MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
          MUseBitmap 0
          WritePixelArray8_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
        Else
          WriteChunkyPixels_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
        EndIf
        ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
        If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
      Else
        If OSVersion<40
          MUseBitmap5
          MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
          MUseBitmap 0
          WritePixelArray8_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
        Else
          WriteChunkyPixels_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
        EndIf
      EndIf

      Case 1 ; MBlockScroll
      If CGFXAvail AND PrefCGFXLock
        Dim CGFXTags.TagItem(1)
        CGFXData.l=0
        CGFXTags(0)\ti_Tag=#LBMI_BASEADDRESS,&CGFXData
        CGFXTags(1)\ti_Tag=#TAG_DONE,0
        LockHandle.l=LockBitMapTagList_(*RP0\_BitMap,&CGFXTags(0))
        MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,CGFXData
      Else
        MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP0\_BitMap\Planes
      EndIf
      If PrefDisplayBuffering>1
        *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
        MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight+(cnt*PrefDisplayHeight),0 ; From modulo bitmap
        ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
        If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
      Else
        MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From modulo bitmap
      EndIf
      MUseBitmap 0
      If CGFXAvail AND (LockHandle<>0) AND PrefCGFXLock Then UnLockBitMap_ LockHandle

      Case 2 ; CGFXWriteChunkyPixels
      If PrefDisplayBuffering>1
        *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
        WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP1,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
        ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
        If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
      Else
        WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
      EndIf
    End Select
  EndIf

  MDrawParticles &pnt(0),#Objects,&old(0)

  its+1
Wend

;Report
t=Timer
t=Max(t,1)
its=Max(its,1)
a.q=50.0/(t/its)
WBenchToFront_
WbToScreen 1
Window 2,16,16,300,40,0,"Test results",1,0
WindowOutput 2
NPrint a," frames per second"
NPrint " "
NPrint "Press mouse/joy button..."
VWait 20
Repeat
Until Joyb(0)<>0 OR Joyb(1)<>0

Finish:
End