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$(""ed$(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