MacFormat 1996 July/macformat-039.iso/DATABASE/SHARED.DIR/01002.ls

Text File | 1996-03-14 | 7.3 KB | 291 lines

on retrieverec record, fileName, index
  global gPath, gBit, gHDpath
  set myfile to FileIO(mnew, "read", gHDpath & fileName)
  if not objectp(myfile) then
    alert("Problem opening database")
    return 0
  end if
  if item record of field index <> EMPTY then
    set tmp to integer(item record of field index)
  else
    alert("Error loading record: " & record & " from the database")
  end if
  set err to myfile(mSetPosition, tmp)
  if err then
    alert("Problem retrieving record " & record, " using fileio")
  else
    set tmp to myfile(mReadToken, "@", EMPTY)
    myfile(mdispose)
    return tmp
  end if
end

on retrieve record, fieldnum, fileName, index
  global gPath, gBit, gHDpath
  set myfile to FileIO(mnew, "read", gHDpath & fileName)
  if not objectp(myfile) then
    alert("Problem opening database")
    return 0
  end if
  set tmp to integer(item record of field index)
  set err to myfile(mSetPosition, tmp)
  if err then
    alert("problem retrieving record")
  else
    repeat with i = 1 to fieldnum
      set tmp to myfile(mReadLine)
    end repeat
    set tmp to char 1 to the number of chars in tmp - 1 of tmp
    myfile(mdispose)
    return tmp
  end if
end

on search str, indextmp
  set tmp to Bsearch(str, indextmp)
  if tmp then
    return item 2 to the number of items in line tmp of field indextmp of line tmp of field indextmp
  else
    return 0
  end if
end

on LogicalAnd listA, listB
  set tmplist to EMPTY
  if (listA = EMPTY) or (listA = 0) then
    return EMPTY
  end if
  if (listB = EMPTY) or (listB = 0) then
    return EMPTY
  end if
  set numA to the number of items in listA
  set numB to the number of items in listB
  set posA to 1
  set posB to 1
  repeat while (posA <= numA) and (posB <= numB)
    if integer(item posA of listA) = integer(item posB of listB) then
      put item posA of listA & "," after tmplist
      set posA to posA + 1
      set posB to posB + 1
      next repeat
    end if
    if integer(item posA of listA) < integer(item posB of listB) then
      set posA to posA + 1
      next repeat
    end if
    set posB to posB + 1
  end repeat
  set tmplist to item 1 to the number of items in tmplist - 1 of tmplist
  return tmplist
end

on LogicalOr listA, listB
  set tmplist to EMPTY
  set numA to the number of items in listA
  set numB to the number of items in listB
  set posA to 1
  set posB to 1
  if (listA <> EMPTY) and (listB <> EMPTY) then
    repeat while (posA <= numA) and (posB <= numB)
      if integer(item posA of listA) = integer(item posB of listB) then
        put item posA of listA & "," after tmplist
        set posA to posA + 1
        set posB to posB + 1
        next repeat
      end if
      if integer(item posA of listA) < integer(item posB of listB) then
        put item posA of listA & "," after tmplist
        set posA to posA + 1
        next repeat
      end if
      put item posB of listB & "," after tmplist
      set posB to posB + 1
    end repeat
  end if
  if (posA <= numA) and (listA <> EMPTY) then
    put item posA to numA of listA & "," after tmplist
  else
    if posB <= numB then
      put item posB to numB of listB & "," after tmplist
    end if
  end if
  set tmplist to item 1 to the number of items in tmplist - 1 of tmplist
  return tmplist
end

on Bsearch str, txt
  set txt to the number of cast txt
  set start to 1
  set end to the number of lines in field txt
  set middle to (start + end) / 2
  repeat while str <> item 1 of line middle of field txt
    if str = item 1 of line end of field txt then
      return end
    end if
    if start = middle then
      return 0
    end if
    if str < item 1 of line middle of field txt then
      set end to middle
    else
      set start to middle
    end if
    set middle to (start + end) / 2
  end repeat
  if str = item 1 of line middle of field txt then
    return middle
  else
    return 0
  end if
end

on iBsearch str, txt
  set start to 1
  set end to the number of items in field txt
  set middle to (start + end) / 2
  repeat while str <> integer(item middle of txt)
    put start && middle && end
    if str = integer(item end of txt) then
      return end
    end if
    if start = integer(middle) then
      return 0
    end if
    if str < integer(item middle of txt) then
      set end to middle
    else
      set start to middle
    end if
    set middle to (start + end) / 2
  end repeat
  if str = integer(item middle of txt) then
    put "found " && str && " in list"
    return middle
  else
    put "didn't find " && str
    return 0
  end if
end

on sortlines txt
  set num to the number of lines in field txt
  set tmp2 to the number of cast txt
  repeat with i = 1 to num
    set flag to 0
    repeat with j = 2 to num
      if item 1 of line j of field tmp2 < item 1 of line j - 1 of field tmp2 then
        set flag to 1
        set tmp to line j - 1 of field tmp2
        put line j of field txt into line j - 1 of field tmp2
        put tmp into line j of field tmp2
      end if
    end repeat
    if flag = 0 then
      exit repeat
    end if
  end repeat
end

on sortitems txt
  if txt = EMPTY then
    return EMPTY
  end if
  set num to the number of items in txt
  repeat with i = 1 to num
    set flag to 0
    repeat with j = 2 to num
      if item j of txt < item j - 1 of txt then
        set flag to 1
        set tmp to item j - 1 of txt
        put item j of txt into item j - 1 of txt
        put tmp into item j of txt
      end if
    end repeat
    if flag = 0 then
      exit repeat
    end if
  end repeat
  return txt
end

on merge listA, listB
  if listA = EMPTY then
    return listB
  end if
  if listB = EMPTY then
    return listA
  end if
  set listNew to EMPTY
  set posA to 1
  set posB to 1
  set posNew to 1
  set numA to the number of items in listA
  set numB to the number of items in listB
  repeat while (posA <= numA) and (posB <= numB)
    if integer(item posA of listA) = integer(item posB of listB) then
      put item posA of listA & "," after listNew
      set posA to posA + 1
      set posB to posB + 1
    else
      if integer(item posA of listA) < integer(item posB of listB) then
        put item posA of listA & "," after listNew
        set posA to posA + 1
      else
        put item posB of listB & "," after listNew
        set posB to posB + 1
      end if
    end if
    set posNew to posNew + 1
  end repeat
  if posA <= numA then
    repeat while posA <= numA
      put item posA of listA & "," after listNew
      set posA to posA + 1
    end repeat
  else
    repeat while posB <= numB
      put item posB of listB & "," after listNew
      set posB to posB + 1
    end repeat
  end if
  return listNew
end

on siBsearch str, txt
  set start to 1
  set end to the number of items in field txt
  set middle to (start + end) / 2
  repeat while str <> item middle of txt
    put start && middle && end
    if str = item end of txt then
      return end
    end if
    if start = middle then
      return 0
    end if
    if str < item middle of txt then
      set end to middle
    else
      set start to middle
    end if
    set middle to (start + end) / 2
  end repeat
  if str = item middle of txt then
    put "found " && str && " in list"
    return middle
  else
    put "didn't find " && str
    return 0
  end if
end

on find str, txt
  repeat with i = 1 to the number of items in field txt
    if str = item i of field txt then
      put i
      exit repeat
    end if
  end repeat
  return -1
end