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

Text File | 1990-08-28 | 19KB | 690 lines

-- card: 2288 from stack: in
-- bmap block id: 8187
-- flags: 0000
-- background id: 2685
-- name: Draw Tree
----- HyperTalk script -----
on openCard
  hide menuBar
  get lockMenuBar(true)
  setTreeDirty
  pass openCard
end openCard

on closeCard
  get lockMenuBar(false)
  pass closeCard
end closeCard

---------------------------------------------------------------------
-- The "tree dirty" flags remember what aspects of the tree must
-- be recalculated. Whenever the tree changes setTreeDirty should
-- be called with no parameters
---------------------------------------------------------------------

function treeDirty what
global gTreeDirtyWidths
global gTreeDirtyCoordinates
global gTreeDirtyDraw
if (what = "widths") then return gTreeDirtyWidths
if (what = "coordinates") then return gTreeDirtyCoordinates
if (what = "draw") then return gTreeDirtyDraw
return ((gTreeDirtyWidths) or (gTreeDirtyCoordinates) or (gTreeDirtyDraw))
end treeDirty

on setTreeDirty what, dirty
  global gTreeDirtyWidths
  global gTreeDirtyCoordinates
  global gTreeDirtyDraw
  global gTreeDirtyWhat
  if (what = "widths") then put dirty into gTreeDirtyWidths
  else if (what = "coordinates") then put dirty into gTreeDirtyCoordinates
  else if (what = "draw") then put dirty into gTreeDirtyDraw
  else if (what Γëá empty) and (what Γëá gTreeDirtyWhat) then
    put true into gTreeDirtyWidths
    put true into gTreeDirtyCoordinates
    put true into gTreeDirtyDraw
    put what into gTreeDirtyWhat
  else if (what = empty) then
    put true into gTreeDirtyWidths
    put true into gTreeDirtyCoordinates
    put true into gTreeDirtyDraw
  end if
end setTreeDirty

---------------------------------------------------------------------
-- These functions return information about the nodes in the tree.
-- If the tree is dirty (see below) then the data are recalculated.
---------------------------------------------------------------------

on treeErase
  eraseRect the rect of cd fld "DrawingArea", 1
  setTreeDirty draw, true
end treeErase

on treeDraw what
  answer "Draw what part of the tree?" with "Indexes" or "Data" or "Keys"
  put it into what
  if (what Γëá empty) then
    setTreeDirty what, true
    if (treeDirty(draw)) then
      set cursor to watch
      treeErase
      treeSetupDraw
      put treeCoordinates(what) into coordinates
      put treeRoot(rect of cd fld "DrawingArea", what) into point
      treeExecuteDraw treeName(), coordinates, point, what
      treeRestoreDraw
      setTreeDirty draw, false
      put "Finished Drawing " & what & "." into cd fld "Progress"
      choose browse tool
    end if
  end if
end treeDraw

function treeWidth what
global gTreeSavedWidth
setTreeDirty what, true
if (treeDirty(widths)) then
  treeSetupDraw
  put treeCalcWidth(treeName(), what) into gTreeSavedWidth
  treeRestoreDraw
  setTreeDirty widths, false
end if
return gTreeSavedWidth
end treeWidth

function treeCoordinates what
global gTreeSavedCoordinates
setTreeDirty what, true
if (treeDirty(coordinates)) then
  treeSetupDraw
  put treeCalcCoordinates(treeName(), treeWidth(what)) into gTreeSavedCoordinates
  treeRestoreDraw
  setTreeDirty coordinates, false
end if
return gTreeSavedCoordinates
end treeCoordinates

function treeRoot drawrect, what

-- get width of left and right sides of tree
put treeWidth(what) into widths
put item 1 of line 1 of widths into lwidth
put item 1 of line 2 of widths into rwidth

-- get width of draw rectangle
put ((item 3 of drawrect) - (item 1 of drawrect)) into drawwidth

-- adjust center so maximum amount of tree will be visible
if ((lwidth Γëñ drawwidth/2) and (rwidth Γëñ drawwidth/2)) then
  put (item 1 of drawrect + drawwidth/2) into center
else if (lwidth < rwidth) then
  put (item 1 of drawrect + lwidth) into center
else
  put (item 3 of drawrect - rwidth) into center
end if

