Sound, Music & MIDI Collection 2/SMMVOL2.bin/DEMO/PRG/CIRCLES.ZIP/CI_MAIN.DIX/00003_FILM.ls

Text File | 1995-05-01 | 16.2 KB | 592 lines

on startMovie
  global player, xdbg, demo, demosegs, disk, idsw, maxsegs, minsegs, minsprites, maxsprits, stepcount, backcast, freemaster, file, fileName, dir_sep, memchange, fcommand, scommand, ecommand, fl_msg, segcurrent, framecnt, segsprite, stepsize, playloop, sample_offset, circle_qua, stepaction, mixedloop, t1pos, t2pos, t1idx, t2idx, t1mute, t2mute, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, LED_1, LED_2, t_add, areon, cstart, cstop, pastebu, walk_on, pastebuf, objectCount, theObjects, spritecount, soundCount, theSounds, backwhat, firstsound, FLED, TLED, MUTE, new_read, nn_mixcastinit, nn_mixcast, AR_nnsc, nn_sprite, cast_segs, cast_col, text_col, cp_idx, cp_1, cp_2, ver_cfile, ver_ifile, ini_file, my_cursor, my_cursor_on, my_cursor_busy, hp_page, hp_item, up_2ndch, up_sampm, up_load, up_save, up_override, up_temp, up_ini, up_mem, up_lang, up_mdicha, up_mdinot, up_cload, up_csave, mix_vol1, mix_vol2, mix_ofs1, mix_fn1, mix_fn2, mix_fnO, mix_seg, mix_pos, mix_ofs2, mix_rate, mix_qua, mix_mon, mix_size, mix_err, mix_idx1, mix_idx2, mix_loop, mix_start, mix_end, sndobj, mywin, acwin, last_mdinote, last_play, last_mute, ltl_len, ltl_time, ltl_scast, ltl_mix, Sp_idx, Sp_cast, Sp_locH, Sp_locV, Sp_ink, Sp_visib, Sp_name, Sp_fore, Sp_back, Sp_stch, Sp_stcv, ll_cast, ll_ttime, ll_size, ll_walk, ll_name, leff_name, leff_time1, leff_time2, eff_vol, eff_lidx, l_notload, sl_str, sl_x, sl_y, l_fold, l_file, l_disp, fl_bas, fl_step, fl_search, junk_cst, junk_vol, junk_time, loop_time, add_time, ticks_ps, sample_rate, butisflash, mixneed, namepause, namepause_bs, xy_copy, xy_past, xy_load, xy_save, xy_inse, xy_dele, xy_info, xy_ende, xy_paus, xy_halt, xy_mix, xy_rand, xy_setu, xy_l01, xy_l02, xy_l03, xy_l04, xy_l05, xy_l06, xy_l07, xy_l08, xy_l09, xy_l10, xy_l11, xy_l12, xy_m01, xy_m02, xy_s12, xy_s09, xy_s08, xy_s06, xy_s05, xy_s04, xy_s03, xy_s02, xy_s01
  set player to 1
  set xdbg to 0
  set demo to 1
  set disk to "PLANET"
  set idsw to 0
  if demo then
    set demosegs to 12
  else
    set demosegs to 24
  end if
  cursor(4)
  set ltl_len to []
  set ltl_time to []
  set ltl_scast to []
  set ltl_mix to []
  set ltl_upd to []
  set Sp_idx to []
  set Sp_cast to []
  set Sp_locH to []
  set Sp_locV to []
  set Sp_ink to []
  set Sp_visib to []
  set Sp_name to []
  set Sp_fore to []
  set Sp_back to []
  set Sp_stch to []
  set Sp_stcv to []
  set ll_cast to []
  set ll_ttime to []
  set ll_size to []
  set ll_walk to []
  set ll_name to []
  set eff_vol to 16
  set eff_lidx to 1
  set l_notload to []
  setAt(ltl_len, 25, "0")
  setAt(ltl_time, 25, 0)
  setAt(ltl_scast, 25, 0)
  setAt(ltl_mix, 25, 0)
  setAt(ltl_upd, 25, 0)
  set ver_ifile to "--CIRCLE elements INIT v1.04" & RETURN
  set ver_cfile to "--CIRCLE elements v1.01" & RETURN
  set ini_file to the pathName & "circle.ini"
  set the beepOn to 0
  set AR_nnsc to 1
  set butisflash to 0
  set nn_mixcastinit to 500
  set nn_mixcast to nn_mixcastinit
  set nn_sprite to 1
  set my_cursor to 4
  set my_cursor_on to -1
  set my_cursor_busy to 4
  set up_mem to 10
  set circle_qua to "8"
  mem_update()
  set maxsegs to 25
  set minsegs to 1
  set minsprites to 26
  set maxsprits to 48
  set objectCount to minsegs
  set spritecount to minsprites
  set theObjects to Array(mnew)
  set theSounds to Array(mnew)
  InitializeArrays()
  initArLEDS()
  set namepause to "PAUSE_"
  if the machineType = 256 then
    set namepause_bs to "\" & namepause
    set dir_sep to "\"
  else
    set namepause_bs to ":" & namepause
    set dir_sep to ":"
  end if
  set soundCount to 1
  set last_mute to 0
  set ticks_ps to 60
  set sample_rate to 22050
  set mixneed to 0
  set new_read to 1
  set last_mdinote to -1
  set segcurrent to EMPTY
  set segsprite to 0
  put " " into field "sndwin"
  set playloop to 0
  set stepaction to EMPTY
  set framecnt to 0
  set t1_segcnt to 0
  set t2_segcnt to 0
  set t1_idxcnt to 0
  set t2_idxcnt to 0
  set t1pos to 1
  set t2pos to 1
  set t1idx to 1
  set t2idx to 1
  set t1mute to 0
  set t2mute to 0
  set cstart to 1
  set cstop to 0
  set backcast to 0
  set mastervol to 0
  set the searchCurrentFolder to 1
  set firstsound to 1
  set LED_1 to 0
  set LED_2 to 0
  set areon to 0
  set TLED to 13
  set FLED to 13
  set MUTE to 1
  set pastebuf to 0
  set walk_on to 0
  set sample_offset to 100 - 22
  set Citotaltime to 0
  set cp_idx to 25
  set cp_1 to 0
  set cp_2 to 0
  set fl_bas to 42
  set fl_step to 16
  set l_fold to []
  set l_file to []
  set l_disp to []
  set fcommand to "INIT"
  set scommand to EMPTY
  set ecommand to EMPTY
  set fl_msg to EMPTY
  set acwin to "MAIN"
  set the exitLock to 0
  if the colorDepth < 8 then
    alert("CIRCLE ELEMENTS needs a 256 color display" & RETURN & RETURN & "CIRCLE ELEMENTS benoetigt einen 256 Farben Monitor")
    if not demo then
      quit()
    end if
    puppetPalette("PAL_MAIN")
    if 0 then
      set the name of cast "4LOGOCIR" to "LOGOCIR"
      set the name of cast "4LOGOBS" to "LOGOBS"
      set the name of cast "4LED1" to "LED1"
      set the name of cast "4LED2" to "LED2"
      set the name of cast "4POINTER" to "POINTER"
      set the name of cast "4WALK" to "WALK"
      set the name of cast "4EFXHI" to "EFXHI"
      set the name of cast "4ARUP" to "ARUP"
      set the name of cast "4ARDWN" to "ARDWN"
      set the name of cast "4STARS" to "STARS"
    end if
  else
    puppetPalette("PAL_MAIN")
    if 0 then
      set the name of cast "8LOGOCIR" to "LOGOCIR"
      set the name of cast "8LOGOBS" to "LOGOBS"
      set the name of cast "8LED1" to "LED1"
      set the name of cast "8LED2" to "LED2"
      set the name of cast "8POINTER" to "POINTER"
      set the name of cast "8WALK" to "WALK"
      set the name of cast "8EFXHI" to "EFXHI"
      set the name of cast "8ARUP" to "ARUP"
      set the name of cast "8ARDWN" to "ARDWN"
      set the name of cast "8STARS" to "STARS"
    end if
  end if
