Garbo/Garbo.cdr/mac/hypercrd/xcmd/prctclxf.sit/DemoStack/card_4530.txt

Text File | 1990-08-28 | 20KB | 705 lines

-- card: 4530 from stack: in
-- bmap block id: 0
-- flags: 0000
-- background id: 2685
-- name: Array
----- HyperTalk script -----
on openCard
  if (debugging() = true) then pass openCard
  set cursor to watch
  get Init2D()
  if (it = empty) then get NewArray()
  if (it = empty) then get SetArray()
  if (it Γëá empty) then answer "openCard: " & errorstring(it)
  pass openCard
end openCard

on closeCard
  if (debugging() = true) then pass closeCard
  set cursor to watch
  get DisposeArray()
  get End2D()
  if (it Γëá empty) then answer "closeCard: " & errorstring(it)
  pass closeCard
end closeCard

on changeSize theRect, theItem, itemDiff, countDiff, count, separator
  repeat forever
    put countDiff & "," & count
    if (countDiff < 0 and count <= countDiff) then exit repeat
    else if (countDiff > 0 and count > 20) then exit repeat
    add countDiff to count
    put separator & count after cd fld "ArrayRows"
    add itemDiff to item theItem of theRect
    set the rect of cd fld "ArrayRows" to theRect
    if (mouse() Γëá down) then exit repeat
  end repeat
end changeSize

--------------------------------------------------------------------
-- Handlers demonstrating a two-dimensional array using
-- ArrayList. The global "arrayName" contains the name of
-- the field used for the demonstration.
-- NewArray       Creates the array
-- DisposeArray   Disposes of the array
-- DisplayArray   Dumps the array to the array display field
-- SetArray       Read the array from the array display field
-- RandomizeArray Fills array with random numbers
-- SortArray      Sorts array
--------------------------------------------------------------------

function arrayName value
return "Array"
end arrayName

-- return number of rows
function arrayRows
put textHeight of cd fld "arrayRows" into txtHt
put height of cd fld "arrayRows" into fldHt
return (fldHt / txtHt)
end arrayRows

-- return number of columns
function arrayCols
put textSize of cd fld "arrayCols" into txtWidth
put width of cd fld "arrayCols" into fldWidth
return (fldWidth div txtWidth div 2)
end arrayCols

function NewArray
return New2D(arrayName(), arrayRows(), arrayCols())
end NewArray

function DisposeArray
return Dispose2D(arrayName())
end DisposeArray

function SizeArray
put empty into cd fld arrayName()
get DisposeArray()
get NewArray()
get SetArray()
end SizeArray

function DisplayArray
put alist(get, arrayName(), space) into cd fld arrayName()
return alist(error)
end DisplayArray

function SetArray
get alist(set, arrayName(), cd fld arrayName(), space)
return it
end SetArray

-- Fill array with random data
function RandomizeArray
set cursor to watch
put Get2DDimensions(arrayName()) into dim
if (dim = empty) then exit RandomizeArray
put (item 1 of dim) * (item 2 of dim) into size
repeat with i=1 to size
  put random(100)-1 into rand
  if (rand < 10) then put "0" before rand
  put rand & " " after data
end repeat
delete last char of data
put data into card field arrayName()
return SetArray()
end RandomizeArray

-- Sort the array
function SortArray
set cursor to watch
get alist(sort, arrayName())
if (it Γëá empty) then return it
return DisplayArray()
end SortArray

--------------------------------------------------------------------
-- Handlers implementing a two-dimensional array using ArrayList.
-- Init2D     Call before using any 2D routines.
-- End2D      Call when completely finished using 2D routines.
-- New2D      Create a new two-dimensional array with given dimensions.
-- Dispose2D  Dispose of a two-dimensional array.
-- Get2D      Return value of indexed item of array.
-- Set2D      Set value of indexed item of array.
-- Get2DIndex Return real index into the array list that stores the
--            two-dimensional array.
-- Get2DDimensions Return dimensions of an array
--------------------------------------------------------------------

function arrayIndex
return("_arrayIndex")
end arrayIndex

function arrayDimen
return("_arrayDimen")
end arrayDimen

