The Princeton Review - Science Smart/SCIENCE.iso/mac/files/CAD.DiR/04132.ls

Text File | 1995-12-08 | 11.3 KB | 452 lines

on startMovie
  global fopen, gframe
  put "Starting up the program. Please wait." into field 4305
  preLoad(1, 1)
  set gframe to EMPTY
  cursor(4)
  puppetSprite(42, 1)
  if fopen <> 1 then
    set fopen to 1
    init()
  end if
  when keyDown then checkkey
  cursor(0)
end

on checkkey
  if the frameLabel = "scard" then
    if the key = RETURN then
      if the puppet of sprite 48 = 1 then
        exit
      end if
      sresp(8)
      scardok()
      dontPassEvent()
    end if
  end if
end

on init
  global log1, log2, gframe, grecent, gsectlist, gsublist, gsubsublist, csize, gunload
  set csize to 4000
  set gunload to 1
  set the textSize of field 7 to 10
  set gsectlist to 1
  set gsublist to 1
  set gsubsublist to 0
  set grecent to EMPTY
  set gframe to EMPTY
  set log1 to "land"
  set log2 to "land"
  mfileNew()
  set the hilite of cast 7758 to 1
  set the hilite of cast 7761 to 1
  unLoad()
end

on mfileNew
  global gReadObject, marklist, dloc
  if objectp(gReadObject) then
    gReadObject(mdispose)
  end if
  set gReadObject to FileIO(mnew, "read", dloc)
  set mtemp to value(gReadObject(mReadLine))
  if mtemp <> 0 then
    set marklist to mtemp
  else
    set marklist to list()
  end if
  gReadObject(mdispose)
end

on initloc
  global gindexnum, gcodenum, greadnum, gpreadnum, gmapnum, ggplistnum, gsresults, gindexoffset, gslider1, gslider2, gpcountnum
  set gslider1 to 4538
  set gslider2 to 4539
  set gindexnum to 4512
  set gcodenum to 4514
  set greadnum to 4515
  set gpreadnum to 4516
  set gmapnum to 4517
  set ggplistnum to 4518
  set gsresults to 5993
  set gindexoffset to 4411
  set gpcountnum to 4519
end

on stopprint
  global printer, hook
  if objectp(printer) then
    printer(mdispose)
  end if
  if objectp(hook) then
    hook(mdispose)
  end if
end

on scardok
  global gmatchlist, gmatchlistnum, gsword, log1, log2, ghits, gonsearch
  set the itemDelimiter to ","
  set gsword to word 1 of field 7766
  if gsword = EMPTY then
    exit
  end if
  cursor(4)
  puppetSprite(9, 1)
  puppetSprite(11, 1)
  set the visible of sprite 9 to 0
  set the visible of sprite 11 to 0
  updateStage()
  set gsword to word 1 of field 7766
  set temp to lup(line 1 of gsword)
  if word 1 of field 7756 <> EMPTY then
    put word 1 of field 7756 into line 2 of gsword
    set temp2 to lup(line 2 of gsword)
    set exres to "put " & log1 & " (temp,temp2) into temp"
    do(exres)
    if word 1 of field 7757 <> EMPTY then
      put word 1 of field 7757 into line 3 of gsword
      set temp2 to lup(line 3 of gsword)
      set exres to "put " & log2 & " (temp,temp2) into temp"
      do(exres)
    end if
  end if
  set gmatchlist to expand(temp)
  set ghits to line 1 of gmatchlist
  put ghits into field 7765
  delete line 1 of gmatchlist
  set gmatchlistnum to the number of lines in gmatchlist
  put gmatchlist into field 7764
  set the visible of sprite 9 to 1
  set the visible of sprite 11 to 1
  cursor(0)
  updateStage()
  puppetSprite(9, 0)
  puppetSprite(11, 0)
  if gmatchlistnum > 1 then
    set gonsearch to 1
  end if
  if gmatchlist = EMPTY then
    showdiag("There are no matches.")
  end if
end

on closeWindow
  stopMovie()
  tell the stage
    cleanupMIAW()
  end tell
end

on lup vword
  global stime
  set stime to the ticks
  set res to shash(vword)
  set lnum to value(item 2 of res)
  set cname to "lup" & item 1 of res
  set res to line lnum of the text of cast cname
  set the itemDelimiter to "!"
  repeat with ind = 1 to the number of items in res
    if item ind of res starts vword & "," then
      set temp to item ind of res
      set the itemDelimiter to ","
      delete item 1 of temp
      return temp
    end if
  end repeat
  set the itemDelimiter to ","
  return EMPTY