put center into item 1 of point
put item 2 of drawrect into item 2 of point
return point
end treeRoot

function treeRect
end treeRect

function treeName
return("demoTree")
end treeName

function treeClear tree
get btree(dispose, tree)
get btree(new, tree, numeric)
setTreeDirty empty
return it
end treeClear

---------------------------------------------------------------------
-- Functions for updating the tree and calculating things for the
-- tree.
---------------------------------------------------------------------

-- Setup environment for drawing
on treeSetupDraw
  global gTreeSetupDraw
  global gTreeDrawEnv
  add 1 to gTreeSetupDraw
  if (gTreeSetupDraw = 1) then
    put tool() into line 1 of gTreeDrawEnv
    put setTextStyle("Geneva, 9, 9, center") into line 2 of gTreeDrawEnv
  end if
end treeSetupDraw

-- Restore drawing environment
on treeRestoreDraw
  global gTreeSetupDraw
  global gTreeDrawEnv
  subtract 1 from gTreeSetupDraw
  if (gTreeSetupDraw = 0) then
    choose line 1 of gTreeDrawEnv
    get setTextStyle(line 2 of gTreeDrawEnv)
  end if
end treeRestoreDraw

-- Draw the tree
on treeExecuteDraw tree, coordinates, point, what
  put "Drawing tree..." into cd fld "Progress"

  put btree(levelorder, tree, what) into nodes
  put btree(levelorder, tree, indexes) into indexes
  put line 1 of coordinates into coordinatesH
  put line 2 of coordinates into coordinatesV

  add nodeVertical() to item 2 of point

  choose text tool
  repeat with i=1 to number(items in nodes)

    put (item i of indexes) into index

    -- get coordinates of node
    put (item index of coordinatesH + item 1 of point) into nodeH
    put (item index of coordinatesV + item 2 of point) into nodeV

    -- if this node has a parent
    if (i > 1) then
      -- get parent's coordinates
      put ((item (index div 2) of coordinatesH) + item 1 of point) into parentH
      put ((item (index div 2) of coordinatesV) + item 2 of point) into parentV

      -- draw line from parent to node
      choose line tool
      drag from round(parentH),round(parentV) to round(nodeH),(round(nodeV)-nodeVertical())
      choose text tool
    end if
    -- draw node
    click at round(nodeH),round(nodeV)-nodeMargin()
    type (item i of nodes)
  end repeat
end treeExecuteDraw

--
-- Calculates the width of the left and right children of every
-- node in the tree. The widths are returned in pixels, one item
-- per node, and correspond to a level-order traversal of the tree.
-- Parameters:
--   tree  The tree to calculate for
-- Returns:
-- Line 1  Widths of left sides of nodes
-- Line 2  Widths of right sides of nodes
--
function treeCalcWidth tree, what
put "Calculating widths of nodes..." into cd fld "Progress"

-- get level order traversal of tree
put btree(levelorder, tree, what) into nodes
put btree(levelorder, tree, indexes) into indexes

-- these variables hold the lists of left and right widths
put empty into lwidths
put empty into rwidths

-- work up towards root from bottom of tree
repeat with i=number(items in nodes) down to 1
  set cursor to busy

  -- get index to node and to its children
  put (item i of indexes) into index
  put lindex(index) into left
  put rindex(index) into right
  put (left is in indexes) into hasleft
  put (right is in indexes) into hasright

  -- calculate left and right widths
  put number(chars in item i of nodes)*the textSize/2 into nodeWidth
  if ((not hasleft) and (not hasright)) then
    -- node is a leaf
    put nodeWidth into lwidth
    put nodeWidth into rwidth
  else
    -- node has children
    if (hasleft) then
      put (item left of lwidths + item left of rwidths) into lwidth
    else put nodeWidth into lwidth
    if (hasright) then
      put (item right of lwidths + item right of rwidths) into rwidth
    else put nodeWidth into rwidth
  end if

  -- store widths
  put lwidth into item index of lwidths
  put rwidth into item index of rwidths

end repeat

-- make result
put lwidths into line 1 of widths
put rwidths into line 2 of widths
return widths
end treeCalcWidth

--
-- Calculates the coordinates of the nodes in the tree. The root
-- of the tree is at 0,0.
-- Parameters:
--   tree  The tree to calculate for
-- Returns:
--   Line 1  Horizontal coordinates in level-order
--   Line 2  Vertical coordinates in level-order
--
function treeCalcCoordinates tree, widths
put "Calculating coordinates of nodes..." into cd fld "Progress"