function Init2D
-- create private lists of arrays
get alist(dispose, arrayIndex())
get alist(dispose, arrayDimen())
get alist(new, arrayIndex())
if (it = empty) then get alist(new, arrayDimen())
if (it = empty) then get alist(setattribute, arrayIndex(), compare, ignorecase)
if (it = empty) then get alist(setattribute, arrayIndex(), sorted, true)
return it
end Init2D

function End2D
-- dispose of every two-dimensional array
put alist(get, arrayIndex()) into list
put empty into it
repeat with i=1 to the number of items in list
  get alist(dispose, item i of list)
  if (it Γëá empty) then exit repeat
end repeat
-- dispose of master lists
if (it = empty) then get alist(dispose, arrayIndex())
if (it = empty) then get alist(dispose, arrayDimen())
return it
end End2D

-- Create a new array with dimensions rows by cols.
function New2D name, rows, cols
get alist(dispose, name)

-- create the group to hold the array
get alist(new, name & "[" & rows * cols & "]")
if (it Γëá empty) then return it

-- Add name to list of arrays and add dimensions to corresponding list.
get alist(add, arrayIndex(), name)
if (it Γëá empty) then return it
put alist(search, arrayIndex(), name) into index
get alist(insert, arrayDimen()&"["&index&"]", rows & "," & cols)
if (it Γëá empty) then return it

end New2D

-- Completely dispose of the two-dimensional array and all of its
-- contents. Call this when you're completely finished with the array.
function Dispose2D name
put alist(search, arrayIndex(), name) into index
if (index Γëá empty) then
  get alist(delete, arrayIndex() & "[" & index & "]")
  if (it = empty) then get alist(delete, arrayDimen() & "[" & index & "]")
  if (it = empty) then get alist(dispose, name)
  return it
end if
end Dispose2D

-- Return string contained in item i, j of the two-dimensional array.
function Get2D name, i, j
return alist(get, name & Get2DIndex(name, i, j))
end Get2D

-- Set string contained in item i, j of the two-dimensional array.
-- Returns empty if succesful, otherwise an error string.
function Set2D name, i, j, value
get alist(set, name&Get2DIndex(name, i, j), value)
return it
end Set2D

-- Return index to item i, j from named two-dimensional array
-- If array doesn't exists then it is created with dimensions
-- i, j.
-- Returns index if succesful, otherwise empty.
function Get2DIndex name, i, j
put Get2DDimensions(name) into dim
put item 1 of dim into rows
put item 2 of dim into cols
return "["&j+(i-1)*rows&"]"
end Get2DIndex

-- Return dimensions of array, or empty if error or array doesn't
-- exist.
function Get2DDimensions name
put alist(search, arrayIndex(), name) into index
return alist(get, arrayDimen()&"["&index&"]")
end Get2DDimensions



-- part 19 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=253 top=44 right=214 bottom=498
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Group
----- HyperTalk script -----
on mouseWithin
  mouseEnter
end mouseWithin

on mouseEnter
  if (optionKey() Γëá down) then exit mouseEnter
  put "btn decreaseRows,btn increaseRows," & "btn decreaseCols,btn increaseCols," & "cd fld Rows,cd fld Cols," & "cd fld arrayRows,cd fld arrayCols,cd fld " & arrayName() into objects

  set cursor to cross
  put rect of me into myRect
  put the loc of me into myLoc

  -- drag objects around
  repeat while (mouseLoc() is within myRect) and (optionKey() = down)

    if (mouse() = down) then
      put myLoc into mySaveLoc

      -- drag the main field around until mouse is released
      put mouseLoc() into saveLoc
      repeat while (mouse() = down)
        put mouseLoc() into curLoc
        add (item 1 of curLoc - item 1 of saveLoc) to item 1 of myLoc
        add (item 2 of curLoc - item 2 of saveLoc) to item 2 of myLoc
        set the loc of me to myLoc
        put curLoc into saveLoc
      end repeat

      -- calculate change in position of main field
      put (item 1 of myLoc - item 1 of mySaveLoc) into diff1
      put (item 2 of myLoc - item 2 of mySaveLoc) into diff2

      -- move all the other objects in the group
      if (diff1 Γëá 0) or (diff2 Γëá 0) then
        --set lockScreen to true
        set cursor to watch
        repeat with i=1 to the number of items in objects
          put the loc of item i of objects into curLoc
          add diff1 to item 1 of curLoc
          add diff2 to item 2 of curLoc
          set the loc of item i of objects to curLoc
        end repeat
      end if
    end if
  end repeat
