home *** CD-ROM | disk | FTP | other *** search
/ Fujiology Archive / fujiology_archive_v1_0.iso / !MAGS / !BONUS / COVERDSK / STFORMAT / STF34.ZIP / STF34A.MSA / INTRO / INTROPL5.LST < prev    next >
File List  |  1989-04-06  |  12KB  |  422 lines
  1. On Break Gosub Break
  2. On Error Gosub Break
  3. @Main_program
  4. Setcolor 0,1911
  5. Procedure Break
  6.   Setcolor 0,1911
  7.   Setcolor 15,0
  8.   End             !change to system or remove when compiling
  9. Return
  10. ' (  *****  PROGRAM INTRODUCTION SEQUENCES  ***** )
  11. ' written by Anthony Daniels. December 1991.
  12. ' (  *****     SECTION DISPLAY PROGRAM      ***** )
  13. ' update on 22/2/1992 so samples can be played, & pics only use memory when loaded}
  14. '
  15. ' var
  16. ' screen$(1 to 8)= picture
  17. ' screen_title$= current picture or samples name to be loaded
  18. ' screen_no%= no. of screen$(screen_no%) to be loaded or sput, or value for other commands
  19. ' p= pause time in 200th of a second
  20. '
  21. Procedure Initialise
  22.   Hidem
  23.   Dim Screen_title$(220)
  24.   Dim Com%(Total_commands%)
  25.   Dim Screen_no%(Total_commands%)
  26.   Free_memory%=Fre(O)
  27.   No_screens%=Trunc((Free_memory%-2000)/32066)  !2k for variables etc
  28.   Print No_screens%
  29.   Dim Screen$(No_screens%)
  30.   @Load_sample_code
  31.   Fade!=False
  32.   Scroll%=0
  33.   Curtain%=0
  34. Return
  35. '
  36. Procedure Load_sample_code
  37.   Dim A%(2000)
  38.   Code%=Varptr(A%(0))
  39.   Bload "BASCODE.EXE",Code%
  40.   Start%=Code%+28
  41.   Sample_speed%=4        ! ie default speed setting
  42.   Dim Sample_add%(No_screens%)     ! initialise sample variables. This holds the address
  43.   Dim Sample_length%(No_screens%)  ! length in bytes
  44.   Dim Sample$(No_screens%)         ! the actual sample held in a string
  45. Return
  46. '
  47. Procedure Load_screen           !proc to carry out com%(com_no%)=1 ie loading
  48.   Local Add%
  49.   Screen$(Screen_no%(Com_no%))=Space$(32066)    ! define some space for picture
  50.   Add%=Varptr(Screen$(Screen_no%(Com_no%)))
  51.   If Right$(Screen_title$(Com_no%),3)="PI1"
  52.     Bload Screen_title$(Com_no%),Add%
  53.   Else      !ie its a pc1 screen - load and decompress screen
  54.     @Load_degas_compressed
  55.   Endif
  56. Return
  57. '
  58. Procedure Load_degas_compressed
  59.   Pc1_file$=Space$(32066)      !to hold a pc1 screen of up to 32k
  60.   Pc1_file%=Varptr(Pc1_file$)
  61.   '  Print "loading Degas : "'Screen_title$(Com_no%)
  62.   Bload Screen_title$(Com_no%),Pc1_file%-34
  63.   Bmove Pc1_file%-34,Add%,34     !copy pallette to memory area for uncompressed screen
  64.   Add Add%,34
  65.   Ctr%=0
  66.   Repeat
  67.     Pic_line$=Space$(160)        ! tempary storage for one line of pic
  68.     Line_add%=Varptr(Pic_line$)  ! address of tempary line
  69.     Line_len%=0                      ! length of tempary line
  70.     Repeat
  71.       Repeat
  72.         Dat%=Peek(Pc1_file%)     !peek at data byte from compressed screen
  73.         Inc Pc1_file%
  74.       Until Dat%<>128
  75.       If Dat%<128
  76.         Inc Dat%
  77.         Add Line_len%,Dat%
  78.         For I%=1 To Dat%
  79.           Poke Line_add%,Peek(Pc1_file%)
  80.           Inc Line_add%
  81.           Inc Pc1_file%
  82.         Next I%
  83.       Else      ! ie dat%>=128
  84.         Dat%=257-Dat%
  85.         Add Line_len%,Dat%
  86.         For I%=1 To Dat%
  87.           Poke Line_add%,Peek(Pc1_file%)
  88.           Inc Line_add%
  89.         Next I%
  90.         Inc Pc1_file%
  91.       Endif
  92.     Until Line_len%=160
  93.     Line_add%=Varptr(Pic_line$)
  94.     For I%=1 To 20
  95.       Dpoke Add%,Dpeek(Line_add%)
  96.       Dpoke Add%+2,Dpeek(Line_add%+40)
  97.       Dpoke Add%+4,Dpeek(Line_add%+80)
  98.       Dpoke Add%+6,Dpeek(Line_add%+120)
  99.       Add Add%,8
  100.       Add Line_add%,2
  101.     Next I%
  102.     '
  103.     Inc Ctr%
  104.   Until Ctr%=200
  105.   Showm
  106. Return
  107. '
  108. Procedure Get_colours
  109.   Local Q%
  110.   For Q%=0 To 15
  111.     Colour%(Q%)=Xbios(7,Q%,-1)
  112.   Next Q%
  113. Return
  114. '
  115. Procedure Restore_col
  116.   Local Q%
  117.   For Q%=0 To 15
  118.     '    ==>     ~XBIOS(7,q%,colour%(q%))
  119.   Next Q%
  120. Return
  121. '
  122. Procedure Wait_key
  123.   Repeat
  124.   Until Inkey$<>""
  125. Return
  126. '
  127. Procedure Sputing
  128.   Local Add%
  129.   Add%=34+Varptr(Screen$(Screen_no%(Com_no%)))   !address of screen memory (1 to 7 on a 520 ST)
  130.   Bmove Add%-34,Xbios(3)-34,34
  131.   If Fade! Or Scroll_step%<>0 Or Curtain<>0
  132.     If Fade!
  133.       @Fade_out
  134.       Add%=34+Varptr(Screen$(Screen_no%(Com_no%)))   !this seems to move so its reset here
  135.       Bmove Add%,Xbios(3),32000
  136.       '      Void Xbios(6,L:Add%+2-34)    ! set colours (first 2 bytes of file are resolution)
  137.       @Fade_in
  138.     Else
  139.       If Scroll_step%<>0
  140.         @Scroll_off
  141.         Add%=34+Varptr(Screen$(Screen_no%(Com_no%)))   !address of screen memory (1 to 7 on a 520 ST)
  142.         Cls
  143.         Void Xbios(6,L:Add%+2-34)    ! set colours (first 2 bytes of file are resolution)
  144.         @Scroll_on
  145.         Bmove Add%,Xbios(3),32000
  146.       Else
  147.       Endif
  148.     Endif
  149.   Else
  150.     Add%=34+Varptr(Screen$(Screen_no%(Com_no%)))   !address of screen memory (1 to 7 on a 520 ST)
  151.     Void Xbios(6,L:Add%+2-34)    ! set colours (first 2 bytes of file are resolution)
  152.     Bmove Add%,Xbios(3),32000    !first 34 bytes are resolution and colors in pallette
  153.   Endif
  154. Return
  155. '
  156. Procedure Scroll_off
  157.   Local Y
  158.   If Scroll_step%>0
  159.     Y=0
  160.     Bmove Xbios(3)+(Y*160),Xbios(3)+((Y+Scroll_step%)*160),32000-(Y*160)
  161.     Deffill 0
  162.     Pbox 0,0,319,Scroll_step%
  163.     Repeat
  164.       Bmove Xbios(3)+(Y*160),Xbios(3)+((Y+Scroll_step%)*160),32000-(Y*160)
  165.       Y=Y+Scroll_step%
  166.     Until Y>=200-Scroll_step%
  167.   Endif
  168.   If Scroll_step%<0
  169.     Scroll_step%=Abs(Scroll_step%)
  170.     Y=Scroll_step%
  171.     Deffill 0
  172.     Pbox 0,199-Scroll_step%,319,199
  173.     Repeat
  174.       Bmove Xbios(3)+(Scroll_step%*160),Xbios(3),32000-(Y*160)
  175.       Y=Y+Scroll_step%
  176.     Until Y=>200-Scroll_step%
  177.   Endif
  178. Return
  179. '
  180. Procedure Scroll_on
  181.   Local Y
  182.   If Scroll_step%>0
  183.     Y=1
  184.     Repeat
  185.       Bmove Add%+((199-Y)*160),Xbios(3),Y*160
  186.       Y=Y+Scroll_step%
  187.     Until Y=>200-Scroll_step%
  188.   Endif
  189.   If Scroll_step%<0
  190.     Y=1
  191.     Repeat
  192.       Bmove Add%,Xbios(3)+((199-Y)*160),Y*160
  193.       Y=Y+Scroll_step%
  194.     Until Y=>200-Scroll_step%
  195.   Endif
  196. Return
  197. ' Setcolor 0,1911
  198. ' Setcolor 15,0
  199. ' '''Fileselect "\autoplay\*.pi1","thund1.pi1",Filename$
  200. ' Bload Filename$,Xbios(3)-34
  201. ' '@Get_pallette(Xbios(3))
  202. ' Repeat
  203. ' Until Inkey$<>""
  204. Procedure Get_pallette(Scrn_address%)
  205.   Local A%
  206.   Erase Col%()
  207.   Dim Col%(15)
  208.   For A%=0 To 15
  209.     Col%(A%)=Dpeek(Scrn_address%-32+(2*A%))
  210.     If Col%(A%)>1911    ! if the pallette uses extra STE colors
  211.       W=Col%(A%)     ! the STFM can not handle the extended pallette of the STe thus colors are rounded
  212.       Erase Bit_flag!()
  213.       Dim Bit_flag!(15)
  214.       For Bit_no%=15 Downto 0
  215.         Bit=W/(2^Bit_no%)
  216.         If Bit=>1
  217.           Bit_flag!(Bit_no%)=True
  218.         Else
  219.           Bit_flag!(Bit_no%)=False
  220.         Endif
  221.         W=(Frac(Bit))*(2^Bit_no%)
  222.       Next Bit_no%
  223.       For Count%=15 Downto 11
  224.         Bit_flag!(Count%)=0
  225.       Next Count%
  226.       Bit_flag!(7)=0
  227.       Bit_flag!(3)=0
  228.       Word=0
  229.       For Count%=0 To 15
  230.         If Bit_flag!(Count%)
  231.           Word=Word+(2^Count%)
  232.         Endif
  233.       Next Count%
  234.       Col%(A%)=Word
  235.     Endif
  236.     '    Print "color ";A%;" = ";Hex$(Col%(A%))
  237.   Next A%
  238. Return
  239. '
  240. Procedure Set_pallette
  241.   Local F%
  242.   For F%=0 To 15
  243.     Setcolor F%,Col%(F%)
  244.   Next F%
  245. Return
  246. '
  247. Procedure Fade_out
  248.   '  Local Q%,K%
  249.   '  Fade_speed=100
  250.   @Get_pallette(Xbios(3))       !into col%(1..15)
  251.   @Set_pallette
  252.   Fading!=True
  253.   While Fading!
  254.     Fading!=False
  255.     For U%=0 To 15
  256.       If Col%(U%)>0      !if this color is not yet black
  257.         @Get_rgb(Col%(U%),*Red,*Green,*Blue)
  258.         If Red>0
  259.           Red=Trunc(Red)-1     !lower red component of color
  260.         Endif
  261.         If Green>0
  262.           Green=Trunc(Green)-1
  263.         Endif
  264.         If Blue>0
  265.           Blue=Trunc(Blue)-1
  266.         Endif
  267.         Col%(U%)=(Red*256)+(Green*16)+Blue     ! work out new color value
  268.         Setcolor U%,Col%(U%)
  269.         Fading!=True
  270.         For K%=0 To Fade_speed  !loop to slow down fading
  271.         Next K%
  272.       Endif
  273.     Next U%
  274.   Wend
  275. Return
  276. '
  277. Procedure Fade_in
  278.   @Get_pallette(Xbios(3))
  279.   Erase Scrn_col%()
  280.   Dim Scrn_col%(15)
  281.   Swap Col%(),Scrn_col%()
  282.   @Get_pallette(Xbios(3))
  283.   For U%=0 To 15
  284.     Col%(U%)=0
  285.     Setcolor U%,0
  286.   Next U%
  287.   Fading!=True
  288.   While Fading!
  289.     Fading!=False
  290.     For U%=0 To 15
  291.       '      Scrn_col%=Dpeek(Xbios(3)-32+(2*U%))
  292.       Scrn_col%=Scrn_col%(U%)
  293.       @Get_rgb(Scrn_col%,*Scrn_red%,*Scrn_green%,*Scrn_blue%)  !find out screens r,g,b
  294.       @Get_rgb(Col%(U%),*Current_red%,*Current_green%,*Current_blue%)
  295.       If Current_red%<Scrn_red% Or Current_green%<Scrn_green% Or Current_blue%<Scrn_blue%
  296.         If Current_red%<Scrn_red%
  297.           Inc Current_red%
  298.         Endif
  299.         If Current_green%<Scrn_green%
  300.           Inc Current_green%
  301.         Endif
  302.         If Current_blue%<Scrn_blue%
  303.           Inc Current_blue%
  304.         Endif
  305.         Col%(U%)=(Current_red%*256)+(Current_green%*16)+Current_blue%
  306.         '        Setcolor 0,1911
  307.         '        Setcolor 15,0
  308.         '        Print "previously, color ";U%;" = ";Scrn_col%;"    now = ";Col%(U%)
  309.         '        Repeat
  310.         '      Until Inkey$<>""
  311.         Setcolor U%,Col%(U%)
  312.         Fading!=True
  313.         For K%=0 To Fade_speed  !loop to slow down fading
  314.         Next K%
  315.       Endif
  316.     Next U%
  317.   Wend
  318. Return
  319. '
  320. Procedure Get_rgb(Color%,R%,G%,B%)    ! ie address of color components red, green & blue
  321.   Local Red_value,Green_value,Blue_value
  322.   Red_value=Color%/256
  323.   Green_value=Frac(Red_value)*16
  324.   Blue_value=Frac(Green_value)*16
  325.   *R%=Trunc(Red_value)
  326.   *G%=Trunc(Green_value)
  327.   *B%=Trunc(Blue_value)
  328. Return
  329. '
  330. Procedure Pausing
  331.   Pause Screen_no%(Com_no%)
  332. Return
  333. '
  334. Procedure Gotoing
  335.   Com_no%=Screen_no%(Com_no%)-1
  336. Return
  337. '
  338. Procedure Clsing
  339.   Cls
  340.   Setcolor 0,Screen_no%(Com_no%)
  341. Return
  342. '
  343. Procedure Scrolling
  344.   Scroll_step%=Screen_no%(Com_no%)
  345. Return
  346. '
  347. Procedure Fading
  348.   If Screen_no%(Com_no%)=0
  349.     Fade!=False
  350.   Else
  351.     Fade!=True
  352.     Fade_speed=Screen_no%(Com_no%)
  353.   Endif
  354. Return
  355. '
  356. Procedure Loading_sequence
  357.   Print "press mouse to select introduction"      !erase this if you do not ever want to select a file to load
  358.   For N=1 To 700
  359.     If Mousek=1
  360.       Fileselect "*.itr","",Load_seq$
  361.       N=700
  362.     Else
  363.       Load_seq$="introseq.itr"         !this is the default setting for the intro sequence file name
  364.     Endif
  365.   Next N
  366.   Print "Loading"'Load_seq$
  367.   Open "i",#1,Load_seq$
  368.   Input #1,Total_commands%
  369.   '  Input #1,No_loadscrn%
  370.   @Initialise                           ! to dimention variables
  371.   For Com_no%=1 To Total_commands%
  372.     Input #1,Com%(Com_no%)
  373.     Input #1,Screen_no%(Com_no%)
  374.     If Com%(Com_no%)=1 Or Com%(Com_no%)=12+1
  375.       Input #1,Screen_title$(Com_no%)
  376.     Endif
  377.   Next Com_no%
  378.   Close #1
  379.   Cls
  380. Return
  381. '
  382. Procedure N    !nil proc
  383. Return
  384. '
  385. Procedure Main_program
  386.   @Loading_sequence
  387.   Screen_title%=1
  388.   For Com_no%=1 To Total_commands%
  389.     '    Print Com_no%
  390.     On Com%(Com_no%) Gosub Load_screen,Sputing,Pausing,Gotoing,Clsing,Scrolling,Fading,N,N,N,N,N,Load_samples,Play_sample,Set_speed
  391.     '                                1       2       3       4      5 6 7 8 910 11 12 13
  392.   Next Com_no%
  393.   Setcolor 0,1911
  394.   Setcolor 15,0
  395.   Edit
  396. Return
  397. '
  398. Procedure Load_samples
  399.   Sample_title$=Screen_title$(Com_no%)
  400.   Sample_no%=Screen_no%(Com_no%)
  401.   '  Print "Loading sample : "'Sample_title$
  402.   Open "i",#1,Sample_title$
  403.   Sample_length%(Sample_no%)=Lof(#1)
  404.   '  Print "Sample length : "'Sample_length%(Sample_no%)
  405.   Close #1
  406.   Sample$(Sample_no%)=Space$(Sample_length%(Sample_no%))
  407.   Sample_add%(Sample_no%)=Varptr(Sample$(Sample_no%))
  408.   Bload Sample_title$,Sample_add%(Sample_no%)
  409. Return
  410. '
  411. Procedure Play_sample
  412.   Sample_no%=Screen_no%(Com_no%)
  413.   Lpoke Start%+2,Sample_add%(Sample_no%)
  414.   Lpoke Start%+6,Sample_length%(Sample_no%)
  415.   Lpoke Start%+10,Sample_speed%       !0 is slowest, 7 is fastest
  416.   Call Start%
  417. Return
  418. '
  419. Procedure Set_speed
  420.   Sample_speed%=Screen_no%(Com_no%)
  421. Return
  422.