La isla del Coco [para QL]

Descripción del contenido de la página

Código fuente del juego de simulación y aventura escrito para QL en SBASIC (con formato SBim).

Etiquetas:

Código fuente de La isla del Coco, proyecto inacabado escrito en SBASIC en formato SBim:

rem "La isla del Coco" 
let version$="0.1.0-dev.1+201710160202"

rem Proyecto inacabado de
rem juego de simulación y aventura
rem escrito en SBASIC para QPC2 (emulador de SMSQ/E)
rem en formato SBim.

rem Página del proyecto:
rem http://programandala.net/es.programa.la_isla_del_coco.sbim.html

rem Copyright (C) 2011 Marcos Cruz (programandala.net)
rem Licencia: http://programandala.net/licencia
rem License: http://programandala.net/license

rem Inspirado en "Jolly Roger" para ZX Spectrum
rem Copyright (C) 1984 Barry Jones / Video Vault ltd.

' ==============================================================
' Requisitos {{{1

' Este programa usa varios procedimientos y funciones de las
' siguientes extensiones de S*BASIC:

' De "DIY Toolkit", (C) Simon N. Goodwin:

'   MINIMUM%(),MAXIMUM%()

' De MegaToolkit, (C) 1992 Michael A. Crowe:

'   TRUE,FALSE,LNUM(),CHAR_W,CHAR_H,PIXMOV,POS_Y,POS_X

' Las extensiones citadas las carga el programa cargador antes
' de cargar a su vez este programa principal.

' ==============================================================
' Acerca del formato de este código fuente {{{1

' Este programa, escrito en SBASIC para QL, utiliza un formato
' de código fuente mejorado para dicho lenguaje, denominado
' SBim:

' http://programandala.net/es.programa.sbim.html

' Por otra parte, nótese que este fichero no usa el juego de
' caracteres propio de QL sino la codificación estándar ISO
' 8859-1 («Latin1» en Vim).

' ==============================================================
' Tareas pendientes  {{{1

' Mostrar mensajes de confirmación de cada acción, tras borrar
' la pantalla. Por ejemplo «Das la orden de /seguir/empezar a
' caminar/ hacia el este».

' Hacer que no sea posible alcanzar la costa si quedan pocos
' marineros o están heridos.

' Hacer bordes irregulares en los mapas, con celdas a cero
' que representen zonas inexistentes.

' Hacer que el mensaje previo al panel de comandos dependa de
' la moral de la tripulación. Cuando la moral es baja, el
' mensaje es menos entusiasta y menos respetuoso.

' Fallo: la pregunta de si si desembarca para comerciar no
' debería hacerse si no hay isla.

' Contar aparte el número de varones y mujeres vivos, para
' ajustar los mensajes.

' Fallo: algunas veces no se imprime el mensaje de
' presentación del panel!

' Pasar la creación de la matriz stock_name$ y similares a un
' procedimiento propio llamado desde init_once, para evitar
' repetir la tarea con cada partida. Para marcar los nombres
' elegidos, usar una nueva matriz numérica en lugar de borrar
' los nombres de stock_name$.

' Recordar los nombres de las islas que hayan sido visitadas
' (y revelados por el negociador). Se explicarán si el juego
' concluye con éxito.

' Guardar en un fichero los nombres de los capitanes, para
' elegir de entre ellos en otras ocasiones.

' Hacer que la moral descienda cada vez que da una orden
' imposible. Ajustar los comentarios en función de la
' situación y la moral del momento.

' Al final, se da la opción de consultar las curiosidades
' (historia de la verdadera isla del Coco, nombres reales de
' los usados para los piratas, significado de los nombres de
' islas).

' Crear un modo de demostración en que el programa funcione
' solo (acortando las pausas al mínimo).

' Hacer que la localización de las islas sea análoga a la de
' los arrecifes, es decir, que sean vistas antes de estar en
' su casilla.

' Marcar las casillas del mar visitadas, pues serán solo ellas
' las mostradas al dibujar el mapa.

' Hacer que la advertencia de arrecifes varíe si están en la
' misma dirección que la vez anterior (y no ha dejado de
' haberlos, claro).

' Hacer que se recuerde la posición de la barca y
' solo se pueda embarcar si está presente.

' ¿Dividir la posición en dos, fila y columna, para
' simplificar los cálculos de movimiento?

' Hacer que la lucha en el mar sea también con cocos,
' contra un bote de nativos. Algunas veces el golpe lo
' recibe uno de tus propios hombres.

' Hacer que el mapa de la isla sea de tamaño variable.

' Hacer que la munición y la comida sean la misma cosa:
' cocos.

' Hacer palmeras con cocos; pueden caer sobre la cabeza de
' un marinero al intentar tirarlas.

' Hacer que no haya barco, solo una chalupa.

' Hacer que el mapa del mar dependa del tamaño de pantalla.

' Hacer opción para ver el mapa conocido hasta el momento.

' Poner nombre a las islas y a los poblados. Marcar los que
' se usan durante el juego y explicarlos al final
' (significado y composición).

' Terminar de implementar el sistema de pistas al azar
' en enter_treasure_island.

' Guardar el recuerdo de si la negociación en cada isla fue
' exitosa o no, para ajustar los mensajes cuando se pretende
' desembarcar de nuevo.

' Hacer que el evento «la tripulación está hambrienta»
' dependa del estado de las provisiones.

' Si al embarcar hay algún herido grave, hay posibilidades de
' que muera.

' Implementar médico, curandero y medicinas. Elegir a quién
' curar.

' Convertir el indicador de moral en texto (entusiasmados,
' animados, tristes...)

' En los informes, poner colores por grados a los estados de
' salud, moral y otros.

' Convertir la resolución de cada pista en una función que
' devuelva la opción elegida. Así el cálculo de todas las
' pistas podría hacerse con una simple suma.

' Sustituir los procedimientos de dibujo de escenarios
' por descripciones textuales.

' Hacer que se pueda intentar comerciar con los
' nativos fuera del poblado.

' Hay dos cálculos de daños del barco: tormenta y arrecifes.
' ¿Unificar en subrutina?

' Cambiar la medida del daño del barco (variable «damage%»)
' por su estado, análogamente a la tripulación, y mostrarlo
' en forma de texto.

' Usar PAUSE en vez de bucles para las pausas que usan IF
' LEN INKEY$.

' Tabla de mejores puntuaciones; guardada en disquete.

' Hacer dos aspectos para el final: éxito y fracaso.

' Ampliar with_letters$() y usarla en la negociación.

' Usar un juego de caracteres diferente para las palabras de
' los nativos.

' Hacer que se reciba provisiones, munición y tropa tras
' vencer a un barco.

' Poder matar escorpión.

' Reducir moral unas décimas cuando un hombre sea herido o
' muerto.

' Reducir la energía un número proporcional a la gravedad
' del ataque, no siempre 1.

' Revisar los rangos de doblones al comerciar.

' Informar de si hay muertos cuando el bote es alcanzado por
' error. Calcular 'alive%' antes y después de herir a los
' hombres.

' Embellecer tabla de puntuación final.

' Hacer que el jugador pueda poner nombre a los miembros de
' la tripulación.

' Que no aparezcan los comandos que no puedan usarse en cada
' situación, o que aparezcan apagados.

' Hacer que el jugador pueda elegir su nombre de capitán. 

' ==============================================================
' Meta {{{1

' 2012-01-26:
' Sistema antiguo, innecesario tras la introducción
' de etiquetas en el formato SBim.
' Las etiquetas se definían antes de esta forma:
' defproc label_LABEL_NAME:enddef

' deffn label%(label$)
'
'  ' Devuelve el número de línea de un procedimiento vacío,
'  ' creado solo para servir de etiqueta y evitar así usar
'  ' números de línea en el programa cuando son inevitables
'  ' (por ejemplo con RESTORE).
'
'  ' Para evitar posibles coincidencias y al mismo tiempo
'  ' hacer el código más legible, el nombre del
'  ' procedimiento debe empezar por "label_"; y este prefijo
'  ' se omite en el parámetro y se añade aquí.
'
'  ' LNUM() es una función de MegaToolkit.
'
'  ret lnum("label_"&label$)
'
' enddef

' ==============================================================
' Teclado y juego de caracteres {{{1

defproc init_the_keyboard

  ' Carga la tabla de teclado española para SMSQ si es
  ' necesario.

  loc es
  let es=34
  if ver$="HBA"
    if language<>es
      lrespr dev$&"qxl-es_kbt"
      kbd_table es
      lang_use es
    endif
  endif

enddef

defproc init_the_font

  ' Carga el juego de caracteres ISO, si no se ha hecho ya.

  loc font_size%
  if not iso_font_address
    let font$=dev$&"iso8859-1_font"
    font_size%=flen(\font$)
    iso_font_address=alchp(font_size%)
    lbytes font$,iso_font_address

    ' XXX REMARK -- CHAR_DEF no surte efecto en las ventanas
    ' abiertas con posterioridad, al contrario de lo que
    ' dice el manual:

    ' char_def font_address,0

    ' En su lugar usamos pues CHAR_USE (llamando a iso_font)
    ' tras abrir cada ventana.

  endif
enddef

defproc iso_font(window%)

  ' Selecciona el juego de caracteres original de QL para
  ' la ventana cuyo canal se indica.

  char_use #window%,iso_font_address,0

enddef

defproc ql_font(window%)

  ' Selecciona el juego de caracteres original de QL para
  ' la ventana cuyo canal se indica.

  char_use #window%,0,0

enddef

' ==============================================================
' Pantalla {{{1

' XXX OLD -- 
' deffn command_colour%
'
'  ' Devuelve el color de la tinta de los comandos,
'  ' según la localización del personaje.
'
'  ret dark_cyan%*aboard%+yellow%*not aboard% ' XXX TMP
'
' enddef

deffn rgb(red%,green%,blue%)

  ' Devuelve un código de color de 24 bitios a partir de
  ' sus componentes de rojo, verde y azul.

  ret red%*65535+green%*256+blue%

enddef

defproc init_the_colours

  ' Fija el modo de color PAL y define constantes con los
  ' colores a usar.

  colour_pal
  let black%=0 ' Negro
  let brown%=127 ' Marrón
  let dark_cyan%=7:palette_8 dark_cyan%,rgb(0,139,139) ' Cian oscuro
  let dark_green%=17 ' Verde oscuro
  let grey%=11 ' Gris
  let green%=3 ' Verde
  let light_grey%=12 ' Gris claro
  let light_red%=1:palette_8 light_red%,rgb(255,51,51) ' Rojo claro
  let red%=2 ' Rojo
  let very_light_grey%=13 ' Gris muy claro
  let yellow%=6 ' Amarillo

  ' Colores elegidos para cada función:
  let background_colour%=black% ' Fondo
  let narration_colour%=light_grey% ' Narración
  let native_speech_colour%=brown% ' Palabras de un nativo
  let sailor_speech_colour%=grey% ' Palabras de un marinero
  ' let panel_paper%=yellow% ' Fondo de la ventana del panel
  let sea_colour%=dark_cyan% ' Mar en el mapa
  let island_colour%=brown% ' Islas en el mapa del mar
  let command_colour%=red% ' Comandos
  let prompt_colour%=command_colour% ' Presto
  let title_colour%=very_light_grey% ' Títulos

enddef

defproc init_the_screen

  ' Inicializa la pantalla, cambiando el modo y la
  ' modalidad de color si es necesario.

  ' XXX TODO -- Probar bien y después simplificar.
  sel on disp_type
    =0
      ' Modo de QL con 4 colores 
      disp_colour 3:mode 8:init_the_colours
    =8
      ' Modo de QL con 8 colores 
      init_the_colours
    =16
      ' Modo de 256 colores (8 bitios por punto)
      init_the_colours
    =32
      ' Modo de 65535 colores (16 bitios por punto)
      init_the_colours
    =remainder
      ' Modo de color desconocido
      init_the_colours
  endsel

enddef

defproc wipe_the_window
  border #tw%,0
  cls #tw%
  border #tw%,window_gap%
enddef

defproc init_the_window

  ' Crea la ventana única del juego, hasta un tamaño máximo
  ' de 800x600.

  let tw%=fopen("con_")
  let csize_w%=3-(scr_xlim=512)
  let csize_h%=scr_xlim>512
  csize #tw%,csize_w%,csize_h%
  let tw_w%=minimum%(800,scr_xlim)
  let tw_h%=minimum%(600,scr_ylim)
  let tw_x%=(scr_xlim-tw_w%)/2
  let tw_y%=(scr_ylim-tw_h%)/2
  window #tw%,tw_w%,tw_h%,tw_x%,tw_y%
  paper #tw%,background_colour%
  ink #tw%,narration_colour%
  over #tw%,0
  iso_font #tw%
  wipe_the_window

enddef

' XXX OLD -- 
' defproc wipe_the_game_window
'  border #gw%,0
'  cls #gw%
' enddef
'
' defproc init_the_game_window
'
'  ' Crea la ventana de fondo del juego, hasta un tamaño
'  ' máximo de 800x600.
'
'  let gw%=fopen("con_")
'  let gw_w%=minimum%(800,scr_xlim)
'  let gw_h%=minimum%(600,scr_ylim)
'  let gw_x%=(scr_xlim-gw_w%)/2
'  let gw_y%=(scr_ylim-gw_h%)/2
'  window #gw%,gw_w%,gw_h%,gw_x%,gw_y%
'  paper #gw%,background_colour%
'  ink #gw%,narration_colour%
'  iso_font #gw%
'  wipe_the_game_window
'
' enddef
'
' defproc wipe_the_panel_window
'  border #pw%,0
'  cls #pw%
'  border #pw%,8
'  print #pw%,"La isla del Coco"
' enddef
'
' defproc init_the_panel_window
'
'  ' Crea la ventana para el panel de comandos, en función
'  ' de la ventana principal.
'
'  let pw%=fopen("con_")
'  let csize_w%=2
'  let csize_h%=1
'  csize #pw%,csize_w%,csize_h%
'  let pw_h%=gw_h%-2*window_gap%
'  let pw_w%=200 ' XXX TMP
'  let pw_x%=gw_x%+window_gap%
'  let pw_y%=gw_y%+window_gap%
'  window #pw%,pw_w%,pw_h%,pw_x%,pw_y%
'  paper #pw%,panel_paper%
'  ink #pw%,panel_colour%
'  iso_font #pw%
'  wipe_the_panel_window
'
' enddef
'
' defproc wipe_the_text_window
'  border #tw%,0
'  cls #tw%
' enddef
' defproc init_the_text_window
'
'  ' Crea la ventana principal para el texto, en función de
'  ' la ventana principal y de la ventana del panel.
'
'  let tw%=fopen("con_")
'  let csize_w%=3
'  let csize_h%=1
'  csize #tw%,csize_w%,csize_h%
'  let tw_w%=gw_w%-3*window_gap%-pw_w%
'  let tw_h%=gw_h%-2*window_gap%
'  let tw_x%=pw_x%+pw_w%+window_gap%
'  let tw_y%=pw_y%
'  window #tw%,tw_w%,tw_h%,tw_x%,tw_y%
'  paper #tw%,background_colour%
'  ink #tw%,narration_colour%
'  iso_font #tw%
'  wipe_the_text_window
'
' enddef

defproc init_the_windows

  ' Crea las ventanas.

  loc window_gap%
  let window_gap%=8 ' Espacio alrededor y entre las ventanas.
  init_the_font
  init_the_window

  ' XXX OLD --  pantalla con varias ventanas.
'  init_the_game_window ' Ventana de fondo.
'  init_the_panel_window ' Ventana de comandos.
'  init_the_text_window ' Ventana de texto.

enddef

' ==============================================================
' Manipulación de textos {{{1

' ----------------------------------------------
' Rangos {{{2

deffn iso_alpha%(char$)

  ' Devuelve un indicador: ¿Es el carácter indicado una
  ' letra en el juego de caracteres ISO 8859-1?

  ' XXX REMARK -- SBASIC permite expresiones en las estructuras SELect,
  ' pero no si son cortas. Por eso hace falta usar una
  ' variable intermedia o, como en este caso, una estructura
  ' larga:

  sel on code(char$)
    =65 to 90,\ ' «A» - «Z»
    97 to 122,\ ' «a» - «z»
    192 to 214,\ ' «A» con tilde grave - «O» con diéresis
    216 to 246,\ ' «O» barrada - «o» con diéresis
    248 to 255:\ ' «o» barrada - «y» con diéresis
    ret true
    =remainder:ret false
  endsel

