
/*

An example of how to sort arrys into alphanumerical order.
To do this I calculate the ASCII value of each alphanumeric character
and string of characters.

*/
$include "windowssdk.inc"

DEF a[255]:string 
DEF a1,a2,b1,b2,swap,doswap,lswap,loops,NoChange:int
def x1,x2:uint 
DEF t1,t2:string
DEF position:int

'The array we want to sort
a[1] =  "declare extern GetRoot(Key as string),UInt"
a[2] =  "declare extern RegCreateKeyHandle(Key as string),Uint"
a[3] =  "declare extern MyBase(string Stringin),int"
a[4] =  "declare extern RegDeleteValue(Key as string,ValueName as string),string"
a[5] =  "declare extern RegCreateKey(Key as string),int"
a[6] =  "declare extern RegDeleteKey(Key as string),int"
a[7] =  "declare extern RegSetBinValue(Key as string,lns as int,Value as Istring,opt ValueName as string),int "
a[8] =  "declare extern RegCopyKey(Key as String,ToKey as string),int"
a[9] =  "declare extern RegRenameKey(string mykey,string newkey),int"
a[10] = "declare extern RegKeyExists(Key as string),int"
a[11] = "declare extern RegCountAllSubKeys(Key as string),int"
a[12] = "declare extern RegGetQWValue(Key as string,opt ValueName as string),uint64"
a[13] = "declare extern RegSetQWValue(Key as string,Value as uint64,opt ValueName as string),int"
a[14] = "declare extern RegGetDWValueU32(Key as string,opt ValueName as string),uint64 'DWord Value"
a[15] = "declare extern RegSetNoneValue(Key as string,lns as int,Value as istring,opt ValueName as string),int "
a[16] = "declare extern RegExportKey(mykey as string,RegFileName as string,opt RegExportSort as int),int"
a[17] = "declare extern RegEntryExists(Key as string,opt ValueName as string),int"

'High value dummy needed for a last compare
for x = 1 to 255
	 a[18] = a[18] + chr$(126)
next x


'Begin the sort.
OPENCONSOLE
print
x1 = GetTickCount()
print "  Start time ",x1

count = 17 'The number we want to sort

'1st letter of the word sort e.g. (a)pple,(c)at,(d)og,(e)arth....(w)ater
'Sorts the words beginnig with A to Z

loops = 0

FOR x = 1 to count
    loops ++
	 FOR z = 1 to count
        loops ++
		  length = 1
		  position = 1
		  getval1()  'get the ASCII value of first letter
		  checkltr() 'sort them from words beginnig with A to Z
	 NEXT z
NEXT x

'Check subsequent letters of all array entries
'both single letters and strings of letters
LABEL totloop

FOR y = 1 TO count
    loops ++

	 FOR z = 1 to count

       if lswap = swap
          NoChange ++
          if NoChange = count 'After 17 compares, nothing changed - so end the sort! 
             breakfor
          endif
       endif

       loops ++
		 length = 1
		 position = 1 
		 getval1() 

		 FOR h = 2 TO LEN(a[z])
           loops ++

			  IF LEN(a[z]) >= h
				  IF b1 = b2 'letter match
                 doswap = 1
				     length = h
					  position = 1 
					  getval1()
					  checkltr()
              else 
                 breakfor
				  ENDIF
			  ENDIF

			  if doswap = 1
				  swap = swap + 1
				  lswap = swap
				  NoChange = 0
				  breakfor
			  endif

		  NEXT h

	 NEXT z

	 if NoChange = count 'After 17 compares, nothing changed - so end the sort!
		 breakfor
	 endif

NEXT y


print
x2 = GetTickCount()
print "  End Time ",x2
print
print "  Sort took ",x2-x1," millisecs"
print
PRINT
PRINT "  Final alphabetical listing"
print

for x = 1 to count
    PRINT "  ",a[x]
next x

PRINT
print "  Number of swaps done ",swap
print 
print "  Looped through ",loops
print
print 
PRINT "  Press any key to exit..."
DO:UNTIL INKEY$ <> ""
END
 
'Total up the ASCII values of each array for "g" positions 
SUB getval1 

a1 = 0
a2 = 0
b1 = 0
b2 = 0

FOR g = 1 TO length
	 a1 = ASC(LCASE$(MID$(a[z],g,1)))
	 b1 = b1 + a1 

	 a2 = ASC(LCASE$(MID$(a[z+1],g,1)))
	 b2 = b2 + a2
NEXT g

RETURN
ENDSUB

SUB checkltr() 

doswap = 0

'Swap array entries over if needed 
'b1 & b2 hold the ASCII values of the current character or string of characters.

	IF b1 > b2 'To sort in decending order change to "b1 < b2"
   
      'write f1,""
      'write f1,"Swap...."
      'write f1,a[z] + "   = " + str$(b1)
      'write f1,a[z+1] + "   = " + str$(b2)
      'write f1,""

      doswap = 1
	   t1 = a[z]
	   t2 = a[z+1]
	   a[z] = t2
	   a[z+1] = t1

      'write f1,""
      'write f1,"E - swap " + str$(swap)
      'write f1,""

	ENDIF 

RETURN 0
ENDSUB