end

on inisys
  global up_ini, demo, player, up_mdicha, idsw
  ini_init()
  if not demo then
    if load_ini() then
      set up_ini to 1
    end if
  end if
  lib_load()
  if snd_init() then
    chk_ini()
    if not demo then
      if player then
        casts_import(70)
      end if
    end if
    eff_init()
    initxy()
    initfl()
    help_init()
    tl_create()
    sl_create()
    if the machineType = 256 then
      if up_mdicha >= 0 then
        midi_init()
      end if
    end if
  else
    play frame 9
    set fcommand to "QUIT"
    cur_on()
  end if
end

on haltcircle
  cleanupsounds()
  lib_free()
  halt()
end

on stopMovie
  global player, fcommand
  if 0 then
    if the colorDepth < 8 then
      set the name of cast "LOGOCIR" to "4LOGOCIR"
      set the name of cast "LOGOBS" to "4LOGOBS"
      set the name of cast "LED1" to "4LED1"
      set the name of cast "LED2" to "4LED2"
      set the name of cast "POINTER" to "4POINTER"
      set the name of cast "WALK" to "4WALK"
      set the name of cast "EFXHI" to "4EFXHI"
      set the name of cast "ARUP" to "4ARUP"
      set the name of cast "ARDWN" to "4ARDWN"
      set the name of cast "STARS" to "4STARS"
    else
      set the name of cast "LOGOCIR" to "8LOGOCIR"
      set the name of cast "LOGOBS" to "8LOGOBS"
      set the name of cast "LED1" to "8LED1"
      set the name of cast "LED2" to "8LED2"
      set the name of cast "POINTER" to "8POINTER"
      set the name of cast "WALK" to "8WALK"
      set the name of cast "EFXHI" to "8EFXHI"
      set the name of cast "ARUP" to "8ARUP"
      set the name of cast "ARDWN" to "8ARDWN"
      set the name of cast "STARS" to "8STARS"
    end if
  end if
  lib_free()
