English Amiga Board


Go Back   English Amiga Board > Coders > Coders. Language

 
 
Thread Tools
Old 25 September 2014, 23:35   #1
Coagulus
Gets there in the end...

Coagulus's Avatar
 
Join Date: Sep 2005
Location: Wales
Posts: 625
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!!!
Coagulus is offline  
Old 24 November 2014, 00:08   #2
Cylon
Registered User

 
Join Date: Oct 2014
Location: Europe
Posts: 466
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
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.
Attached Thumbnails
Click image for larger version

Name:	CD32-SelMenu.png
Views:	151
Size:	60.6 KB
ID:	42352  

Last edited by Cylon; 30 November 2014 at 05:05. Reason: added example for gfx text blitting
Cylon is offline  
 


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 17:02
What was the url for JAMBO! in 1999? caffeinekid Amiga websites reviews 2 26 July 2008 11:36
T-Zero AmigaCD (1999) clickBOOM seuden request.Old Rare Games 3 08 May 2007 19:56
Moonbases (1999 Homegrown/Alive Mediasoft) Korodny request.Old Rare Games 11 10 August 2004 17:46
1999 moonbase alpha ? sborat Looking for a game name ? 3 26 July 2001 01:23

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT +2. The time now is 15:29.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2018, vBulletin Solutions Inc.
Page generated in 0.05907 seconds with 16 queries