DEFINT A-Z

'$INCLUDE: 'QBXM.BI'

'=========================================================================
'
'   XMDEMO1.BAS a simple demo of a few of the QBXM routines.  Note that
'   these programs can be run in the QB environment as is.  If compiled
'   to an EXE, the BASIC run time library must be used (No /O on the
'   command line) because of the CHAIN statement at the end of the code
'   to XMDEMO2.  To use as a stand alone program, change the commented
'   out code at the end of the file, so that the extra memory parameters
'   are written out to disk, and XMDEMO2 is RUN instead of CHAINed to.
'
'=========================================================================

COMMON SHARED paramBuffer AS STRING * 530

DIM rec1 AS STRING * 20
REDIM test1(1 TO 32000)       'REDIM forces array to be $DYNAMIC

'=========================================================================
'
'   The GetXM routine is called first.  It returns a flag indicating the
'   type of memory installed, expanded or extended.  It's just there of
'   course if you're interested.  The type of memory has no effect on any
'   of the routines.  The SELECT CASE statement illustrates the values
'   returned.  The major and minor version numbers of the driver in use
'   are also returned.  Care must be taken if an EMS driver earlier than
'   version 4.0 is in use.  If that is the case, the named handle routines
'   should not be called.  EMS 3.0 and 3.2 did not support named handles.
'
'=========================================================================

CLS
CALL GetXM(major, minor, flag)

SELECT CASE flag
	CASE 0
		PRINT "No extra memory is installed."
		END
	CASE 1
		PRINT "Expanded memory is in use, version:";
	CASE 2
		PRINT "Extended memory is in use, version:";
	CASE ELSE
		PRINT "An error was returned.  Code: ";
		PRINT RIGHT$("0000" + HEX$(flag), 4)
		END
END SELECT

PRINT USING "##.##"; major + minor / 10

'=========================================================================
'
'   Now, find out how much memory is installed and how much is free.
'
'   GetPagesXM returns:
'
'   'total' as the number of 16k pages installed for EMS,
'           or the number of 16k pages free at the moment for XMS.
'
'   'pages' as the count of free pages for EMS, all this could be allocated
'           to 1 handle in an EMS system,
'           with XMS this indicates the largest block that can be allocated
'           to one handle.  The 'total' and 'pages' should be equal most of
'           the time.  A multitasker with another program running may cause
'           memory to become fragmented.
'
'=========================================================================


CALL GetPagesXM(total, pages)

SELECT CASE flag
	CASE 1
		PRINT USING "Expanded memory total: ###,###,###"; CLNG(total) * 16384&
		PRINT "Expanded";
	CASE 2
		PRINT USING "Extended memory total: ###,###,###"; CLNG(total) * 16384&
		PRINT "Extended";
END SELECT
	   
PRINT USING " memory free:  ###,###,###"; CLNG(pages) * 16384&

'=========================================================================
'
'   An example of the 'Bulk' memory handling routines.
'
'   First, fill an array of 32000 integers and store it in eXtraMem:
'   32,000 integers require 64,000 bytes.  64,000 / 16384 page size
'   means that we need 4 pages (65,536 bytes)
'
'=========================================================================

pages = 4
CALL OpenXM(pages, handle, errCode)
PRINT
PRINT "OpenXM call: ";
PRINT "Requested:"; pages; "pages,";
PRINT " Handle assigned: "; handle;
PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)

IF errCode THEN GOSUB CloseExtraMem

'=========================================================================
'
'   Just out of curiousity, see if PageCountXM returns 4....
'
'=========================================================================

x = PageCountXM(handle)

IF x <> pages THEN
	PRINT "GetPagesXM error, returned: "; x
	GOSUB CloseExtraMem
END IF

PRINT
PRINT USING "Conventional memory free with array:    ###,###"; FRE(-1)
PRINT "Filling array, ";

FOR i = 1 TO 32000
	test1(i) = i
NEXT

PRINT "storing array in extra memory, ";

'=========================================================================
'
'   To move x number of bytes from conventional memory to extra memory,
'   you need to specify the starting address in conventional memory as
'   a segment offset pair.  VARSEG and VARPTR do the trick.  (I embed the
'   function right in the call because BASIC may move things around in
'   memory, and I'm BASICly a chicken.)  Next you need the extra memory
'   handle that you want to store the data in, then the number of bytes
'   to move.  Because the bytes to move value is really an unsigned integer
'   it can range from 0-65535.  BASIC won't take 64,000 in a signed integer,
'   so for ease of use I specified a hex value.  Equates to -1536, if your
'   interested.  When an unknown number of bytes must be moved you can use
'   a loop instead.  See the doc file for an example.  Finally, you have
'   to say where in the extra memory handle you want to store the data.
'   This value is a long integer and is treated as an offset into the extra
'   memory handle, the first byte is at offset 0, so that's where this array
'   is going.
'
'=========================================================================

CALL Conv2XM(VARSEG(test1(1)), VARPTR(test1(1)), handle, &HFA00, 0, errCode)

IF errCode THEN
	PRINT : PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
	GOSUB CloseExtraMem
END IF

