'===========================================================================
' Subject: FAST MEMCOPY ROUTINE              Date: 07-11-96 (10:14)       
' Author:  Jonathan Leger                    Code: QB, QBasic, PDS        
' Origin:  leger@mail.dtx.net              Packet: GRAPHICS.ABC
'===========================================================================
'***************** MEM.BAS **************************************************
'*** These routines were written by Jonathan Leger:                       ***
'***                                                                      ***
'***                    leger@mail.dtx.net                                ***
'***                    http://www.dtx.net/~leger/                        ***
'***                                                                      ***
'***    PLEASE write to me with your questions.  I would appreciate any   ***
'*** feedback or machine language ideas for the expansion of Qbasic.      ***
'*** What can other compilers do that Qbasic can't?  What can PowerBASIC  ***
'*** or QuickBASIC do that Qbasic can't?  Maybe we can make it work using ***
'*** Machine Language routines that will blow away the other compilers    ***
'*** in speed... lemme know!  Write to me at the above e-mail address.    ***
'*** If you'd like to know how the ML routines work, write me and I'll    ***
'*** give you a step-by-step explanation.                                 ***
'****************************************************************************

DEFINT A-Z

DECLARE SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DECLARE SUB FillChar (segment%, offset%, value%, bytes%)

'$STATIC    '*** "REM $STATIC" keeps our buffer from moving around in memory
'           '*** for more info, see the manual or the HELP screen.

'*** Dim a 64,000 byte buffer to hold the screen image (an integer is
'*** 2 bytes, so 32000 * 2 = 64000, the size of a SCREEN 13 image).
DIM buffer(1 TO 32000) AS INTEGER
'$DYNAMIC

'*** Go to screen 13.
SCREEN 13

'*** Clear the screen using color 200 (sorta bluish-purple)
FillChar &HA000, 0, 200, &HFA00

'*** Draw some circles on the screen.
FOR x = 1 TO 100
   CIRCLE (159, 99), x, x
NEXT x

'*** Copy the image (which is 64,000 (FA00) bytes and starts at memcoy
'*** locat A000) and dump its contents into buffer().
MemCopy &HA000, 0, VARSEG(buffer(1)), VARPTR(buffer(1)), &HFA00

LOCATE 7, 7: PRINT "This image has been dumped"
LOCATE 8, 5: PRINT "Into a 64,000 byte buffer() array."
LOCATE 9, 8: PRINT "Press a key to reload it."

WHILE INKEY$ = "": WEND

'*** Clear the screen using color 150 (sorta deep blue)
FillChar &HA000, 0, 150, &HFA00

LOCATE 2, 1
PRINT "I'm putting this here to prove that I"
PRINT "actually cleared the screen. ;)  It"
PRINT "Also demonstrates the speed of the"
PRINT "FillChar() routine which was used to"
PRINT "clear the screen in this spiffy"
PRINT "color."
PRINT : PRINT "Press another key to reload the image."

WHILE INKEY$ = "": WEND

'*** Dump the contents of the buffer back onto the screen.
MemCopy VARSEG(buffer(1)), VARPTR(buffer(1)), &HA000, 0, &HFA00

LOCATE 1, 2: PRINT "Tada! So fast you don't believe it. ;)"

WHILE INKEY$ = "": WEND
SCREEN 0: WIDTH 80

REM $STATIC
'*****************************************************
'***                 FillChar()                    ***
'*****************************************************
'***  FillChar() puts whatever is in value% (which ***
'***  should be a number from 0-255) into memory   ***
'***  starting at location segment:offset, ending  ***
'***  at location segment:offset+bytes%.  An good  ***
'***  example of its use would be for clearing the ***
'***  screen with a different background color in  ***
'***  a graphics screen (which is pitifully slow   ***
'***  usint PSET).  To do this for SCREEN 13, for  ***
'***  example:                                     ***
'***                                               ***
'***  FillChar &HA000, 0, 15, &HFA00               ***
'***             ^     ^   ^    ^                  ***
'***             |     |   |    |                  ***
'***  Screen 13--+     |   |    |                  ***
'***                   |   |    |                  ***
'*** Start with first  |   |    |                  ***
'*** pixel.------------+   |    |                  ***
'***                       |    |                  ***
'*** Fill with character/  |    |                  ***
'*** color 15--------------+    |                  ***
'***                            |                  ***
'*** Do so 64,000 times---------+                  ***
'***                                               ***
'*** This will "clear" SCREEN 13 with the color 15 ***
'*** (bright white), and it does so _faster_ than  ***
'*** the CLS routine clears SCREEN 13 in black.    ***
'***                                               ***
'*** Notice that the 64,000 is in HEX (FA00).  This***
'*** is the same as with MemCopy(), where a value  ***
'*** greater than 32,767 has to be put into hex.   ***
'*** Since BASIC integers are signed (can be plus  ***
'*** or minues 32,767), BASIC does not let you use ***
'*** 65,534 (64k) in an integer, and there is no   ***
'*** way to declare a variable as an unsigned int- ***
'*** eger.  Machine Language, however, does not    ***
'*** recognize the plus or minus of a number unless***
'*** you tell it to, so by using the HEX value, we ***
'*** can trick BASIC into passing a number larger  ***
'*** than 32767 to the Machine Language routine,   ***
'*** which will treat &HFA00 as 64000 (even though ***
'*** if you do a PRINT &HFA00 it returns -1536).   ***
'*****************************************************
SUB FillChar (segment%, offset%, value%, bytes%)