end

on circleend
  global fcommand, hp_page, demo, minsprites, maxSprites, spritecount, theObjects, mywin
  put "circleend"
  save_mix(0)
  cur_busy()
  if not demo then
    save_ini()
  end if
  if hp_page >= 0 then
    help_close()
  end if
  repeat with i = minsprites to spritecount
    set the puppet of sprite i to 0
  end repeat
  cleanup()
  cleanupsounds()
  lib_free()
  KillArrays()
  if objectp(theObjects) = 1 then
    theObjects(mdispose)
  end if
  if the machineType = 256 then
    puppetTransition(50, 1, 5)
  else
    puppetTransition(50, 1, 10)
  end if
  but_reflash()
  set the castNum of sprite 1 to the number of cast "EMPTY"
  set the puppet of sprite 1 to 1
  if objectp(mywin) then
    forget(mywin)
  end if
  play frame 9
  set fcommand to "QUIT"
  cur_on()
end

on cleanup
  global objectCount, theObjects, minsegs, maxsegs, segsprite, segcurrent, firstsound, pastebuf, t1_segcnt, t2_segcnt, t1_idxcnt, t2_idxcnt, AR_nnsc, sel_ttrak
  if objectp(theObjects) = 0 then
    exit
  end if
  repeat with i = minsegs + 1 to objectCount
    set ithObject to theObjects(mget, i)
    if objectp(ithObject) then
      ithObject(mrelease)
      ithObject(mdispose)
    end if
  end repeat
  set objectCount to minsegs
  set segsprite to 0
  set segcurrent to EMPTY
  set sel_ttrak to "1"
  puppetSound(0)
  set AR_nnsc to 1
  set t1_segcnt to 0
  set t2_segcnt to 0
  set t1_idxcnt to 0
  set t2_idxcnt to 0
  set firstsound to 1
  mixneed_off()
  ledclear()
  set hl to "LD" & lzero(1)
end

on cleanupsounds
  global pastebuf, nn_mixcast, nn_mixcastinit, Citotaltime, ltl_mix, namepause_bs, cp_idx, cp_1, cp_2
  repeat with i = 1 to 24
    if namepause_bs <> Ar1sound(mget, i) then
      if Ar1play(mget, i) > 0 then
        snd_close(Ar1play(mget, i))
        Ar1play(mput, i, 0)
      end if
    end if
  end repeat
  set tmpsprite to getspritenum("FIRE")
  set the visible of sprite tmpsprite to 0
  set pastebuf to 0
  cp1set(0)
  cp2set(0)
  set Citotaltime to 0
  tl_create()