put btree(levelorder, tree, indexes) into indexes
put line 1 of widths into lwidths
put line 2 of widths into rwidths

-- these variables will hold the coordinates of each of the nodes
put empty into coordinatesH
put empty into coordinatesV

-- nodeH and nodeV hold the coordinates of the current node
put 0 into nodeH
put 0 into nodeV

repeat with i=1 to number(items in indexes)
  set cursor to busy

  put (item i of indexes) into index

  -- if this node has a parent
  if (i > 1) then
    -- get parent's coordinates
    put item (index div 2) of coordinatesH into parentH
    put item (index div 2) of coordinatesV into parentV

    -- calculate vertical coordinate of node
    put trunc(log2(index)) into height
    put (height * (nodeVertical()+nodeTop())) into nodeV

    -- calculate horizontal coordinate of node
    if ((index mod 2) = 0) then
      -- node is a left child
      put (parentH - (item index of rwidths)) into nodeH
    else
      -- node is a right child
      put (parentH + (item index of lwidths)) into nodeH
    end if
  end if

  -- store coordinates of node
  put nodeH into item index of coordinatesH
  put nodeV into item index of coordinatesV
end repeat

-- return the coordinates
put coordinatesH into line 1 of coordinates
put coordinatesV into line 2 of coordinates
return coordinates
end treeCalcCoordinates

-- return vertical space needed by text of node
function nodeVertical
return the textHeight + 2*nodeMargin()
end nodeVertical

-- return vertical space needed for tree's edges
function nodeTop
return 4
end nodeTop

-- return margin around text of node
function nodeMargin
return 2
end nodeMargin

-- return index of left child
function lindex i
return 2*i
end lindex

-- return index of right child
function rindex i
return 2*i+1
end rindex

---------------------------------------------------------------------
-- report the error to the user
---------------------------------------------------------------------

on treeError error
  answer "Error: " & errorstring(error)
end treeError

---------------------------------------------------------------------
-- some simple drawing functions
---------------------------------------------------------------------

-- Erase the specified rectangle
on eraseRect rct, pat
  put the tool into saved_tool
  put the pattern into saved_pat
  put the filled into saved_filled
  choose rect tool
  set pattern to pat
  set filled to true
  drag from (item 1 to 2 of rct) to (item 3 to 4 of rct)
  set pattern to saved_pat
  set filled to saved_filled
  choose saved_tool
end eraseRect

--
-- Set the style of text; returns the old style, so that when
-- the caller is finished the text enviroment may be restored
-- to its original values. For instance,
--   on doStuff
--     put setTextStyle(Courier, 12, 16, left) into saved_style
--     ...do stuff...
--     get setTextStyle(saved_style)
--   end doStuff
--
function setTextStyle new_style
put the textFont into item 1 of old_style
put the textSize into item 2 of old_style
put the textHeight into item 3 of old_style
put the textAlign into item 4 of old_style
set textFont to item 1 of new_style
set textSize to item 2 of new_style
set textHeight to item 3 of new_style
set textAlign to item 4 of new_style
return old_style
end setTextStyle





-- part 1 (button)
-- low flags: 00
-- high flags: 8003
-- rect: left=129 top=8 right=30 bottom=229
-- 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: Random Tree
----- HyperTalk script -----
on mouseUp
  -- get size of tree from user
  put 0 into size
  repeat until ((1 Γëñ size) and (size Γëñ 128))
    ask "Enter size of tree (1-128): " with 16
    put it into size
    if (size = empty) then exit mouseUp
  end repeat
  -- fill tree with random data
  set cursor to watch
  get randomizeTree(treeName(), size, 1000)
  if (it Γëá empty) then treeError(it)
  treeDraw
end mouseUp

function randomizeTree tree, size, max
get treeClear(tree)
if (it Γëá empty) then return it
put empty into list
repeat with i=1 to size
  put random(max) & "," after list
end repeat
get btree(insert, tree, list, empty, ",")
return empty
end randomizeTree