end mouseEnter



-- part 1 (field)
-- low flags: 00
-- high flags: 4002
-- rect: left=298 top=75 right=195 bottom=480
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Array
----- HyperTalk script -----
on enterInField
  get SetArray()
  exit enterInField

  -- get start and end words of current selection
  put word 2 of selectedChunk() into start
  put word 4 of selectedChunk() into stop
  put char 1 to start of card field arrayName() into text
  put the number of words in text into startIndex
  if (stop < start) then
    put startIndex into stopIndex
  else
    put char start to stop of card field arrayName() into text
    put startIndex-1+the number of words in text into stopIndex
  end if
  select word startIndex to stopIndex of card field arrayName()

  -- get text of selected words and set into array
  put word 2 of selectedChunk() into start
  put word 4 of selectedChunk() into stop
  put char start to stop of card field arrayName() into text
  get alist(set, arrayName()&"["&startIndex&"]", text, space)
end enterInField

on returnInField
  enterInField
end returnInField

on closeField
  enterInField
end closeField



-- part 2 (field)
-- low flags: 01
-- high flags: 4002
-- rect: left=279 top=75 right=195 bottom=296
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 65535
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: ArrayRows
----- HyperTalk script -----
on setHeight newHeight
  set cursor to watch

  -- get current rectangle and text height
  put rect of the target into theRect
  put textHeight of the target into txtHt

  put height of the target into oldHeight

  -- set height and resize rectangle
  put (txtHt * newHeight) into newHeight
  put (item 2 of theRect + newHeight) into item 4 of theRect
  set rect of the target to theRect

  -- set height of array rectangle
  put the rect of cd fld arrayName() into arrayRect
  put (item 2 of theRect + newHeight) into item 4 of arrayRect
  set the rect of cd fld arrayName() to arrayRect

  -- set height of group field
  put rect of cd fld "group" into groupRect
  put height of cd fld "group" into groupHeight
  put (groupHeight - oldHeight + newHeight) into groupHeight
  put (item 2 of groupRect + groupHeight) into item 4 of groupRect
  set rect of cd fld "group" to groupRect

  get SizeArray()
end setHeight




-- part 3 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=298 top=61 right=74 bottom=480
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: ArrayCols
----- HyperTalk script -----
on setWidth newWidth
  set cursor to watch

  -- get current rectangle and text width
  put rect of the target into theRect
  put textSize of the target into txtWidth

  put width of the target into oldWidth

  -- set width and resize rectangle
  put (txtWidth * newWidth * 2 + 2) into newWidth
  put (item 1 of theRect + newWidth) into item 3 of theRect
  set rect of the target to theRect

  -- set width of array rectangle
  put the rect of cd fld arrayName() into arrayRect
  put (item 1 of arrayRect + newWidth) into item 3 of arrayRect
  set the rect of cd fld arrayName() to arrayRect

  -- set width of group field
  put rect of cd fld "group" into groupRect
  put width of cd fld "group" into groupWidth
  put (groupWidth - oldWidth + newWidth) into groupWidth
  put (item 1 of groupRect + groupWidth) into item 3 of groupRect
  set rect of cd fld "group" to groupRect

  get SizeArray()
end setWidth


-- part 4 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=284 top=287 right=309 bottom=384
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Randomize
----- HyperTalk script -----
on mouseUp
  get RandomizeArray()
end mouseUp



-- part 5 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=284 top=257 right=279 bottom=384
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Display
----- HyperTalk script -----
on mouseUp
  get DisplayArray()
end mouseUp



-- part 6 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=385 top=258 right=280 bottom=485
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Set
----- HyperTalk script -----
on mouseUp
  get SetArray()
end mouseUp



-- part 7 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=386 top=287 right=309 bottom=486
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Sort
----- HyperTalk script -----
on mouseUp
  get SortArray()
end mouseUp



-- part 12 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=256 top=87 right=100 bottom=276
-- title width / last selected line: 0
-- icon id / first selected line: 3584 / 3584
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: IncreaseRows
----- HyperTalk script -----
on mouseDown
  put arrayRows() into size
  put size into oldSize
  repeat while (size < 10)
    add 1 to size
    put size into cd fld "Rows"
    if (mouse() Γëá down) then exit repeat
  end repeat
  if (size Γëá oldSize) then send "setHeight " & size to cd fld "ArrayRows"
