Category : BASIC Source Code
Archive   : QBNWS203.ZIP
Filename : G13UTIL.BAS

DEFINT A-Z
'$DYNAMIC
DECLARE SUB changeclr (ary(), oclr, nclr)
DECLARE SUB mirror (ary(), bry())
DECLARE SUB superimp (ary(), xpos, ypos, mode)
DECLARE SUB scrollup (ary(), xpos, ypos)

'***************************************************************************
' SCREEN 13 GRAPHIC UTILITIES
' by FRED SEXTON JR.
' CHANGECLR
' Searches an image array for a color and changes it to a
' different color.
' syntax => CALL changeclr(array(),oldcolor,newcolor)
'
' MIRROR
' Returns a mirror image of first array in second array.
' ****DIMENSION BOTH ARRAYS TO THE SAME SIZE****
' syntax => CALL mirror(array1(), array2())
'
' SUPERIMP
' Puts a graphic image at specified location.
' Depending on setting of mode varible the image
' is either put in front of or behind the images
' that exist on the screen.
' syntax => CALL superimp(array(), xpos, ypos, mode)
' mode = 0 => put in front
' mode = 1 => put behind
'
' SCROLLUP
' Scrolls a graphic image up onto the screen ending up
' at specifeid location.
' syntax => CALL scrollup(array(), xpos, ypos)
'
'
'***************************************************************************

SUB changeclr (ary(), oclr, nclr)

xwidth = ary(0) \ 8 'get x-axis width
yheight = ary(1) 'get y-axis height

bytes& = CLNG(xwidth) * CLNG(yheight) 'find # of bytes in image
'while avoiding overflow error

DEF SEG = VARSEG(ary(2)) 'set the segment
aofs = VARPTR(ary(2)) 'get starting offset

FOR t& = 0& TO bytes& - 1 'search the required # of bytes
IF PEEK(t& + aofs) = oclr THEN POKE t& + aofs, nclr 'change as needed
NEXT

END SUB

SUB mirror (ary(), bry())

bry(0) = ary(0) 'make bit width the same
bry(1) = ary(1) 'make height the same

xwidth = ary(0) \ 8 'get x-axis width
yheight = ary(1) 'get y-axis height

aseg = VARSEG(ary(2)) 'get the segment of array1
aofs = VARPTR(ary(2)) 'get the offset of element 2
bseg = VARSEG(bry(2)) 'get the segment of array2
bofs = VARPTR(bry(2)) + xwidth - 1 'get the offset to start at


'the two sets of "FOR:NEXT
'will effectively step thru array1
'byte by byte
FOR t = 1 TO yheight
FOR tt = 0 TO xwidth - 1
DEF SEG = aseg
value = PEEK(aofs + tt) 'get a value from array1
DEF SEG = bseg
POKE bofs, value 'put it into array2
bofs = bofs - 1
NEXT
aofs = aofs + xwidth 'setup offsets for next row
bofs = bofs + (xwidth * 2)
NEXT
'return to default segment
DEF SEG

END SUB

SUB scrollup (ary(), xpos, ypos)

yheight = ary(1) 'get yaxis height
ypos = ypos + yheight 'setup starting ypos value

FOR t = 1 TO yheight
ary(1) = t 'modify the value that PUT will use
ypos = ypos - 1 'move ypos up one row
PUT (xpos, ypos), ary, PSET 'put image to screen

SOUND 32767, 2 'use your favorite method to create
'a delay here
'(I use an routine I wrote in
' MASM but this will work)
NEXT

END SUB

SUB superimp (ary(), xpos, ypos, mode)

DIM wry(UBOUND(ary)) 'dim a work array the same size

xwidth = ary(0) / 8 'get x-axis width
yheight = ary(1) 'get y-axis height

GET (xpos, ypos)-(xpos + xwidth - 1, ypos + yheight - 1), wry

'get the target area of screen in work array


IF mode = 0 THEN 'mode 0 means put in front

FOR t = 2 TO UBOUND(ary) 'search the source array

DEF SEG = VARSEG(ary(t)) 'starting with element 2
lb = PEEK(VARPTR(ary(t))) 'get the lower byte
ub = PEEK(VARPTR(ary(t)) + 1) 'get the upper byte

IF lb <> 0 THEN 'if soucre array isn't zero
DEF SEG = VARSEG(wry(t))
POKE VARPTR(wry(t)), lb 'put it into work array
END IF

IF ub <> 0 THEN 'same thing for upper byte
DEF SEG = VARSEG(wry(t))
POKE VARPTR(wry(t)) + 1, ub
END IF

NEXT
DEF SEG 'return to default segment

ELSE 'nonzero mode means put behind

FOR t = 2 TO UBOUND(wry) 'search work array
DEF SEG = VARSEG(wry(t)) 'starting with element 2
lb = PEEK(VARPTR(wry(t))) 'get lower byte
ub = PEEK(VARPTR(wry(t)) + 1) 'get upper byte

IF lb = 0 THEN 'if work value is zero
DEF SEG = VARSEG(ary(t)) 'get corresponding byte
lb = PEEK(VARPTR(ary(t))) 'from source array
DEF SEG = VARSEG(wry(t)) 'put it into work array
POKE VARPTR(wry(t)), lb
END IF

IF ub = 0 THEN 'same thing for upper byte
DEF SEG = VARSEG(ary(t))
ub = PEEK(VARPTR(ary(t)) + 1)
DEF SEG = VARSEG(wry(t))
POKE VARPTR(wry(t)) + 1, ub
END IF

NEXT
DEF SEG 'return to default segment
END IF

PUT (xpos, ypos), wry, PSET 'put the resulting array on screen

END SUB