end

on cleanUpArrs x
  if x = 0 then
    set x to 1
  end if
  repeat with i = x to x + 23
    AR1idx(mput, i, 0)
    ar1seg(mput, i, 0)
    ar1pos(mput, i, 0)
    ARCiidx(mput, i, 0)
  end repeat
end

on cleanUpt2
  global t2_segcnt, t2_idxcnt, namepause_bs
  repeat with i = 13 to 24
    if Ar1sound(mget, i) <> namepause_bs then
      if value(Ar1play(mget, i)) > 0 then
        snd_close(Ar1play(mget, i))
      end if
    end if
    AR1idx(mput, i, 0)
    ar1seg(mput, i, 0)
    ar1pos(mput, i, 0)
    Ar1play(mput, i, 0)
    Ar1sound(mput, i, EMPTY)
    ARCiidx(mput, i, 0)
  end repeat
  set t2_segcnt to 0
  set t2_idxcnt to 0
end

on set_sprites
  global minsprites, disk
  set sp to create_vsp("SNDWIN")
  set the ink of sprite sp to 1
  sprite_show(sp, 557, 195)
  set sp to create_vsp("LOP")
  set the ink of sprite sp to 36
  set the backColor of sprite sp to 0
  sprite_show(sp, 235, 292)
  set sp to create_vsp("FIRE")
  set the ink of sprite sp to 8
  sprite_show(sp, 237, 247)
  set the visible of sprite sp to 0
  set sp to create_vsp("DEL")
  set the ink of sprite sp to 8
  sprite_show(sp, 189, 199)
  set sp to create_vsp("MIX")
  set the ink of sprite sp to 8
  sprite_show(sp, 282, 199)
  set sp to create_vsp("VOLUME")
  set the ink of sprite sp to 8
  sprite_show(sp, 458, 458)
  set sp to create_vsp("TITLE")
  set the ink of sprite sp to 1
  sprite_show(sp, 557, 176)
  set sp to create_vsp("POINTER")
  set the ink of sprite sp to 36
  sprite_show(sp, 525, 1500)
  set sp to create_vsp("WINMSG")
  set the ink of sprite sp to 0
  sprite_show(sp, 1500, 1500)
  put "INIT" into field "MSGTXT"
  set sp to create_vsp("MSGTXT")
  set the ink of sprite sp to 1
  set the editableText of sprite sp to 0
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("EFXHI")
  set the ink of sprite sp to 36
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("MUTE")
  set the ink of sprite sp to 36
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("LED1")
  set the ink of sprite sp to 36
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("LED2")
  set the ink of sprite sp to 36
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("WALK")
  set the ink of sprite sp to 36
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("BF_CP1")
  set the ink of sprite sp to 8
  sprite_show(sp, 1500, 1500)
  set sp to create_vsp("BF_CP2")
  set the ink of sprite sp to 8
  sprite_show(sp, 1500, 1500)
  setfont("title")
  setfont("sndwin")
  setdisk_col()
end

on getspritenum name
  global minsprites, spritecount, maxSprites
  repeat with i = minsprites to spritecount
    if vsprites(mget, i) = name then
      return i
    end if
  end repeat
  alert("sprite >" & name & "< not found !")
end

on create_vsp spritename
  global spritecount
  set the castNum of sprite spritecount to the number of cast spritename
  set the puppet of sprite spritecount to 1
  vsprites(mput, spritecount, spritename)
  set spritecount to spritecount + 1
  return spritecount - 1
end

on chksprites
  global spritecount, minsprites, maxSprites
  repeat with i = minsprites to spritecount
  end repeat
end

on casts_get disk, colres
  put "DISK>" & disk & "  color>" & colres
  casts_load(the pathName & "CI__" & disk & lzero(colres) & ".DIR", 35)
  casts_load(the pathName & "ci_segs.dir", 95)
end

on casts_load file, init
  set chkcast to init + 1
  if the loaded of cast chkcast = 0 then
    importFileInto(cast init, file)
    if the loaded of cast chkcast = 0 then
      alert("File " & file & " not found. Terminating...")
      return 1
    else
      return 0
    end if
  else
    return 0
  end if