enddef

' ----------------------------------------------
' Mayúsculas y minúsculas {{{2

deffn iso_upper%(char%)

  ' Devuelve el código de mayúscula correspondiente a un
  ' código de un carácter ISO 8859-1.

  sel on char%=\
    97 to 122,\ ' «a» - «z»
    224 to 246,\ ' «a» con tilde grave - «o» con diéresis
    248 to 254:\ ' «o» barrada - Thorn minúscula
    ret char%-32

  ret char%

enddef

deffn iso_lower%(char%)

  ' Devuelve el código de minúscula correspondiente a
  ' un código de un carácter ISO 8859-1.

  sel on char%=\
    65 to 90,\ ' «A» - «Z»
    192 to 214,\ ' «A» con tilde grave - «O» con diéresis
    216 to 222:\ ' «O» barrada - Thorn mayúscula
    ret char%+32

  ret char%

enddef

deffn iso_upper$(txt$)

  rem Devuelve en mayúsculas un texto ISO 8859-1.

  loc i%,upper_txt$
  let upper_txt$=txt$
  for i%=1 to len(upper_txt$)
    let upper_txt$(i%)=chr$(iso_upper%(code(txt$(i%))))
  endfor i%
  ret upper_txt$

enddef

deffn iso_lower$(txt$)

  rem Devuelve en minúsculas un texto ISO 8859-1.

  loc i%,lower_txt$
  let lower_txt$=txt$
  for i%=1 to len(lower_txt$)
    let lower_txt$(i%)=chr$(iso_lower%(code(txt$(i%))))
  endfor i%
  ret lower_txt$

enddef

deffn iso_upper_1$(txt$)

  ' Devuelve el texto ISO 8859-1 dado, con la primera
  ' letra en mayúsculas.

  ret iso_upper$(txt$(1))&txt$(2 to)

enddef

deffn iso_lower_1$(txt$)

  ' Devuelve el texto ISO 8859-1 dado, con la primera
  ' letra en minúsculas.

  ret iso_lower$(txt$(1))&txt$(2 to)

enddef

deffn iso_title$(txt$)

  ' Devuelve el texto ISO 8859-1 dado, con la primera letra
  ' de cada palabra en mayúscula y las restantes en
  ' minúscula.

  loc char_position%,new_txt$
  let new_txt$=txt$

  for char_position%=1 to len(new_txt$)

    sel on char_position%
      =1:\
        let new_txt$(char_position%)=\
          iso_upper$(new_txt$(char_position%))
      =remainder
        if iso_alpha%(new_txt$(char_position%-1))
          let new_txt$(char_position%)=\
            iso_lower$(new_txt$(char_position%))
        else
          let new_txt$(char_position%)=\
            iso_upper$(new_txt$(char_position%))
        endif
    endsel

  endfor char_position%

  ret new_txt$

enddef

' ----------------------------------------------
' Formato {{{2

deffn field$(txt$,length%)

  ' Devuelve un texto tras añadirle por la izquierda los
  ' espacios necesarios para que tenga la longitud indicada.

  ret fill$(" ",length%-len(txt$))&txt$

enddef

deffn single_spaces_only$(txt$)

  ' Devuelve un texto tras quitarle los espacios dobles.

  loc new_txt$
  let new_txt$=txt$

  rep
    let spaces_position%="  " instr new_txt$
    sel on spaces_position%
      =0:exit
      =remainder
        let new_txt$=\
          new_txt$(to spaces_position%)&\
          new_txt$(spaces_position%+2 to)
    endsel
  endrep

  ret new_txt$

enddef

deffn trim$(txt$,forbidden$)

  ' Devuelve un texto tras quitarle los caracteres
  ' laterales que estén en el parámetro forbidden$;
  ' si el parámetro forbidden$ se omite, se
  ' usara un espacio.

  loc new_txt$

  if not len(txt$):ret txt$
  if not len(forbidden$):let forbidden$=" "
  let new_txt$=txt$

  rep
    if not new_txt$(1) instr forbidden$:exit
    let new_txt$=new_txt$(2 to)
  endrep
  rep
    if not new_txt$(len(new_txt$)) instr forbidden$:exit
    let new_txt$=new_txt$(to len(new_txt$)-1)
  endrep

  ret new_txt$

enddef

deffn name_chars_only$(name$)

  ' Devuelve un nombre tras haber purgado los caracteres
  ' ilegales. Solo se conservan los caracteres alfabéticos,
  ' el espacio y el apóstrofo.

  loc new_name$,char%

' XXX REMARK -- SBASIC permite expresiones en las estructuras SELect,
' pero no si son cortas:

'  if len(name$):\
'    for char%=1 to len(name$):\
'      sel on code(name$(char%))=\
'          32,39,45,\ ' espacio, apóstrofo «y» guion
'          65 to 90,\ ' «A» - «Z»
'          97 to 122,\ ' «a» - «z»
'          192 to 214,\ ' «A» con tilde grave - «O» con diéresis
'          216 to 246,\ ' «O» barrada - «o» con diéresis
'          248 to 255:\ ' «o» barrada - «y» con diéresis
'          let new_name$=new_name$&name$(char%)

  if len(name$)
    for char%=1 to len(name$)
      sel on code(name$(char%))
          =32,39,45,\ ' espacio, apóstrofo y guion
          65 to 90,\ ' «A» - «Z»
          97 to 122,\ ' «a» - «z»
          192 to 214,\ ' «A» con tilde grave - «O» con diéresis
          216 to 246,\ ' «O» barrada - «o» con diéresis
          248 to 255:\ ' «o» barrada - «y» con diéresis
          let new_name$=new_name$&name$(char%)
      endsel
    endfor char%
  endif

  ret new_name$

enddef

deffn clean_name_part$(name_part$)

  ' Devuelve una parte de un nombre (nombre de pila,
  ' apellido o alias) tras haberla «limpiado»: dejando solo
  ' los caracteres alfanuméricos y los apóstrofos; quitando
  ' los espacios y los apóstrofos laterales; y con
  ' minúsculas salvo las iniciales de palabra.

  loc new_name_part$
  let new_name_part$=name_part$

  let new_name_part$=single_spaces_only$(new_name_part$)
  let new_name_part$=name_chars_only$(new_name_part$)
  let new_name_part$=trim$(new_name_part$," '")
  let new_name_part$=iso_title$(new_name_part$)

  ret new_name_part$

enddef

' ==============================================================
' Textos calculados {{{1

' ----------------------------------------------
' Varios {{{2

deffn dubloons$(coins%)

  ' Devuelve «doblón» o «doblones» según la cantidad.

  ret "dobl"&if$(coins%>1,"ones")&if$(coins%=1,"ón")

enddef

deffn with_letters$(number%)

  ' Devuelve un número en letra, para poner ante el
  ' sustantivo.

  if number%<=max_number%:ret number$(number%):else ret number%

enddef

deffn _with_letters$(number%)

  ' Devuelve un número en letra, para poner tras el
  ' sustantivo.

  if number%=1:ret "uno":else ret with_letters$(number%)

enddef

deffn coins$(coins%)

  ' Devuelve una cantidad completa de doblones.

  ret with_letters$(coins%)&" "&dubloons$(coins%)

enddef

deffn condition$(crewman%)

  ' Devuelve el estado físico de un miembro de la
  ' tripulación.

  ret asterisk_to_gender$(stamina$(stamina%(crewman%)),gender%(crewman%))

enddef

' ----------------------------------------------
' Nombres {{{2

deffn ao$(gender%)

  ' Devuelve «a» u «o» según el sexo o género gramatical
  ' indicado.

  ret if$(gender%=female%,"a","o")

enddef

deffn definite_article$(gender%)

  ' Devuelve «la» o «el» según el sexo o género gramatical
  ' indicado.

  ret if$(gender%=female%,"la","el")

enddef

deffn asterisk_to_gender$(txt$,gender%)

  ' Devuelve un texto tras cambiar todos los asteriscos por
  ' «a» u «o», según corresponda al sexo o género
  ' gramatical indicado.

  loc new_txt$,asterisk%
  let new_txt$=txt$

  rep
    let asterisk%="*" instr new_txt$
    if not asterisk%:exit
    let new_txt$=\
      new_txt$(to asterisk%-1)&\
      ao$(gender%)&\
      new_txt$(asterisk%+1 to)
  endrep

  ret new_txt$

enddef

deffn quoted_alias$(alias$)

  ' Devuelve un alias entre comillas simples, si no está
  ' vacío.

  ret if$(len(alias$),"'"&alias$&"'")

enddef

deffn whole_name$(crewman%)

  ' Devuelve el nombre completo de un tripulante.

  ret trim$(\
    name$(crewman%)&" "&\
    surname$(crewman%)&" "&\
    quoted_alias$(alias$(crewman%)))

enddef

deffn proper_name$(crewman%)

  ' Devuelve un nombre adecuado a un tripulante, combinando
  ' al azar los datos disponibles (nombre propio, apellido
  ' y alias), y teniendo en cuenta si se trata del capitán.

  loc name%,surname%,alias%

  let name%=%001*(len(name$(crewman%))>0)
  let surname%=%010*(len(surname$(crewman%))>0)
  let alias%=%100*(len(alias$(crewman%))>0)

  sel on name%+surname%+alias%
    =name%
      ret name$(crewman%)
    =surname%
      ret surname$(crewman%)
    =alias%
      ret alias$(crewman%)
    =name%+surname%
      if crewman%=captain%
        ret surname$(crewman%)
      else
        ret one_of$(\
          name$(crewman%),\
          surname$(crewman%),\
          name$(crewman%)&" "&surname$(crewman%))
      endif
    =name%+surname%+alias%
      if crewman%=captain%
        ret surname$(crewman%)
      else
        ret one_of$(\
          name$(crewman%),\
          name$(crewman%)&" "&surname$(crewman%),\
          name$(crewman%)&" "&alias$(crewman%),\
          name$(crewman%)&" "&surname$(crewman%)&" "&alias$(crewman%),\
          surname$(crewman%),\
          surname$(crewman%)&" "&alias$(crewman%),\
          alias$(crewman%))
      endif
    =name%+alias%
      if crewman%=captain%
        ret name$(crewman%)
      else
        ret one_of$(\
          name$(crewman%),\
          alias$(crewman%),\
          name$(crewman%)&" "&alias$(crewman%))
      endif
    =surname%+alias%
      if crewman%=captain%
        ret surname$(crewman%)
      else
        ret one_of$(\
          surname$(crewman%),\
          alias$(crewman%),\
          surname$(crewman%)&" "&alias$(crewman%))
      endif
  endsel

enddef

deffn the_captain_is_a_man%

  ' Devuelve un indicador:
  ' ¿El capitán es un varón?

  ret gender%(captain%)=male%

enddef

deffn the_captain_is_a_woman%

  ' Devuelve un indicador:
  ' ¿El capitán es una mujer?

  ret gender%(captain%)=female%

enddef

deffn captain$

  ' Devuelve «capitán» o «capitana».

  ret if$(the_captain_is_a_woman%,"capitana","capitán")

enddef

deffn the_captain$

  ' Devuelve «el capitán» o «la capitana».

  ret if$(the_captain_is_a_woman%,"la capitana","el capitán")

enddef

deffn the_captain_name$

  ' Devuelve el nombre del capitán, con artículo y rango.

  ret the_captain$&" "&proper_name$(captain%)

enddef

deffn the_captain_whole_name$

  ' Devuelve el nombre completo del capitán, con artículo,
  ' rango y alias.

  ret the_captain$&" "&whole_name$(captain%)

enddef

deffn the_sailor$(sailor%)

  ' Devuelve «el marinero» o «la marinera».

  ret \
    definite_article$(gender%(sailor%))&\
    " mariner"&\
    ao$(gender%(sailor%))

enddef

deffn the_sailor_$(sailor%)

  ' Devuelve una referencia a un marinero.

  sel on rnd(2)
    =0:ret the_sailor$(sailor%)
    =1:ret the_sailor$(sailor%)&" "&proper_name$(sailor%)
    =2:ret proper_name$(sailor%)
  endsel

enddef

' ----------------------------------------------
' Textos aleatorios {{{2

deffn one_of$(t0$,t1$,t2$,t3$,t4$,t5$,t6$,t7$,t8$,t9$)

  ' Devuelve un texto al azar entre los indicados.

  ' Los parámetros omitidos (o las cadenas vacías) que
  ' estén al final de la lista no serán tenidos en cuenta.
  ' Los parámetros omitidos (o las cadenas vacías) que
  ' estén al comienzo o en medio de la lista serán
  ' considerados cadenas vacías y contarán igual que los
  ' demás.

  ' Las funciones provistas por el módulo «params» de DIY
  ' Toolkit (PARNAME$, PARTYPE, PARSEPA) permitirían
  ' simplificar el método y hacerlo también más elegante,
  ' pero no funcionan correctamente en SBASIC.

  ' Las funciones propias de SBASIC relacionadas con
  ' parámetros (PARNAM$, PARTYP, PARSTR$ y PARUSE) tampoco
  ' son de utilidad porque tienen algunas limitaciones con
  ' los parámetros omitidos al final de la lista.

  loc texts%
  let texts%=10
  rep
    if t9$="":let texts%=texts%-1:else exit
    if t8$="":let texts%=texts%-1:else exit
    if t7$="":let texts%=texts%-1:else exit
    if t6$="":let texts%=texts%-1:else exit
    if t5$="":let texts%=texts%-1:else exit
    if t4$="":let texts%=texts%-1:else exit
    if t3$="":let texts%=texts%-1:else exit
    if t2$="":let texts%=texts%-1:else exit
    if t1$="":let texts%=texts%-1:else exit
    if t0$="":let texts%=texts%-1
    exit
  endrep
  if not texts%:ret ""
  sel on rnd(texts%-1)
    =0:ret t0$
    =1:ret t1$
    =2:ret t2$
    =3:ret t3$
    =4:ret t4$
    =5:ret t5$
    =6:ret t6$
    =7:ret t7$
    =8:ret t8$
    =9:ret t9$
  endsel

enddef

' XXX OLD -- 
' deffn of_2$(text0$,text1$)
'  ' Devuelve un texto al azar entre 2.
'  sel on rnd(1)
'    =0:ret text0$
'    =1:ret text1$
'  endsel
' enddef
'
' deffn of_3$(text0$,text1$,text2$)
'  ' Devuelve un texto al azar entre 3.
'  sel on rnd(2)
'    =0:ret text0$
'    =1:ret text1$
'    =2:ret text2$
'  endsel
' enddef
'
' deffn of_4$(text0$,text1$,text2$,text3$)
'  ' Devuelve un texto al azar entre 4.
'  sel on rnd(3)
'    =0:ret text0$
'    =1:ret text1$
'    =2:ret text2$
'    =3:ret text3$
'  endsel
' enddef
'
' deffn of_5$(text0$,text1$,text2$,text3$,text4$)
'  ' Devuelve un texto al azar entre 5.
'  sel on rnd(4)
'    =0:ret text0$
'    =1:ret text1$
'    =2:ret text2$
'    =3:ret text3$
'    =4:ret text4$
'  endsel
' enddef
'
' deffn of_6$(text0$,text1$,text2$,text3$,text4$,text5$)
'  ' Devuelve un texto al azar entre 6.
'  sel on rnd(5)
'    =0:ret text0$
'    =1:ret text1$
'    =2:ret text2$
'    =3:ret text3$
'    =4:ret text4$
'    =5:ret text5$
'  endsel
' enddef

deffn now$

  ' Devuelve «ahora» o una cadena vacía.

  ret one_of$(""," ahora")

enddef

deffn again$

  ' Devuelve una variante de «otra vez».

  ret one_of$(\
    "otra vez",\
    "una vez más",\
    "de nuevo")

enddef

deffn good_luck$

  ' Devuelve una variante de «buena_suerte».

  ret one_of$("suerte","fortuna")

enddef

deffn speech_start$(optional$,start$)

  ' Devuelve el comienzo de un discurso,
  ' con o sin una entradilla opcional.

  loc optional_start$

  let optional_start$=one_of$("",optional$)
  ret if$(\
    len(optional_start$),\
    optional_start$&" "&start$,\
    iso_upper_1$(start$))

enddef

