Qbasicnews.com

Full Version: Cant work this one out
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
I get a "Wrong number of dimensions. Found: 'Colornumber'"

On line 194, in the first line of the very last sub.

What is the problem!? I cant work it out.

A cookie for anyone who can.

(Most of the code is not mine, I'm just attempting to learn SDL)

[syntax="qbasic"]defint a-z
'$include: "sdl\sdl.bi"
'$include: "gl\gl.bi"
'$include: "gl\glu.bi
declare sub PSET (screen as SDL_Surface ptr , x as integer , y as integer, R as UBYTE , G as UBYTE, B as UBYTE, A as UBYTE)
DECLARE SUB SetColor (ColorNumber as integer, Red as ubyte, Green as ubyte, Blue as ubyte)

TYPE BMPHeader
ValidID AS STRING * 2
SizeOfFile AS LONG
Reserved AS LONG
OffsetOfBitMap AS LONG
END TYPE
TYPE WindowsBMPInfoHeader
SizeOfHeader AS LONG
Widthz AS LONG
Heightz AS LONG
Planes AS INTEGER
BitsPerPixel AS INTEGER
CompressMethod AS LONG
ImageSizeInBytes AS LONG
HorizontalResol AS LONG
VerticalResol AS LONG
ColorsUsed AS LONG
ImportantColors AS LONG
END TYPE

type paltype
r as ubyte
g as ubyte
b as ubyte
end type
dim pal(255) as paltype

dim screen as SDL_Surface ptr
dim a as string
Dim X as integer
Dim Y as integer
Dim red as integer
Dim green as integer
Dim blue as integer
Dim alpha as ubyte
Dim T as UBYTE
dim xRes as integer
dim yRes as integer

const NULL = 0



xRes = 800
yRes = 600
filename$ = "grz_cc.bmp"

dim bmpbuffer(xres,yres) as integer

screen = SDL_SetVideoMode(xRes, yRes, 32, SDL_HWSURFACE or SDL_FULLSCREEN)
if screen = 0 then
SDL_Quit
end 1
end if

'Start Load
SDL_LockSurface (screen)


'Start sub
DIM BMPHeader AS BMPHeader
DIM BMPInfoHeader AS WindowsBMPInfoHeader
DIM ColorPalArray(255, 3): ColorsInArray = 0
ColorPalArray(Loops, 1) = 0: ColorPalArray(Loops, 2) = 0
ColorPalArray(Loops, 3) = 0: Quality = 1: Variation = 3

OPEN FileName$ FOR BINARY AS #1
IF LOF(1) = 0 THEN
CLOSE #1
KILL FileName$
sdl_quit
end
END IF

GET #1, , BMPHeader
GET #1, , BMPInfoHeader

IF BMPInfoHeader.BitsPerPixel <> 24 THEN
CLOSE #1
sdl_quit
end
END IF

LineExtract& = BMPInfoHeader.Widthz * 3
IF (4 - (LineExtract& MOD 4)) <> 4 THEN
LineExtract& = LineExtract& + (4 - (LineExtract& MOD 4))
END IF
LineExtract$ = SPACE$(LineExtract&)

IF BMPInfoHeader.Heightz > yres THEN HeightLimit = yres-1 ELSE HeightLimit = BMPInfoHeader.Heightz - 1
IF BMPInfoHeader.Widthz > xres THEN WidthLimit = xres-1 ELSE WidthLimit = BMPInfoHeader.Widthz - 1

FOR YHeight = HeightLimit TO 0 STEP -1
GET #1, posi = 55 + (LineExtract& * (BMPInfoHeader.Heightz - 1)) - (LineExtract& * YHeight), LineExtract$
FOR XWidth = 0 TO WidthLimit
PixelBlue = ASC(MID$(LineExtract$, (XWidth * 3) + 1, 1)) \ (Quality * 4)
PixelGreen = ASC(MID$(LineExtract$, (XWidth * 3) + 2, 1)) \ (Quality * 4)
PixelRed = ASC(MID$(LineExtract$, (XWidth * 3) + 3, 1)) \ (Quality * 4)
PixelSet = 0
FOR Loops = 0 TO ColorsInArray
IF PixelBlue >= ColorPalArray(Loops, 3) - Variation AND PixelBlue <= ColorPalArray(Loops, 3) + Variation THEN
IF PixelGreen >= ColorPalArray(Loops, 2) - Variation AND PixelGreen <= ColorPalArray(Loops, 2) + Variation THEN
IF PixelRed >= ColorPalArray(Loops, 1) - Variation AND PixelRed <= ColorPalArray(Loops, 1) + Variation THEN
bmpbuffer (xwidth,ywidth) = loops
PixelSet = 1
EXIT FOR
END IF
END IF
END IF
NEXT Loops

IF PixelSet = 0 AND ColorsInArray < 255 THEN
ColorsInArray = ColorsInArray + 1
ColorPalArray(ColorsInArray, 1) = PixelRed
ColorPalArray(ColorsInArray, 2) = PixelGreen
ColorPalArray(ColorsInArray, 3) = PixelBlue
CALL SetColor(ColorsInArray, PixelRed, PixelGreen, PixelBlue)
bmpbuffer (xwidth,ywidth) = colorsinarray
ELSE
IF PixelSet = 0 THEN
Movement = 0
DO
FOR Loops = 0 TO 255
IF PixelBlue >= (ColorPalArray(Loops, 3) - Movement) AND PixelBlue <= (ColorPalArray(Loops, 3) + Movement) THEN
IF PixelGreen >= (ColorPalArray(Loops, 2) - Movement) AND PixelGreen <= (ColorPalArray(Loops, 2) + Movement) THEN
IF PixelRed >= (ColorPalArray(Loops, 1) - Movement) AND PixelRed <= (ColorPalArray(Loops, 1) + Movement) THEN
bmpbuffer (xwidth,ywidth) = loops
EXIT DO
END IF
END IF
END IF
NEXT Loops
Movement = Movement + 1
LOOP
END IF
END IF
NEXT XWidth
NEXT YHeight

close

for x = 0 to xres-1
for y = 0 to yres-1
c = bmpbuffer(x,y)
pset screen, x, y,pal©.r,pal©.g,Pal©.b,255
next
next


SDL_unlocksurface (screen)


SDL_PumpEvents
do
loop until SDL_GetMouseState( byval 0, byval 0 )

SDL_Quit
end


sub PSET (screen as SDL_Surface ptr , x as integer , y as integer, R as UBYTE , G as UBYTE, B as UBYTE, A as UBYTE)
dim cl as uinteger ptr
dim colkey as uinteger
dim Colptr as UBYTE ptr

colptr = @colkey : *colptr = R
colptr = @colkey + 1 : *colptr = G
colptr = @colkey +2 : *colptr = B
colptr = @colkey + 3 : *colptr = A
cl = screen->pixels + y * screen->pitch + x * len( integer )
*cl = colkey
end sub


SUB SetColor (ColorNumber as integer, Red as ubyte, Green as ubyte, Blue as ubyte)

pal(colornumber).r = red
pal(colornumber).g = green
pal(colornumber).b = blue

END SUB
[/syntax]
pal() is being accessed inside a subroutine but it's not declared as shared, FB will only create scalar vars.

btw, that BMP loader probably won't work, due the way user types are packed, you can load a bmp on SDL by doing:

dim mybmpsurface as SDL_Surface ptr
mybmpsurface = SDL_LoadBMP( "filename.bmp" )

SDL_LoadBMP's prototype was included on version 0.10b.


EDIT: also, PSET, SCREEN are all reserved words now.
*Smacks head on desk*

how did i suddenly lose my ability to handle Shared vars?

Heh

also thanks for the info about the bmp loading, although it really was just an excercise, i didnt really need a loader

Where can i get a list of the routines in SDL?
At http://sdldoc.csn.ul.ie/

C-oriented only, may won't be too simple to "translate".