; *************************************************** ; * Coagulus Pairs 1.0AGA By Rob Hewitt / Coagulus * ; * Music and Graphics by Rob Hewitt * ; * Written using Blitz Basic 2.1 - Acid Software * ; * This is totally freeware but no use of any code * ; * sound or graphics in other projects without the * ; * permission of myself in writing beforehand. * ; *************************************************** ; * Written in August 1999 *** Copyright - Coagulus * ; *************************************************** ; ; This program is provided as is. There is no warranty ; either expressed or implied regarding the use of this ; program. The running of this program is done entirely ; at his/her own risk and no responsibility either ; directly or indirectly because of use of this program ; shall be assumed. This is standard freeware bumpf but be ; sure that you do run this at your own risk. ; I Like writing a game which has more comments than coding!!! WBStartup ; A command which allows the running from an icon NoCli ; just a directive to stop Blitz opening a shell window BitMap 0,320,256,8 ; Open a 256 colour bitmap BitMap 1,320,256,8 ; Open another for double buffering BitMap 2,320,256,8 ; Open one for the title page BitMap 3,320,256,8 ; Open one for the main blank game screen BitMap 4,320,256,8 ; Open one for the cards ; Look at that eh! 400k just for screen buffers and gfx!!! ; The game screen has the cards on for grabbing later ; main game routine calls - designed on paper beforehand (!) Gosub loadage Gosub defvars Gosub goblitz Gosub grabgfx ; extract the cards from the loaded bitmap Gosub main Goto nd .loadage ; ************************************************************* ; * The graphics that were created in PPaint and Dpaint * ; * loaded up here along with a mouse pointer for the game. * ; * Also loaded is the music which I wrote on an Amiga 500! * ; * While I was still at school, eight long, long years ago!! * ; ************************************************************* LoadBitMap 2,"gfx/pics/pairtitle",0 LoadBitMap 3,"gfx/pics/pairscreen" LoadBitMap 4,"gfx/pics/pairblocks" LoadModule 0,"sfx/mod.at" LoadShape 0,"gfx/brushes/pairpoint.bsh" Return .defvars ; ************************************************************* ; * Nice, structured code means that all variables are here!! * ; * This is always a good thing to do when coding as if you * ; * take a few days off you'll find it hard to remember them! * ; * (These are the words of someone who's done this a lot!) * ; ************************************************************* Dim m.w(10,6) ; set up an array containing the cards player1score.w=0 ; player one's score (never more than 30) player2score.w=0 ; player two's score (never more than 30) b.w=1 ; loop for blocks to display sgx.w=1 ; shape grab x position and block randompointer x pos sgy.w=1 ; shape grab y position and block randompointer y pos osgx.w=1 ; block randompointer x pos - other card osgy.w=1 ; block randompointer y pos - other card pairsleft=30 ; No of pairs left to find!! p1$="" ; player one's score string for screen output p2$="" ; player two's score string for screen output psl$="" ; pairsleft string for screen output card1.w=0 ; first card picked card2.w=0 ; second card picked player.w=2 ; current player pointer c$="" ; character for blitting c=0 ; shape pointer for blitting Return .goblitz ; ************************************************************* ; * For a change I decided to do all the init crap right here * ; ************************************************************* InitCopList 0,$10008 ; A Low-res 256 colour coplist VWait 100 ; wait 2 seconds to allow for drive delays BLITZ ; Disable the OS for higher, smoother, speed Mouse On ; turn on mouse coordinate reading relative to screen BlitzKeys On ; turn on key reading for quit key (escape) MouseArea 24,32,264,224 GetaSprite 0,0 ; get the mouse pointer ready Return .main ; ************************************************************* ; * An initial test run showing the 256 colour graphics and * ; * music was set up first and run just to get the feel for a * ; * go at the full game - This was successful so I will now * ; * have a main loop which continues until all the pairs are * ; * used up - a scoring system will give less points as the * ; * time limit runs out allowing for people to compete on the * ; * score as well as a normal time comparison - Coagulus 1999 * ; ************************************************************* ; * In actual fact I've now changed this to the traditional!! * ; ************************************************************* CreateDisplay 0 ; Initialise the coplist onscreen DisplayPalette 0,0 ; use the palette from the loaded bitmap PlayModule 0 SetInt 5 DisplaySprite 0,0,MouseX,MouseY,0 ; interrupt sprite pointer End SetInt quit=False Repeat DisplayBitMap 0,2 ; show the title bitmap Repeat Until Joyb(0)<>0 If Joyb(0)=1 ; if the left mouse button is pressed... Gosub maingame ; ...start the game... quit=False ; ...and you obviously don't want to quit yet! Else If Joyb(0)=2 ; if the right mouse button is pressed... quit=True ; ...you want to quit my lovely little game! End If End If If quit<>True ; ie. if you've just come back from playing a game Repeat Until Joyb(0)=0 ; make sure you don't carry a mouse click over End If Until quit=True AND Joyb(0)=2 ; Now you quit with right click! ClrInt 5 Return .drawscreen ; ************************************************************* ; * The playscreen is copied to the buffer and cards put on * ; ************************************************************* Use BitMap 0 CopyBitMap 3,0 DisplayBitMap 0,0 For x.w=1 To 10 For y.w=1 To 6 VWait 2 m(x,y)=0 Blit 31,x*24,y*32 Next Next Return .drawscore ; ************************************************************* ; * The blocks for numbers are blitted onscreen at the end of * ; * every loop in the main game. This is the 'hardest' part * ; * of the game to code but is still pretty simple. Rob 1999 * ; * However this code below is probably the worst you've ever * ; * seen. It worked (I was drunk!) so didn't bother changing * ; * it. Coagulus/Rob August 4 1999 at 00:37 (I was bored!) * ; ************************************************************* ;draw player one score Format "00" ; format the output for blitting p1$=Str$(player1score) p2$=Str$(player2score) psl$=Str$(pairsleft) ;draw pairs left If Len(psl$)=2 c$=Left$(psl$,1) Gosub parsechar Blit c,275,215 c$=Right$(psl$,1) Gosub parsechar Blit c,283,215 Else Blit 43,275,215 c$=psl$ Gosub parsechar Blit c,283,215 End If ;draw player 1 score If Len(p1$)=2 c$=Left$(p1$,1) Gosub parsechar Blit c,298,16 c$=Right$(p1$,1) Gosub parsechar Blit c,306,16 Else Blit 43,298,16 c$=p1$ Gosub parsechar Blit c,306,16 End If ;draw player 2 score If Len(p2$)=2 c$=Left$(p2$,1) Gosub parsechar Blit c,298,59 c$=Right$(p2$,1) Gosub parsechar Blit c,306,59 Else Blit 43,298,59 c$=p2$ Gosub parsechar Blit c,306,59 End If Return .parsechar c=43 ; just in case (!) If Val(c$)=1 Then c=34 If Val(c$)=2 Then c=35 If Val(c$)=3 Then c=36 If Val(c$)=4 Then c=37 If Val(c$)=5 Then c=38 If Val(c$)=6 Then c=39 If Val(c$)=7 Then c=40 If Val(c$)=8 Then c=41 If Val(c$)=9 Then c=42 If Val(c$)=0 Then c=43 ; Aaaah, that should do it Return .erasepair ; ************************************************************* ; * A quick routine to copy an area from the original image * ; * to the game display. Thus erasing the cards from onscreen * ; ************************************************************* VWait 50 ; wait a second (!) ; Use BitMap 3 ; switch to original sceen background image Scroll sgx*24,sgy*32,24,32,sgx*24,sgy*32,3 ; remove first card Scroll osgx*24,osgy*32,24,32,osgx*24,osgy*32,3 ; and it's pair ; Use BitMap 0 ; return to main screen pairsleft-1 If player=1 player1score+1 Else player2score+1 End If m(sgx,sgy)=-1 m(osgx,osgy)=-1 Return .flipnotpair ; ************************************************************* ; * Another nice neat place for an often used routine. Rob 99 * ; * In a routine for easily tarting up in the future I hope!! * ; ************************************************************* VWait 50 ; wait a second (!) Blit 31,sgx*24,sgy*32 Blit 31,osgx*24,osgy*32 Return .turncard ; ************************************************************* ; * This is just the routine to flip the card. To be flashed * ; * up later, it currently just blits the cards onscreen * ; ************************************************************* If card1<>0 Blit card1,sgx*24,sgy*32 ; plonk the card onscreen End If If card2<>0 Blit card2,osgx*24,osgy*32 ; plonk the other card onscreen End If Return .maingame ; ************************************************************* ; * I decided, for ease of looking at it afterwards, to have * ; * a separated routine which contains the main game in its * ; * entirity. This makes it much easier to come back to later * ; * However, due to a bug in WinUAE I had to improvise code! * ; ************************************************************* Gosub drawscreen Gosub randpairs card1=0 card2=0 player=1 ; player 1 starts the fun! player1score=0 player2score=0 pairsleft=30 Gosub drawscore Repeat If player=2 Then AGAPalRGB 0,224,255,255,0:AGAPalRGB 0,225,0,0,0 If player=1 Then AGAPalRGB 0,225,255,255,0:AGAPalRGB 0,224,0,0,0 DisplayPalette 0,0 ;highlight the word under the current `player' Repeat Repeat Until Joyb(0)=0 ; so you can't click 2 by accident MouseWait ; for some reason - Joyb(0) is erratic in WinUAE 0.8.8 r6 sgx=Int(MouseX/24) sgy=Int(MouseY/32) card1=m(sgx,sgy) Until card1<>-1 Gosub turncard Repeat Repeat Repeat Until Joyb(0)=0 ; so you can't click 2 by accident MouseWait ; for some reason-Joyb(0) doesn't work in WinUAE osgx=Int(MouseX/24) osgy=Int(MouseY/32) Until osgx<>sgx OR osgy<>sgy ; So you can't click same card card2=m(osgx,osgy) Until card2<>-1 Gosub turncard If card1=card2 ; I wonder what this means! Gosub erasepair Else Gosub flipnotpair player=3-player ; Quick way to switch from 1 to 2 to 1 etc End If card1=0 ; reset the card pointers card2=0 Gosub drawscore Until Joyb(0)=2 OR pairsleft=0 If pairsleft=0 AGAPalRGB 0,225,55,0,0 AGAPalRGB 0,224,55,0,0 If player2score<=player1score Then AGAPalRGB 0,225,55,255,255 If player1score<=player2score Then AGAPalRGB 0,224,55,255,255 DisplayPalette 0,0 MouseWait End If Return .randpairs ; ************************************************************* ; * Quite simple routine to mix up the pairs in the map array * ; * Ha - tested this routine and apart from typos, it worked * ; * probably a better and quicker way but what the hell eh? * ; * In theory this loop could repeat forever but I doubt it! * ; ************************************************************* b=1 ; card pointer starting with card one Repeat Repeat Repeat sgx=Rnd(10)+1 sgy=Rnd(6)+1 osgx=Rnd(10)+1 osgy=Rnd(6)+1 Until sgx<>osgx OR sgy<>osgy Until m(sgx,sgy)=0 AND m(osgx,osgy)=0 m(sgx,sgy)=b m(osgx,osgy)=b b=b+1 ; get next card ready to place Until b=31 pairsleft=30 Return .grabgfx ; ************************************************************* ; * A quick loop for grabbing the cards from a normal Amiga * ; * IFF file, allowing for future editing after its finished * ; ************************************************************* sgx=1 sgy=1 Use BitMap 4 ; Use the bitmap with the cards on For b=1 To 32 ; loop for number of blocks from shape 1 GetaShape b,sgx*24,sgy*32,24,32 sgx+1 If sgx>10 sgy+1 sgx=1 End If Next ; now to get the numerics 1234567890 + blank one For sgx=24 To 112 Step 8 b+1 GetaShape b,sgx,160,8,8 Next Return .nd ; ************************************************************* ; * Normally in this situation I would use a goto call to the * ; * ending routing but since I know that GOTO is frowned upon * ; * in professional coding circles of which I am not one. * ; * Everything is freed up nicely and returned to AmigaDOS * ; * A feature which is missing on a hell of a lot of games!!! * ; ************************************************************* StopModule ClrInt 5 ; Stop playing the music as it is no longer needed! Free Module 0 Free BitMap 3 Free BitMap 2 ; Nice and clean. Remember to free everything Free BitMap 1 ; for a nice, legally coded exit to the OS Free BitMap 0 AMIGA ; Return the operating system for legal exit End ; end the program Return ; Of course, this command is never reached!!!