asm$ = ""
asm$ = asm$ + CHR$(85)                             'PUSH BP
asm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SP
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8)       'MOV DX,[BP+08]
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12)      'MOV AX,[BP+0C]
asm$ = asm$ + CHR$(30)                             'PUSH DS
asm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AX       
asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10)      'MOV BX,[BP+0A]  
asm$ = asm$ + CHR$(136) + CHR$(23)                 'MOV [BX],DL <------+
asm$ = asm$ + CHR$(67)                             'INC BX             |
asm$ = asm$ + CHR$(226) + CHR$(251)                'LOOP 0112   -------+
asm$ = asm$ + CHR$(31)                             'POP DS
asm$ = asm$ + CHR$(93)                             'POP BP
asm$ = asm$ + CHR$(203)                            'RETF

DEF SEG = VARSEG(asm$)
   CALL Absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(asm$))
DEF SEG

END SUB

'*************************************************************
'***                       MemCopy()                       ***
'*************************************************************
'*** This routine will copy the number of bytes specified  ***
'*** in the Bytes% variable from the segment:offset in     ***
'*** fromseg%:fromoffset% to the segment:offset given in   ***
'*** toseg%:tooffset%.  To copy more than 32767 bytes,     ***
'*** put the HEX value in Bytes% instead of the decimal    ***
'*** value.  For example, in HEX, 64000 is FA00 (prepended ***
'*** by an &H in BASIC, to make it &HFA00), so if you were ***
'*** to copy a 64,000 byte screen 13 image, you would do:  ***
'***********************************************************************
'*** MemCopy &HA000, 0, VARSEG(buffer(0)), VARPTR(buffer(0)), &HFA00 ***
'***           ^     ^        ^                   ^             ^    ***
'***           |     |        |                   |             |    ***
'*** Screen 13-+     |        |                   |             |    ***
'***                 |        |                   |             |    ***
'*** Start copying at+        |                   |             |    ***
'*** the first pixel-+        |                   |             |    ***
'***                          |                   |             |    ***
'*** Segment of our 64k buffer+                   |             |    ***
'***                                              |             |    ***
'*** Offset of our 64k buffer --------------------+             |    ***
'***                                                            |    ***
'*** Copy 64,000 bytes (HEX = FA00, BASIC = &HFA00) ------------+    ***
'***********************************************************************
'*** For a full explanation of why we must use HEX instead of decimal***
'*** for values greater than 32,767, see the remarks in the FillChar ***
'*** routine.                                                        ***
'***********************************************************************
'    This routine was written by Jonathan Leger, and if you use it,
'    please let me know.  I'd like to know if this code is getting
'    any practical use.  I've wanted to emulate PowerBASIC's POKE$
'    and PEEK$ for a _long_ time (also Pascal's Mem[] routine), and
'    this is my first stab at it, which worked out very well and is
'    very fast since it's in pure machine language (it was written
'    in DOS' Debug! =).
'***********************************************************************
SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)

asm$ = ""
asm$ = asm$ + CHR$(85)                             'PUSH BP
asm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SP
asm$ = asm$ + CHR$(30)                             'PUSH DS
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10)      'MOV AX,[BP+0A]
asm$ = asm$ + CHR$(142) + CHR$(192)                'MOV ES,AX
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14)      'MOV AX,[BP+0E]
asm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AX
asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8)      'MOV SI,[BP+08]
asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12)     'MOV DI,[BP+0C]
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
asm$ = asm$ + CHR$(243)                            'REPZ
asm$ = asm$ + CHR$(164)                            'MOVSB
asm$ = asm$ + CHR$(31)                             'POP DS
asm$ = asm$ + CHR$(93)                             'POP BP
asm$ = asm$ + CHR$(203)                            'RETF

DEF SEG = VARSEG(asm$)
   CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(asm$))
DEF SEG

END SUB