Qbasicnews.com
December 10, 2019, 07:06:38 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Animated map "challenge"?  (Read 2384 times)
seph
Na_th_an
*****
Posts: 1915



« on: August 24, 2003, 10:41:44 PM »

Not really a challenge, but it could be if you wanted to... I just wantd to show Agamemnus how I made an animated map possible with one single array... and I wanna see what he did too...

Code:
DECLARE SUB DrawMap ()
DECLARE SUB ExitError (msg$)
DECLARE SUB Do.Init ()
DECLARE SUB Do.Main ()
DECLARE SUB Do.End ()

'$INCLUDE: 'ugl\inc\ugl.bi'
'$INCLUDE: 'ugl\inc\kbd.bi'

CONST cRes = UGL.8BIT, xRes = 320, yRes = 200
CONST totalNumImages = -2, currentImage = -1, maxImages = 16
CONST mapX% = 20, mapY% = 12

DIM SHARED video AS LONG, buffer AS LONG, keys AS TKBD
DIM SHARED images(0 TO (maxImages - 1), -2 TO 5) AS LONG
DIM SHARED mapitem(1 TO mapX%, 1 TO mapY%) AS INTEGER

ImageData:
DATA 1,1,1,2,2,2,2,6,2,2,2,2,1,1,1,1

MapData:
DATA 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12
DATA 12,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,15,12
DATA 12,00,02,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,12
DATA 12,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,00,12
DATA 12,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,12
DATA 12,00,12,12,12,00,00,00,03,04,04,04,04,05,00,00,00,00,00,12
DATA 12,00,12,12,12,00,00,00,06,07,07,07,07,08,00,00,00,00,00,12
DATA 12,00,12,12,12,00,00,00,06,07,07,07,07,08,00,00,02,00,00,12
DATA 12,00,13,14,15,00,00,00,09,10,10,10,10,11,00,00,00,00,00,12
DATA 12,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,12
DATA 12,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,12
DATA 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12

Do.Init
Do.Main
Do.End

SUB Do.End
kbdEnd
uglRestore
uglEnd
SCREEN 0
CLS
SYSTEM
END SUB

SUB Do.Init
IF NOT uglInit THEN ExitError "Can't Init UGL"

video = uglSetVideoDC(cRes, xRes, yRes, 1)
buffer = uglNew(UGL.MEM, cRes, xRes, yRes)

IF NOT uglPutBMP(buffer, 0, 0, "newtest.bmp") THEN ExitError "Can't load images"

kbdInit keys

RESTORE ImageData
FOR allImages% = 0 TO (maxImages - 1)
READ numFrames%
images(allImages%, totalNumImages) = numFrames%
FOR i% = 0 TO numFrames% - 1
images(allImages%, i%) = uglNew(UGL.EMS, cRes, 16, 16)
uglGet buffer, allImages% * 16, i% * 16, images(allImages%, i%)
NEXT i%
NEXT allImages%

RESTORE MapData
FOR y% = 1 TO mapY%
FOR x% = 1 TO mapX%
READ mapitem(x%, y%)
NEXT x%
NEXT y%

uglClear buffer, 0
END SUB

SUB Do.Main
DO
IF keys.esc THEN EXIT SUB
DrawMap

uglPut video, 0, 0, buffer
LOOP
END SUB

SUB DrawMap
STATIC timecheck AS SINGLE

IF timecheck < TIMER THEN
timecheck = TIMER + .1

FOR i% = 0 TO (maxImages - 1)
imax% = images(i%, totalNumImages)
IF imax% > 0 THEN images(i%, currentImage) = (images(i%, currentImage) + 1) MOD imax%
NEXT i%

FOR y% = 1 TO mapY%
FOR x% = 1 TO mapX%
uglPut buffer, (x% - 1) * 16, (y% - 1) * 16, images(mapitem(x%, y%), images(mapitem(x%, y%), currentImage))
NEXT x%
NEXT y%
END IF
END SUB

SUB ExitError (msg$)
kbdEnd
uglRestore
uglEnd
SCREEN 0
CLS
PRINT msg$
SYSTEM
END SUB
Logged

earn.
Agamemnus
x/ \z
*****
Posts: 3491



« Reply #1 on: August 24, 2003, 10:49:59 PM »

It's a start, but I did it like this:

image.start(1 to animation.amount)
image.end(1 to animation.amount)
image.handle(1 to image.amount)

animation.amount >= image.amount

--------------------

Sometimes you want to reuse images, so:

image.start(1 to animation.amount) 'uses image.pointer
image.end(1 to animation.amount) 'uses image.pointer
image.pointer(1 to image.pointer.amount) 'points to image.handle
image.handle(1 to image.amount)
Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!