25 September 2014, 22:35 | #1 |
Gets there in the end...
Join Date: Sep 2005
Location: Wales
Posts: 880
|
Coagulus Pairs AGA from 1999 - and source
Well, not exactly new, it's been on my site since 1999! But here is Coagulus Pairs AGA, written in Blitz 2.1, the last game I wrote directly on my A1200 as I use WinUAE now for speed and storage.
Zipped .adf http://coagulus.newport.net/c1/bin/pairs.zip Source code (probably awful, but here it is!) http://coagulus.newport.net/c1/txt/pairs.txt in case it helps anyone! Code:
; *************************************************** ; * 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!!! |
23 November 2014, 23:08 | #2 |
Registered User
Join Date: Oct 2014
Location: Europe
Posts: 481
|
You're right, it's awful. ;-)
An example for "blitting" char font shapes to realise text: Code:
fn$="abcdefghijklmnopqrstuvwxyz1234567890äöü?()\|/-_:;,.'"+Chr$(34)+"&+!$*=" Statement ptext {t$,x,y,del.w} SHARED db.b,fn$ tl=Len(t$) If tl<1 Then Statement Return t$=LCase$(t$) c=1:xx=x Repeat ch=Instr(fn$,Mid$(t$,c,1)) If ch ;copy char from bmap 4 to xx onto bmap 3 Use BitMap3 ;BMap 3 consists only of one faked bitplane Scroll (ch-1)*10,0,10,11,xx,y,4 EndIf c+1:xx+11 ;13 Space/charwidth If del>0 Then VWait del Until c>tl Use BitMap db End Statement Please note: The 'äöü' is displayed within the BB2 environment as [][][]. This is not the usual approach to "blit" one shape out of a shapes file with the offset from ASCII input. Instead, this font is a fixed width font with (naturally) fixed offsets, loaded into a bmap and copied (scrolled) char by char to the destination place. Last edited by Cylon; 30 November 2014 at 04:05. Reason: added example for gfx text blitting |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | |
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
[ongoing] Italian Night 1999 - Simulmondo Translation Project | Iena | project.Amiga Game Factory | 12 | 16 September 2017 16:02 |
What was the url for JAMBO! in 1999? | caffeinekid | Amiga websites reviews | 2 | 26 July 2008 10:36 |
T-Zero AmigaCD (1999) clickBOOM | seuden | request.Old Rare Games | 3 | 08 May 2007 18:56 |
Moonbases (1999 Homegrown/Alive Mediasoft) | Korodny | request.Old Rare Games | 11 | 10 August 2004 16:46 |
1999 moonbase alpha ? | sborat | Looking for a game name ? | 3 | 26 July 2001 00:23 |
|
|