end

on casts_clear dwn
  repeat with i = 129 down to 69
    erase(cast i)
    duplicate(cast "EMPTY", cast i)
  end repeat
end

on circle_init
  global fcommand
  put "init"
  if the machineType = 256 then
    puppetTransition(50, 1, 5)
  else
    puppetTransition(50, 1, 10)
  end if
  set the castNum of sprite 1 to the number of cast "STARS"
  sprite_show(1, 320, 240)
  set the puppet of sprite 1 to 1
  set the castNum of sprite 3 to the number of cast "LOGOBS"
  set the ink of sprite 3 to 8
  sprite_show(3, 310, 140)
  set the puppet of sprite 3 to 1
  set the castNum of sprite 4 to the number of cast "LOGOCIR"
  set the ink of sprite 4 to 8
  sprite_show(4, 310, 340)
  set the puppet of sprite 4 to 1
  set the castNum of sprite 5 to the number of cast "PRESENTS"
  set the ink of sprite 5 to 1
  sprite_show(5, 280, 210)
  set the puppet of sprite 5 to 1
  set fcommand to EMPTY
end

on circle_start1
  global fcommand, framecnt, player
  set the exitLock to 1
  inisys()
  if player then
    if the machineType = 256 then
      puppetTransition(50, 1, 5)
    else
      puppetTransition(50, 1, 10)
    end if
  end if
  set the castNum of sprite 1 to the number of cast "MAIN"
  set the locH of sprite 1 to 319
  set the locV of sprite 1 to 240
  set the puppet of sprite 1 to 1
  set the scriptText of cast "MAIN" to the text of cast "SC_MAIN"
  set the scriptText of cast "FSEL" to the text of cast "SC_FSEL"
  set the scriptText of cast "VOLUME" to the text of cast "SC_SLIDE"
  set the scriptText of cast "MIX" to the text of cast "SC_MAIN"
  set the scriptText of cast "DEL" to the text of cast "SC_MAIN"
  set the scriptText of cast "LOP" to the text of cast "SC_MAIN"
  set the scriptText of cast "SELFNA" to the text of cast "SC_SELF"
  set the textStyle of field "TITLE" to "BOLD"
  set_sprites()
  mute1On()
  set fcommand to "STR2"
  updateStage()
end

on circle_start2
  global fcommand, demo
  if demo then
    demowin(0)
  end if
  circlemaster()
  set fcommand to EMPTY
  cur_on()
  set hl to "LD" & lzero(1)
  ledklick(hl)
end

on lib_load
  global sndobj, xdbg
  if the machineType = 256 then
    openXLib(the pathName & "xsndwork.dll")
    set sndobj to xsndwork(mnew, xdbg)
  else
    openXLib(the pathName & "sndwork")
    set sndobj to sndwork(mnew)
  end if
  if not objectp(sndobj) then
    alert("XOBJ SNDWORK not found")
  end if
end

on lib_free
  global sndobj
  snd_done()
  midi_done()
  if objectp(sndobj) then
    sndobj(mdispose)
    if the machineType = 256 then
      closeXLib(the pathName & "xsndwork.dll")
    else
      closeXLib(the pathName & "sndwork")
    end if
  end if
end

on keyDown
  global fcommand
  if not (fcommand = "FSDO") then
    mykeyup()
  end if
end

on cmdstate
  global fcommand, scommand, ecommand, fl_msg, acwin, framecnt
  put "<<cmdstate sc>" & scommand & " fc>" & fcommand & " ec>" & ecommand
  put "<<cmdstate fl_msg>" & fl_msg & "< acwin>" & acwin & "<"
end

on getfreecast
  repeat with i = 33 to the maxinteger
    if not (the loaded of cast i) then
      exit repeat
    end if
  end repeat
  return i
end

on mem_update
  global up_mem, up_sampm, circle_qua, freemaster
  if circle_qua = "16" then
    set up_sampm to integer(up_mem * 50000)
  else
    set up_sampm to integer(up_mem * 100000)
  end if
  set freemaster to up_sampm
end

factory Array