Qbasicnews.com
September 29, 2020, 05:35:17 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Super Array Handler  (Read 2340 times)
KiZ
__/--\__
*****
Posts: 2879


WWW
« on: April 07, 2004, 04:21:33 PM »

Hey folks!

I thought "hmm... i soooo cant be assed with the puny arrays that QB has. I need some power!"
So I made this. It supports ridiculously large arrays, up to (im not sure about this) 2Gb large. because I think thats DOS's file handling limit.

Anyway, ive tested up to a 100Mb array (10240x10240) and it works fine.

It is relatively simple, but this presents a few restrictions:

1. It supports ONLY number arrays.
2. It supports ONLY the values 0-255 (i know, i know...)
3. The subscripts are defined ONLY for values above 0. Example: 1-100.

Thats about it! also, i forgot to add a delete array script, so if you create a 500mb array, you will be left with a file measuring 500mb on your HDD after the program is run ^_^  so i would recommend deleting it. It also has full erasing support, ie if there was already an array on HDD, then it will resize that array next time it dimensions it.

Finally: It is quite slow. =S Not suitable for programs that require a lot of speed. But for other stuff it is fine.

Here we go:
Code:

'Huge array handler...
'Handles over 100mb arrays! (Over 104 million subscripts!)
'Values must be in range (1-255)
'dimension id,sizex,sizey
'arput id,xpos,ypos,value
'arget id,xpos,ypos

'-----AH setup-------
DECLARE SUB dimension (id!, xsize!, ysize!)
DECLARE SUB arput (id!, xpos!, ypos!, value!)
DECLARE FUNCTION arget! (id!, xpos!, ypos!)
TYPE array
  xsize AS SINGLE
  ysize AS SINGLE
END TYPE
DIM SHARED ar(10) AS array
'------------------------

CLS
PRINT "Dimensioning array 1 for 1024x1024...(1mb)"
dimension 1, 1024, 1024
PRINT "Done"
PRINT
PRINT "Putting `72` into position 800,100 in array 1..."
arput 1, 800, 100, 72
PRINT "done"
PRINT
PRINT "Getting a value from position 800,100 in array 1..."
a = arget(1, 800, 100)
PRINT "Done. The value was:"; a
CLOSE

FUNCTION arget (id, xpos, ypos)
a$ = " "
GET #id, xpos * ar(id).ysize + ypos - ar(id).ysize, a$
arget = ASC(a$)
END FUNCTION

SUB arput (id, xpos, ypos, value)
a$ = CHR$(value)
PUT #id, xpos * ar(id).ysize + ypos - ar(id).ysize, a$
END SUB

SUB dimension (id, xsize, ysize)
OPEN "array" + LTRIM$(STR$(id)) + ".arr" FOR BINARY AS #id
IF LOF(id) THEN
  CLOSE
  KILL "array" + LTRIM$(STR$(id)) + ".arr"
  OPEN "array" + LTRIM$(STR$(id)) + ".arr" FOR BINARY AS #id
END IF
ar(id).xsize = xsize
ar(id).ysize = ysize
IF xsize * ysize > 1000 THEN
  a$ = STRING$(1000, " ")
  FOR i = 1 TO xsize * ysize STEP 1000
    PUT #id, , a$
    z = z + 1000
    IF xsize * ysize - z < 1000 THEN a$ = STRING$(xsize * ysize - z, " "): PUT #id, , a$: EXIT FOR
  NEXT
ELSE
  a$ = STRING$(xsize * ysize, " "): PUT #id, , a$
END IF
END SUB
Logged
1000101
Ancient Guru
****
Posts: 519



WWW
« Reply #1 on: April 07, 2004, 05:30:01 PM »

Kind of neat, but...why not just use EMS?  When are you going to need an array that large?

Besides, you can cache to disk when you are out of EMS.

So, the program logic would be like this:

BASIC <-> EMS <-> Disk

Basic always get's/puts from/to EMS and internall you handle the EMS buffering of the disk array.

If the data location requested isn't in EMS, you save the current area to disk then load the requested area.
Logged

Life is like a box of chocolates', hrm, WTF, no it isn't, more like, 'life is like a steaming pile of horse crap.'
Z!re
*/-\*
*****
Posts: 4599


« Reply #2 on: April 07, 2004, 06:18:11 PM »

Cool, yeah, QB's arrays kinnda suck when you need large amounts of space Tongue

Here's an on disk array handler I wrote some time ago, it's used in Novix. And is somewhat more flexibel then your's.

I'm not trying to steal this thread, this code has been up before, and noone cared, so don't start now Tongue

Anyways, use it as you like, rewrite it, ignore it, worship it. It's up to you. You don't even need to give credit (although it would be nice)


Here:
It can handle strings of up to 8192bytes in size (This is changeable)
And the largest array possible would be 8192x1024 (again, changeable, I have it set to 261120x8192, but in this code it was 1024x8192), this is the maximum that is set now, you may change this in the CreateArray function.

Code:
qbasic'Array handler capable of handling arrays of up to 261120x8192 (2Gb) in size.
DEFINT A-Z
'$DYNAMIC
DECLARE FUNCTION ArrGet$ (arr AS STRING, index AS LONG)
DECLARE SUB ArrPut (arr AS STRING, index AS LONG, dat AS STRING)
DECLARE FUNCTION CreateArray$ (slots&, bytes%)
DECLARE SUB EraseArr (arr AS STRING)
DECLARE FUNCTION RHEX$ (Lenght AS INTEGER)

CLS

PRINT "Loading..." ;
arr$ = CreateArray(5040, 1000)    'create our array (5mb in size)
PRINT "Done"

