I am a procrastinator...

by Michael Calkins (Login MCalkins)
ASM Forum

 
It's barely tested, and it is in the GOSUB style...

Regards,
Michael


' public domain
TYPE othertype
 x AS LONG
 y AS LONG
END TYPE

DIM i AS LONG
DIM i1 AS LONG
DIM xu AS LONG
DIM xl AS LONG
DIM yu AS LONG
DIM yl AS LONG
DIM numEntries AS LONG
DIM k AS STRING
DIM t AS STRING

'dynamic arrays can be resized as needed with REDIM _PRESERVE later.
REDIM txt(0 TO 7) AS STRING
REDIM other(0 TO 7) AS othertype

DO
 PRINT
 PRINT
 PRINT "----- main menu ----- (numEntries:"; numEntries; ") (ubound:"; UBOUND(txt); ")"
 PRINT "esc - exit"
 PRINT "0 - reset to test data"
 PRINT "1 - read data from 'delme.txt'"
 PRINT "2 - write data to 'delme.txt'"
 PRINT "3 - add data"
 PRINT "4 - delete data"
 PRINT "5 - search data"
 PRINT "6 - shell to 'notepad delme.txt'"
 PRINT "choice? ";
 SLEEP: k = INKEY$
 PRINT k
 PRINT
 SELECT CASE k
  CASE CHR$(&H1B): EXIT DO
  CASE "0": GOSUB resetdata
  CASE "1": GOSUB readfile
  CASE "2": GOSUB writefile
  CASE "3": GOSUB add
  CASE "4": GOSUB delete
  CASE "5": GOSUB search
  CASE "6": SHELL "notepad delme.txt"
 END SELECT
LOOP
SYSTEM

readfile:
IF 0 = _FILEEXISTS("delme.txt") THEN PRINT "'delme.txt' doesn't exist.": RETURN
OPEN "delme.txt" FOR INPUT AS 1
numEntries = 0
DO UNTIL EOF(1)
 IF numEntries >= &H7FFFFF00 THEN PRINT "Enough. Didn't read all of file.": RETURN
 IF numEntries > UBOUND(txt) THEN GOSUB growarrays
 LINE INPUT #1, txt(numEntries)
 INPUT #1, other(numEntries).x, other(numEntries).y
 numEntries = numEntries + 1
LOOP
CLOSE 1
PRINT "Read"; numEntries; "entries from 'delme.txt'."
RETURN

writefile:
OPEN "delme.txt" FOR OUTPUT AS 1
FOR i = 0 TO numEntries - 1
 PRINT #1, txt(i)
 PRINT #1, other(i).x; ","; other(i).y
NEXT
CLOSE 1
PRINT "Wrote"; numEntries; "entries from 'delme.txt'."
RETURN

add:
DO
 IF numEntries >= &H7FFFFF00 THEN PRINT "Enough.": RETURN
 LINE INPUT "(blank to stop) Text? "; k
 IF 0 = LEN(k) THEN RETURN
 IF numEntries > UBOUND(txt) THEN GOSUB growarrays
 txt(numEntries) = k
 INPUT "(comma seperated) Two numbers? ", other(numEntries).x, other(numEntries).y
 numEntries = numEntries + 1
 PRINT "Entry added."
LOOP
RETURN

delete:
INPUT "(negative to cancel) Index to delete? ", i
IF i < 0 OR i >= numEntries THEN PRINT "Deletion canceled.": RETURN
'it might be preferrable to mark the entry as invalid, but for simplicity of
'the rest of the code, I will compact the array immediately.
FOR i1 = i TO numEntries - 2
 txt(i1) = txt(i1 + 1) ' oh, wouldn't you love to have move semantics here...
NEXT
FOR i1 = i TO numEntries - 2
 other(i1) = other(i1 + 1) ' this would be nice as a memmove...
NEXT
numEntries = numEntries - 1
IF numEntries < UBOUND(txt) - 8 THEN GOSUB shrinkarrays
PRINT "Entry deleted."
RETURN

growarrays:
REDIM _PRESERVE txt(0 TO UBOUND(txt) + 8) AS STRING
REDIM _PRESERVE other(0 TO UBOUND(txt)) AS othertype
RETURN

shrinkarrays:
REDIM _PRESERVE txt(0 TO UBOUND(txt) - 8) AS STRING
REDIM _PRESERVE other(0 TO UBOUND(txt)) AS othertype
RETURN

search:
LINE INPUT "(blank for ignore) Text to search for? "; t
t = LCASE$(t)
LINE INPUT "(blank for ignore) Lower limit of first number? "; k
IF LEN(k) THEN xl = VAL(k) ELSE xl = &H80000000
LINE INPUT "(blank for ignore) Upper limit of first number? "; k
IF LEN(k) THEN xu = VAL(k) ELSE xu = &H7FFFFFFF
LINE INPUT "(blank for ignore) Lower limit of second number? "; k
IF LEN(k) THEN yl = VAL(k) ELSE yl = &H80000000
LINE INPUT "(blank for ignore) Upper limit of second number? "; k
IF LEN(k) THEN yu = VAL(k) ELSE yu = &H7FFFFFFF
i1 = 0
FOR i = 0 TO numEntries - 1
 IF xl <= other(i).x AND xu >= other(i).x THEN
  IF yl <= other(i).y AND yu >= other(i).y THEN
   IF LEN(t) THEN
    IF INSTR(LCASE$(txt(i)), t) THEN GOSUB displayentry
   ELSE
    GOSUB displayentry
   END IF
  END IF
 END IF
NEXT
PRINT i1; "matches."
RETURN

displayentry:
PRINT "Entry #"; i; ", '"; txt(i); "',"; other(i).x; ","; other(i).y
i1 = i1 + 1
IF 0 = (i1 AND 7) THEN PRINT "Press any key...": SLEEP: WHILE LEN(INKEY$): WEND
RETURN

resetdata:
REDIM txt(0 TO 7) AS STRING
REDIM other(0 TO 7) AS othertype
txt(0) = "alpha"
txt(1) = "bravo"
txt(2) = "charlie"
txt(3) = "delta"
txt(4) = "echo"
txt(5) = "foxtrot"
txt(6) = "golf"
txt(7) = "hotel"
FOR numEntries = 0 TO 7
 other(numEntries).x = INT(RND * 128) - 64
 other(numEntries).y = INT(RND * 128) - 64
NEXT
' numentries = 8 after loop
PRINT "Data reset to test data. (8 entries)."
RETURN

Posted on Feb 16, 2013, 6:16 AM

Respond to this message   

Return to Index

 Copyright © 1999-2018 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Quantcast