-- part 4 (button)
-- low flags: 00
-- high flags: 8003
-- rect: left=245 top=8 right=30 bottom=345
-- 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: Complete Tree
----- HyperTalk script -----
on mouseUp

  -- get height of tree from user
  put -1 into height
  repeat until ((0 Γëñ height) and (height Γëñ 7))
    ask "Enter height of tree (0-7): " with 4
    put it into height
    if (height = empty) then exit mouseUp
  end repeat

  -- build the tree
  set cursor to watch
  get buildCompleteTree(treeName(), height)
  if (it Γëá empty) then treeError(it)

  treeDraw
end mouseUp

function buildCompleteTree tree, height
global completed_tree

-- create the tree
get treeClear(tree)
if (it Γëá empty) then return it

-- build a list of items to insert into tree
put empty into completed_tree
completeTree 2^height, 1, height

-- insert into tree
get btree(insert, tree, completed_tree, empty, ",")
return it
end buildCompleteTree

----------------------------------------------------------------------
-- Recursively build a list of items so that when inserted into
-- a tree it will be a complete tree.
-- Parameters:
--   node  Value to place at root node
--   index Index to root node (should initially be 1)
--   height Height of tree
-- For instance, to build a tree with 15 items use:
--  completeTree 8, 1, 4
----------------------------------------------------------------------
on completeTree node, index, height
  global completed_tree
  put node into item index of completed_tree
  if (height > 0) then
    completeTree node-(2^(height-1)), 2*index, height-1
    completeTree node+(2^(height-1)), 2*index+1, height-1
  end if
end completeTree



-- part 6 (button)
-- low flags: 00
-- high flags: 8003
-- rect: left=13 top=7 right=29 bottom=113
-- 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: Draw Tree
----- HyperTalk script -----
on mouseUp
  treeDraw draw
end mouseUp





-- part 8 (button)
-- low flags: 00
-- high flags: 8003
-- rect: left=358 top=8 right=30 bottom=458
-- 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: Father William
----- HyperTalk script -----
on mouseUp
  -- build a tree containing text from the poem "Father William"
  -- by Lewis Carroll
  set cursor to watch
  setTreeDirty
  get btree(dispose, treeName())
  get btree(new, treeName())
  put "You are old Father William the young man said And your hair has become very white And yet you incessantly stand on your head Do you think at your age it is right" into keys
  put "In my youth Father William replied to his son I feared it might injure the brain But now that I'm perfectly sure I have none Why I do it again and again" into data
  get btree(insert, treeName(), keys, data, space)

  treeDraw
end mouseUp



-- part 9 (field)
-- low flags: 01
-- high flags: 0000
-- rect: left=1 top=35 right=202 bottom=510
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: DrawingArea


-- part 14 (field)
-- low flags: 01
-- high flags: 0004
-- rect: left=88 top=294 right=314 bottom=484
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Progress


-- part 18 (field)
-- low flags: 01
-- high flags: 0007
-- rect: left=11 top=205 right=291 bottom=509
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Commands
----- HyperTalk script -----
on enterInField
  set cursor to watch
  executeField
end enterInField

on returnInField
  if the commandKey is down then send enterInField
  else pass returnInField
end returnInField

-------------------------------------------------------------------
-- Execute the selected lines in the field
-------------------------------------------------------------------
on executeField
  put (word 2 of selectedLine())-1 into firstLine
  put selectedChunk() into saveChunk
  put selectedText() into commands
  if (commands = empty) then put value(selectedLine()) into commands
  repeat with i=1 to number(lines of commands)
    select line i+firstLine of cd fld "Commands"
    do line i of commands
  end repeat
  select saveChunk
end executeField




-- part 19 (field)
-- low flags: 01
-- high flags: 0000
-- rect: left=36 top=294 right=312 bottom=135
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name:


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

-- part contents for background part 1
----- text -----
Draw Tree

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

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











-- part contents for card part 14
----- text -----
Finished Drawing Keys.

-- part contents for card part 18
----- text -----
Instructions:
"Draw Tree" draws the demo tree, which should first be configured using one of the other buttons. A dialog box asks what type of data to draw: the keys of the nodes, the data fields of the nodes, or the indexes of the nodes.
"Random Tree" builds and draws a tree containing random integers.
"Complete Tree" builds and draws a tree containing all of its nodes.
"Father William" builds and draws a tree containing part of the poem "Father William" by Lewis Carroll.

-- part contents for card part 19
----- text -----
Status: