ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/QBNWS203.ZIP/SPRITE.ZIP/G13UTIL.BAS

BASIC Source File | 1991-09-16 | 5.9 KB | 168 lines

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