end

on land l1, l2
  set lres to EMPTY
  set hittemp to 0
  delete item 1 of l1
  delete item 1 of l2
  set in2 to 2
  set l1count to the number of items in l1
  set l2count to the number of items in l2
  if (l1 = EMPTY) or (l2 = EMPTY) then
    return EMPTY
  end if
  repeat with index = 1 to l1count / 2
    set in1 to index * 2
    repeat while (value(item in2 of l2) < value(item in1 of l1)) and (l2count > 0)
      set in2 to in2 + 2
      if in2 > l2count then
        exit repeat
      end if
    end repeat
    if item in2 of l2 = item in1 of l1 then
      put integer(item in1 - 1 of l1 + item in2 - 1 of l2) & "," & item in1 of l1 & "," after lres
      set hittemp to hittemp + item in1 - 1 of l1 + item in2 - 1 of l2
    end if
  end repeat
  delete item the number of items in lres of lres
  set hittemp to integer(hittemp) & "/" & integer(the number of items in lres / 2)
  return hittemp & "," & lres
end

on lor l1, l2
  set hittemp to 0
  set lres to EMPTY
  delete item 1 of l1
  delete item 1 of l2
  set l1count to the number of items in l1
  set l2count to the number of items in l2
  if l1count = 1 then
    set l1count to 0
  end if
  if l2count = 1 then
    set l2count to 0
  end if
  set in2 to 2
  repeat with index = 1 to l1count / 2
    set in1 to index * 2
    repeat while (in2 <= l2count) and (value(item in2 of l2) < value(item in1 of l1))
      put item in2 - 1 of l2 & "," & item in2 of l2 & "," after lres
      set in2 to in2 + 2
      if in2 = l2count then
        put item in2 - 1 of l2 & "," & item in2 of l2 & "," after lres
      end if
    end repeat
    if item in2 of l2 = item in1 of l1 then
      put integer(item in1 - 1 of l1 + item in2 - 1 of l2) & "," & item in1 of l1 & "," after lres
      set in2 to in2 + 2
      next repeat
    end if
    put item in1 - 1 of l1 & "," & item in1 of l1 & "," after lres
  end repeat
  if in2 < l2count then
    put item in2 - 1 to l2count of l2 & "," after lres
  end if
  delete item the number of items in lres of lres
  set xnum to the number of items in lres
  repeat with index = 0 to (xnum / 2) - 1
    set hittemp to hittemp + item (2 * index) + 1 of lres
  end repeat
  set hittemp to integer(hittemp) & "/" & integer(xnum / 2)
  return hittemp & "," & lres
end

on lbnot l1, l2
  set lres to EMPTY
  set hittemp to 0
  delete item 1 of l1
  delete item 1 of l2
  set l1count to the number of items in l1
  set l2count to the number of items in l2
  if l1count = 1 then
    set l1count to 0
  end if
  if l2count = 1 then
    set l2count to 0
  end if
  set in2 to 2
  repeat with index = 1 to l1count / 2
    set in1 to index * 2
    repeat while (l2count > 0) and (in2 <= l2count) and (value(item in2 of l2) < value(item in1 of l1))
      set in2 to in2 + 2
    end repeat
    if item in2 of l2 <> item in1 of l1 then
      put item in1 - 1 of l1 & "," & item in1 of l1 & "," after lres
    end if
  end repeat
  if the number of items in lres = 1 then
    return EMPTY
  end if
  delete item the number of items in lres of lres
  set xnum to the number of items in lres
  repeat with index = 0 to (xnum / 2) - 1
    set hittemp to hittemp + item (2 * index) + 1 of lres
  end repeat
  set hittemp to integer(hittemp) & "/" & integer(xnum / 2)
  return hittemp & "," & lres
end

on clearall
  global rval, son, gsword, scard, gmatchlist, log1, log2, ghits, gscardon, gmatchlistnum, gonsearch
  cursor(4)
  go("clearcard")
  set gmatchlistnum to 0
  set gonsearch to 0
  set log1 to "land"
  set log2 to "land"
  set rval to EMPTY
  set son to EMPTY
  set gscardon to EMPTY
  set gsword to EMPTY
  set scard to EMPTY
  set ghits to EMPTY
  set gmatchlist to EMPTY
  put EMPTY into field 7764
  put EMPTY into field 7766
  put EMPTY into field 7756
  put EMPTY into field 7757
  put EMPTY into field 7765
  set the hilite of cast 7758 to 1
  set the hilite of cast 7759 to 0
  set the hilite of cast 7760 to 0
  set the hilite of cast 7761 to 1
  set the hilite of cast 7762 to 0
  set the hilite of cast 7763 to 0
  switchmatch(2060)
  go("scard")
  cursor(0)