' ----------------------------------------------
' Textos condicionados {{{2

deffn if$(condition%,txt1$,txt2$)

  ' Devuelve una u otra cadena según una condición.

  ' Un parámetro omitido se considerará una cadena vacía.

' XXX INFORMER
'  cr:tell \
'  "if$("&quoted$(condition%)&", "&\
'  quoted$(txt1$)&", "&\
'  quoted$(txt2$)&")"
'  prompt

  if condition%:ret txt1$:else ret txt2$

enddef

deffn s$(number%)

  ' Devuelve una terminación de plural si corresponde.

  ret if$(number%>1,"s")

enddef

' ==============================================================
' Impresión de textos {{{1

' ----------------------------------------------
' Tinta y borrado {{{2

defproc pen(foreground_colour%)

  ' Cambia el color de la tinta.  Se usa solo para hacer
  ' el código más legible evitando la mención del canal.

  ink #tw%,foreground_colour%

enddef

defproc pen_on_paper(foreground_colour%,background_colour%)

  ' Cambia el color de la tinta y del papel.  Se usa solo
  ' para hacer el código más legible evitando la mención
  ' del canal.

  pen foreground_colour%
  paper #tw%,background_colour%

enddef

defproc page

  ' Borra la pantalla y restaura el color habitual de la
  ' tinta.

  pen narration_colour%
  cls #tw%

enddef

' ----------------------------------------------
' Procedimientos básicos para imprimir texto justificado {{{2