t! = TIMER                        'start timing
FOR a& = 0 TO 5040
 ArrPut arr$, a&, STR$(a&)        'put some data in the array (at every pos)
NEXT
FOR a& = 0 TO 5040
 g$ = ArrGet(arr$, a&)            'retreive all data
NEXT
PRINT TIMER - t!                  'display ttal time for put and get


ArrPut arr$, 0, ""                'put a 0 lenght string
PRINT "->"; ArrGet(arr$, 0); "<-" 'retreive it, is it 1000 bytes? no =)

ArrPut arr$, 0, "Testing "        'put a 8 lenght string (note the space)
PRINT "->"; ArrGet(arr$, 0); "<-" 'retreive it, is it 1000 bytes? no =)

'ArrGet only return the number of bytes saved

EraseArr arr$

'Returns the value stored at index
'in array handle arr
'
'By J. Pihl [Z!re | XiberLord]
'
FUNCTION ArrGet$ (arr AS STRING, index AS LONG)
IF LEN(arr) <> 8 THEN EXIT FUNCTION
ff = FREEFILE
OPEN arr + ".Arr" FOR BINARY AS #ff
slots& = CVL(INPUT$(4, #ff))
bytes = CVI(INPUT$(2, #ff))
IF index > slots& THEN CLOSE #ff: EXIT FUNCTION
offs& = index * (bytes + 2) + 7
t$ = "  "
GET #ff, offs&, t$
t$ = SPACE$(CVI(t$))
GET #ff, , t$
CLOSE #ff
ArrGet$ = t$
END FUNCTION

'Stores dat at location index
'in array handle arr
'
'By J. Pihl [Z!re | XiberLord]
'
SUB ArrPut (arr AS STRING, index AS LONG, dat AS STRING)
IF LEN(arr) <> 8 THEN EXIT SUB
ff = FREEFILE
OPEN arr + ".Arr" FOR BINARY AS #ff
slots& = CVL(INPUT$(4, #ff))
bytes = CVI(INPUT$(2, #ff))
IF LEN(dat) > bytes THEN CLOSE #ff: EXIT SUB
IF index > slots& THEN CLOSE #ff: EXIT SUB
offs& = index * (bytes + 2) + 7
t$ = MKI$(LEN(dat)) + dat
PUT #ff, offs&, t$
CLOSE #ff
END SUB

'Creates an array with slots& slots
'and bytes% bytes per slot
'
'Returns the array handle or nothing if error
'
'Do not lose the handle, without it you can't
'access the array, nor remove it.
'
'By J. Pihl [Z!re | XiberLord]
'
FUNCTION CreateArray$ (slots&, bytes%)

'_____________LIMITS___________
'look here for the limits!!

IF bytes > 8192 THEN EXIT FUNCTION
IF slots& * bytes >= 8192 * 1024& THEN EXIT FUNCTION

'note that the maximum size would be 2gb,
'and bytes% cannot be more then 32767
'bytes (that is a massive string)
'^^^^^^^^^^^^^^^^^^^^^^^^^

arrn$ = RHEX(8)
ff = FREEFILE
OPEN arrn$ + ".Arr" FOR BINARY AS #ff
t$ = MKL$(slots&) + MKI$(bytes)
PUT #ff, 1, t$
t$ = MKI$(0)
FOR a& = 0 TO slots&
 PUT #ff, 7& + (bytes% + 2) * a&, t$
NEXT
CLOSE #ff
CreateArray$ = arrn$
END FUNCTION

'Removes array file by using array handle
'
'By J. Pihl [Z!re | XiberLord]
'
SUB EraseArr (arr AS STRING)
IF arr = "" THEN EXIT SUB
ff = FREEFILE
OPEN arr + ".Arr" FOR OUTPUT AS #ff
CLOSE #ff
KILL arr + ".Arr"
END SUB

'Returns a lenght long hex string
'
'By J. Pihl [Z!re | XiberLord]
'
FUNCTION RHEX$ (Lenght AS INTEGER)
FOR a = 1 TO Lenght
 s$ = s$ + HEX$(INT(16 * RND))
NEXT
RHEX$ = s$
END FUNCTION


Writing a bunch of bytes to the file instead of writing/reading one at a time means a huge speed increase. Try it  :lol:
Logged
KiZ
__/--\__
*****
Posts: 2879


WWW
« Reply #3 on: April 08, 2004, 09:45:06 AM »

Well, that certainly looks better than mine... i think?  I am also surprised at how my array functions have almost exactly the same names as yours. hmm :shifty:

Is that handler fast at all?

1000101: I dont actually know... how to use.... EMS... *runs away*
Logged
Z!re
*/-\*
*****
Posts: 4599


« Reply #4 on: April 08, 2004, 12:19:25 PM »

It's faster then your's at writing a lot of data.

And it's more flexible, as you can write long strings at a time instead of single bytes.


But no, it's not fast, anything that writes/reads to7from the disk is slow  Tongue , that's why they invented RAM..  :lol:
Logged
1000101
Ancient Guru
****
Posts: 519



WWW
« Reply #5 on: April 08, 2004, 06:53:58 PM »

Quote from: "dark_prevail"
1000101: I dont actually know... how to use.... EMS... *runs away*


There are plenty of examples of of EMS and QB (that is to say, QB code making use of EMS and not some external library).

Plus, even if you do use the disk to you should use interrupts to transfer and buffer large blocks of data.  That would speed it up tremendously.
Logged

Life is like a box of chocolates', hrm, WTF, no it isn't, more like, 'life is like a steaming pile of horse crap.'
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!