end

on expand temp
  set res to EMPTY
  set num to (the number of items in temp - 1) / 2
  repeat with index = 1 to num
    put item index * 2 of temp & "   " & numtoframe(item (index * 2) + 1 of temp) into line index + 1 of res
  end repeat
  put item 1 of temp into line 1 of res
  return res
end

on doentermainframe
  global gpcount
  setmatch()
  set temp to numtoframe(the frame)
  updatemarked(temp)
  set temp to stripend(temp)
  updaterecent(temp)
end

on doenterpframe
  global gpcount
  set temp to numtoframe(the frame)
  updatemarked(temp)
  set temp to stripend(temp)
  set temp to temp & " P"
  updaterecent(temp)
end

on updatemarked card
  global marklist
  set mvar to getOne(marklist, card)
  if mvar >= 1 then
    puppetSprite(43, 1)
    set the locV of sprite 43 to 25
  else
    puppetSprite(43, 0)
  end if
end

on shash vword
  set vword to tolower(vword)
  set hashkey to EMPTY
  set ex to length(vword)
  if ex > 6 then
    set ex to 6
  end if
  repeat with ind = 1 to ex
    put charToNum(char ind of vword) after hashkey
  end repeat
  put ".0" after hashkey
  set res1 to rmod((25173 * hashkey) + 13849, 65567)
  set res2 to rmod(res1, 6000)
  put strip(rdiv(res2, 300) + 1) into item 1 of finres
  put strip(rmod(res2, 300) + 1) into item 2 of finres
  return finres
end

on shash2 vword
  set vword to tolower(vword)
  set hashkey to EMPTY
  set ex to length(vword)
  if ex > 6 then
    set x to 6
  end if
  repeat with ind = 1 to x
    put charToNum(char ind of vword) after hashkey
  end repeat
  put ".0" after hashkey
  set hashkey to rmod(hashkey, 6000)
  put strip(rdiv(hashkey, 300) + 1) into item 1 of finres
  put strip(rmod(hashkey, 300) + 1) into item 2 of finres
  return finres
end

on rmod vnum, mnum
  set vnumt to vnum / mnum
  set numtemp to string(vnumt)
  set varplace to offset(".", numtemp)
  set numtemp to char 1 to varplace - 1 of numtemp
  set nx to numtemp
  return vnum - (nx * mnum)
end

on rdiv vnum, mnum
  set vnumt to vnum / mnum
  set numtemp to string(vnumt)
  set varplace to offset(".", numtemp)
  set numtemp to char 1 to varplace - 1 of numtemp
  return numtemp
end

on strip num
  set num to string(num)
  set varplace to offset(".", num)
  set num to char 1 to varplace - 1 of num
  return value(num)
end

on tolower pword
  set wdnum to the number of chars in pword
  repeat with x = 1 to wdnum
    if (charToNum(char x of pword) >= 97) and (charToNum(char x of pword) <= 122) then
      put numToChar(charToNum(char x of pword) - 32) into char x of pword
    end if
  end repeat
  return pword
end

on stripparts pword
  set wdnum to the number of chars in pword
  repeat while wdnum > 0
    set avalue to charToNum(char 1 of pword)
    if ((avalue >= 65) and (avalue <= 90)) or ((avalue >= 97) and (avalue <= 122)) then
      exit repeat
      next repeat
    end if
    delete char 1 of pword
    set wdnum to wdnum - 1
  end repeat
  repeat while wdnum > 0
    set avalue to charToNum(char wdnum of pword)
    if ((avalue >= 65) and (avalue <= 90)) or ((avalue >= 97) and (avalue <= 122)) then
      exit repeat
      next repeat
    end if
    delete char wdnum of pword
    set wdnum to wdnum - 1
  end repeat
  return pword
end

on updaterecent card
  global grecent
  set numline to the number of lines in grecent
  if grecent = EMPTY then
    set grecent to card
    exit
  end if
  repeat with index = 1 to numline
    if line index of grecent = card then
      put card into line numline + 1 of grecent
      delete line index of grecent
      exit
    end if
  end repeat
  put card into line numline + 1 of grecent
  if numline = 20 then
    delete line 1 of grecent
  end if
end

on stripend what
  return word 1 to the number of words in what - 1 of what
end