defproc indent

  ' Hace una indentación.

  if not pos_x(#tw%)
    pixmov #tw%,indentation%,0
    let just_indented%=true
  endif

enddef

defproc cr

  ' Hace un salto de línea con indentación.

  if pos_y(#tw%) or pos_x(#tw%):\
    print #tw%\\:\
    indent

enddef

defproc backspace

  ' Mueve el cursor una posición a la izquierda.

  if pos_x(#tw%) ' ¿El cursor no está en el margen izquierdo?

    ' Mover el cursor al carácter previo:

    ' Usar aquí el comando CURMOV (de MegaToolkit) causa un
    ' extraño problema al imprimir la primera de las flechas
    ' de dirección (primer carácter en el párrafo) en el
    ' procedimiento «show_arrow»: El carácter se muestra, la
    ' mayoría de las veces, desplazado hacia abajo en su
    ' línea.  Se ha comprobado que el problema no está
    ' causado por el cambio de juego de caracteres en el
    ' procedimiento «show_ql_option».  El problema
    ' desaparece quitando el comando CHAR_INC del
    ' procedimiento «panel», pero no puede hacerse porque es
    ' necesario.  

    ' curmov #tw%,-1,0

    ' El comando PIXMOV (también de MegaToolkit) hace el
    ' mismo efecto y no falla en el caso mencionado:

    pixmov #tw%,-char_w(#tw%),0

  else ' El cursor está en el margen izquierdo

    ' Apuntar el cursor al último carácter de la línea previa:

    cursor #tw%,\
      (char_x(#tw%)-1)*char_w(#tw%),\ ' Ã<9a>ltimo carácter
      pos_y(#tw%)-char_h(#tw%) ' Línea previa

  endif

enddef

defproc tell(txt$)

  ' Imprime un texto justificado a la izquierda a partir
  ' de la posición actual del cursor.

  loc text$,first%,last%

  if len(txt$)
    let text$=txt$&" "
    let first%=1
    for last%=1 to len(text$)
      if text$(last%)=" "
        if just_indented% ' Indicador activado por el procedimiento de indentación.
          print #tw%;text$(first% to last%-1);
          let just_indented%=false
        else
          print #tw%,!text$(first% to last%-1);
        endif
        let first%=last%+1
      endif
    endfor last%
  endif
  print #tw%!;

enddef

' XXX OLD --
' defproc tell_cr(txt$)
'  ' Imprime un párrafo justificado y con una separación
'  ' posterior.
'  tell txt$:cr
' enddef

' XXX OLD --
' defproc cr_tell(txt$)
'  ' Imprime un párrafo justificado y con una separación
'  ' previa.
'  if pos_x(#tw%) or pos_y(#tw%)
'    print #tw%:curmov #tw%,2*char_w(#tw%),0
'  endif
'  tell txt$
' enddef

' XXX OLD -- 
' defproc tell_zone(txt$,zone_width,y,x)
'  ' Imprime un párrafo formateado en una zona
'  loc char
'  rep tell_line
'    if len(txt$)<=zone_width:exit tell_line
'    for char=zone_width to 1 step -1
'      if txt$(char)=" ":\
'        at y,x:print txt$(to char-1):\
'        let txt$=txt$(char+1 to):\
'        let y=y+1:\
'        exit char
'    endfor char
'  endrep tell_line
'  at y,x:print txt$:\
' enddef

' ----------------------------------------------
' Texto de la narración {{{2

defproc narrate(txt$)

  ' Imprime texto de la narración.

  pen narration_colour%:tell txt$

enddef

defproc narrate_char_to(txt,column%,char$)

  ' Imprime texto de la narración, con un carácter
  ' posterior de relleno para ocupar hasta la columna
  ' relativa indicada.

  narrate txt$&fill$(char$,maximum%(1,column%-len(txt$)))

enddef

defproc narrate_to(txt$,column%)

  ' Imprime texto de la narración, con un espacio
  ' posterior para ocupar hasta la columna relativa
  ' indicada.

  narrate_char_to txt$,column%," "

enddef

defproc narrate_dots_to(txt$,column%)

  ' Imprime texto de la narración, con puntos detrás para
  ' ocupar hasta la columna relativa indicada.

  narrate_char_to txt$,column%,"."

enddef

' ----------------------------------------------
' Palabras de los personajes {{{2

deffn quoted$(speech$)

  ' Añade comillas a una cita.

  ret left_quote$&speech$&right_quote$

enddef

defproc char_after_the_quote(char$)

  ' Imprime un carácter (punto o coma) en sustitución del ya
  ' imprimido justo tras una cita entrecomillada.

  pen narration_colour%
  backspace
  print #tw%,char$;

enddef

defproc speak(speech$,speech_colour%)

  ' Imprime una cita en el color adecuado, poniéndola entre
  ' comillas y teniendo en cuenta su signo de puntuación
  ' final.

  loc last%
  let last%=len(speech$)

  ' Añadir el punto final si faltara:
  if not speech$(last%) instr ".,!?"
    let speech$=speech$&"."
    let last%=last%+1
  endif

  pen speech_colour%
  sel on code(speech$(last%))
    =code(".")
      if speech$(last%-1)<>"." ' Si no se trata de puntos suspensivos
        ' El punto final fuera de las comillas,
        ' como es norma:
        tell quoted$(speech$(to last%-1))&"."
        char_after_the_quote "."
      endif
    =code(",")
      ' La coma fuera de las comillas, pues indica que tras
      ' la pregunta continuará la narración.
      tell quoted$(speech$(to last%-1))&","
      char_after_the_quote ","
    =remainder
      tell quoted$(speech$)
  endsel

enddef

' XXX OLD -- 
' defproc speak(speech$,speech_colour%)
'  ' Imprime una cita de un diálogo, con las comillas
'  ' adecuadas.
'  loc last%,right_quote%,left_quote%
'  let right_quote%=right_quote$ instr speech$
'  let left_quote%=left_quote$ instr speech$
'  pen speech_colour%
'  if right_quote% and not left_quote%
'    tell left_quote$&speech$(to right_quote%+1)
'    ' XXX TODO -- Finish.
'    pen narration_colour%
'    backspace:print #tw%,speech$(right_quote%+1);
'    tell speech$(right_quote%+2 to)
'  else
'    let last%=len(speech$)
'    if speech$(last%)="." and speech$(last%-1)<>"."
'      tell left_quote$&speech$(1 to last%-1)&right_quote$&"."
'    else
'      tell left_quote$&speech$&right_quote$
'    endif
'  endif
' enddef

defproc says(who$,action$,comment$,speech$,speech_colour%)

  ' Imprime palabras de alguien, en una de dos variantes
  ' elegida al azar.

  ' who$ = Nombre del que habla; en minúscula salvo si es
  ' nombre propio.

  ' action$ = Acción efectiva en tercera persona ("dice",
  ' "grita", "susurra"...).

  ' comment$ = Descripción opcional de lo que hace durante
  ' la acción, sin espacios iniciales o finales y con toda
  ' la puntuación necesaria.

  ' speech$ = Palabras pronunciadas. Si no tiene ningún
  ' signo de puntuación al final, se le añadirá un punto.

  ' speech_colour% = Color de tinta de la cita.

' XXX OLD -- Versión antigua obsoleta.
'  if rnd(1)
'    speak speech$&right_quote$&", "&action$&" "&who$&".",speech_colour%
'  else
'    narrate iso_upper_1$(who$)&" "&action$&":"
'    speak speech$&".",speech_colour%
'    backspace:print #tw%,".";
'  endif

  if rnd(1)
    pen speech_colour%
    tell quoted$(speech$)&","
    char_after_the_quote ","
    narrate action$&" "&who$&comment$&"."
  else
    narrate iso_upper_1$(who$)&" "&action$&comment$&":"
    speak speech$,speech_colour%
  endif

enddef

' ----------------------------------------------
' Palabras de los marineros {{{2

deffn new_speaker%

  ' Devuelve el marinero que pronuncia las palabras.

  ret alive_man%

enddef

deffn captain_vocative$

  ' Devuelve un vocativo para el capitán.

  loc vocative$,name_part$
  let vocative$=captain$ ' «capitán» o «capitana»

  ' Elegir la primera parte del nombre que esté disponible,
  ' en orden de prioridad (apellido, alias y nombre):
  sel on true
    =len(surname$(captain%))>0
      let name_part$=surname$(captain%)
    =len(alias$(captain%))>0
      let name_part$=alias$(captain%)
    =len(name$(captain%))>0
      let name_part$=name$(captain%)
  endsel

  ret vocative$&one_of$(""," "&name_part$)

enddef

deffn said_to_captain$(speech$)

  ' Devuelve una locución con el vocativo del capitán.

  loc vocative$
  let vocative$=captain_vocative$

  ret one_of$(\
    iso_upper_1$(vocative$)&", "&iso_lower_1$(speech$),\
    iso_upper_1$(speech$)&", "&vocative$)

enddef

deffn asked_to_captain$(question$)

  ' Devuelve una pregunta con el vocativo del capitán.

  loc vocative$
  let vocative$=captain_vocative$

  ret one_of$(\
    iso_upper_1$(vocative$)&\
      ", ¿"&iso_lower_1$(question$)&"?",\
    "¿"&iso_upper_1$(question$)&", "&vocative$&"?")

enddef

defproc sailor_shouts(speech$,comment$)

  ' Imprime palabras gritadas por un marinero.

  loc speaker%,again%
  let speaker%=new_speaker%
  let again%=speaker%=former_speaker%

  says \
    proper_name$(speaker%),\
    if$(again%,"añade gritando","grita"),\
    comment$,\
    "¡"&iso_upper_1$(speech$)&"!",\
    sailor_speech_colour%

  let former_speaker%=speaker%

enddef

defproc sailor_shouts_to_you(speech$,comment$)

  ' Imprime palabras gritadas por un marinero al capitán.

  sailor_shouts said_to_captain$(speech$),comment$

enddef

defproc sailor_says(speech$,comment$)

  ' Imprime palabras dichas por un marinero.

  loc speaker%,again%
  let speaker%=new_speaker%
  let again%=speaker%=former_speaker%
  ' tell "[again%="&again%&"]" ' XXX INFORMER

  says \
    proper_name$(alive_man%),\
    if$(again%,"añade","dice"),\
    comment$,\
    iso_upper_1$(speech$),\
    sailor_speech_colour%

  let former_speaker%=speaker%

enddef

defproc sailor_just_says(speech$)

  ' Imprime palabras de un marinero, sin ninguna aclaración
  ' adicional.

  speak iso_upper_1$(speech$),sailor_speech_colour%

enddef

defproc sailor_says_to_you(speech$,comment$)

  ' Imprime palabras de un marinero dirigidas al capitán.

  sailor_says said_to_captain$(speech$),comment$

enddef

defproc sailor_asks_you(question$)

  ' Muestra la pregunta indicada, hecha por un marinero.

  local crewman%,complete_question$
  let crewman%=alive_man%
  let complete_question$=asked_to_captain$(question$)

  if rnd(1)
    cr:narrate proper_name$(crewman%)&" pregunta:"
    speak complete_question$,sailor_speech_colour%
  else
    cr:speak complete_question$&",",sailor_speech_colour%
    narrate "pregunta "&proper_name$(crewman%)&"."
  endif

enddef

' ----------------------------------------------
' Palabras de los nativos {{{2

defproc native_says(speech$,comment$)

  ' Imprime palabras del nativo.

  says "el nativo","dice",comment$,iso_upper_1$(speech$),native_speech_colour%

enddef

defproc native_just_says(speech$)

  ' Imprime palabras del nativo, sin ninguna aclaración
  ' adicional.

  speak iso_upper_1$(speech$),native_speech_colour%

enddef

' ----------------------------------------------
' Otros casos especiales {{{2

defproc title(txt$)

  ' Borra la pantalla y muestra un título.

  ' XXX TODO -- Finish. Centrar el título.
  page
  pen title_colour%
  ' under #tw%,1
  tell txt$
  ' under #tw%,0
  cr

enddef

' ==============================================================
' Entrada {{{1

defproc mistype

  ' Sonido de error cuando se pulsa una tecla incorrecta.
  beep 32,200
  ' if mistype_bell_active:beep 1000,0 ' XXX OLD 

enddef

deffn yes%

  ' Espera la pulsación de las teclas S o N (sin
  ' distinguir minúsculas de mayúsculas)
  ' tras mostrar las dos posibles respuestas.
  ' Devuelve 1 si se pulsó S; 0 si se pulsó N.

  loc answer$

' XXX OLD --
' loc answer$,options%,options$
'  let options$=options$&option$("Sí",1,true)
'  let options$=options$&option$("No",1,true)
'  show_options options$

  cr:cr:show_option "&Sí":show_option "&No"

  cursen #tw%
  rep
    let answer$=inkey$(#tw%,-1)
    if answer$ instr "SsNn":exit:else mistype
  endrep
  curdis #tw%

  ret answer$ instr "Ss"

enddef

deffn sailor_asks_you%(question$)

  ' Muestra la pregunta indicada, hecha por un marinero,
  ' y devuelve la respuesta (1=sí; 0=no).

  sailor_asks_you(question$)
  ret yes%

enddef

defproc prompt

  ' Muestra un presto y hace una pausa larga.

  loc y%
  cr:cr
  let y%=pos_y(#tw%)
  pen prompt_colour%:tell "... "
  cursen #tw%:long_pause:curdis #tw%
  cls #tw%,3
  cursor #tw%,0,y%

enddef

defproc end_of_scene

  ' Final de una escena. Imprime un presto y limpia la
  ' pantalla.

  prompt
  page
  let former_speaker%=false ' Borrar el recuerdo del último marinero que habló

enddef

defproc wait_for_key_press(seconds)

  ' Espera los segundos indicados, o hasta que se pulse una
  ' tecla.

  loc start_time
  let start_time=date

  ' Esperar a que se deje de pulsar una tecla
  ' o se cumpla el tiempo:
  rep:if inkey$(#tw%)="" or date>start_time+seconds:exit

  ' Esperar a que se pulse una tecla
  ' o se cumpla el tiempo:
  rep:if inkey$(#tw%)<>"" or date>start_time+seconds:exit

enddef

defproc short_pause

  ' Hace una pausa corta; se usa entre ciertos párrafos.

  wait_for_key_press(rnd(2 to 3))

enddef

defproc long_pause

  ' Hace una pausa larga; se usa tras cada escena.

  wait_for_key_press(rnd(16 to 32))

enddef

defproc do_pause(loops)

  ' XXX OLD --  Herencia de ZX Spectrum. Hacer de otra forma.

  loc z%
  for z%=1 to loops

enddef

deffn digit%(min%,max%)

  ' Devuelve el valor de un dígito pulsado.

  loc key_code%,number%
  rep
    let key_code%=code(inkey$(#tw%,-1))
    if not key_code%:ret no_option%
    let number%=key_code%-code("0")
    if number%<min% or number%>max%:mistype:else exit
  endrep
  ret number%

enddef

deffn char%(valid_chars$)

  ' Devuelve el código de un carácter pulsado de entre los
  ' de la cadena provista.

  ' XXX TODO -- Finish. Implementar tiempo máximo de espera y la
  ' devolución del valor -1.

  loc char$
  cursen #tw%
  rep
    let char$=inkey$(#tw%,0)
    if not len(char$):next
    if char$ instr valid_chars$:exit:else mistype
  endrep
  curdis #tw%
  ret code(char$)

enddef

' ==============================================================
' Informes {{{1

' Mapa

defproc show_map(array%,columns%,rows%,position%)

  ' Muestra el mapa del mar o de la isla.

  ' XXX TODO -- Finish. Signos provisionales.

  loc column%,row%,cell%

' XXX OLD -- (Para matriz con elemento 0 ignorado):
'  for row%=0 to rows%-1
'   print #tw%
'    for column%=1 to columns%
'      let cell%=row%*columns%+column%
'      print #tw%,if$(\
'        cell%=position%,\
'        "*",\
'        if$(array%(cell%),chr$(65+array%(cell%))," "));
'    endfor column%
'  endfor row%

  for row%=0 to rows%-1
    print #tw%
    for column%=0 to columns%-1
      let cell%=row%*columns%+column%
      print #tw%,if$(\
        cell%=position%,\
        "*",\
        if$(array%(cell%),chr$(65+array%(cell%))," "));
    endfor column%
  endfor row%

enddef

defproc land_on_sea_map(char$)

  pen_on_paper island_colour%,sea_colour%
  print #tw%,char$;

enddef

defproc show_sea_map

  ' Muestra el mapa del mar.

  title "Mapa de las zonas conocidas del mar"
  ' show_map sea_map%,sea_columns%,sea_rows%,sea_position

  for row%=0 to sea_rows%-1
    print #tw%
    for column%=0 to sea_columns%-1
      let cell%=row%*sea_columns%+column%
      if cell%=sea_position%
        pen_on_paper command_colour%,sea_colour%
        print #tw%,"X";
      else
        sel on sea_map%(cell%)
          =first_island_type% to last_island_type%
            land_on_sea_map "o"
          =treasure_island%
            land_on_sea_map "O"
          =reef%
            land_on_sea_map "."
          =remainder
            print #tw%," ";
        endsel
      endif
    endfor column%
  endfor row%

  pen_on_paper narration_colour%,background_colour%
  end_of_scene

enddef

defproc show_island_map

  ' Muestra el mapa de la isla.

  title "Mapa de las zonas conocidas de la isla"
  show_map island_map%,island_columns%,island_rows%,island_position%
  end_of_scene

enddef

defproc status_report

  ' Informe de estado

  loc field_width%
  let field_width%=3

  page
  narrate "Informe de situación"
  cr:cr:narrate_dots_to "Hombres:",20
  narrate field$(alive%,field_width%)
  cr:narrate_dots_to "Días:",20
  narrate field$(days%,field_width%)
  cr:narrate_dots_to "Hundimientos:",20
  narrate field$(sunk%,field_width%)
  cr:narrate_dots_to "Daños :",20
  narrate field$(damage%,field_width%)
  cr:narrate_dots_to "Moral:",20
  narrate field$(morale%,field_width%)
  cr:narrate_dots_to "Provisiones:",20
  narrate field$(supplies%,field_width%)
  cr:narrate_dots_to "Doblones:",20
  narrate field$(cash%,field_width%)
  cr:narrate_dots_to "Munición:",20
  narrate field$(ammo%,field_width%)

  end_of_scene

enddef

defproc crew_report

  ' Informe de tripulación

  loc crewman%,column%
  let column%=max_whole_name_length%+2

  page
  pen narration_colour%
  narrate "Informe del estado de la tripulación"
  cr:narrate_to "Nombre",column%
  narrate "Condición":cr

  for crewman%=1 to crewmen%:
    cr:narrate_dots_to whole_name$(crewman%),column%
    sel on stamina%(crewman%)
      =0:pen 11 ' grey
      =1:pen 2 ' red
      =2:pen 136 ' orange
      =3:pen 184 ' light orange
      =4:pen 191 ' green
    endsel
    tell iso_upper_1$(condition$(crewman%))
  endfor crewman%

  end_of_scene

enddef

defproc dead_report(crewman%)
  narrate proper_name$(crewman%)&" ha muerto."
enddef

defproc injured_report(crewman%)
  narrate proper_name$(crewman%)&" ha resultado "&condition$(crewman%)&"."
enddef

deffn injured$(crewman%)
  ret proper_name$(crewman%)&", que resulta "&condition$(crewman%)&"."
enddef

' ==============================================================
' Encallar {{{1

defproc run_aground

  let damage%=damage%+rnd(10 to 20):\
  if damage%>100:let damage%=100

  page
  narrate "¡El bote ha chocado con una roca!"
  narrate "Los daños en la embarcación son ya del "&damage%&"%."
  if damage%=100:narrate "El bote está destrozado."

  ' XXX TODO -- hacer esto al azar:
  dead_report man_dead%
  injured_report man_injured%

  let morale%=morale%-rnd(1 to 4)
  do_pause 300

enddef

' ==============================================================
' Movimiento  {{{1

' ----------------------------------------------
' En general {{{2

deffn offset_to_cardinal_point$(offset%)

  ' Devuelve un punto cardinal a partir de un incremento de
  ' casilla en la matriz del mapa (tanto en el mar como en
  ' la isla).

  sel on offset%
    =sea_north_offset%,island_north_offset%:ret "norte"
    =sea_south_offset%,island_south_offset%:ret "sur"
    =sea_east_offset%,island_east_offset%:ret "este"
    =sea_west_offset%,island_west_offset%:ret "oeste"
  endsel

enddef

' XXX OLD --
' deffn impossible_move%(columns%,rows%,position%,offset%)
'
'  ' ¿Es imposible el movimiento en un mapa de las
'  ' proporciones indicadas, haciendo cierto desplazamiento
'  ' desde la posición actual en la matriz?
'
'  ' XXX TODO --
'
'  loc cells%
'
'  sel on offset%
'    =sea_north_offset%,island_north_offset%
'
'      ' XXX OLD -- Primera versión.
'      #sel on position%
'      '  =1 to columns%:ret true ' Primera fila
'      '  =remainder:ret false
'      #endsel
'
'      ' XXX NEW -- Segunda versión, más directa:
'      ret ((position%-1) div columns%)=0
'
'    =sea_south_offset%,island_south_offset%
'
'      ' XXX OLD -- Primera versión:
'      #let cells%=columns%*rows%
'      #sel on position%
'      '  =cells%-columns%+1 to cells%:ret true
'      '  =remainder:ret false
'      #endsel
'
'      ' Segunda versión, más directa:
'      ret ((position%-1) div columns%)=columns%
'
'    =sea_east_offset%,island_east_offset%
'      ret (position% mod columns%)=1
'    =sea_west_offset%,island_west_offset%
'      ret (position% mod columns%)=0
'  endsel
'
' enddef

deffn that_way$(offset%)

  ' Devuelve una forma de expresar la dirección
  ' correspondiente a un desplazamiento en un mapa.

  ret one_of$(\
    "en esa dirección",\
    "hacia el "&offset_to_cardinal_point$(offset%),\
    "al "&offset_to_cardinal_point$(offset%))

enddef

' ----------------------------------------------
' Movimiento en el mar {{{2

deffn sea_row%

  ' Devuelve la fila de la posición actual en el mapa del
  ' mar (0...sea_last_row%)

  ret sea_position% div sea_columns%

enddef

deffn sea_column%

  ' Devuelve la columna de la posición actual en el mapa del
  ' mar (0...sea_last_column%)

  ret sea_position% mod sea_columns%

enddef

' XXX OLD -- 
' deffn impossible_sea_move%(position%,offset%)
'
'  ' ¿Es imposible el movimiento en el mapa del mar,
'  ' haciendo cierto desplazamiento desde la posición actual
'  ' en la matriz?
'
'  ret impossible_move%(sea_columns%,sea_rows%,position%,offset%)
'
' enddef

defproc impossible_sea_move(offset%)

  ' Responde a una orden de movimiento en tierra imposible
  ' de cumplir.

  loc direction$
  let direction$=that_way$(offset%)

  sailor_says one_of$(\
    "No es posible ir "&direction$,\
    "No podemos ir más "&direction$,\
    iso_upper_1$(direction$)&" los arrecifes son demasiado peligrosos")

enddef

deffn valid_sea_offset%(offset%)

  ' Devuelve 1 si el desplazamiento indicado es válido a
  ' partir de la posición actual en el mar. Devuelve 0 en
  ' caso contrario.

  sel on offset%
    =sea_north_offset%:ret sea_row%<>0
    =sea_south_offset%:ret sea_row%<>sea_last_row%
    =sea_east_offset%:ret sea_column%<>sea_last_column%
    =sea_west_offset%:ret sea_column%<>0
  endsel

enddef

defproc sea_move(offset%)

  ' Movimiento en el mar.

  ' XXX TODO -- Finish.

  loc new_position%

  page
  if not valid_sea_offset%(offset%):\
    impossible_sea_move offset%:ret

  let new_position%=sea_position%+offset%
  if sea_map%(new_position%)=reef%
    ' XXX TODO -- Finish.
    ' XXX TODO -- Que los marineros confirmen la orden.
    let sea_position%=new_position%
    ' XXX TODO -- Que haya probabilidad de escapar.
    run_aground
  else
    let sea_position%=new_position%
    sea_scenery
  endif

enddef

' ----------------------------------------------
' Movimiento en la isla {{{2

deffn island_row%

  ' Devuelve la fila de la posición actual en el mapa de la
  ' isla (0...island_last_row%)

  ret island_position% div island_columns%

enddef

deffn island_column%

  ' Devuelve la columna de la posición actual en el mapa de
  ' la isla (0...island_last_column%)

  ret island_position% mod island_columns%

enddef

defproc impossible_island_move(offset%)

  ' Responde a una orden de movimiento en tierra imposible
  ' de cumplir.

  loc direction$
  let direction$=that_way$(offset%)

  sailor_says one_of$(\
    "No es posible ir "&direction$,\
    "No podemos ir más "&direction$,\
    "No hay más isla "&direction$,\
    iso_upper_1$(direction$)&" solo está el mar")

enddef

' XXX OLD 
' deffn impossible_island_move%(position%,offset%)
'
'  ' ¿Es imposible el movimiento en el mapa de la isla,
'  ' haciendo cierto desplazamiento desde la posición actual
'  ' en la matriz?
'
'  ret impossible_move%(island_columns%,island_rows%,position%,offset%)
'
' enddef

deffn valid_island_offset%(offset%)

  ' Devuelve 1 si el desplazamiento indicado es válido a
  ' partir de la posición actual en la isla. Devuelve 0 en
  ' caso contrario.

  sel on offset%
    =island_north_offset%:ret island_row%<>0
    =island_south_offset%:ret island_row%<>island_last_row%
    =island_east_offset%:ret island_column%<>island_last_column%
    =island_west_offset%:ret island_column%<>0
  endsel

enddef

defproc island_move_message(offset%)

  ' Muestra un mensaje acerca del movimiento válido
  ' efectuado en la isla.

  ' XXX TODO -- Finish.
  narrate "[mensaje de movimiento]"

enddef

defproc island_move(offset%)

  ' Movimiento en tierra.

  loc new_position%

' XXX INFORMER
'  cr:tell island_position%
'  cr:tell offset%
'  cr:tell new_position%

' XXX OLD --
'  if impossible_island_move%(island_position%,offset%)
'    island_impossible_move offset%
'  else
'    let island_position%=new_position%
'    enter_island_location
'  endif

  page
  if not valid_island_offset%(offset%):\
    impossible_island_move offset%:ret

  let island_position%=island_position%+offset%
  island_move_message offset%
  enter_island_location

enddef

' ==============================================================
' Embarcar  {{{1

defproc embark_message

  ' Mensaje de embarque.

  loc dead_on_the_island%

  narrate "Regresas al bote con "&\
    if$(alive%=1,"el único de tus hombres que queda con vida.",\
    "tus hombres.")
  let dead_on_the_island%=alive%-alive_before_disembarking%
  if dead_on_the_island%
    end_of_scene
    narrate \
      "Has perdido "&\
      with_letters$(dead_on_the_island%)&\
      one_of$(" marinero"," hombre")&\
      s$(dead_on_the_island%)&\
      " en esa isla."
  endif

enddef

defproc embark

  ' Acción de embarcar.

  page
  embark_message
  if not sea_memory%(sea_position%):\
    let sea_memory%(sea_position%)=visited%
  let days%=days%+1
  let aboard%=true

enddef

' ==============================================================
' Crear mapa de la isla {{{1

defproc map_border(array%,columns%,rows%,value%)

' XXX OLD -- Para matriz con elemento 0 ignorado:
'  loc z%,locations%
'  let locations%=columns%*rows%
'  for z%=\
'    1 to columns%+1,\ ' Norte
'    (rows%-1)*columns% to locations%,\ ' Sur
'    columns%*2 to locations%-columns%*2 step columns%,\ ' Este
'    columns%*2+1 to locations%-columns%*2+1 step columns%:\ ' Oeste
'    let array%(z%)=value%

  loc z%,last_location%
  let last_location%=columns%*rows%-1

  for z%=\
    0 to columns%,\ ' Norte
    (rows%-1)*columns% to last_location%,\ ' Sur
    columns%*2-1 to last_location%-columns%*2 step columns%,\ ' Este
    columns%*2 to last_location%-columns%*2+1 step columns%:\ ' Oeste
    let array%(z%)=value%

enddef

defproc new_island_map

  ' Crea el mapa de la nueva isla.

  loc w%,minimum_locations%,position%,z%

  let minimum_locations%=16
  rep
    let island_rows%=rnd(3 to 5) ' Filas.
    let island_columns%=rnd(3 to 6) ' Columnas.
    let island_locations%=island_rows%*island_columns%
    if island_locations%>=minimum_locations%:exit
  endrep

  let island_first_row%=0
  let island_first_column%=0
  let island_last_row%=island_rows%-1
  let island_last_column%=island_columns%-1
  let island_north_offset%=-island_columns%
  let island_south_offset%=island_columns%
  let island_east_offset%=1
  let island_west_offset%=-1
  let island_last_location%=island_locations%-1

  dim island_map%(island_last_location%)

  ' Rodear la isla con costa:
' XXX OLD --
'  for z%=\
'    1 to island_columns%+1,\ ' Norte
'    (island_rows%-1)*island_columns% to island_locations%,\ ' Sur
'    island_columns%*2 to island_locations%-island_columns%*2 step island_columns%,\ ' Este
'    island_columns%*2+1 to island_locations%-island_columns%*2+1 step island_columns%:\ ' Oeste
'    let island_map%(z%)=coast%
  map_border island_map%,island_columns%,island_rows%,coast%

  ' XXX TODO -- Quitar números mágicos:
  for z%=island_columns%+2 to island_locations%-island_columns%-1
    if island_map%(z%)<>coast%:let island_map%(z%)=rnd(2 to 7)
  endfor z%

  let island_map%(rnd(island_last_location%))=native_ammo%
  let island_map%(rnd(island_last_location%))=native_supplies%
  ' Situación del poblado:
  rep
    let position%=rnd(island_last_location%)
    if island_map%(position%)<>coast%:exit
  endrep
  let island_map%(position%)=native_village%

  ' Posición inicial en la isla:
  rep
    let island_position%=rnd(island_last_location%)
    if island_map%(island_position%)=coast%:exit
  endrep

enddef

' ==============================================================
' Desembarcar {{{1

defproc disembark_message_on_the_boat

  ' Mensaje de desembarco estado aún en el bote.

  let alive_before_disembarking%=alive%

  sel on alive_before_disembarking%
    ' XXX TODO -- Finish. Contar con los heridos.
    =1
      narrate "Con tu ayuda, "&proper_name$(alive_man%)&" pone"
    =remainder
      narrate "Obedeciendo tus órdenes, "&\
      one_of$(\
        "los "&with_letters$(alive_before_disembarking%)&\
          " "&one_of$(\
            "miembros de la tripulación",\
            "marineros",\
            "hombres")&" ponen",\
      one_of$("tus","los")&\
        one_of$(\
          "",\
          " "&with_letters$(alive_before_disembarking%))&\
        " hombres ponen",\
      "la tripulación pone")
  endsel
  ' XXX TODO -- Finish. Añadir nombre de la isla si es conocida (cuando esté implantado el sistema de nombres de isla)
  narrate "rumbo a la isla."
  short_pause
  sel on alive_before_disembarking%
    ' XXX TODO -- Finish. Contar con los heridos.
    =1
      narrate "Los dos remáis"
    =remainder
      narrate "Todos reman"
  endsel
  narrate one_of$(\
    "con energía",\
    "con fuerza",\
    "con ímpetu",\
    "con decisión",\
    "enérgicamente")
  narrate "y pronto alcanzáis la costa."
  end_of_scene

enddef

defproc disembark_message_on_the_coast

  ' Mensaje de desembarco estando ya en la costa.

  ' XXX TODO -- Finish.
  narrate "Tras asegurar el bote sobre la arena os disponéis a examinar los alrededores..."
  short_pause

enddef

deffn island_there%(position%)

  ' Devuelve uno si en la posición indicada del mar hay
  ' una isla y cero en caso contrario.

  sel on sea_map%(position%)
    =treasure_island%,first_island_type% to last_island_type%:ret true
    =remainder:ret false
  endsel

enddef

deffn island_here%

  ' Devuelve uno si en la posición actual en el mar hay
  ' una isla y cero en caso contrario.

  ret island_there%(sea_position%)

enddef

defproc enter_the_island

  ' Pone el pie en la isla.

  if sea_map%(sea_position%)=treasure_island%
    enter_treasure_island
  else
    new_island_map
    enter_island_location
  endif

enddef

defproc disembark

  ' Acción de desembarcar.

  page
  if not island_here%:\
    page:sailor_says_to_you one_of$(\
      "No hay ninguna isla en la que desembarcar",\
      "No hay tierra a la vista"):\
    ret

  sel on sea_memory%(sea_position%)
      =visited%
        sailor_says_to_you one_of$(\
          "ya hemos estado en esa isla y no encontramos a nadie con quien negociar",\
          "es mejor no visitar dos veces la misma isla",\
          "en esa isla ya nos conocen, sería peligroso")
        ret
      =successful_trade%
        sailor_says_to_you one_of$(\
          "en esa isla ya hicimos negocio",\
          "ahí no tenemos nada más que negociar")
        ret
      =unsuccessful_trade%
        sailor_says_to_you one_of$(\
          "de esa isla nos echaron",\
          "después de lo que pasó en esa isla, no seremos bien recibidos")
        ret
  endsel

  ' XXX
  disembark_message_on_the_boat
  let supplies%=supplies%-rnd(1 to 2)
  let supplies%=maximum%(supplies%,0)
  let aboard%=false
  disembark_message_on_the_coast
  enter_the_island

enddef

' ==============================================================
' Comerciar {{{1

defproc trade

  ' Acción de comerciar.

  page
  if aboard%
    if sea_memory%(sea_position%)
      sailor_says_to_you "no es buena idea regresar a la misma isla a comerciar"
    else
      if island_here%
        if sailor_asks_you%("desembarcamos para buscar nativos con los que comerciar")
          disembark
        else
          page
          sailor_says_to_you "será mejor largarse de aquí"
        endif
      else
        sailor_says_to_you one_of$(\
          "No hay ninguna isla en la que desembarcar",\
          "No hay tierra a la vista"):\
      endif
    endif
    ret
  endif

  sel on island_map%(island_position%)
    =native_supplies%
      page:native_says "Buena comida solo regalo, amigo"
    =native_ammo%
      page:native_says "Buena bala gorda solo regalo, amigo"
    ' =native_fights%
    =native_village%
      actual_trade
    =remainder
      page:sailor_says_to_you "Fuera de los poblados no encontraremos nativos con quienes comerciar"
  endsel

enddef

defproc actual_trade

  loc price%,speech$,silent%

  cr:narrate "Un nativo te sale al encuentro."
  narrate "Parece alguien importante en su tribu."
  let price%=rnd(4 to 9)
  cr:native_says "Yo saber qué cosa tú buscar. Yo vender pista de tesoro a tú... Precio ser "&coins$(price%)&". ¿Tú qué dar?"

  rep
    let offer%=new_offer%
    if offer%<>no_offer%:exit
    ' XXX TODO -- Finish.
    let silent%=silent%+1
    if rnd(5-silent%)
      let speech$=one_of$(\
        "¿Tú no "&one_of$("saber","entender","oír","escuchar","comprender")&"?",\
        "¿Tú ser "&one_of$("mudo","sordo")&"?",\
        "¿Tú no tener "&one_of$("boca","lengua")&"?",\
        "¿Tú no "&one_of$("decir","hablar")&one_of$(""," algo")&"?")
      let speech$=speech$&" Yo "&one_of$(\
        "enfadar"&one_of$("","mucho")&".",\
        one_of$("no","nada","poco")&" contento.",\
        "no esperar.")
      native_says speech$&" "&one_of$(\
        "Tú decir algo.",\
        "¿Tú qué dar?",\
        "¿Tú no tener doblones?")
    else
      let speech$="Tú"
      let speech$=speech$&" "&one_of$(\
        "",\
        "cara pálida",\
        "rostro pálido",\
        "blanco")
      let speech$=speech$&" "&one_of$(\
        "tonto",\
        "bobo")
      let speech$=speech$&" "&one_of$(\
        "sin "&one_of$("lengua","boca","palabras"),\
        "no saber "&one_of$("hablar","usar boca","usar lengua"))
      let speech$=speech$&". "&one_of$(\
        "¡Tú marchar!",\
        "¡Fuera de isla mía!")
      rejected_offer speech$
      ret
    endif
  endrep

  ' Si le hemos ofrecido un doblón menos, acepta:
  if offer%>=(price%-1):accepted_offer:ret
  ' Si le hemos ofrecido demasiado poco, no hay trato:
  if offer%<=(price%-4):rejected_offer "¡Ser insulto! ¡Fuera de isla mía!":ret

  ' Le hemos ofrecido poco.
  sel on rnd(1 to 4)
    =1
      ' Rebaja el precio:
      let price%=price%-rnd(2 to 3)
      native_says "Bueno, tú darme ya "&coins$(price%)&" y no hablar más"
      let offer%=new_offer%
      if offer%>=price%:accepted_offer:else rejected_offer "¡Ser insulto! ¡Fuera de isla mía!"
      ret
    =2
      ' Pone un nuevo precio:
      let price%=rnd(3 to 8)
      native_says iso_upper_1$(coins$(price%))&" ser nuevo precio. ¿Tú qué dar ahora?"
    =remainder
      ' Rebaja un doblón:
      let price%=price%-1
      native_says "¡No! ¡Yo querer más! Tú darme "&coins$(price%)
  endsel

  ' Ã<9a>ltima oferta.
  let offer%=new_offer%
  ' Acepta un doblón menos otra vez:
  if offer%>=(price%-1):accepted_offer:else rejected_offer "¡Ser insulto! ¡Fuera de isla mía!"

enddef

deffn new_offer%

  ' Devuelve una oferta del jugador.

  loc offer%,z%,max_offer%,options%,options$

  cr:narrate "Tienes "&coins$(cash%)&". ¿Qué oferta le haces?"
  let max_offer%=minimum%(9,cash%)
' Método obsoleto:
'  for z%=1 to max_offer%:\
'    let options$=options$&\
'      option$(z%,1,true)
'  show_options options$
  cr:\
  for z%=1 to max_offer%:\
    show_option "&"&z%

  let offer%=digit%(1,max_offer%)
  page
  if offer%=no_offer%
    narrate one_of$(\
      "Dudas demasiado.",\
       "No eres capaz de decidirte a hacer una oferta.",\
      "Tardas mucho en tomar una decisión.")
    narrate "Eso"
    narrate one_of$(\
      "pone nervioso",\
      "ofende",\
      "enfurece",\
      "hace enfadar",\
      "indigna",\
      "hace perder la paciencia")
    narrate one_of$(\
      "a aquel hombre.",\
      "a aquel nativo.",\
      "al nativo.",\
      "a tu interlocutor.")
    short_pause
  else
    narrate "Le ofreces "&coins$(offer%)&"."
  endif

  ret offer%

enddef

defproc rejected_offer(speech$)

  ' El nativo rechaza la oferta.

  do_pause 200
  cr
  native_says speech$
  do_pause 200
  let sea_memory%(sea_position%)=unsuccessful_trade%
  embark

enddef

defproc the_native_counts_the_doubloons

  cr:native_says \
    one_of$(\
      "Bueno, bueno...",\
      "Gustar doblones...",\
      "Doblones gustar...",\
      "Doblones bonitos...",\
      "Doblones buenos..."),\
    one_of$(\
      ", mirando",\
      ", contando",\
      ", haciendo tintinear",\
      ", contemplando",\
      ", manoseando",\
      ", acariciando")&\
    " "&one_of$(\
      "las monedas",\
      "el dinero",\
      "los doblones")&\
    " "&one_of$("en","con","entre")&" sus "&\
    one_of$(""," gordas")&" manos"

enddef

defproc the_native_tells_a_clue

  loc clue%

  let clue%=rnd(clues%-1)
  sel on clue%
    =0:native_just_says "Tú tomar camino "&_with_letters$(path_clue%)
    =1:native_just_says "Tú parar en árbol "&_with_letters$(tree_clue%)
    =2:native_just_says "Tú ir "&hand$(hand_clue%)&" en árbol"
    ' =4:native_just_says "Tú atravesar poblado "&village$(village_clue) ' XXX OLD
    =3:native_just_says "Tú ir "&cardinal_point$(direction_clue%)&" desde poblado"
    =4:native_just_says "Tú dar "&with_letters$(pace_clue%)&" paso"&s$(pace_clue%)&" desde poblado"
  endsel

  if got_clue%(clue%)
    cr:sailor_says_to_you \
      one_of$(\
        "menuda novedad nos cuenta",\
        "menuda negocio hemos hecho",\
        "qué desperdicio de "&one_of$("dinero","doblones"),\
        "eso ya lo sabíamos"),\
      one_of$(\
        " en voz baja",\
        " bajando la voz",\
        " al oído")
    cr:narrate "Efectivamente, lo que aquel nativo te ha dicho ya lo sabías, pero debes disimular tu decepción."
    short_pause
  else
    cr:narrate "Anotas en tu cabeza la valiosa información y se la agradeces con un gesto."
    cr:sailor_says \
      one_of$(\
      "Ya estamos más cerca del tesoro",\
      "Pronto seremos ricos",\
      "Ya casi puedo oler ese tesoro"),\
      one_of$(\
      ", haciendo un "&one_of$("","visible ","gran ")&"esfuerzo para",\
      ", esforzándose en",\
      ", casi sin poder",\
      ", sin poder")&\
      " "&one_of$(\
      "contener",\
      "reprimir",\
      "ocultar",\
      "disimular")&\
      " "&one_of$(\
      "su alegría",\
      "la emoción",\
      "su satisfacción")
    let got_clue%(clue%)=true
  endif

enddef

defproc the_native_says_goodbye

  ' Despedida del nativo tras la negociación con éxito.

  cr:native_says one_of$(\
    "¡Viaje bueno a isla de coco!",\
    "¡Tú encontrar pronto isla de coco!"),\
    one_of$(\
      " despidiéndose",\
      " haciendo un gesto de despedida",\
      " levantando el brazo a modo de despedida")

enddef

defproc accepted_offer

  ' El nativo acepta la oferta.

  the_native_counts_the_doubloons
  short_pause
  narrate "Cuando termina levanta de nuevo la vista y, mirándote fijamente, te dice:"
  short_pause
  the_native_tells_a_clue
  short_pause
  the_native_says_goodbye
  let cash%=cash%-offer%
  let tradings%=tradings%+1
  let sea_memory%(sea_position%)=successful_trade%
  end_of_scene
  embark

enddef

' ==============================================================
' Entrar en un escenario de la isla {{{1

defproc enter_island_location

  loc dubloons%

  sel on island_map%(island_position%)
    =snake%
      let injured%=man_injured%
      cr:narrate "Una serpiente ha mordido a "&injured$(injured%)
    =native_fights%
      let injured%=man_injured%
      cr:narrate "Un nativo intenta bloquear el paso y hiere a "&injured$(injured%)
    =dubloons_found%
      let dubloons%=rnd(1 to 3)
      cr:narrate "Encuentras "&coins$(dubloons%)&"."
      let cash%=cash%+dubloons%
      let island_map%(island_position%)=already_visited%
    =native_ammo%
      cr:narrate "Un nativo te da algo de munición."
      let ammo%=ammo%+1
      let island_map%(island_position%)=native_fights%
    =native_supplies%
      cr:narrate "Un nativo te da provisiones."
      let supplies%=supplies%+1
      let island_map%(island_position%)=native_fights%
    =native_village%
      cr:narrate "Descubres un poblado nativo."
    =already_visited%,nothing_happens%
      island_special_events
  endsel

enddef

' ==============================================================
' Dibujar escenario de la isla {{{1

defproc island_scenery

  ' XXX TODO -- Finish.

  loc position%,position$

  page
  sunny_sky
  let position%=\
    position%+(island_map%(island_position%+island_north_offset%)=coast%)+\
    position%+2*(island_map%(island_position%+island_south_offset%)=coast%)+\
    position%+4*(island_map%(island_position%+island_east_offset%)=coast%)+\
    position%+8*(island_map%(island_position%+island_west_offset%)=coast%)

  sel on position%
    =%0001
      let position$="norte"
    =%0010
      let position$="sur"
    =%0100
      let position$="este"
    =%1000
      let position$="oeste"
    =%1001
      let position$="noroeste"
    =%0101
      let position$="noreste"
    =%1010
      let position$="suroeste"
    =%0110
      let position$="sureste"
  endsel
  if position%
    cr:narrate "Estás en la costa "&position$&"."
  endif

  sel on island_map%(island_position%)
    =native_village%
      draw_village
    =dubloons_found%
    =native_fights%
      draw_native
    =already_visited%
    =snake%
      draw_snake
    =nothing_happens%
    =native_supplies%
      draw_supplies
      draw_native
    =native_ammo%
      draw_ammo
      draw_native
  endsel

enddef

' ==============================================================
' Atacar {{{1

defproc attack

  ' Acción de atacar

  page
  if aboard%:attack_on_the_boat:else attack_on_the_island

enddef

defproc attack_on_the_island

  ' Atacar en la isla

  ' XXX TODO -- Finish.

  ' XXX INFORMER
  cr:tell "[Contenido de la posición=]"&island_map%(island_position%)

  sel on island_map%(island_position%)
    =dubloons_found%,already_visited%,nothing_happens%
      cr:sailor_says_to_you "No hay nadie a quien atacar"
    =snake%
      attack_the_snake
    =native_village%
      attack_the_village
    =native_supplies%,native_ammo%,native_fights%
      attack_the_native
  endsel

  if island_map%(island_position%)<>native_village%
    let island_map%(island_position%)=already_visited%
  endif

  do_pause 160

enddef

defproc attack_the_snake

  ' Atacar a la serpiente.

  ' XXX TODO -- Finish.
  loc crewman%
  let crewman%=alive_man%
  if alive%=1
    cr:narrate proper_name$(crewman%)&" le lanzáis un cocotazo a la serpiente, pero antes ella mata a "&proper_name$(man_dead%)&"."
  else
    cr:narrate proper_name$(crewman%)&" le lanzáis un cocotazo a la serpiente, pero antes ella mata a "&proper_name$(man_dead%)&"."
  endif

enddef

defproc attack_the_village

  ' Atacar el poblado.

  cr:narrate "Un poblado entero es un enemigo muy difícil. "&proper_name$(man_dead%)&" muere en la lucha."

enddef

defproc attack_the_native

  ' Atacar al nativo.

  loc dubloons%

  sel on rnd(4)
    =0
      cr:narrate "El nativo muere, pero antes mata a "&proper_name$(man_dead%)&"."
    =1
      cr:narrate "El nativo tiene provisiones escondidas en su taparrabos."
      let supplies%=supplies%+rnd(1 to 2)
    =remainder
      let dubloons%=rnd(2 to 4)
      let crewman%=alive_man%
      ' XXX TODO -- mensaje personalizado de crewman%,
      ' «que a pesar de sus heridas registra el cuerpo»
      cr:narrate "Encuentras "&coins$(dubloons%)&" en el cuerpo del nativo muerto."
      let cash%=cash%+dubloons%
  endsel

enddef

defproc attack_on_the_boat
  ' XXX TODO -- Finish.
enddef

defproc attack_the_boat

  ' XXX TODO -- Finish.

  ' Atacar el bote enemigo

  ' not(sea_map%(sea_position%)<13 or
  ' sea_map%(sea_position%)=21 or
  ' sea_map%(sea_position%)=treasure_island%)

enddef

defproc attack_the_own_boat

  ' XXX TODO -- Finish.
  loc z%,injured%

  narrate "Disparas por error a uno de tus propios botes..."
  do_pause 400

  if rnd(3)
    narrate "Por suerte el disparo no ha dado en el blanco."
  else
    narrate "La bala alcanza su objetivo. Esto desmoraliza a la tripulación."
    let morale%=morale%-rnd(1 to 2)
    for z%=1 to rnd(2 to 4)
      let injured%=man_injured%
    endfor z%
  endif
  do_pause 400

enddef

' ==============================================================
' Abortar {{{1

deffn abort%

  ' Devuelve un indicador:
  ' ¿El jugador confirma que quiere dejar el juego?

  loc answer%

  page
  narrate one_of$(\
    "¿Seguro que",\
    "¿De verdad",\
    "¿Estás segur"&ao$(gender%(captain%))&" de que")
  narrate one_of$("quieres","deseas","prefieres")
  narrate one_of$("abandonar","dejar")
  narrate one_of$(\
    "la aventura?",\
    "la empresa?",\
    "la búsqueda?")

  let answer%=yes%
  page

  ret answer%

enddef

' ==============================================================
' Panel de comandos {{{1

' XXX OLD -- 
' defproc panel
'
'  ' Panel de comandos disponibles.
'
'  loc options%,options$
'
'  let options$=\
'    option$("Norte",1,1)
'  let options$=options$&\
'    option$("Sur",1,1)
'  let options$=options$&\
'    option$("Este",1,1)
'  let options$=options$&\
'    option$("Oeste",1,1)
'  let options$=options$&\
'    option$("Informe",1,true)
'  let options$=options$&\
'    option$("Tripulación",1,true)
'  let options$=options$&\
'    option$("Desembarcar",1,aboard%)
'  let options$=options$&\
'    option$("EmBarcar",3,not aboard%)
'  let options$=options$&\
'    option$("Comerciar",1,true)
'  let options$=options$&\
'    option$("Atacar",1,true)
'  let options$=options$&\
'    option$("Fin",1,true)
'  let options$=options$
'
'  show_options options$
'
' enddef
'
' deffn option$(option$,letter%,active%)
'
'  ' Devuelve una opción del panel, activa o inactiva según
'  ' se indique.
'
'  let options%=options%+active%
'  ret \
'    if$(not active%,"")&\
'    if$(active%,if$(options%>1," ")&active_option$(option$,letter%))
'
' enddef
'
' deffn active_option$(option$,letter%)
'
'  ' Devuelve una opción del panel, activa.
'
'  ' XXX REMARK --
'  ' Por un motivo que no entiendo, esto no funciona
'  ' (las referencias a option$ provocan un error
'  ' «Unknown function or array»):
'
'  #ret \
'  '  option$(to letter%-1)&\
'  '  short_key$(option$(letter%))&\
'  '  option$(letter%+1 to)
'
'  ' Hace falta crear una variable local intermedia
'  ' para el parámetro:
'
'  loc o$
'  let o$=option$
'  ret \
'    o$(to letter%-1)&\
'    short_key$(o$(letter%))&\
'    o$(letter%+1 to)
'
' enddef
'
' deffn short_key$(letter$)
'
'  ' Devuelve una letra resaltada como acceso del panel.
'
'  ret "["&letter$&"]"
'
' enddef
' defproc show_options(txt$)
'
'  ' Imprime las opciones que tiene el jugador.
'
'  csize #tw%,0,1
'  pen red%
'  cr:tell "Teclas disponibles:"
'  cr:tell txt$&" "
'  ' Restaurar el tamaño de letra calculado en el fichero de arranque:
'  csize #tw%,csize_w%,csize_h%
'
' enddef

' XXX OLD -- 
' deffn possible_attack%
'  if aboard%
'    ret sea_map%(sea_position%)>=13 and sea_map%(sea_position%)<=16
'  else
'    ' XXX TODO -- Finish.
'    ret true
'  endif
' enddef

defproc command

  ' Espera la pulsación de un comando.

  cursen #tw%
  rep
    sel on code(inkey$(#tw%,50*30))
      ' "N" o arriba:
      =78,110,up_chr%
        if aboard%:sea_move sea_north_offset%:\
        else island_move island_north_offset%
        exit
      ' "S" o abajo:
      =83,115,down_chr%:
        if aboard%:sea_move sea_south_offset%:\
        else island_move island_south_offset%
        exit
      ' "E" o derecha:
      =69,101,right_chr%
        if aboard%:sea_move sea_east_offset%:\
        else island_move island_east_offset%
        exit
      ' "O" o izquierda:
      =79,111,left_chr%
        if aboard%:sea_move sea_west_offset%:\
        else island_move island_west_offset%
        exit
      ' "I":
      =73,105:status_report:exit
      ' "A":
      =65,97:attack:exit
      ' "T":
      =84,116:crew_report:exit
      ' "D":
      =68,100:if aboard%:disembark:exit
      ' "C":
      =67,99:trade:exit
      ' "B":
      =66,98:if not aboard%:embark:exit
      ' "M":
      =77,109
      if aboard%:show_sea_map:else show_island_map
      exit
      ' "F":
      =70,102:let abandon%=abort%:exit
    endsel
  endrep
  curdis #tw%

enddef

defproc panel_message

  ' Imprime un mensaje de presentación de las opciones
  ' disponibles en el panel.

  loc crewman%

  cr:cr
  sel on rnd(2)
    =0
      if alive%=1
        let crewman%=alive_man%
        narrate proper_name$(crewman%)&" espera tus órdenes."
      else
        narrate one_of$(\
          one_of$(\
          "Tus hombres "&one_of$("esperan","aguardan"),\
          "Tu tripulación "&one_of$("espera","aguarda")),\
          "Los "&with_letters$(alive%)&" "&\
            one_of$("hombres","marineros")&\
            " "&one_of$("esperan","aguardan"))
        narrate "tus órdenes."
      endif
    =1
      sailor_asks_you one_of$(\
        "qué hacemos"&now$,\
        "qué ordena"&now$,\
        "cuáles son sus órdenes")
    =2
      sailor_says_to_you one_of$(\
        "estamos a",\
        "esperamos")&" sus órdenes"
' XXX OLD -- Anulado para no crear diálogo con entre narrador y jugador:
'    =3
'      narrate "¿"&one_of$(\
'        "Qué haces ahora",\
'        "Qué ordenas"&now$,\
'        "Qué quieres hacer"&now$,\
'        "Cuáles son tus órdenes")&\
'      one_of$("",the_captain_surname$)&"?"
  endsel

enddef

defproc show_option(option$)

  ' Muestra una opción del panel de comandos.
  ' La letra precedida por el signo «&» será resaltada.

  loc access_key%,o$
  let o$=option$
  let access_key%="&" instr o$

  ink #tw%,command_colour%
  ' XXX REMARK --
  ' Si se usa option$, la siguiente línea provoca
  ' "unknown function or array"
  print #tw%,o$(to access_key%-1);
  ink #tw%,foreground_colour%
  strip #tw%,command_colour%
  print #tw%,iso_upper$(o$(access_key%+1));
  ink #tw%,command_colour%
  paper #tw%,background_colour%
  print #tw%,o$(access_key%+2 to);" ";

enddef

defproc show_ql_option(option$)

  ' Muestra una opción del panel de comandos,
  ' con el juego de caracteres original de QL.
  ' La letra precedida por el signo «&» será resaltada.

  ql_font #tw%:show_option(option$):iso_font #tw%

enddef

defproc show_arrow(arrow$)

  ' Muestra una flecha, usada como tecla de acceso
  ' adicional en las opciones de movimiento del panel.

  show_ql_option "&"&arrow$:backspace

enddef

defproc panel

  ' Panel de comandos disponibles.

  loc char_heigth%
  let char_height%=char_h

  ' Mensaje previo de ambientación:
  panel_message:cr:cr

  ' Incrementar el espaciado vertical de los caracteres,
  ' para que las teclas de acceso en colores invertidos no
  ' se peguen entre sí cuando su posición de columna
  ' coincida:
  char_inc #tw%,char_w,char_height%+2

  ' Mostrar los comandos, en varias líneas:
  show_arrow up_arrow$
  show_option "&Norte"
  show_arrow down_arrow$
  show_option "&Sur"
  show_arrow right_arrow$
  show_option "&Este"
  show_arrow left_arrow$
  show_option "&Oeste"
  cr
  show_option "&Informe"
  show_option "&Tripulación"
  show_option "&Mapa"
  cr
  show_option if$(aboard%,"&Desembarcar","Em&Barcar")
  show_option "&Comerciar"
  show_option "&Atacar"
  show_option "&Fin"

  ' Restaurar el espaciado vertical:
  char_inc #tw%,char_w,char_height%

enddef

' ==============================================================
' Eventos {{{1

' ----------------------------------------------
' Eventos especiales en la isla {{{2

defproc island_special_events

  loc injured%,dubloons%

  sel on rnd(1 to 11)

    =1
      cr:narrate proper_name$(man_dead%)&" se hunde en arenas movedizas."
    =2
      cr:narrate proper_name$(man_dead%)&" se hunde en un pantano."
    =3
      let injured%=man_injured%
      cr:narrate "A "&proper_name$(injured%)&" le muerde una araña y resulta "&condition$(injured%)&"."
    =4
      let injured%=man_injured%
      cr:narrate "Un escorpión le pica a "&injured$(injured%)
    =5
      cr:narrate "La tripulación está hambrienta."
      let morale%=morale%-1
    =6
      cr:narrate "La tripulación está sedienta."
      let morale%=morale%-1
    =7
      let dubloons%=rnd(2 to 3)
      cr:narrate "Encuentras "&coins$(dubloons%)&"."
      let cash%=cash%+dubloons%
    =8 to 11
      sel on rnd(1 to 3)
        =1:cr:sailor_says "Sin novedad, capitán"
        =2:cr:sailor_says "La zona está despejada, capitán"
        =3:cr:narrate "Todo parece en calma."
      endsel

  endsel

enddef

' ----------------------------------------------
' Eventos en el mar {{{2

defproc storm

  ' Tormenta.

  ' XXX TODO -- Finish.

  let damage%=damage%+rnd(5 to 20)
  let damage%=minimum%(100,damage%)
  page
  narrate "Una tormenta causa destrozos en el bote. El daño total es del "&damage%&" por ciento."

  end_of_scene

enddef

' ----------------------------------------------
' Gestores de eventos {{{2

defproc sea_events

  ' Gestor de eventos en el mar

    if not rnd(15):storm ' ¿Tormenta?

enddef

defproc island_events

  ' Gestor de eventos en tierra

enddef

defproc events

  ' Gestor de eventos

  if aboard%:sea_events:else island_events

enddef

' ==============================================================
' Elegir tripulantes {{{1

deffn alive_man%

  ' Elige al azar un marinero que no esté muerto.

  loc chosen%
  rep
    let chosen%=rnd(1 to crewmen%)
    if stamina%(chosen%):exit
  endrep
  ret chosen%

enddef

deffn man_injured%

  ' Elige al azar un marinero que ha sido herido.

  loc injured%
  let injured%=alive_man%
  let stamina%(injured%)=stamina%(injured%)-1
  let alive%=alive%-not stamina%(injured%)
  ret injured%

enddef

defproc kill_man(crewman%)

  ' Mata a un marinero.

  let stamina%(crewman%)=0
  let alive%=alive%-1

enddef

deffn man_dead%

  ' Elige al azar un marinero que ha muerto.

  ' Si no queda alguno vivo, el bucle en la función
  ' alive_man%() no terminaría; pero esto no debería pasar
  ' dado el flujo principal.

  loc dead%
  let dead%=alive_man%
  kill_man dead%
  ret dead%

enddef

' ==============================================================
' Describir el escenario en el mar {{{1

defproc sea_scenery

  ' Describe algunos detalles de cada tipo de escenario.

  page
  sel on sea_map%(sea_position%)
    =11,12,21
      cr:sailor_says "No hay tierra a la vista"
    =2 to 20
      if sea_memory%(sea_position%)
        cr:sailor_says one_of$(\
          "Juraría que ya hemos estado allí",\
          "¿De qué me suena a mí esta isla?",\
          "Esta isla me recuerda algo",\
          "Esta isla me suena")
      else
        cr:sailor_shouts "Tierra a la vista"
        cr:narrate "¡Una isla desconocida!"
      endif
    =treasure_island%
      if sea_memory%(sea_position%)
        cr:sailor_says one_of$(\
          "Ah, me muero de ganas de intentarlo otra vez",\
          "Ese tesoro no puede estar muy lejos",\
          "Pronto daremos con esos cofres llenos de doblones",\
          "La próxima vez no nos equivocaremos")
      else
        cr:sailor_shouts "Tierra a la vista"
        cr:narrate "Una isla desconocida."
      endif
  endsel

  reef_report

enddef

deffn reef_over_there%(offset%)

  ' Devuelve 1 si hay arrecifes en la posición calculada
  ' con el desplazamiento indicado a partir de la posición
  ' actual. Devuelve 0 en caso contrario.

  ret sea_map%(sea_position%+offset%)=reef%

enddef

deffn another_reef$(sea_position%,direction$)

  ' Devuelve un posible elemento de la lista de puntos
  ' cardinales hacia donde hay arrecifes a la vista, con el
  ' separador adecuado.

  ' Las variables reefs% y current_reef% son locales del
  ' procedimiento de llamada.

  loc separator$

  ' print sea_position%,direction$ ' XXX INFORMER
  if sea_map%(sea_position%)=reef%
    let current_reef%=current_reef%+1
    let separator$=\
      if$(current_reef%>1 and current_reef%<>reefs%,", ")&\
      if$(current_reef%=reefs% and reefs%>1," y ")
    ret separator$&direction$
  else
    ret ""
  endif

enddef

defproc reef_warning

  ' Imprime una advertencia de un marinero sobre
  ' la existencia de arrecifes.

  loc reefs$,current_reef%

  let reefs$=\
    another_reef$(sea_position%+sea_north_offset%,"el norte")&\
    another_reef$(sea_position%+sea_south_offset%,"el sur")&\
    another_reef$(sea_position%+sea_east_offset%,"el este")&\
    another_reef$(sea_position%+sea_west_offset%,"el oeste")
  cr:sailor_says_to_you \
    one_of$("Hay ","Veo ")&\
    if$(rnd(1),if$(reefs%=1,"un banco de ","bancos de "),"")&\
    "arrecifes hacia "&reefs$

enddef

defproc reef_check

  ' Imprime un mensaje del narrador, confirmando
  ' la existencia de arrecifes.

  cr:narrate "Tomas tu catalejo y"
  narrate one_of$(\
    "miras",\
    "oteas",\
    "echas un vistazo")&one_of$(" en"," hacia")
  narrate one_of$(\
    if$(reefs%=1,\
      "esa dirección",\
      "esas direcciones"),\
    if$(reefs%=1,\
      "la dirección indicada",\
      "las direcciones indicadas")&\
    one_of$(\
      "",\
      "por "&the_sailor_$(former_speaker%))\
    )&"."
  narrate one_of$(\
    "Esos arrecifes",\
    "Esas rocas")
  narrate one_of$(\
    "son "&one_of$("cosa seria","un serio peligro"),\
    "tienen muy mala pinta",\
    "no son desdeñables",\
    "no son poca cosa",\
    "son una amenaza")&\
    "."
  narrate speech_start$(\
    one_of$(\
      "No cabe duda de que",\
      "No cabe ninguna duda de que",\
      "No cabe duda alguna de que",\
      "Sin ninguna duda",\
      "Sin duda",\
      "A todas luces",\
      "Con toda seguridad",\
      "Ciertamente",\
      "Sin lugar a dudas"),\
    one_of$(\
      "es",\
      "sería"))
  narrate one_of$(\
    "arriesgado",\
    "peligroso",\
    "temerario",\
    "osado",\
    "de locos",\
    "una osadía",\
    "una locura",\
    "una temeridad")
  narrate one_of$(\
    "",\
    "cometer el error de",\
    "cometer la imprudencia de")
  narrate one_of$(\
    one_of$(\
      "aventurarse",\
      "adentrarse",\
      "navegar",\
      "meterse")&\
      " "&one_of$("allí","allá","por allí"),\
    one_of$(\
      "navegar hacia",\
      "poner proa hacia",\
      "dirigirse hacia",\
      "dirigirse")&\
      " "&one_of$("allí","allá"))&"."

enddef

defproc reef_report

  ' Informa de los arrecifes alrededor si los hubiere.

  loc reefs%

  let reefs%=\
    reef_over_there%(sea_north_offset%)+\
    reef_over_there%(sea_south_offset%)+\
    reef_over_there%(sea_east_offset%)+\
    reef_over_there%(sea_west_offset%)
  if reefs%:reef_warning:reef_check

enddef

' ==============================================================
' Dibujos {{{1

' Esta sección se conserva porque quizá se usará para
' sustituir los dibujos originales, que han sido eliminados,
' con descripciones textuales.

' Islas

defproc draw_big_island5
enddef

defproc draw_big_island4
enddef

defproc draw_little_island2
enddef

defproc draw_little_island1
enddef

defproc draw_big_island3
enddef

defproc draw_big_island2
enddef

defproc draw_big_island1
enddef

defproc draw_two_little_islands
enddef

defproc draw_far_islands
enddef

' El bote enemigo

defproc draw_enemy_boat
enddef

' El bote de desembarco

defproc draw_boat
enddef

' Aleta de tiburón

defproc draw_shark
enddef

' Dibujar la isla del tesoro

defproc draw_treasure_island
enddef

' Cambiar el dibujo del bote

defproc redraw_boat
enddef

' Cielo de tormenta, las nubes y el sol

defproc stormy_sky
enddef

' Olas

defproc sea_waves
enddef

' Mar y cielo

defproc sea_and_sky
enddef

' Cielo despejado, las nubes y el sol

defproc sunny_sky
enddef

' El cielo, las nubes y el sol

defproc sun_and_clouds(sunny)
enddef

' Dibujar olas en el horizonte

defproc draw_horizont_waves
  tell "Hacia el norte está el mar."
enddef

' Dibujar olas en primer plano

defproc draw_bottom_waves
  tell "Hacia el sur está la playa."
enddef

' Dibujar olas a la izquierda

defproc draw_left_waves
enddef

' Dibujar olas a la derecha

defproc draw_right_waves
enddef

' Dibujar poblado

defproc draw_village
enddef

' Dibujar nativo

defproc draw_native
enddef

' Dibujar municiones

defproc draw_ammo
enddef

' Dibujar provisiones

defproc draw_supplies
enddef

' Dibujar serpiente

defproc draw_snake
enddef

' Dibujar doblones

defproc draw_dubloons(coins)
enddef

' Dibujar olas en el horizonte

defproc draw_horizont_waves
  tell "Hacia el norte está el mar."
enddef

' Dibujar olas en primer plano

defproc draw_bottom_waves
  tell "Hacia el sur está la playa."
enddef

' Dibujar olas a la izquierda

defproc draw_left_waves
enddef

' Dibujar olas a la derecha

defproc draw_right_waves
enddef

' Dibujar poblado

defproc draw_village
enddef

' Dibujar nativo

defproc draw_native
enddef

' Dibujar municiones

defproc draw_ammo
enddef

' Dibujar provisiones

defproc draw_supplies
enddef

' Dibujar serpiente

defproc draw_snake
enddef

' Dibujar doblones

defproc draw_dubloons(coins)
enddef

' Dibujar olas en el horizonte

defproc draw_horizont_waves
  tell "Hacia el norte está el mar."
enddef

' Dibujar olas en primer plano

defproc draw_bottom_waves
  tell "Hacia el sur está la playa."
enddef

' Dibujar olas a la izquierda

defproc draw_left_waves
enddef

' Dibujar olas a la derecha

defproc draw_right_waves
enddef

' Dibujar poblado

defproc draw_village
enddef

' Dibujar nativo

defproc draw_native
enddef

' Dibujar municiones

defproc draw_ammo
enddef

' Dibujar provisiones

defproc draw_supplies
enddef

' Dibujar serpiente

defproc draw_snake
enddef

' Dibujar olas en el horizonte

defproc draw_horizont_waves
  tell "Hacia el norte está el mar."
enddef

' Dibujar olas en primer plano

defproc draw_bottom_waves
  tell "Hacia el sur está la playa."
enddef

' Dibujar olas a la izquierda

defproc draw_left_waves
enddef

' Dibujar olas a la derecha

defproc draw_right_waves
enddef

' Dibujar poblado

defproc draw_village
enddef

' Dibujar nativo

defproc draw_native
enddef

' Dibujar municiones

defproc draw_ammo
enddef

' Dibujar provisiones

defproc draw_supplies
enddef

' Dibujar serpiente

defproc draw_snake
enddef

' ==============================================================
' Datos {{{1

' ----------------------------------------------
' Nombres de los poblados {{{2

' Son palabras compuestas en esperanto,
' de significado gracioso:
' XXX TODO -- Finish.

' defproc label_village_names_data:enddef
label @village_names_data
data "Mislongo":rem "Longitud errónea"
data "Trolonga":rem "Demasiado largo/a"
data "Figokesto":rem "Cesto de higos"
data "Misedukoto":rem "Aquel que será educado erróneamente"
data "Topikega":rem "Enormemente tópico"
data "Fibaloto":rem "Elecciones moralmente despreciables"
data "Balototago":rem "Día de elecciones"
data "Balototagacho":rem "Asqueroso día de elecciones"
data "Pomputo":rem "Pozo de manzanas"
data "Kapotombo":rem "Tumba de cabezas"
data "Ursorelo":rem "Oreja de oso"
data "Kukumemo":rem "Tendencia o gusto hacia los pepinos"
data "" ' Fin de la lista

' ----------------------------------------------
' Nombres de los estados físicos {{{2

' defproc label_stamina_data:enddef
label @stamina_data
data "muert*"
data "herid* grave"
data "herid* leve"
data "magullad*"
data "san*"

' ----------------------------------------------
' Nombres de los tripulantes {{{2

' defproc label_crew_names_data:enddef
label @crew_names_data
' XXX TODO -- Finish.

' Nombres de piratas históricos, castellanizados de cualquier manera:
data "Guillermo","Chico","",male% ' William Kidd (1645-1701)
data "Quique","Morgano","",male% ' Henry Morgan (1635-1688)
data "Eduardo","Inglaterra","",male% ' Edward England (1695-1720)
data "Bartolomé","Robertos","",male% ' Bartholomew Roberts (1682-1722)
data "Eduardo","Enseña","Barbanegra",male% ' Edward Teach (1680-1718)
data "Paco","Dragón","",male% ' Francis Drake (1540-1596)
data "Francisco","Loloné","",male% ' François L'Olonnais (1635-1667)
' data "Jacobo Calico" ' Jack Rackham, 'Calico' (por el tejido de calicó que gustaba vestir) (16??-1720)
data "Ana","Linda","",female% ' Anne Bonny (1700-?)
data "María","Lee","",female% ' Mary Read (1684-1721)
data "Gracia","Omali","",female% ' Grace O'Malley (1530-1603)
data "","","La china",female% ' Cheng I Sao / Ching Shih (1785-1844)
' data "Artemisa","","",female% ' Artemisa de Halicarnaso (siglo V a.C.)

' Nombres de piratas de ficción:
data "Jacobo","Gorrión","",male% ' Jack Sparrow, Piratas del caribe
data "Juan","Plata","El largo",male% ' John 'Long' Silver, La isla del tesoro
data "","","Perro Negro",male% ' La isla del tesoro
data "Benito","Pistola","",male% ' Ben Gunn, La isla del tesoro
data "","","Garfio",male% ' Peter Pan
data "","","Garrapata",male% ' Cuentos infantiles
' data "","","El Rojo",Rackham el Rojo ' de Tintín

' Nombres de personajes de Gomaespuma:
data "Ricardo","Borriquero","",male%
data "Pedro","Medario","",male%

' Nombres inventados, a lo Gomaespuma:
data "Felipe","Llejoseco","",male%
data "Vicente","Rador","",male%

' Otros, inventados:
data "Jerónimo","","el Tuerto",male%
data "Bonifacio","","Caracortada",male%

data "" ' Fin de la lista

' ----------------------------------------------
' Números en letra {{{2

' defproc label_numbers_data:enddef
label @numbers_data
data "cero","un","dos","tres","cuatro","cinco","seis","siete","ocho","nueve","diez","once","doce","trece","catorce","quince","dieciséis","diecisiete","dieciocho","diecinueve","veinte"
data "" ' Fin de la lista

' ==============================================================
' Preparativos antes de la primera partida {{{1

defproc init_the_numbers

  ' Prepara la matriz de números en letra.

  loc z%,z$,lenght%

  ' max_number% guardará el número máximo del que se
  ' dispondrá de versión en letra; se inicia a -1 para que
  ' su valor definitivo coincida con el del último número
  ' disponible y al mismo tiempo sirva como índice para
  ' dimensionar la matriz:
  let max_number%=-1

  ' restore label%("numbers_data")
  restore @numbers_data
  rep
    read z$
    if not len(z$):exit
    let max_number%=max_number%+1
    if len(z$)>length%:let length%=len(z$)
  endrep

  dim number$(max_number%,length%)
  ' restore label%("numbers_data")
  restore @numbers_data
  for z%=0 to max_number%:read number$(z%)

enddef

defproc init_the_constants

  ' Crea las constantes (variables usadas como tales pues
  ' no cambian de valor durante la ejecución del programa).

  ' Caracteres de control en el juego original de QL:
  let right_chr%=200
  let left_chr%=192
  let up_chr%=208
  let down_chr%=216

  ' Caracteres imprimibles del juego original de QL:
  let right_arrow$=chr$(189)
  let left_arrow$=chr$(188)
  let up_arrow$=chr$(190)
  let down_arrow$=chr$(191)

  ' Comillas castellanas:
  let left_quote$="«"
  let right_quote$="»"

  ' Pixeles de indentación de la primera línea de párrafo:
  let indentation%=2*char_w(#tw%) ' Ancho de dos caracteres

  ' Indicadores de género gramatical y sexo:
  let male%=false:let masculine%=male%
  let female%=true:let feminine%=female%

  ' Indicadores para la entrada de comandos:
  let no_option%=-1
  let no_offer%=no_option%

  ' Indicadores para las islas visitadas:
  let visited%=1
  let unsuccessful_trade%=2
  let successful_trade%=3

  ' Nombres:
  let island_name$="del Coco" ' La isla
  let boat_name$="Hispaniolo" ' La embarcación
  let boat_gender%=masculine% ' Género gramatical del nombre de la embarcación

  ' Identificador de zonas en el mapa del mar:
  let reef%=1
  let first_island_type%=2
  let last_island_type%=21
  let treasure_island%=last_island_type%+1

  ' Identificadores de zonas en los mapas de las islas:
  let coast%=1
  let dubloons_found%=2
  let native_fights%=3
  let already_visited%=4
  let snake%=5
  let nothing_happens%=6
  let native_supplies%=7
  let native_ammo%=8
  let native_village%=9

  ' Valores de la trama:
  let clues%=5 ' Pistas del tesoro
  let crewmen%=10 ' Miembros de la tripulación, sin incluiar al capitán
  let max_stamina%=4 ' Valor máximo del estado físico de cada miembro de la tripulación
  let max_morale%=10 ' Valor máximo de la moral de la tripulación
  ' let villages%=9 ' XXX OLD

  ' Matriz de números en letra:
  init_the_numbers

  ' Ã<8d>ndice del capitán en la matriz de tripulación:
  let captain%=0

enddef

defproc init_once

  ' Preparativos antes de la primera partida.

  instr_case 1
  init_the_constants
  init_the_keyboard
  init_the_screen
  init_the_windows

enddef

' ==============================================================
' Preparativos antes de empezar cada partida {{{1

' ----------------------------------------------
' Mapa del mar {{{2

defproc new_sea_map

  ' Crea el mapa del mar.

  loc location%,minimun_locations%

  let minimum_locations%=128
  rep
    let sea_rows%=rnd(8 to 14) ' Filas.
    let sea_columns%=rnd(8 to 32) ' Columnas.
    let sea_locations%=sea_rows%*sea_columns%
    if sea_locations%>=minimum_locations%:exit
  endrep

  let sea_first_row%=0
  let sea_first_column%=0
  let sea_last_row%=sea_rows%-1
  let sea_last_column%=sea_columns%-1
  let sea_north_offset%=-sea_columns%
  let sea_south_offset%=sea_columns%
  let sea_east_offset%=1
  let sea_west_offset%=-1
  let sea_last_location%=sea_locations%-1

  dim sea_map%(sea_last_location%)
  dim sea_memory%(sea_last_location%)

  ' Rodear el mar con arrecifes:
' XXX OLD --
'  for z%=\
'    1 to sea_columns%+1,\ ' Norte
'    (sea_rows%-1)*sea_columns% to sea_locations%,\ ' Sur
'    sea_columns%*2 to sea_locations%-island_columns%*2 step sea_columns%,\ ' Este
'    sea_columns%*2+1 to sea_locations%-sea_columns%*2+1 step sea_columns%:\ ' Oeste
'    let sea_map%(z%)=reef%
  map_border sea_map%,sea_columns%,sea_rows%,reef%

  ' Poner un tipo de isla al azar en cada casilla:
  ' XXX TODO -- Cambiar el método de raíz.
  for location%=sea_columns%+1 to sea_locations%-sea_last_column%:\
    if sea_map%(location%)<>reef%:\
      let sea_map%(location%)=rnd(first_island_type% to last_island_type%)

  ' Elegir el lugar de la isla del tesoro:
  rep
    let location%=rnd(sea_columns%+1 to sea_locations%-sea_last_column%)
    if sea_map%(location%)<>reef%:\
      let sea_map%(location%)=treasure_island%:\
      exit
  endrep

  ' Elegir la posición del bote:
  rep
    let location%=rnd(sea_columns%+1 to sea_locations%-sea_last_column%)
    sel on sea_map%(location%)
      =reef%:next
      =treasure_island%:next
      =first_island_type% to last_island_type%:next
      =remainder:let sea_position%=location%:exit
    endsel
  endrep

enddef

' ----------------------------------------------
' Tripulación {{{2

defproc init_the_crew

  ' Prepara la tripulación.

  loc crewman%,stock_names%,z%
  loc stock_name$(1),stock_surname$(1),stock_alias$(1),stock_gender%(1)
  loc a_name$,a_surname$,an_alias$,a_gender%

  ' Calcular cuántos nombres hay y cuál es la longitud
  ' máxima de cada una de sus partes:
  ' restore label%("crew_names_data")
  restore @crew_names_data
  let max_name_length%=0
  let max_surname_length%=0
  let max_alias_length%=0
  rep
    read a_name$,a_surname$,an_alias$,a_gender%
    if not len(a_name$):exit
    let stock_names%=stock_names%+1
    let max_name_length%=maximum%(max_name_length%,len(a_name$))
    let max_surname_length%=maximum%(max_surname_length%,len(a_surname$))
    let max_alias_length%=maximum%(max_alias_length%,len(an_alias$))
  endrep
  let max_whole_name_length%=\
    max_name_length%+\
    max_surname_length%+\
    max_alias_length%

  ' Matrices temporales:
  dim stock_name$(stock_names%,max_name_length%)
  dim stock_surname$(stock_names%,max_surname_length%)
  dim stock_alias$(stock_names%,max_alias_length%)
  dim stock_gender%(stock_names%)

  ' Leer todos los nombres disponibles:
  ' restore label%("crew_names_data")
  restore @crew_names_data
  for z%=0 to stock_names%-1:\
    read \
    stock_name$(z%),\
    stock_surname$(z%),\
    stock_alias$(z%),\
    stock_gender%(Z%)

  ' Matrices:
  dim name$(crewmen%,max_name_length%)
  dim surname$(crewmen%,max_surname_length%)
  dim alias$(crewmen%,max_alias_length%)
  dim gender%(crewmen%)

  ' Elegir los nombres necesarios al azar de entre todos
  ' los disponibles:
  for crewman%=1 to crewmen%
    rep
      let name%=rnd(stock_names%-1)
      if len(stock_name$(name%))
        let name$(crewman%)=stock_name$(name%)
        let surname$(crewman%)=stock_surname$(name%)
        let alias$(crewman%)=stock_alias$(name%)
        let gender%(crewman%)=stock_gender%(name%)
        let stock_name$(name%)="" ' Invalidar el nombre usado
        exit
      endif
    endrep
  endfor crewman%

  ' Indicadores de estado físico de la tripulación (0-4):
  dim stamina%(crewmen%)
  for crewman%=1 to crewmen%:\
    let stamina%(crewman%)=max_stamina%

  ' Nombres de los grados de estado físico de los miembros
  ' de la tripulación (de 0 a max_stamina%):
  dim stamina$(max_stamina%,13)
  ' restore label%("stamina_data")
  restore @stamina_data
  for z%=0 to max_stamina%:\
    read stamina$(z%)

enddef

' ----------------------------------------------
' Datos del capitán {{{2

deffn new_captain_gender%

  ' Pide y devuelve el sexo de un nuevo capitán.

  page
  narrate "¿Eres un capitán pirata o una capitana pirata?"
  cr:cr:show_option "&Capitán":show_option "Capitan&a"

  sel on char%("CcAa")
    =67,99:ret male%
    =65,97:ret female%
  endsel

enddef

deffn new_captain_name$

' XXX TODO -- Finish.

  loc name$

  rep
    page:narrate "¿Cuál es tu nombre de pila?"
    cr:cr:input #tw%,name$
    if len(name$)
      exit
    else
      page
      narrate "No has escrito nada. ¿Tienes nombre de pila?"
      if not yes%:exit
    endif
  endrep

  ret name$

enddef

deffn new_captain_surname$

' XXX TODO -- Finish.

  loc surname$

  rep
    page:narrate "¿Cuál es tu apellido?"
    cr:cr:input #tw%,surname$
    if len(surname$)
      exit
    else
      page
      narrate "No has escrito nada. ¿Tienes apellido?"
      if not yes%:exit
    endif
  endrep

  ret surname$

enddef

deffn new_captain_alias$

' XXX TODO -- Finish.

  loc alias$

  rep
    page:narrate "¿Cuál es tu alias?"
    cr:cr:input #tw%,alias$
    if len(alias$)
      exit
    else
      page
      narrate "No has escrito nada. ¿Tienes un alias?"
      if not yes%:exit
    endif
  endrep

  ret alias$

enddef

deffn captain_confirmed%

  ' Devuelve un indicador:
  ' ¿El nombre del nuevo capitán es válido?

  page
  if len(name$(captain%)&surname$(captain%)&alias$(captain%))
    narrate "¿Eres"
    narrate one_of$("","entonces","por tanto","pues")
    narrate the_captain_whole_name$&"?"
    ret yes%
  else
    narrate "No"
    narrate one_of$("es posible","puede ser")
    narrate "que"
    narrate one_of$(\
      "no tengas ningún nombre",\
      "sepas cómo te llamas",\
      "no te llames de alguna manera",\
      "no tengas nombre, ni apellido ni alias")&"."
    end_of_scene
    ret false
  endif

enddef

defproc new_captain

  ' Pide los datos de un nuevo capitán.

  rep

    let gender%(captain%)=\
      new_captain_gender%
    let name$(captain%)=\
      clean_name_part$(new_captain_name$)
    let surname$(captain%)=\
      clean_name_part$(new_captain_surname$)
    let alias$(captain%)=\
      clean_name_part$(new_captain_alias$)

    if captain_confirmed%
      let max_whole_name_length%=\
        maximum%(\
          max_whole_name_length%,\
          len(name$(captain%))+\
          len(surname$(captain%))+\
          len(alias$(captain%))\
        )
      exit
    endif

  endrep

enddef

defproc save_the_captain_data

  ' Guarda los datos del capitán para la siguiente partida.

  let former_captain_name$=name$(captain%)
  let former_captain_surname$=surname$(captain%)
  let former_captain_alias$=alias$(captain%)
  let former_captain_gender%=gender%(captain%)

enddef

defproc restore_the_captain_data

  ' Recupera los datos del capitán usados en la partida
  ' previa.

  let name$(captain%)=former_captain_name$
  let surname$(captain%)=former_captain_surname$
  let alias$(captain%)=former_captain_alias$
  let gender%(captain%)=former_captain_gender%

enddef

defproc init_the_captain

  ' Pide los datos del capitán, si no existen ya o si el
  ' jugador quiere cambiarlos.

  ' XXX TMP -- Provisional para no perder tiempo durante las pruebas.
  let former_captain_name$="Mortadelo"

  ' XXX TODO -- Finish.
  if len(former_captain_name$)
    restore_the_captain_data
    if rnd(1) ' Primera variante de la pregunta
      narrate "¿"&one_of$(\
        "Quieres",\
        "Te apetece")
      narrate one_of$(\
        "seguir siendo",\
        "ser "&again$,\
        "volver a ser")
    else ' Segunda variante de la pregunta
      narrate "¿"&one_of$(\
        "Vas a ser",\
        "Eres",\
        "Serás")&" "&again$
    endif
    narrate the_captain_whole_name$&"?"
    if not yes%:new_captain
  else
    new_captain
  endif

enddef

' ----------------------------------------------
' Pistas {{{2

defproc init_the_clues

  ' Inicializa las pistas.

  loc z%,z$,length%

  ' Pistas:
  dim got_clue%(clues%-1)
  let path_clue%=rnd(1 to 4)
  let tree_clue%=rnd(1 to 4)
  ' let village_clue=rnd(villages%-1)
  let hand_clue%=rnd(1)
  let direction_clue%=rnd(3)
  let pace_clue%=rnd(1 to 9)

  ' Puntos cardinales para las pistas: 
  dim cardinal_point$(3,5)
  let cardinal_point$(0)="norte"
  let cardinal_point$(1)="sur"
  let cardinal_point$(2)="este"
  let cardinal_point$(3)="oeste"

  ' Izquierda y derecha para las pistas:
  dim hand$(1,9)
  let hand$(0)="izquierda"
  let hand$(1)="derecha"

  ' Nombres de los poblados:

' XXX OLD
'  restore label%("village_names_data")
'  let length%=0
'  for z%=1 to villages%:\
'    read z$:\
'    if len(z$)>length%:let length%=len(z$)
'  restore label%("village_names_data")
'  dim village$(villages%-1,9)
'  for z%=0 to villages%-1:read village$(z%)

enddef

' ----------------------------------------------
' Variables {{{2

defproc init_the_plot_variables

  ' Prepara las variables de la trama.

  let aboard%=true ' Indicador: ¿Estamos a bordo?
  let alive%=crewmen% ' Contador de miembros de la tripulación que siguen con vida.
  let ammo%=2 ' Contador de municiones.
  let cash%=5 ' Contador de doblones.
  let damage%=0 ' Porcentaje de daño del bote.
  let days%=0 ' Contador de días.
  let right_clues%=0 ' Contador de pistas acertadas.
  let morale%=max_morale% ' Contador de moral de la tripulación.
  let sunk%=0 ' Contador de botes enemigos hundidos.
  let supplies%=10 ' Contador de provisiones.
  let tradings%=0 ' Contador de negociaciones exitosas.
  let abandon%=false ' Indicador: ¿Queremos dejar el juego?

enddef

' ----------------------------------------------
' Principal {{{2

defproc init_the_game

  ' Preparación antes de cada partida.

  randomise
  new_sea_map ' Mapa
  init_the_crew ' Tripulación
  init_the_clues ' Pistas
  init_the_plot_variables ' Trama

  ' Otras variables:
  let just_indented%=false ' Indicador: ¿Se acaba de hacer un indentado para un párrafo nuevo?

  init_the_captain

enddef

' ==============================================================
' En la isla del tesoro {{{1

defproc treasure_not_found

  ' XXX TODO -- Finish.

  sailor_says_to_you "nos hemos equivocado"

enddef

defproc treasure_found

  ' XXX TODO -- Finish.

  sailor_shouts_to_you "hemos encontrado el oro"
  sailor_shouts_to_you "somos ricos"

enddef

defproc enter_treasure_island

  let right_clues%=0

  page
  narrate "De la playa parten cuatro caminos."
  sailor_asks_you "qué camino tomamos"
  let option%=digit%(1,4)
  if option%=no_option%
    ' XXX TODO -- implementar esto en los demás casos
    sailor_says_to_you "no podemos esperar más"
    let option%=rnd(1 to 4)
    ' XXX TODO -- Finish. Generalizar este procedimiento y hacerlo variable según el número de marineros.
    sailor_says "Propongo tomar el camino número "&_with_letters$(option%)
    short_pause
  else
    captain_says "Tomemos el camino número "&_with_letters$(option%)
  endif
  let right_clues%=right_clues%+(option%=path_clue%)

  page
  narrate "Hay cuatro árboles  a lo largo del camino."
  sailor_asks_you "en qué árbol giramos"
  let option%=digit%(1,4)
  captain_says "Giremos en el árbol número "&_with_letters$(option%)
  let right_clues%=right_clues%+(option%=tree_clue%)

  sailor_asks_you "hacia dónde giramos"
  cr:cr:show_option "&Izquierda"
  show_option "&Derecha"
  let option%= chr$(iso_upper%(char%("IiDd"))) instr "ID"-1
  captain_says "Giremos hacia la "&hand$(option%)
  let right_clues%=right_clues%+(option%=hand_clue%)

' XXX OLD
'  narrate "El camino conduce a "&with_letters$(villages%)&" poblados [XXX falta lista]."
'  sailor_says "¿Qué poblado debemos atravesar, capitán?"
'  let option%=digit%(1,villages%)
'  captain_says "Vayamos por "&village$(option%)
'  let right_clues%=right_clues%+(option%=village_clue)

  page
  sailor_asks_you "qué dirección debemos seguir"
  cr:cr:show_option "&Norte"
  show_option "&Sur"
  show_option "&Este"
  show_option "&Oeste"
  let option%=chr$(iso_upper%(char%("NnSsEeOo"))) instr "NSEO"-1
  captain_says "Vayamos hacia el "&cardinal_point$(option%)&"."
  let right_clues%=right_clues%+(option%=direction_clue%)

  page
  sailor_says "cuántos pasos tenemos que contar"
  let option%=digit%(1,9)
  captain_says "Demos "&with_letters$(option%)&" pasos."
  let right_clues%=right_clues%+(option%=pace_clue%)

  if right_clues%=clues%
    treasure_found
  else
    treasure_not_found
  endif
  do_pause 100

enddef

' ==============================================================
' Fin del juego {{{1

defproc the_end

  ' Final.

  if success%:happy_end:else sad_end
  narrate "Pulsa una tecla para ver tus puntos"
  end_of_scene
  score_report
  save_the_captain_data

enddef

deffn play_again%

  ' Confirma una nueva partida.

  cr:cr
  if success%
    narrate one_of$(\
      "¿Quieres",\
      "¿Te apetece")
    narrate one_of$(\
      "buscar otro tesoro?",\
      "repetir tu hazaña?")
  else
    narrate one_of$(\
    "Puede que",\
    "Posiblemente",\
    "Tal vez",\
    "Quizá")
    narrate one_of$(\
      "en la próxima ocasión",\
      "en una nueva expedición",\
      "con otra tripulación",\
      "en un nuevo viaje")
    narrate one_of$(\
      "lo "&one_of$("logres","consigas"),\
      "la "&good_luck$&" te acompañe",\
      "tengas mejor "&good_luck$)
    narrate one_of$(\
      "¿Quieres",\
      "¿Te quedan fuerzas para",\
      "¿Te queda "&\
        one_of$("valor","coraje","energía")&\
        " para",\
      "¿Te animas a",\
      "¿Te apetece")
    narrate one_of$("intentarlo","probar")&again$&"?"
  endif

  ret yes%

enddef

' Final fallido

defproc sad_end

  ' XXX TODO -- Finish. Hacer lista bonita con separadores
  ' calculados automáticamente y una explicación detallada
  ' de cada caso.

  page
  narrate "Tu aventura ha tenido un final triste:"
  if not alive%:\
    narrate "Toda tu tripulación ha muerto."
  if supplies%<=0:\
    narrate "las provisiones se han agotado"
  if morale%<=0:\
    narrate "la tripulación se ha amotinado"
  if ammo%<=0:\
    narrate "La munición se ha terminado."
  if damage%=100:\
    narrate "El bote está muy dañado y es imposible repararlo."
  if cash%<=0:\
    narrate "No te queda dinero."

enddef

' Final exitoso

defproc happy_end

  ' XXX TODO -- Finish.

  page
  sailor_shouts_to_you "lo logramos"

enddef

' Puntuación final

deffn score
  ret days%+sunk%+tradings%+right_clues%+cash%
enddef

defproc score_report

  loc field_width%
  let field_width%=4

  title "Resultado de la expedición"
  cr:narrate_dots_to "Días que has sobrevivido",20
  narrate field$(days%,field_width%)
  cr:narrate_dots_to "Negocios completados con éxito",20
  narrate field$(tradings%,field_width%)
  cr:narrate_dots_to "Pistas seguidas correctamente",20
  narrate field$(right_clues%,field_width%)
  cr:narrate_dots_to "Doblones conseguidos",20
  narrate field$(cash%,field_width%)
  cr:narrate_dots_to "Puntuación total",20
  narrate field$(score,field_width%)

enddef

' ==============================================================
' Presentación e introducción {{{1

defproc about

  page
  pen light_red%
  indent:tell "La isla del Coco"
  csize #tw%,minimum%(csize_w%-1),csize_h%
  cr:tell "Versión "&version$
  pen dark_cyan%
  ' csize #tw%,minimum%(csize_w%-1),csize_h%
  cr:cr:tell "Copyright (C) 2011 Marcos Cruz (programandala.net)"
  cr:tell "Inspirado en «Jolly Roger» para ZX Spectrum"
  cr:tell "Copyright (C) 1984 Barry Jones / Video Vault ltd."
  csize #tw%,csize_w%,csize_h%

  pen light_grey%
  cr:cr:tell "http:/"&"/www.caad.es/"
  cr:tell "http:/"&"/www.sinclairql.es/"

enddef

defproc intro

  ' XXX TMP --

  page
  narrate "Eres "&the_captain_whole_name$&". Tu bote pirata se llama "&boat_name$&"."
  cr:narrate "Un viejo marinero te ha contado que existe una isla llamada "&island_name$&", que esconde un fabuloso tesoro. Pero por desgracia nadie sabe dónde está exactamente y hay muchas islas en esa zona."
  cr:narrate "Los nativos de las islas vecinas conocen pistas para llegar al tesoro. Deberás comerciar con ellos para que te las digan."
  cr:narrate "Cuando encuentres la isla "&island_name$&", sigue las pistas. Pero ten cuidado..."

enddef

' ==============================================================
' Principal {{{1

deffn failure%

  ' Devuelve un indicador:
  ' ¿Se ha fracasado en la misión?

  ret \
  not alive% \
  or morale%<=0 \
  or damage%>=100 \
  or supplies%<=0
  ' or cash%<=0

enddef

deffn success%

  ' Devuelve un indicador:
  ' ¿Se ha cumplido con éxito la misión?

  ' XXX TODO -- Finish.
  ret right_clues%=clues%

enddef

deffn game_over%

  ' Devuelve un indicador:
  ' ¿Se ha terminado el juego?

  ret failure% or success% or abandon%

enddef

defproc game

  ' Bucle de cada partida.

  rep
    panel
    command
    events
     if game_over%:exit
  endrep

enddef

defproc main_loop

  ' Bucle principal.

  rep
    about:end_of_scene
    init_the_game
    intro:end_of_scene
    sea_scenery
    game
    the_end
    if not play_again%:exit
  endrep

enddef

defproc main

  ' Arranque del programa.

  init_once
  main_loop

enddef

main

' vim: filetype=sbim

Páginas relacionadas

Historial de desarrollo de La isla del Coco [para QL]
Historial de desarrollo del proyecto de juego de simulación y aventura La isla del Coco, escrito para QL en SBASIC (con formato SBim).