'=========================================================================
'
'   Don't need the array any more, so free up the memory for other uses.
'
'=========================================================================

PRINT "erasing array."
ERASE test1
PRINT USING "Conventional memory free without array: ###,###"; FRE(-1)

'=========================================================================
'
'   Have the array in eXtraMemory in handle number "handle" so we'll name
'   it so XMDEMO2 can use it.   You could pass the handle to the next
'   program in the chain via a variable, or write it to disk, but why use
'   up limited memory (with COMMON SHARED) or take time to write a file
'   if you don't have to.
'
'=========================================================================

CALL PutNameXM("ARRAY", handle, errCode)

IF errCode THEN
	PRINT "Error on PutNameXM: "; RIGHT$("0000" + HEX$(errCode), 4)
	GOSUB CloseExtraMem
END IF

'=========================================================================
'
'   Now let's try the record orientated routines.  We will generate 1,000
'   records that look like "Record: 1", "Record: 2", "Record: 3" etc.
'   Then each record is put to the extra memory 'file'.  XMDEMO2 will use
'   the same code to generate a 'record' then get the corresponding record
'   from the extra memory 'file' and compare the results. Pages should
'   equal, for 1,000 20 byte records:  (2)
'
'=========================================================================


pages = 20000 \ 16384 + 1

'=========================================================================
'
'   OpenRecXM needs the number of 16k pages, then the length of each
'   record associated with the 'file'.  It will return a handle to use
'   with this allocation of memory.
'
'=========================================================================

CALL OpenRecXM(pages, 20, handle, errCode)

PRINT
PRINT "OpenRecXM call: ";
PRINT "Requested:"; pages; "pages,";
PRINT " Handle assigned: "; handle;
PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)
IF errCode THEN GOSUB CloseExtraMem

FOR i& = 1 TO 1000
	rec1 = "Record:" + STR$(i&)
	

'=========================================================================
'
'   PutRecXM needs the 'file' handle, the record number as a long
'   integer, and the segment:offset address of the data to put in
'   the file.  Same route to determine the address of the record to
'   put into extra memory as in Conv2XM, VARSEG and VARPTR.
'   Note that the record length doesn't have to be referred to any
'   more because it was specified when the memory was allocated.
'
'=========================================================================

	CALL PutRecXM(handle, i&, VARSEG(rec1), VARPTR(rec1), errCode)
  
	IF errCode THEN
		PRINT "Put Record Error: "; RIGHT$("0000" + HEX$(errCode), 4)
		GOSUB CloseExtraMem
	END IF
NEXT

'=========================================================================
'
'   Have all 1000 records in eXtraMem in handle number "handle" so name
'   it for XMDEMO2's use:
'
'=========================================================================

CALL PutNameXM("RECORDS", handle, errCode)


'=========================================================================
'
'   Now for the screen handling routines.  This is pretty boring, but
'   what the routine does is generate 102 screens and stores each screen
'   in extra memory.  First thing is to save the current screen with the
'   information that has been printed so far.
'
'=========================================================================

screens = 100                            'Request 100, results in 102
CALL OpenScreenXM(screens, errCode)

IF errCode THEN
	PRINT "Open Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
	GOSUB CloseExtraMem
END IF

screens = ScreenCountXM%        'This gives us the total available.
CALL SaveScreenXM(screens, errCode)

'=========================================================================
'
'   The above saves the current output screen in the last screen available.
'   so that when when it's restored, the prompt below won't be on it.
'   Note also that the current cursor position is saved.  As the test
'   screens are drawn, the cursor location will be changed, this allows
'   the cursor to be restored to it's proper location later.
'
'=========================================================================

holdRow = CSRLIN
holdCol = POS(0)
PRINT "press a key to start generating screens."
DO: LOOP WHILE INKEY$ = ""

FOR scrNum = 1 TO screens - 1
	a$ = LTRIM$(RTRIM$(STR$(scrNum)))
	a$ = RIGHT$("****" + a$, 4)
	FOR row = 1 TO 25
		FOR col = 1 TO 79 STEP 4
			LOCATE row, col
			PRINT a$;
		NEXT
	NEXT

	CALL SaveScreenXM(scrNum, errCode)
   
	IF errCode THEN
		CLS
		PRINT "Save Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
		GOSUB CloseExtraMem
	END IF
NEXT

CALL RestScreenXM(screens, errCode)    'Redisplay the status screen
LOCATE holdRow, holdCol                'restore the cursor

'=========================================================================
'
'   OK, that should be enough for now.  Fill out the parameter buffer for
'   everything we've put in memory, and save it for XMDEMO2's use.
'
'   Adjust the commented code below to change from a CHAIN to a RUN
'   start up for XMDEMO2.
'
'=========================================================================

CALL SaveParamXM(VARSEG(paramBuffer), VARPTR(paramBuffer), errCode)

CHAIN "XMDEMO2"         'Comment out for a RUN command.

'   OPEN "XMPARAM.DAT" FOR BINARY AS #1
'   PUT #1, 1, paramBuffer
'   CLOSE
'   RUN "XMDEMO2"

END

CloseExtraMem:

	CALL CloseAllXM
	END