Coagulus Pairs AGA from 1999 - and source

[Coagulus]

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!

; ***************************************************
; * 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!!!

[Cylon]

You're right, it's awful. ;-)

An example for "blitting" char font shapes to realise text:

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

This code was used to display (semi)transparent text on top of a CD32-like menu screen.
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.