end mouseDown




-- part 13 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=256 top=61 right=74 bottom=276
-- title width / last selected line: 0
-- icon id / first selected line: 16692 / 16692
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: DecreaseRows
----- HyperTalk script -----
on mouseDown
  put arrayRows() into size
  put size into oldSize
  repeat while (size > 1)
    subtract 1 from size
    put size into cd fld "Rows"
    if (mouse() Γëá down) then exit repeat
  end repeat
  if (size Γëá oldSize) then send "setHeight " & size to cd fld "ArrayRows"
end mouseDown



-- part 15 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=256 top=75 right=87 bottom=276
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Rows


-- part 16 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=279 top=46 right=60 bottom=296
-- title width / last selected line: 0
-- icon id / first selected line: 15420 / 15420
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: DecreaseCols
----- HyperTalk script -----
on mouseDown
  put arrayCols() into size
  put size into oldSize
  repeat while (size > 1)
    subtract 1 from size
    put size into cd fld "Cols"
    if (mouse() Γëá down) then exit repeat
  end repeat
  if (size Γëá oldSize) then  send "setWidth " & size to cd fld "ArrayCols"
end mouseDown



-- part 17 (field)
-- low flags: 01
-- high flags: 0002
-- rect: left=298 top=47 right=59 bottom=318
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: Cols


-- part 18 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=318 top=46 right=60 bottom=335
-- title width / last selected line: 0
-- icon id / first selected line: 16560 / 16560
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: IncreaseCols
----- HyperTalk script -----
on mouseDown
  put arrayCols() into size
  put size into oldSize
  repeat while (size < 10)
    add 1 to size
    put size into cd fld "Cols"
    if (mouse() Γëá down) then exit repeat
  end repeat
  if (size Γëá oldSize) then send "setWidth " & size to cd fld "ArrayCols"
end mouseDown



-- part contents for card part 3
----- text -----
 1  2  3  4  5  6  7  8  9 10

-- part contents for background part 9
----- text -----
DemoStack 0.9

-- part contents for background part 1
----- text -----
Array

-- part contents for background part 12
----- text -----
Card #4

-- part contents for background part 13
----- text -----
Description

-- part contents for background part 14
----- text -----


This is a demonstration of how ArrayList may be used to maintain two-dimensional arrays. A complete set of handlers implements all operations on the arrays.

________________________________
Using the Card

The big grid on the right represents an example array of 10 rows by 10 columns. By using the buttons below the grid you can perform several operations on this array. The Display button redraws the array. The Set button reads and saves the data in the array. The Randomize button fills the array with newly generated random numbers. Finally, the Sort button sorts the elements of the array.

You can also enter new values to the array by typing over the current values. The changes will be saved when you either press return, or press enter, or click outside of the field. Be careful not to enter more than one space between values since this will result in an empty item being set in the array.

________________________________
About the Script

Two-dimensional arrays are stored as one-dimensional arrays in a list with the same name as the array. When an item with some row and column is requested the script calculates the index into the one dimensional array (this is similar to what the C programming language does). Thus, if an array is created with dimensions 10 rows by 10 columns, then the item at (1, 1) has an index of 1, while the item at (3, 4) has an index of 34.

Since the dimensions of the array are needed to calculate the actual index into the list the script must store and retrieve the dimensions of every two-dimensional array. This is accomplished using two auxillary lists. The first is a sorted list of the names of all of the arrays. The second contains the dimensions of the corresponding array. For instance, if the array named "exampleArray" is stored in item 4 of the auxillary names list, then item 4 of the auxillary dimensions list contains the dimensions for "exampleArray".




-- part contents for card part 15
----- text -----
10

-- part contents for card part 2
----- text -----
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

-- part contents for card part 17
----- text -----
10

-- part contents for card part 1
----- text -----
01 02 04 04 05 05 06 08 09 10 10 10 12 13 13 14 17 17 17 18 18 21 21 22 23 26 27 27 27 30 31 33 34 34 35 36 37 40 40 41 42 43 44 45 47 50 52 52 54 55 57 58 59 60 61 61 62 62 62 63 67 69 70 71 71 71 72 72 72 76 78 78 79 80 81 81 81 83 83 84 85 87 88 91 92 92 93 94 95 95 96 96 96 97 97 98 98 98 99 99