APDL Public Domain 1

home *** CD-ROM | disk | FTP | other *** search

/ APDL Public Domain 1 / APDL_PD1A.iso / customise / welcomea / !WelcomeA / Source (.txt) < prev next >

Wrap

RISC OS BBC BASIC V Source | 1993-06-28 | 22.5 KB | 626 lines

>Source Create a module that provides an alternative desktop Welcome A sprite spinning from a random position to the center of the screen We use floating point because the parameters to PutSpriteTransformed are in draw units (1/256 OS) and multiplying would otherwise need 64-bit arithmetic Now has compressed picture (saves 4K) & only claims workspace while animating (saving about 200 bytes!) Assumes sprite needs no pixtrans to plot. Ie YOU must ensure sprites has same bits-per-pixel AND palette for configured desktop MODE Handles sprite in high/low rez on screen low/high rez 1.00 18-Jun-1993 working version 1.10 27-Jun-1993 distributed version with docs + exageratted y start pos MACHINE: Archimedes LANGUAGE: BBC BASIC V v1.05 AUTHOR: Cy Booker, 86 Church View, Main Road, Crockenhill, Swanley, Kent. BR8 8JW "<BasicV$Lib>.LibHandler" : _handle_library_error _hard_initialise_LibHandler( 20, 011 ) FDebug_Wimp%= :Debug%= :On_Lib_Error_MODE%=-1: Desktop Development "XHourglass_On" "XHourglass_Off": _handle_library_error 6 In$ = sysvar("MakeDesktopWelcomeModule$Input") 7 Out$ = sysvar("MakeDesktopWelcomeModule$Output") > NFrames = sysvar("MakeDesktopWelcomeModule$NFrames")) NFrames < 1 1, "Invalid value for system variable MakeDesktopWelcomeModule$NFrames" k Banked_P = ( sysvar("MakeDesktopWelcomeModule$Buffered")) = ("Y")) : boolean, => no flicker \ Test_P = : boolean, => test !% ModuleTitle$ = "WelcomeAnimate" "R ModuleHelp$ = "WelcomeAnimate"+ (9)+ "1.10 (27 Jun 1993)" : Module Now to load in the library files used by this program. _load_library( "<BasicV_Assembler$Lib>.Misc", 020 ) _load_library( "<BasicV_Assembler$Lib>.Services", 008 ) _load_library( "<BasicV_Assembler$Lib>.VduExt", 001 ) _load_library( "<BasicV_Assembler$Lib>.Flop", 004 ) _load_library( "<BasicV_Assembler$Lib>.SpriteVar", 004 ) _assemble( 160000 ) : large for 32K decompress workspace Test_P -4 "OS_ServiceCall",, Service_DesktopWelcome "Created "+ Out$ "XHourglass_Off" ********************************************************************* * Assemble all the code. * IN: code_size% == size of code to use. * OUT: code% <-- Byte array containing code. _assemble( code_size% ) lr, sp, pc, gb pass%, P%, O%, L% code% code_size% gb = 12 sp = 13 lr = 14 pc = 15 PSR_Z = 1 << 30 PSR_C = 1 << 29 PSR_V = 1 << 28 C# L% = code% + code_size% _Services(code%, L%) _VduExt(code%, L%) _SpriteVar(code%, L%) GC _Load_And_Parse_SpriteFile : after SpriteVar _Constants(code%, L%) I% "XHourglass_Percentage", 10 J% pass%= %1100 %1110 %0010 P% = 0 : O% = code% _assemble_Module (pass% 2)=0 N" P%= code% O%-1 !P% = 0 Q( "XHourglass_Percentage", 50 pass% T% "XHourglass_Percentage", 99 V/ "OS_File", 10, Out$, &FFA,, code%, O% W@ "OS_Module", ModHandReason_CopyArea, code%, O% - code% ********************************************************************* _assemble_Module [OPT pass% ]( EQUD 0 ;Module_Start_Code ^. EQUD Module_Initialisation_Code _/ EQUD 0 ;Module_Finalisation_Code `/ EQUD Module_Service_Call_Handler a' EQUD Module_Title_String b& EQUD Module_Help_String c< EQUD 0 ;Module_Help_And_Command_Keyword_Table d1.Module_Title_String EQUS ModuleTitle$+ e0.Module_Help_String EQUS ModuleHelp$+ ALIGN gM\------------------------------------------------------------------------ i/; In R10 = pointer to environment string j'; R11 = instantination number k); R12 = pointer to private word ; Out PSR_V ; Bad R0-R6, R12 .Module_Initialisation_Code p" B xensure_screen qM\------------------------------------------------------------------------ ; In R1 = service number t); R12 = pointer to private word uH; Out R1 = 0 if claiming, R0, R2-R8 may be altered if intercepting ; Bad R12 x .Module_Service_Call_Handler y/ TEQ R1, #Service_DesktopWelcome MOVneS pc, lr {& STMFD (sp)!, {R0-R5, lr} |, MOV R0, #ModHandReason_Claim }! mov("", 3, sizeof_G) ~ SWI "XOS_Module" ; LDMvsFD (sp)!, {R0-R5, pc}^ ; Damn! MOV gb, R2 flop("SMFD sp!, {F0-F3}") MOV lr, #0 % MOV R3, #G_SpriteArea .loop SUBS R3, R3, #4 D STRhs lr, [gb, R3] ; Zero workspace Bhi loop BL init_rnd " BL xensure_screen " BLvc xexpand_sprite # BLvc xinit_animation BLvc xinit_screen MOVvc R4, #0 .loop MOVvc R0, R4 MOVvc R1, #NFrames # BLvc xplot_animation Bvs err_service ADD R4, R4, #1 CMP R4, #NFrames Ble loop .err_service flop("LMFD sp!, {F0-F3}") # BL xrestore_screen MOV R2, gb + MOV R0, #ModHandReason_Free G SWI "XOS_Module" ; Release workspace & LDMFD (sp)!, {R0-R5, lr} MOV R1, #0 MOVS pc, lr R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; Choose a random starting point, and a random rotation %.vars EQUD VduExt_XWindLimit % EQUD VduExt_YWindLimit % EQUD VduExt_XEigFactor % EQUD VduExt_YEigFactor EQUD -1 J.sprite_width EQUD Width% ; set when load sprite H.sprite_height EQUD Height% ; units are 1/256 os .xinit_animation & STMFD (sp)!, {R4-R5, lr} SUB sp, sp, #16 ADR R0, vars MOV R1, sp * SWI "XOS_ReadVduVariables" " LDMFD (sp)!, {R1-R4} & LDMvsFD (sp)!, {R4-R5, pc} ADD R1, R1, #1 ADD R2, R2, #1 I MOV R4, R2, LSL R4 ; OS height of screen # MOV R0, R1, LSL R3 T MOV R5, R0, LSL #8 - 1 ; Screen center in 1/256 OS unit ADD R0, R5, R5 S BL rnd_lo ; Choose random point on screen flop("FLT F0, R0") flop("STF F0, [gb, #G_StartXC]") SUB R0, R5, R0 flop("FLT F0, R0") flop("STF F0, [gb, #G_DeltaXC]") ; Distance XC moves to get to center & ADD R0, R4, R4, LSL #1 @ MOV R0, R0, LSL #8 ; 3/2*height BL rnd_lo I SUB R0, R0, R4, LSL #8 - 2 ; [-1/4, +5/4)*height flop("FLT F0, R0") flop("STF F0, [gb, #G_StartYC]") & ADD R4, R4, R4, LSL #2 C MOV R4, R4, LSL #8 - 3 ; 5/8 up screen SUB R0, R4, R0 flop("FLT F0, R0") flop("STF F0, [gb, #G_DeltaYC]") BL rnd " MOV R0, R0, LSR #2 flop("FLT F0, R0") W MOV R1, #&40000000 / 8 ; / 8 to save a multiply by 8 later flop("FLT F1, R1") flop("DVF F0, F0, F1") ; F0 = random [0, 8.0) flop("ATN F1, #1.0") ; F1 = flop("MUF F0, F0, F1") ; F0 = random [0, 2* flop("STF F0, [gb, #G_StartAngle]") $ LDR R0, sprite_width % LDR R1, sprite_height flop("FLT F0, R0") flop("STF F0, [gb, #G_Width]") ; os width / 2 * 256 flop("FLT F1, R1") flop("STF F1, [gb, #G_Height]") & LDMFD (sp)!, {R4-R5, pc} R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1; Prepare two bank screen (allocating memory) ; And initialise ChangedBox .xinit_screen STMFD (sp)!, {lr} MVN R0, #0 * MOV R1, #VduExt_XEigFactor * SWI "XOS_ReadModeVariable" + STRvc R2, [gb, #G_XEigFactor] * MOVvc R1, #VduExt_YEigFactor * SWIvc "XOS_ReadModeVariable" + STRvc R2, [gb, #G_YEigFactor] MVNvc R0, #0 $ SWIvc "XOS_ChangedBox" D STRvc R0, [gb, #G_ChangedBox] ; Note old state # BLvc xinit_two_banks < MOVvc R0, #1 ; Enable $ SWIvc "XOS_ChangedBox" ; MOVvc R0, #2 ; Reset $ SWIvc "XOS_ChangedBox" LDMFD (sp)!, {pc} R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .xunplot_sprite & STMFD (sp)!, {R4-R8, lr} Banked_P [OPT pass% $ gb("", 4, G_UnPlotBBox) X LDMIA R4, {R5-R8} ; What need to unplot on next screen MVN R0, #0 $ SWI "XOS_ChangedBox" G LDMvcIB R1, {R0-R3} ; What just plotted J STMvcIA R4, {R0-R3} ; Store for next frame ) LDRvc R1, [gb, #G_PlotBank] MOVvc R0, #113 O SWIvc "XOS_Byte" ; Display what just plotted ) LDRvc R1, [gb, #G_PlotBank] @ RSBvc R1, R1, #3 ; Toggle 1/2 ) STRvc R1, [gb, #G_PlotBank] 4 MOVvc R0, #112 O SWIvc "XOS_Byte" ; Plot to screen now hidden [OPT pass% MVN R0, #0 $ SWI "XOS_ChangedBox" LDMvcIB R1, {R5-R8} [OPT pass% SUBvc R5, R5, #1 SUBvc R6, R6, #1 ADDvc R7, R7, #1 ADDvc R8, R8, #1 MOVvc R0, #&84 O SWIvc "XWimp_SetColour" ; Background, wimp colour 4 + LDRvc R3, [gb, #G_XEigFactor] + LDRvc R4, [gb, #G_YEigFactor] MOVvc R0, #19 E SWIvc "XOS_Byte" ; Pause one frame MOVvc R0, #&44 " MOVvc R1, R5, LSL R3 " MOVvc R2, R6, LSL R4 I SWIvc "XOS_Plot" ; Move to bottom left MOVvc R0, #&67 " MOVvc R1, R7, LSL R3 " MOVvc R2, R8, LSL R4 O SWIvc "XOS_Plot" ; Rectangle fill background < MOVvc R0, #1 ; Enable $ SWIvc "XOS_ChangedBox" ; MOVvc R0, #2 ; Reset !$ SWIvc "XOS_ChangedBox" "& LDMFD (sp)!, {R4-R8, pc} #R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .xrestore_screen STMFD (sp)!, {lr} '+ LDRvc R0, [gb, #G_ChangedBox] vc R0, R0, #1 )D SWIvc "XOS_ChangedBox" ; Restore status *" BLvc xinit_one_bank LDMFD (sp)!, {pc} ,R;~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ; In - ; Out - .init_rnd MOV R0, #3 3& STMFD (sp)!, {R0-R1, lr} MOV R1, sp MOV R0, #14 SWI "XOS_Word" 7" LDMFD (sp)!, {R1-R2} 8' ADDS R0, R0, R1, ROR #13 9' RSCS R0, R0, R2, ROR #11 : ADDeq R0, R0, #&CB ;% STR R0, [gb, #G_Seed] < LDMFD (sp)!, {pc}^ =R;~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ; In - ; Out R0 = random 32-bit C% LDR R0, [gb, #G_Seed] DJ R1, R0, #1 << 29 ; These values obtained by trial EJ ADD R1, R1, R1 ; and error. The algorithm is FA R0, R1, R0, ROR #13 ; old hat, GFSR I think G% STR R0, [gb, #G_Seed] MOVS pc, lr IR;~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ K ; In R0 = unsigned 32-bit L(; Out R0 = random in range [0, R0) .rnd_lo O# STMFD (sp)!, {R0, lr} BL rnd LDMFD (sp)!, {R1} BL udivmod S? MOV R0, R1 ; Remainder T LDMFD (sp)!, {pc}^ UR;~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ; In R0 = unsigned X#; R1 = unsigned, non-zero Y4; Out R0 = R0 / R1 (rounded down towards zero) ; R1 = R0 [6; Note if R1 = 0 then get stuck in infinite loop! .udivmod divrem(2, 0, 1, 3) MOV R1, R0 MOV R0, R2 MOVS pc, lr bR; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Banked_P [OPT pass% g>; This ensures there is enough screen memory for two banks .xensure_screen STMFD (sp)!, {lr} MVN R0, #0 l* MOV R1, #VduExt_ScreenSize m* SWI "XOS_ReadModeVariable" nN ADDvc R3, R2, R2 ; Need twice screen memory o< MOVvc R0, #2 ; Screen p) SWIvc "XOS_ReadDynamicArea" LDMvsFD (sp)!, {pc} SUBS R1, R3, R1 s< MOVgt R0, #2 ; Screen tA SWIgt "XOS_ChangeDynamicArea" ; Enlargen it LDMFD (sp)!, {pc} wB; This is called in init_screen to set up the G_UnPlotBBox bit x"; And to page the correct bank .xinit_two_banks STMFD (sp)!, {lr} |" BL xensure_screen MVNvc R0, #0 ~* MOVvc R1, #VduExt_YWindLimit * SWIvc "XOS_ReadModeVariable" MOVvc R3, R2 * MOVvc R1, #VduExt_XWindLimit * SWIvc "XOS_ReadModeVariable" MOVvc R0, #0 MOVvc R1, #0 ' gb("vc", lr, G_UnPlotBBox) ^ STMvcIA lr, {R0-R3} ; Set up so clear bank 2 first time use it MOVvc R1, #1 ) STRvc R1, [gb, #G_PlotBank] MOVvc R0, #113 D SWIvc "XOS_Byte" ; Display bank 1 MOVvc R1, #1 MOVvc R0, #112 E SWIvc "XOS_Byte" ; Write to bank 1 LDMFD (sp)!, {pc} $; Called when finished animation J; Note that if we try restoring screen memory, then Wimp gets confused .xinit_one_bank STMFD (sp)!, {lr} MOV R0, #113 MOV R1, #1 T SWI "XOS_Byte" ; Display bank 1 MOV R0, #112 MOV R0, #1 SWI "XOS_Byte" LDMFD (sp)!, {pc} [OPT pass% 2; If not banked then these routines do nothing .xinit_one_bank .xinit_two_banks .xensure_screen " BICS pc, lr, #PSR_V [OPT pass% R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !; Plot one frame of animation ; In R0 = [0..R1] !; R1 = number of frames ; Out - d = 7 xc = 6 yc = 5 . angle = d : careful cos = 4 . sin = angle : careful w = 3 h = 2 leaves F0/F1 free [OPT pass% .xplot_animation & STMFD (sp)!, {R4-R7, lr} flop("SMFD sp!, {F4-F7}") flop("FLT F0, R0") flop("FLT F1, R1") flop("DVF d, F0, F1") ; d= in range [0..1] flop("ATN F0, #1.0") flop("MUF F0, F0, #2.0") ; F0 = flop("MUF d, d, F0") flop("SIN d, d") ; d= /2) in range [0..1] flop("LDF F0, [gb, #G_DeltaXC]") flop("LDF F1, [gb, #G_DeltaYC]") flop("MUF F0, F0, d") flop("MUF F1, F1, d") flop("LDF xc, [gb, #G_StartXC]") flop("LDF yc, [gb, #G_StartYC]") flop("ADF xc, xc, F0") ; xc= StartXC + F4*DeltaXC flop("ADF yc, yc, F1") ; yc= StartYC + F4*DeltaYC flop("LDF w, [gb, #G_Width]") flop("LDF h, [gb, #G_Height]") flop("MUF w, w, d") ; w = w * d (linear size grow) flop("MUF h, h, d") flop("LDF F0, [gb, #G_StartAngle]") flop("RSF F1, d, #1.0") flop("MUF angle, F0, F1") flop("COS cos, angle") flop("SIN sin, angle") . ; x0 = xc-w* y0 = yc-w* . ; x1 = xc+w* y1 = yc+w* . ; x2 = xc+w* y2 = yc+w* flop("MUF F0, w, cos") flop("MUF F1, h, sin") flop("ADF F1, F0, F1") ; F1 = w* flop("SUF F0, xc, F1") flop("FIX R0, F0") ; R0 = x0 flop("ADF F0, xc, F1") flop("FIX R4, F0") ; R4 = x2 flop("MUF F1, h, sin") flop("MUF F1, F1, #2.0") flop("SUF F0, F0, F1") flop("FIX R2, F0") ; R2 = x1 flop("MUF F0, w, sin") flop("MUF F1, h, cos") flop("SUF F1, F0, F1") ; F1 = w* flop("SUF F0, yc, F1") flop("FIX R1, F0") ; R1 = y0 flop("ADF F0, yc, F1") flop("FIX R5, F0") ; R5 = y2 flop("MUF F1, h, cos") flop("MUF F1, F1, #2.0") flop("ADF F0, F0, F1") flop("FIX R3, F0") ; R3 = y1 flop("LMFD sp!, {F4-F7}") " SUB sp, sp, #4*2*4 MOV R6, sp SUB R7, R0, R2 G ADD R7, R4, R7 ; x3 = x2 + x0 - x1 SUB lr, R1, R3 G ADD lr, R5, lr ; y3 = y2 + y0 - y1 4 STMIA R6, {R0,R1, R2,R3, R4,R5, R7,lr} " BL xunplot_sprite A MOVvc R0, #&200 SpriteReason_PutSpriteTransformed & gb("vc", 1, G_SpriteArea) & LDRvc R2, [R1, #saFirst] ADDvc R2, R1, R2 K MOVvc R3, #1 ; Transform, not matrix H MOVvc R5, #8 ; Use mask if exists J MOVvc R7, #0 ; No translation table " SWIvc "XOS_SpriteOp" " ADD sp, sp, #4*2*4 & LDMFD (sp)!, {R4-R7, pc} R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .xexpand_sprite & STMFD (sp)!, {R4-R5, lr} P MOV R0, #0 ; Flags (fast decompression) # gb("", 1, G_WorkSpace) ' ADR R2, compressed_data ' LDR R3, compressed_size $ gb("", 4, G_SpriteArea) ) LDR R5, decompressed_size ( SWI "XSquash_Decompress" & LDMFD (sp)!, {R4-R5, pc} 3.compressed_size EQUD sizeof_Compressed% 3.decompressed_size EQUD sizeof_SpriteArea% .compressed_data P% += sizeof_Compressed% O% += sizeof_Compressed% aadr(P%)>L% 1, "Assembler out of space" pass% x "Squash_Compress", 0, WorkSpace%, SpriteArea%, sizeof_SpriteArea%, aadr(compressed_data), sizeof_Compressed% _Constants(code%, L%) O%, P%, pass% pass% = %1110 O%=code%:P%=0:[OPT pass% =.G_PrivateWord EQUD 0 ; pointer to private word F.G_XEigFactor EQUD 0 ; VduExt variable for current mode F.G_YEigFactor EQUD 0 ; VduExt variable for current mode !P.G_ChangedBox EQUD 0 ; bit 0 is enable state before we changed it "8.G_Seed EQUD 0 ; random number seed #3.G_StartXC r(8) ; floating point $3.G_StartYC r(8) ; floating point %3.G_DeltaXC r(8) ; floating point &3.G_DeltaYC r(8) ; floating point '3.G_StartAngle r(8) ; floating point (3.G_Width r(8) ; floating point )3.G_Height r(8) ; floating point Banked_P [OPT pass% -H.G_UnPlotBBox r(16) ; x0,y0,x1,y1 inclusive pixel co-ords .1.G_PlotBank EQUD 0 ; toggles 1/2 [OPT pass% 2*.G_SpriteArea r(sizeof_SpriteArea%) 3C.G_WorkSpace r(sizeof_WorkSpace%) ; all 32K of it! .sizeof_G _Load_And_Parse_SpriteFile t%, length%, s%, sp%, size%, w%, h%, x%, y% "OS_File", 17, In$ t%,,,,length% t%<>1 1, "Can't find file "+ In$ length% += 4 s% length% !s% = length% "OS_SpriteOp", &100+SpriteReason_LoadSpriteFile, s%, In$ sp% = s% + s%!saFirst A% size% = s%!saFirst + sp%!spNext s%!saEnd = size% s%!saFree = size% s%!saNumber = 1 the above makes the first sprite the only sprite "OS_SpriteOp", &200+SpriteReason_ReadSpriteSize, s%, sp% ,,, w%, h%,, mode% "OS_ReadModeVariable", mode%, VduExt_XEigFactor ,, x% "OS_ReadModeVariable", mode%, VduExt_YEigFactor ,, y% w% = w% << x% h% = h% << y% KJ Width% = w%/2 * 256 : width radius, in draw units LK Height% = h%/2 * 256 : height radius, in draw units M sizeof_SpriteArea% = size% SpriteArea% = s% "Squash_Compress", 8, size%, s% sizeof_WorkSpace%, sizeof_Compressed% WorkSpace% sizeof_WorkSpace% buffer% sizeof_Compressed% "Squash_Compress", 0, WorkSpace%, s%, size%, buffer%, sizeof_Compressed% ,,,,, n% sizeof_Compressed% -= n% ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sysvar(var$) size%, type%, buf% "XOS_ReadVarVal", var$, 0, -1, 0, 1 ,, size%,, type% size% = 0 [6 1, "System variable `"+ var$+ "' undefined." ]K type%=1 1, "Bad system variable `"+ var$+ "', it's a number." size% = -size% buf% size% `3 "OS_ReadVarVal", var$, buf%, size%, 0, 1 buf%?(size%-1) = 13 var$ = $buf% = var$ _Wimp_Error(A%,A$): _Wimp_CloseDown: