/* * GMSE FiReWoRkS (c) 1996 Richard Clark - PhiRatE * * Fireworks using GMS in E, Requires E 3.0+ * * Code and execs freely distributable. If you use complete functions from * this code, please put my name somewhere in your docs. And send me email * about your software. This applies to commercial software as well :). * * Note: The timings etc were set up for an A1200 +fast, they could look * quite sad on anything slower, but on a fast machine, go ahead and * decrease the delay values in the process procedures! * * Recommended timing for 040+ ... Change all of 'em to 3 or lower! >:) */ OPT PREPROCESS -> Allow our function defines MODULE 'games','games/games', -> GMS library '*qgms2', -> QuickGMS module to make screens easy '*fireworks', -> This one does the work :) '*wordims' -> Word images -> Rasterlist function definitions. Hard to do any other way on E, although -> I'm working on it. #define MIRROR Shl(18,16),0 #define NEWPALETTE(a,b,c) Shl(20,16),(a),(b),(c),0 #define WAITLINE(a) Shl(22,16) OR (a),0 #define RASTEND $ffffffff -> See GMS E support files for the rest of the Rasterlist defines. ENUM ERR_NONE,ERR_REFUSE,ERR_FATAL DEF s:PTR TO qgscn PROC init() /* * Initialise screen and GMS settings */ IF (gmsbase:=OpenLibrary('games.library',0))=NIL Throw(ERR_FATAL,'Cannot load GMS!!') -> Throw pointer to message ENDIF SetUserPrefs(NIL) -> Get default GMS user settings (MUST DO!) -> now to open our screen using QuickGMS NEW s.init([320,256,5,NIL,LORES OR COL12BIT,INTERLEAVED]) IF s=NIL THEN Throw(ERR_FATAL,'Cannot init screen!!') s.scn.palette:={pal} -> Set our palette pointer in the GMS screen -> Setup Rasterlist for Mirror effect s.scn.rasterlist:=[ WAITLINE(180), MIRROR, NEWPALETTE(0,32,{waterpal}), -> New palette to give watery effect RASTEND ] Rnd(-Long(10000+Rnd(1000))) AllocBlitter() -> We use GMS blitter functions so we must alloc IF (s.open())<>ERR_OK THEN Throw(ERR_FATAL,'Cannot open screen!') ENDPROC PROC deinit() /* * Deallocate stuff */ FreeBlitter() IF s THEN END s IF gmsbase THEN CloseLibrary(gmsbase) ENDPROC PROC main() HANDLE /* * Lets make big bangs and little bangs and colourful bangs and well, you * get the picture. */ DEF fwork:PTR TO firework,fwlist=NIL:PTR TO firework,count=NIL,nxt,pc=NIL DEF temp=NIL init() Show_Screen(s.scn) -> Display the GMS screen count:=100 REPEAT INC count INC pc IF pc>4000 -> Loop at 100 seconds (1 minute 20secs) pc:=0 count:=100 ENDIF -> Complete routine list and timing IF pc>1090 fwlist,count:=fast_single(fwlist,count) ELSEIF pc>1060 -> do nothing ELSEIF pc>1000 fwlist,count,temp:=char_word(fwlist,count,'BYE',temp) ELSEIF pc>600 fwlist,count:=fast_double(fwlist,count) ELSEIF pc>599 count:=80 -> Make sure fast_dobe starts right up ELSEIF pc>170 fwlist,count:=thick_fountain(fwlist,count) ELSEIF pc>100 fwlist,count,temp:=char_word(fwlist,count,'GMS',temp) ELSEIF pc>10 -> do nothing ELSEIF pc>0 fwlist,count:=slow_huge(fwlist,count) ENDIF fwork:=fwlist WHILE fwork nxt:=fwork.next -> Get the next one for safety fwork.clear(s.scn,BUFFER1) -> Clear the firework from the screen fwlist:=fwork.update(fwlist) -> Update the firework IF (fwork.flags AND FW_KILLME) -> If firework is to be killed.. END fwork -> Kill it :) ELSE fwork.draw(s.scn,BUFFER1) -> Draw the firework ENDIF fwork:=nxt -> Loop with next one! ENDWHILE Wait_OSVBL() UNTIL (Read_Mouse(JPORT1) AND MB_LMB) EXCEPT DO -> If there's an error or we're at the end, dealloc. deinit() -> Quick, easy, and friendly way of displaying an error IF exception EasyRequestArgs(0,[20,0,'Fireworks error:',exceptioninfo,'DAMN'],0,NIL) ELSE EasyRequestArgs(0,[100,50,'FiReWoRkS!!', 'This demo was written by PhiRatE using\nAmigaE v3.1 and GMS!!\n\nE-mail: phirate@sans.vuw.ac.nz', 'Woohoo!'],0,NIL) ENDIF ENDPROC -> -*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*- -> Firework process procedures for different displays -> -*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*- PROC fast_single(fwlist:PTR TO firework,count) /* * Fast, single-explosion fireworks */ DEF f:PTR TO firework,p,flags IF count>=10 -> CHANGE THIS NUMBER IF YOU GOT A FAST MACHINE!! :) count:=0 p:=Shr(Rnd(12),1) IF Rnd(6)=1 THEN flags:=FW_MULTIHUE ELSE flags:=NIL flags:=flags OR FW_BIGSPARK -> Big spark NEW f.new(160,180, -> X and Y start Rnd(5)-2,Rnd(4)+3, -> X and Y velocities 4, -> Gravity delay (p*4)+8, -> Color value 0, -> Background color 25, -> Firework lifetime 1, -> Number of explosions flags) -> Flags IF fwlist=NIL THEN fwlist:=f ELSE fwlist.add(f) -> Put f into list ENDIF ENDPROC fwlist,count PROC fast_double(fwlist:PTR TO firework,count) /* * Fast, with the occasional double-explosion */ DEF f:PTR TO firework,p,flags IF count>=60 count:=0 p:=Shr(Rnd(12),1) IF Rnd(6)=1 THEN flags:=FW_MULTIHUE ELSE flags:=NIL flags:=flags OR FW_BIGSPARK -> Explosion-sparks get same flags NEW f.new(160,180, -> X and Y start Rnd(5)-2,Rnd(3)+4, -> X and Y velocities 4, -> Gravity delay (p*4)+8, -> Color value 0, -> Background color 25, -> Firework lifetime 2, -> Number of explosions flags) -> Flags IF fwlist=NIL THEN fwlist:=f ELSE fwlist.add(f) -> Put f into list ENDIF ENDPROC fwlist,count PROC slow_huge(fwlist:PTR TO firework,count) /* * Slow but massive bangs :) */ DEF f:PTR TO firework,p,flags IF count>=100 count:=0 p:=Shr(Rnd(12),1) IF Rnd(6)=1 THEN flags:=FW_MULTIHUE ELSE flags:=NIL flags:=flags OR FW_BIGSPARK OR FW_MASSIVE -> Big spark NEW f.new(160,180, -> X and Y start Rnd(5)-2,Rnd(4)+3, -> X and Y velocities 4, -> Gravity delay (p*4)+8, -> Color value 0, -> Background color 25, -> Firework lifetime 1, -> Number of explosions flags) -> Flags IF fwlist=NIL THEN fwlist:=f ELSE fwlist.add(f) -> Put f into list ENDIF ENDPROC fwlist,count PROC char_word(fwlist:PTR TO firework,count,word:PTR TO CHAR,c) /* * Explodes into the word, letter by letter. */ DEF f:PTR TO firework,p,flags,xv IF count>=25 count:=0 IF c>=StrLen(word) THEN c:=0 xv:=(2*(c-Shr(StrLen(word),1)))/Shr(StrLen(word),1) p:=Shr(Rnd(12),1) IF Rnd(6)=1 THEN flags:=FW_MULTIHUE ELSE flags:=NIL flags:=flags OR FW_BIGSPARK OR FW_IMAGE OR FW_KEEPFLAGS -> Big spark NEW f.new(160,180, -> X and Y start xv,Rnd(3)+4, -> X and Y velocities 4, -> Gravity delay (p*4)+8, -> Color value 0, -> Background color 25, -> Firework lifetime 1, -> Number of explosions flags, -> Flags 2,2,getchar(word,c)) -> Character display system IF fwlist=NIL THEN fwlist:=f ELSE fwlist.add(f) -> Put f into list INC c ENDIF ENDPROC fwlist,count,c PROC thick_fountain(fwlist:PTR TO firework,count) /* * Big funky fountain */ DEF f:PTR TO firework,p,flags IF count>=2 count:=0 p:=Shr(Rnd(12),1) IF Rnd(6)=1 THEN flags:=FW_MULTIHUE ELSE flags:=NIL flags:=flags OR FW_BIGSPARK OR FW_SMALL OR FW_KEEPFLAGS -> Big spark NEW f.new(160,180, -> X and Y start Rnd(3)-1,Rnd(4)+2, -> X and Y velocities 4, -> Gravity delay (p*4)+8, -> Color value 0, -> Background color 10, -> Firework lifetime 1, -> Number of explosions flags) -> Flags IF fwlist=NIL THEN fwlist:=f ELSE fwlist.add(f) -> Put f into list ENDIF ENDPROC fwlist,count ->-------------------------- -> Standard palette, stored here simply because I needed to make sure -> that the water palette was similar. Converted to 12bit to make it ECS-OK pal: INT $0000,$0000,$0001,$0001,$0003,$0005,$0006,$0007 INT $0FF0,$0A60,$0830,$0400,$0FFF,$0AAA,$0777,$0444 INT $0F00,$0A00,$0700,$0400,$00F0,$00A0,$0070,$0040 INT $0AAF,$088A,$0667,$0224,$0FF0,$0AA0,$0770,$0440 -> Water palette, same palette with a bit of blue and some dimming waterpal: INT $0001,$0002,$0002,$0004,$0005,$0006,$0007,$0008 INT $0AA6,$0844,$0622,$0301,$088A,$0778,$0334,$0112 INT $0A02,$0802,$0502,$0302,$00A2,$0082,$0052,$0032 INT $077A,$0448,$0225,$0002,$0AA2,$0882,$0552,$0332