home *** CD-ROM | disk | FTP | other *** search
/ Spanish Scene 4 / SpanishScene4.iso / Programas / DDominguez_Ind / PlaySidDevBas.lha / PlaySidExample.bas < prev    next >
BASIC Source File  |  2000-07-02  |  9KB  |  330 lines
  1. ' *********************************************************************
  2. '                   PlaySidExample.bas 1.0 (2.7.00)
  3. '            © 2000 by Dámaso D. Estévez <amidde@arrakis.es>
  4. '                        All Rights Reserved
  5. '              AmiSpaTra - http://www.arrakis.es/~amidde/
  6. '
  7. '  This examples was wrote reading the reduced documentation included
  8. '  in the developper package and with the hard "try & essay" method.
  9. '   The program plays a SID module... you can find some in Aminet
  10. '    (try Crazy_sue.sid or MegaDefender-Cracktro.sid included in
  11. '  the mods/sets/MSX-SIDcollect.lha package), however, probably you
  12. '   must modify them and generate your icon asociated with SIDConv
  13. '     (included in the PlaySID package)... in my machine (060)
  14. '        the library is slow and seems don't work very well
  15. '                      (slow music, freezes...).
  16. '
  17. '  Este ejemplo ha sido escrito basándose en la reducida documentación
  18. '              includa en el paquete para desarrolladores
  19. '      y utilizando el siempre pesado método de ensayo y error :).
  20. '    El programa reproduce un módulo SID... puede encontrar algunos
  21. '     en Aminet (pruebe Crazy_sue.sid o MegaDefender-Cracktro.sid
  22. '  incluidos en el paquete mods/sets/MSX-SIDcollect.lha), sin embargo,
  23. '   probablemente deberá modificarlos y generar su icono asociado con
  24. '     la herramienta  SIDConv (incluido en el paquete PlaySID)...
  25. '   en mi máquina (060) la biblioteca es lenta y no parece funcionar
  26. '              demasiado bien (música lenta, parones...).
  27. ' *********************************************************************
  28.  
  29. REM $include dos.bh
  30. REM $include exec.bh
  31. REM $include playsid.bh
  32.  
  33. ' =====================================================================
  34. '                    Global vars / Variables globales
  35. ' =====================================================================
  36.  
  37. db&    = NULL&   ' DosBase
  38. psb&   = NULL&   ' PlaySidBase
  39.  
  40. long1& = NULL&
  41. long2& = NULL&
  42. long3& = NULL&
  43. long4& = NULL&
  44.  
  45. pause& = TRUE&   ' Status reproduction / Estado de la reproducción
  46.  
  47. ok&    = FALSE&  ' Inicialization ok? / ¿Inicialización correcta?
  48.  
  49. ' =====================================================================
  50. '           Functions and subroutines / Funciones y subrutinas
  51. ' =====================================================================
  52.  
  53. '           -----------------------------------------------------
  54. '                Prints song's author, copyright or name info
  55. '           Imprime el autor, copyright o el nombre de la canción
  56. '           -----------------------------------------------------
  57.  
  58. FUNCTION RecHeadInfo$(address&)
  59. LOCAL t1$,t2$,a%
  60.  
  61.     t1$="":t2$=""
  62.  
  63.     FOR a%=0 TO HEADERINFO_SIZE&-1
  64.         t2$=CHR$(PEEKB(address&+a%))
  65.         IF t2$=CHR$(0) THEN
  66.             EXIT FOR
  67.         ELSE
  68.             t1$=t1$+t2$
  69.         END IF
  70.     NEXT a%
  71.  
  72.     RecHeadInfo$=t1$
  73.  
  74. END FUNCTION
  75.  
  76. '            ---------------------------------------------------
  77. '            Info about the module / Información sobre el módulo
  78. '            ---------------------------------------------------
  79.  
  80. SUB InfoSID(header&)
  81.  
  82.     PRINT
  83.     PRINT "  ------- Some info about the module -------"
  84.     PRINT "  Name     : ";RecHeadInfo$(header&+SIDHeader_name%)
  85.     PRINT "  Length   :";PEEKW(header&+SIDHeader_length%)
  86.     PRINT "  DefSong  :";PEEKW(header&+SIDHeader_defsong%)
  87.     PRINT "  Speed    :";PEEKL(header&+SIDHeader_speed%)
  88.     PRINT "  Author   : ";RecHeadInfo$(header&+SIDHeader_author%)
  89.     PRINT "  Copyright: ";RecHeadInfo$(header&+SIDHeader_copyright%)
  90.     PRINT "  -----------------------------------------"
  91.     PRINT
  92.  
  93. END SUB
  94.  
  95. '               ---------------------------------------------
  96. '                   Processing the CLI argument(s) string
  97. '                     See the dev/basic/ImageDTInfo.lha
  98. '                    package for understand this routine.
  99. '                               ------------
  100. '                 Procesando la cadena de argumento(s) CLI
  101. '               Consulte el paquete dev/basic/ImageDTInfo.lha
  102. '                  para entender cómo funciona esta rutina
  103. '               ---------------------------------------------
  104.  
  105. FUNCTION getarg$(cad$,p%)
  106. LOCAL num%,quotes%,char%,cadtmp$,a%
  107.  
  108.     getarg$=""
  109.  
  110.     WHILE cad$ <> ""
  111.  
  112.         cad$=LTRIM$(RTRIM$(cad$))
  113.  
  114.         num%    = 1
  115.         cadtmp$ = ""
  116.         quotes% = 0
  117.  
  118.         FOR a%=1 TO LEN(cad$)
  119.  
  120.             char%=ASC(MID$(cad$,a%,1))
  121.  
  122.                 SELECT CASE char%
  123.  
  124.                     ' ------ Modifying quotes status -------
  125.                     ' - Modificando estado de las comillas -
  126.                     ' --------------------------------------
  127.                     CASE 34
  128.                     quotes% = NOT quotes%
  129.  
  130.                     ' -- Spaces/ Espacios --
  131.                     ' ----------------------
  132.                     CASE 32
  133.                     IF quotes% = 0 THEN
  134.                         ' --- The space is an arguments separator ---
  135.                         ' - El espacio es un separador de argumentos-
  136.                         ' -------------------------------------------
  137.                         IF num%=p% THEN
  138.                             ' --------- Parse arg asked... end ---------
  139.                             ' - Procesado argumento pedido... terminar -
  140.                             ' ------------------------------------------
  141.                             EXIT FOR
  142.                         ELSE
  143.                             '-- Parse the next character (and argument) --
  144.                             '- Procesar siguiente carácter (y argumento) -
  145.                             ' --------------------------------------------
  146.                             num%=num%+1%
  147.                             EXIT SELECT
  148.                         END IF
  149.                     ELSE
  150.                         ' --------- To preserve space for the argument asked (quoted) ---------
  151.                         ' -- Preservar espacios del argumento pedido si están entre comillas --
  152.                         ' ---------------------------------------------------------------------
  153.                         IF num%=p% THEN cadtmp$=cadtmp$+CHR$(char%)
  154.                     END IF
  155.  
  156.                     ' --- Preserve others characters (only for the argument asked) ----
  157.                     ' - Preservar el resto de los caracteres para el argumento pedido -
  158.                     ' -----------------------------------------------------------------
  159.                     CASE ELSE
  160.                     IF num%=p% THEN cadtmp$=cadtmp$+CHR$(char%)
  161.  
  162.                 END SELECT
  163.  
  164.         NEXT a%
  165.  
  166.         cad$ = cadtmp$
  167.  
  168.         IF cad$ = "?" THEN
  169.  
  170.             PRINT "SIDFILE/A: ";
  171.             INPUT "",cad$
  172.  
  173.         ELSE
  174.  
  175.             ' ---------- Exit point if cad$<>"" -----------
  176.             ' - Punto de salida de la función si cad$<>"" -
  177.             ' ---------------------------------------------
  178.             getarg$=cad$
  179.             EXIT WHILE
  180.  
  181.         END IF
  182.  
  183.     WEND
  184.  
  185.     ' ---------- Exit point if cad$="" -----------
  186.     ' - Punto de salida de la función si cad$="" -
  187.     ' --------------------------------------------
  188. END FUNCTION
  189.  
  190. ' =====================================================================
  191. '                    The main code / El código principal
  192. ' =====================================================================
  193.  
  194. PRINT " Playsid Library Coding Example"
  195. PRINT " ------------------------------"
  196.  
  197. '  Checking the CLI argument
  198. ' Verificando el argumento CLI
  199. ' ----------------------------
  200.  
  201. file$=getarg$(COMMAND$,1%)
  202. IF file$="" THEN
  203.     PRINT "   *** I need a SID file as argument!"
  204.     ok& = FALSE&
  205. ELSE
  206.     ok&=TRUE&
  207. END IF
  208. file$=file$+CHR$(0)
  209.  
  210. ' Opening libraries / Abriendo bibliotecas
  211. ' ----------------------------------------
  212.  
  213. IF ok& = TRUE& THEN
  214.     LIBRARY OPEN "exec.library",36&
  215.  
  216.     db& =OpenLibrary&(SADD("dos.library"+CHR$(0)),36&)
  217.     psb&=OpenLibrary&(SADD("playsid.library"+CHR$(0)),PLAYSIDVERSION&)
  218.  
  219.     IF psb& <> NULL& AND db& <> NULL& THEN
  220.         LIBRARY VARPTR "dos.library",db&
  221.         LIBRARY VARPTR "playsid.library",psb&
  222.         PRINT " . Opened the PlaySid library"
  223.         ok& = TRUE&
  224.     END IF
  225. END IF
  226.  
  227. ' Allocating memory / Reservando memoria
  228. ' --------------------------------------
  229.  
  230. IF ok& = TRUE& THEN
  231.     header&=AllocMem&(SIDHeader_sizeof%,MEMF_CLEAR& OR MEMF_ANY&)
  232.     IF header& = NULL& THEN
  233.         PRINT "   *** No free memory for SIDHeader struct!"
  234.         ok& = FALSE&
  235.     END IF
  236. END IF
  237.  
  238. ' If all are ok... / Si todo ha ido bien...
  239. ' -----------------------------------------
  240.  
  241. IF ok& = TRUE& THEN
  242.  
  243.     long1& = AllocEmulResource&()
  244.  
  245.     IF long1& = NULL& THEN
  246.  
  247.         PRINT " . PlaySID resources allocated"
  248.  
  249.         long2& = ReadIcon&(SADD(file$),header&)
  250.  
  251.         IF long2& = NULL&
  252.  
  253.             PRINT " . Filled the SIDHeader struct with icon file information"
  254.  
  255.             long3& = CheckModule&(header&)
  256.  
  257.             IF long3& = NULL& THEN
  258.  
  259.                 PRINT " . Checked what this file is a SID module"
  260.  
  261.                 OPEN LEFT$(file$,LEN(file$)-1) FOR INPUT AS #1
  262.                     fich$=INPUT$(LOF(1),#1)
  263.                 CLOSE #1
  264.  
  265.                 PRINT " . Loaded the SID module into the memory"
  266.  
  267.                 SetModule header&,SADD(fich$),LEN(fich$)
  268.  
  269.                 InfoSID(header&)
  270.  
  271.                 long4&=StartSong&(0&)
  272.  
  273.                 PRINT " . Playing the SID module 10''...";
  274.  
  275.                 Delay 50*10
  276.  
  277.                 PauseSong
  278.  
  279.                 PRINT " Paused 4''..."
  280.  
  281.                 Delay 50*4
  282.  
  283.                 dummy& = ContinueSong&
  284.  
  285.                 PRINT "   Continued during 5''...";
  286.  
  287.                 Delay 50*5
  288.  
  289.                 StopSong
  290.  
  291.                 ' Detención de la reproducción
  292.                 PRINT " Stopped."
  293.                 
  294.             ELSE
  295.  
  296.                 PRINT "  *** This isn't a SID module!"
  297.  
  298.             END IF
  299.  
  300.         ELSE
  301.  
  302.             PRINT "   *** ReadIcon() failed!: ";long2&
  303.  
  304.         END IF
  305.  
  306.     ELSE
  307.  
  308.         PRINT "   *** Resource allocation failed!: error code #";long1&
  309.  
  310.     END IF
  311.  
  312. END IF
  313.  
  314. ' Releasing resources / Liberando recursos
  315. ' ----------------------------------------
  316.  
  317. IF header& <> NULL& THEN FreeMem header&, SIDHeader_sizeof%
  318.  
  319. IF psb& <> NULL& THEN FreeEmulResource&
  320.  
  321. LIBRARY VARPTR "dos.library", NULL&
  322.  
  323. LIBRARY VARPTR "playsid.library", NULL&
  324.  
  325. LIBRARY CLOSE "exec.library"
  326.  
  327. PRINT " . Resources released"
  328.  
  329. END
  330.