WBStartup .Variables CPUminimum.b=Processor PrefDisplayDepth.w=8 *ScrVP._ViewPort=0 IsAGA.b=False Multitasking.b=True ; Default Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers) .Prefs PrefDisplayID.l=$0 ; Default (unspecified, as it may possibly retarget (doublescan etc)) ;PrefDisplayID.l=$21000 ; AGA Lores PAL 320x256 non-laced single-scan 50Hz ;PrefDisplayID.l=$A1000 ; AGA Lores DoublePAL 384x275 non-laced double-scan 48Hz ;PrefDisplayID.l=$89000 ; AGA Lores Super72 384x290 non-laced single-scan 71Hz ;PrefDisplayID.l=$11000 ; AGA Lores NTSC 320x200 non-laced single-scan 60Hz ;PrefDisplayID.l=$39000 ; AGA Lores Multiscan 320x240 double-scan 58Hz ;PrefDisplayID.l=$59000 ; AGA Lores HighGFX 512x250 non-laced single-scan 54Hz ;PrefDisplayID.l=$69000 ; AGA Lores Euro72 320x200 non-laced double-scan 69Hz ;PrefDisplayID.l=$91000 ; AGA Lores DoubleNTSC 384x227 non-laced double-scan 58Hz ;PrefDisplayID.l=$29004 ; AGA PAL 640x400 Hires laced single-scan 50Hz ;PrefDisplayID.l=$19004 ; AGA NTSC 640x400 Hires laced single-scan 60Hz ;PrefDisplayID.l=$39024 ; AGA Multiscan 640x400 Hires non-laced single-scan 58Hz ;PrefDisplayID.l=$69024 ; AGA Euro72 640x400 Hires non-laced single-scan 69Hz ;PrefDisplayID.l=$A9004 ; AGA DoublePAL 640x400 Hires non-laced double-scan 48Hz ;PrefDisplayID.l=$99004 ; AGA DoubleNTSC 640x400 Hires non-laced double-scan 58Hz PrefDisplayWidth.w=320 PrefDisplayHeight.w=240 PrefDisplayBuffering.b=1 ; 1..3 ;If Joyb(0)=0 AND Joyb(1)=0 Then Goto PrefsSkip #DTAG_DISP=$80000000 #DTAG_DIMS=$80001000 #DTAG_MNTR=$80002000 #DTAG_NAME=$80003000 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 SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0 SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300 SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,600 SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000 SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8 SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1 SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1 SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350 SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50 SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0 SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,1 SMRtags(14)\ti_Tag=#ASLSM_DoWidth,1 SMRtags(15)\ti_Tag=#ASLSM_DoHeight,1 SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook 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 PrefsSkip ;************************************************************************* ; 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. 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 PrefsSkip .Display Statement Permit{} ;Permit multitasking, only if it is globally intended SHARED Multitasking.b If Multitasking Then Permit_ End Statement Statement Forbid{} ;Disable multitasking, if it isn't globally intended SHARED Multitasking.b If Multitasking Then Forbid_ End Statement Statement Multitasking{State.b} ;Toggle global multitasking on or off. SHARED Multitasking.b If State If Multitasking=False Then Permit_ Else If Multitasking Then Forbid_ EndIf Multitasking=State End Statement Function.b InitDisplay{Title$} ;Creates a display ;Title$=The screen title (not displayed) SHARED PrefDisplayHeight.w,PrefDisplayID.l,PrefDisplayBuffering.b,*ScrVP._ViewPort,IsAGA.b SHARED PrefDisplayLeft.w,PrefDisplayTop.w SHARED PrefDisplayDepth.w,PrefDisplayWidth.w,CPUminimum.b SHARED PlanarBuf() ;Open a test screen first to a) test for AGA or GFX-Card, and b) because the dimensions might be ;too large to open a chipram screen, and the dimensions for AGA have not yet been reduced to within limits 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,PrefDisplayDepth 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,True ScrTags(10)\ti_Tag=#SA_Draggable,False ScrTags(11)\ti_Tag=#SA_AutoScroll,True ScrTags(12)\ti_Tag=#TAG_DONE,0 ScrTags(13)\ti_Tag=#TAG_DONE,0 UsedChip.l=(320 LSR 3)*PrefDisplayDepth*240 ; With test params FreeChip.l=AvailMem_(#MEMF_CHIP) Forbid{} If ScreenTags(0,Title$,&ScrTags(0))<>0 ; Test for GFX-Card or AGA NowChip.l=AvailMem_(#MEMF_CHIP) Permit{} If FreeChip-NowChip0 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 PrefDisplayDepth-1 *TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset Next DLoop Next Loop Else Function Return False EndIf Else ; AGA screen IsAGA=True PrefDisplayWidth AND $FFC0 ; For AGA, width to nearest 64 ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers ScrTags(8)\ti_Tag=#SA_DClip,&Rect ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID Forbid{} VWait 5 ; seems to be necessary (safer) Free Screen 0 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) ; Chip bitmap Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's If Memory<>0 CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,PrefDisplayDepth,Memory 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{} EndIf 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_ Use Palette 0 Menus Off If *ScrVP\DHeight<>PrefDisplayHeight Forbid{} *Scr\Height=PrefDisplayHeight ; Enforce y clipping Permit{} EndIf ScreenToFront_ *Scr Function Return True Else Permit{} Function Return False EndIf End Function .Main DEFTYPE.w MaxLen ASLfile$=256 MaxLen ASLpath$=256 ASLpath$="Data:Pictures/IFF" WbToScreen 0 Pic$=ASLFileRequest$("Choose an ILBM picture)",ASLpath$,ASLfile$) ILBMInfo Pic$ ILBMWid=ILBMWidth If ILBMWid MOD 16<>0 Then ILBMWid=(ILBMWid+16) AND $FFFFFFF0 ILBMWid=Max(ILBMWid,320) ILBMHig=ILBMHeight InitBank 0,ILBMWid*ILBMHig,$0 CludgeBitMap 4,ILBMWid,ILBMHig,8,Bank(0) CPUCls 4 LoadBitMap 4,Pic$,0 MBitmap 0,ILBMWid,ILBMHig MPlanar16ToBitmap 0,Bank(0) If InitDisplay{"Game"}=False Then Goto Finish ShowPalette 0 Multitasking{On} buf.b=0 its.l=0 xmult.q=(ILBMWid-PrefDisplayWidth)/PrefDisplayWidth ymult.q=(ILBMHig-PrefDisplayHeight)/PrefDisplayHeight LandX.w=0 LandY.w=0 Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight,ILBMWid,CPUminimum,PrefDisplayWidth,PrefDisplayHeight MCPU CPUminimum If ExecVersion<40 If MBitmap(1,PrefDisplayWidth,PrefDisplayHeight+1)=0 Then Goto Finish EndIf *Ras.RasInfo=*ScrVP\RasInfo *RP._RastPort=RastPort(0) MCludgeBitmap 10,PrefDisplayWidth,PrefDisplayHeight,*RP\_BitMap\Planes ResetTimer While Joyb(0)<>1 AND Joyb(1)=0 If Joyb(0)=2 its=0 ResetTimer EndIf If PrefDisplayBuffering>1 buf+1 If buf=PrefDisplayBuffering Then buf=0 EndIf LandX.w=SMouseX*xmult LandY=SMouseY*ymult LandX=Min(LandX,ILBMWid-PrefDisplayWidth) LandY=Min(LandY,ILBMHig-PrefDisplayHeight) If IsAGA Mc2p MBitmapPtr(LandX,LandY),PlanarBuf(buf) ShowBitMap buf Else *ScrVP\DyOffset=buf*PrefDisplayHeight ; *Ras\RyOffset=buf*PrefDisplayHeight ScrollVPort_ *ScrVP *RP._RastPort=RastPort(buf) ; If ExecVersion<40 ; MBlockScroll LandX,LandY,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; If LandX MOD 16>0 ; MScroll PrefDisplayWidth+(LandX AND $FFF0),LandY,LandX MOD 16,PrefDisplayHeight,PrefDisplayWidth,0,0 ; EndIf ; WritePixelArray8_ *RP,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(LandX MOD 16,0,1),0 ;; For Y=0 To PrefDisplayHeight-1 ;; WritePixelLine8_ *RP,0,Y,PrefDisplayWidth-1,MBitmapPtr(LandX,LandY+Y,0),0 ;; Next Y ; Else ; WriteChunkyPixels_ *RP,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(LandX,LandY,0),ILBMWid ; EndIf MUseBitmap 10 MBlockScroll LandX,LandY,PrefDisplayWidth,PrefDisplayHeight,0,0,0 EndIf its+1 Wend t=Timer t=Max(t,1) its=Max(its,1) a.q=50.0/(t/its) WBenchToFront_ VWait 20 FindScreen 1 Window 2,16,16,500,100,0,"Test results",1,0 WindowOutput 2 NPrint a," frames per second" NPrint " " NPrint "Press mouse/joy button..." Repeat Until Joyb(0)<>0 OR Joyb(1)<>0 Finish: Multitasking{On} End