diff --git a/ASCII_API.md b/ASCII_API.md new file mode 100644 index 0000000..a85cd27 --- /dev/null +++ b/ASCII_API.md @@ -0,0 +1,271 @@ +# ASCII — Referencia del intérprete Lua + +Documento extraído del código fuente en `c:/mingw/gitea/ascii/` (principalmente `ascii.cpp`, `lua.cpp`, `play.cpp`, `ascii.h`). Sirve como guía para portar Pepe Runner desde Turbo Pascal a Lua. + +> Versión analizada del intérprete: v0.6.1 aprox (según el mensaje del boot ROM en `lua.cpp`). + +--- + +## 1. Modelo de ejecución + +Cada juego/programa es **un solo fichero `.lua`** que define dos funciones globales: + +```lua +function init() + -- se llama una sola vez al arrancar +end + +function update() + -- se llama cada frame (~60 FPS, vsync) +end +``` + +- El intérprete se invoca como `ascii.exe nombre_juego.lua`. Si no se pasa argumento, intenta cargar `game.lua`. +- También se puede **arrastrar y soltar** un `.lua` sobre la ventana para cargarlo. +- **F5** reinicia el juego (re-llama a `init()` y vuelve a empezar el bucle). +- **ESC** pausa la ejecución y abre una consola de depuración (`> ` prompt). Los comandos `run` y `cont` la cierran. Comandos prefijados con `?` evalúan e imprimen (ej.: `?1+1`). +- Se usa la versión estándar de Lua que está vendorizada en `ascii/lua/` (con `luaL_openlibs`), así que están disponibles `string`, `math`, `table`, etc. + +--- + +## 2. Modos de pantalla — `mode(n)` + +| Modo | Resolución carácter | Resolución pixel | Notas | +|------|--------------------:|-----------------:|-------| +| 0 | 80 × 30 | 640 × 240 | Color único global (no por-carácter) — usado para depuración / texto. `current_color` aplica a toda la pantalla. | +| 1 | 40 × 30 | 320 × 240 | **Modo por defecto.** Color por carácter. | +| 2 | 20 × 15 | 160 × 120 | Mitad de resolución. Cómodo para tiles grandes (ej.: sokoban). | +| 3 | 32 × 24 | 256 × 192 | Estilo "ZX Spectrum" (con bordes anchos). | + +Cada carácter es **8×8 píxeles**. Los gráficos son texto coloreado, no píxeles libres — el "lienzo" es una matriz de celdas (carácter + atributo de color). + +--- + +## 3. Paleta de colores (16, CGA/EGA) + +Constantes Lua predefinidas (`lua.cpp` líneas 610-625): + +| Código | Constante | Aprox. | +|-------:|------------------------|---------------| +| 0 | `COLOR_BLACK` | #000000 | +| 1 | `COLOR_BLUE` | #0000AA | +| 2 | `COLOR_GREEN` | #00AA00 | +| 3 | `COLOR_CYAN` | #00AAAA | +| 4 | `COLOR_RED` | #AA0000 | +| 5 | `COLOR_MAGENTA` | #AA00AA | +| 6 | `COLOR_BROWN` | #AA5500 | +| 7 | `COLOR_LIGHT_GRAY` | #AAAAAA | +| 8 | `COLOR_DARK_GRAY` | #555555 | +| 9 | `COLOR_LIGHT_BLUE` | #5555FF | +| 10 | `COLOR_LIGHT_GREEN` | #55FF55 | +| 11 | `COLOR_LIGHT_CYAN` | #55FFFF | +| 12 | `COLOR_LIGHT_RED` | #FF5555 | +| 13 | `COLOR_LIGHT_MAGENTA` | #FF55FF | +| 14 | `COLOR_YELLOW` | #FFFF55 | +| 15 | `COLOR_WHITE` | #FFFFFF | + +El atributo de color de una celda es 1 byte: nibble bajo = INK (tinta), nibble alto = PAPER (fondo). + +--- + +## 4. API — Funciones expuestas a Lua + +### Pantalla y color + +| Función | Descripción | +|---------|-------------| +| `mode(n)` | Cambia modo de pantalla (0-3) y hace cls. | +| `cls([chr=32])` | Limpia con el carácter dado (32 = espacio). En modo ≠0 además rellena el color attr. | +| `ink(c)` | Color de tinta (0-15). | +| `paper(c)` | Color de fondo (0-15). | +| `border(c)` | Color del borde de la ventana. | +| `color(ink, paper, [border])` | Combina los tres. | +| `locate(x, y)` | Posiciona cursor en celda (x, y). | +| `print(str, [x, y])` | Imprime `str` (sin salto de línea). Si se dan x,y, primero hace `locate`. | +| `crlf()` | CR + LF (mueve cursor a inicio de siguiente línea). | + +### Entrada + +| Función | Descripción | +|---------|-------------| +| `btn(k)` | `true` si la tecla `k` está pulsada *en este frame* (estado SDL_GetKeyboardState). | +| `btnp(k)` | `true` solo en el frame en que la tecla se pulsa (edge). | +| `mousex()` / `mousey()` | Posición del ratón en **coordenadas de carácter** (ya escalado al modo). | +| `mousewheel()` | Delta de la rueda en este frame. | +| `mousebutton(i)` | `true` si el botón `i` está pulsado (1=izq, 2=medio, 3=der; usa `SDL_BUTTON(i)`). | + +Códigos de tecla — todos definidos como globales `KEY_*` en Lua. Lista completa (de `lua.cpp` 502-608): + +``` +KEY_A..KEY_Z = 4..29 +KEY_1..KEY_0 = 30..39 (1=30, 2=31, ..., 9=38, 0=39) +KEY_RETURN=40 KEY_ESCAPE=41 KEY_BACKSPACE=42 KEY_TAB=43 KEY_SPACE=44 +KEY_MINUS=45 KEY_EQUALS=46 KEY_LEFTBRACKET=47 KEY_RIGHTBRACKET=48 +KEY_BACKSLASH=49 KEY_NONUSHASH=50 KEY_SEMICOLON=51 KEY_APOSTROPHE=52 +KEY_GRAVE=53 KEY_COMMA=54 KEY_PERIOD=55 KEY_SLASH=56 KEY_CAPSLOCK=57 +KEY_F1..KEY_F12 = 58..69 +KEY_PRINTSCREEN=70 KEY_SCROLLLOCK=71 KEY_PAUSE=72 +KEY_INSERT=73 KEY_HOME=74 KEY_PAGEUP=75 KEY_DELETE=76 KEY_END=77 KEY_PAGEDOWN=78 +KEY_RIGHT=79 KEY_LEFT=80 KEY_DOWN=81 KEY_UP=82 +KEY_NUMLOCKCLEAR=83 KEY_KP_DIVIDE=84 KEY_KP_MULTIPLY=85 KEY_KP_MINUS=86 KEY_KP_PLUS=87 KEY_KP_ENTER=88 +KEY_KP_1..KEY_KP_0 = 89..98 KEY_KP_PERIOD=99 +KEY_NONUSBACKSLASH=100 KEY_APPLICATION=101 +KEY_LCTRL=224 KEY_LSHIFT=225 KEY_LALT=226 KEY_LGUI=227 +KEY_RCTRL=228 KEY_RSHIFT=229 KEY_RALT=230 KEY_RGUI=231 +``` + +(Son los SDL2 scancodes.) + +### Matemáticas + +`abs(x)`, `ceil(x)`, `flr(x)`, `sgn(x)`, `sin(x)`, `cos(x)`, `atan2(dx, dy)`, `sqrt(x)`, `max(a,b)`, `min(a,b)`, `mid(a,b,c)` (devuelve el del medio, equivalente a `clamp`). + +`rnd(n)` devuelve un entero en `[0, n-1]` (`rand()%n`). `srand(seed)` siembra el RNG. + +### Strings + +| Función | Descripción | +|---------|-------------| +| `tostr(v)` | Convierte valor a string. Soporta nil, function, table (formato `{k=v,...}`), number, boolean, string. | +| `strlen(s)` | Longitud en bytes. | +| `ascii(s, i)` | Código del byte en índice `i` (0-based). | +| `chr(n)` | String de un solo carácter cuyo código es `n`. | +| `substr(s, start, length)` | Subcadena. | + +> Nota: Lua estándar también está disponible, así que `string.format`, `string.sub`, etc., funcionan. Pero los demos usan estas helpers. + +### Memoria + +| Función | Descripción | +|---------|-------------| +| `peek(addr)` | Lee 1 byte de la VRAM/memoria (0..0x1FFF). | +| `poke(addr, val)` | Escribe 1 byte. | +| `memcpy(dst, src, size)` | Copia bytes en la memoria del fantasy console. | +| `setchar(idx, b0..b7)` | Define los 8 bytes del carácter `idx` en el char-ROM (sobrescribe la fuente). | + +**Mapa de memoria** (8 KB total, `mem[8192]`): + +- `0x0000` (0): char_screen (matriz de códigos de carácter por celda) +- Tras char_screen viene color_screen (offset = `screen_width * screen_height`) +- `0x0A00` (2560 = `MEM_CHAR_OFFSET`): char-ROM (definición de glifos, 8 bytes por carácter, 256 chars = 2048 bytes) +- `0x1200` (4608 = `MEM_BOOT_OFFSET`): zona de boot/recursos de ROM + +Para los modos 1 y 2 los color_screen offsets son 1200 y 300 respectivamente; en modo 3 es 768; en modo 0 no hay color_screen por celda (color global). + +### Audio + +**Sonido simple:** +- `sound(freq, len)` — onda cuadrada a `freq` Hz durante `len` (en algo similar a centésimas de segundo; `audio_len = len*44.1`). +- `nosound()` — silencio inmediato. + +**Mini-lenguaje MML — `play(str)`:** + +Sintaxis tipo BASIC `PLAY` / MML. Tokens (case-sensitive, minúsculas): + +| Token | Significado | +|-------|-------------| +| `c d e f g a b` | Nota. Acepta sufijo `#` o `+` (sostenido) o `-` (bemol). Luego dígito 0-9 para duración. | +| `r` | Silencio. Acepta dígito de duración. | +| `o<0-7>` | Octava absoluta. | +| `>` `<` | Sube / baja octava. | +| `l<0-9>` | Longitud por defecto para notas sin duración. | +| `v<0-9>` | Volumen (se traduce a `(d-0)<<4`). | +| `t<0-9>` | Tempo. | + +Duraciones: índice 0-9 → tabla `{313,625,938,1250,1875,2500,3750,5000,7500,10000}` (de "redonda" a "trentaidosava", aproximadamente). + +Ejemplo (de `breakout.lua`): + +```lua +play("l0o3bagfedc") -- escala descendente como sonido de game-over +play("o5l0c") -- pitido agudo (rebote) +``` + +### Ficheros y portapapeles + +| Función | Descripción | +|---------|-------------| +| `load([filename])` | Reinicia y carga otro `.lua` (o el mismo si filename=nil). | +| `fileout(name, addr, size)` | Vuelca `size` bytes de memoria a un binario. | +| `filein(name, addr, size)` | Carga un binario a memoria. | +| `toclipboard(str)` | Copia al portapapeles del SO. | +| `fromclipboard()` | Lee del portapapeles (máx 1023 chars). | + +### Utilidades de tiempo / frame + +| Función | Descripción | +|---------|-------------| +| `time()` | Milisegundos desde inicio (`SDL_GetTicks()`). | +| `cnt()` | Contador de frames desde el último `rst()`. | +| `rst()` | Resetea el contador de frames a 0. | +| `log(str)` | Imprime en la consola de debug (no en pantalla). | + +--- + +## 5. Caracteres especiales útiles + +Los demos usan códigos > 127 que corresponden a glifos definidos en `rom.c` (el char-ROM por defecto). Algunos vistos: + +- `\003` (3) — un bloque relleno (usado en pong para los compases) +- `\016` (16) — cubo de caja (en sokoban) +- `\127` (127) — pared en sokoban (redefinido con `setchar(127, ...)`) +- `\143`, `\154`, `\150`, `\156`, `\149` — esquinas y trazos de marcos +- `\248`, `\250`, `\251` — sprite animado de "OK" en sokoban +- `\233` — pelota en breakout +- `\131` — pala en breakout +- `\001` — cubo de tetromino (redefinido con `setchar(1, 0xff,0x81,...)`) + +Para usarlos siempre se puede hacer `setchar(idx, b0..b7)` con la bitmap deseada y luego imprimirlo con `print(chr(idx), x, y)`. + +--- + +## 6. Patrón típico de un juego + +```lua +function init() + mode(1) + cls() + -- estado inicial + player = {x=10, y=15} + score = 0 +end + +function update() + -- input + if btnp(KEY_LEFT) then player.x = player.x - 1 end + if btnp(KEY_RIGHT) then player.x = player.x + 1 end + + -- lógica + -- ... + + -- render (no hay vsync explícito; el bucle ya hace flip al final) + cls() + color(COLOR_WHITE, COLOR_BLACK) + print("\248", player.x, player.y) + print("SCORE: "..tostr(score), 0, 0) +end +``` + +**Cosas a recordar:** + +- No se "pintan" píxeles; se imprime un código de carácter en una celda y se le asocia un atributo de color (ink + paper). Para gráficos personalizados, redefinir glifos con `setchar`. +- El bucle de render lo hace el motor C++ después de `update()` — no hay que llamar a ningún `flip`. +- El `state machine` típico se hace asignando `update = otra_funcion` (ver `demos/sokoban.lua`). +- Las coordenadas de pantalla son **enteras y por celda**, no por píxel. (0,0) es esquina superior izquierda. +- Para depurar: `log("mensaje")` o pulsar ESC y usar la consola con `?variable`. + +--- + +## 7. Cómo compilar el intérprete + +Desde `c:/mingw/gitea/ascii/`: + +```sh +make windows +``` + +Requiere MinGW (g++) y SDL2 para Windows. Produce `ascii.exe`. Para correr Pepe Runner: + +```sh +ascii.exe pepe_runner.lua +``` diff --git a/SDL2.dll b/SDL2.dll new file mode 100644 index 0000000..1bba76f Binary files /dev/null and b/SDL2.dll differ diff --git a/ascii.exe b/ascii.exe new file mode 100644 index 0000000..ca0cbc1 Binary files /dev/null and b/ascii.exe differ diff --git a/original_turbopascal/0.MAP b/original_turbopascal/0.MAP new file mode 100644 index 0000000..a623481 Binary files /dev/null and b/original_turbopascal/0.MAP differ diff --git a/original_turbopascal/1.MAP b/original_turbopascal/1.MAP new file mode 100644 index 0000000..0f2d1b1 Binary files /dev/null and b/original_turbopascal/1.MAP differ diff --git a/original_turbopascal/10.MAP b/original_turbopascal/10.MAP new file mode 100644 index 0000000..79c1549 Binary files /dev/null and b/original_turbopascal/10.MAP differ diff --git a/original_turbopascal/2.MAP b/original_turbopascal/2.MAP new file mode 100644 index 0000000..5070d9b Binary files /dev/null and b/original_turbopascal/2.MAP differ diff --git a/original_turbopascal/3.MAP b/original_turbopascal/3.MAP new file mode 100644 index 0000000..06d5ec0 Binary files /dev/null and b/original_turbopascal/3.MAP differ diff --git a/original_turbopascal/4.MAP b/original_turbopascal/4.MAP new file mode 100644 index 0000000..3e44628 Binary files /dev/null and b/original_turbopascal/4.MAP differ diff --git a/original_turbopascal/5.MAP b/original_turbopascal/5.MAP new file mode 100644 index 0000000..8301f2c Binary files /dev/null and b/original_turbopascal/5.MAP differ diff --git a/original_turbopascal/6.MAP b/original_turbopascal/6.MAP new file mode 100644 index 0000000..b4faf58 Binary files /dev/null and b/original_turbopascal/6.MAP differ diff --git a/original_turbopascal/7.MAP b/original_turbopascal/7.MAP new file mode 100644 index 0000000..664bb39 Binary files /dev/null and b/original_turbopascal/7.MAP differ diff --git a/original_turbopascal/8.MAP b/original_turbopascal/8.MAP new file mode 100644 index 0000000..7893abc Binary files /dev/null and b/original_turbopascal/8.MAP differ diff --git a/original_turbopascal/9.MAP b/original_turbopascal/9.MAP new file mode 100644 index 0000000..b287f3c Binary files /dev/null and b/original_turbopascal/9.MAP differ diff --git a/original_turbopascal/APPEND.BAK b/original_turbopascal/APPEND.BAK new file mode 100644 index 0000000..5dea64e --- /dev/null +++ b/original_turbopascal/APPEND.BAK @@ -0,0 +1,58 @@ +uses crt; + +const + num_map = 6; + +var + fich_o1, fich_d : file of byte; + buffer : byte; + j : integer; + i : longint; + nom : string; + +begin + clrscr; + + asm { hide cursor } + mov ax,0100h + mov cx,0100h + int 10h + end; + + Write('UNINT MAPES ... '); + + Assign(fich_d,'total.map'); + Rewrite(fich_d); + + for j:=0 to num_map do + begin + GotoXY(17,1); + Write((j*100) div num_map:3, '%'); + + str(j,nom); + + nom := nom + '.map'; + + Assign(fich_o1, nom); + + Reset(fich_o1); + + for i:=1 to FileSize(fich_o1) do + begin + Read(fich_o1,buffer); + Write(fich_d,buffer); + end; + + + close(fich_o1); + + end; + + close(fich_d); + + GotoXY(1,3); + Writeln('COMPLET.'); + Writeln('(Pulsa una tecla per acabar)'); + Readkey; + +end. \ No newline at end of file diff --git a/original_turbopascal/APPEND.EXE b/original_turbopascal/APPEND.EXE new file mode 100644 index 0000000..02d540f Binary files /dev/null and b/original_turbopascal/APPEND.EXE differ diff --git a/original_turbopascal/APPEND.PAS b/original_turbopascal/APPEND.PAS new file mode 100644 index 0000000..6dee644 --- /dev/null +++ b/original_turbopascal/APPEND.PAS @@ -0,0 +1,58 @@ +uses crt; + +const + num_map = 10; + +var + fich_o1, fich_d : file of byte; + buffer : byte; + j : integer; + i : longint; + nom : string; + +begin + clrscr; + + asm { hide cursor } + mov ax,0100h + mov cx,0100h + int 10h + end; + + Write('UNINT MAPES ... '); + + Assign(fich_d,'total.map'); + Rewrite(fich_d); + + for j:=0 to num_map do + begin + GotoXY(17,1); + Write((j*100) div num_map:3, '%'); + + str(j,nom); + + nom := nom + '.map'; + + Assign(fich_o1, nom); + + Reset(fich_o1); + + for i:=1 to FileSize(fich_o1) do + begin + Read(fich_o1,buffer); + Write(fich_d,buffer); + end; + + + close(fich_o1); + + end; + + close(fich_d); + + GotoXY(1,3); + Writeln('COMPLET.'); + Writeln('(Pulsa una tecla per acabar)'); + Readkey; + +end. \ No newline at end of file diff --git a/original_turbopascal/ASCII.EXE b/original_turbopascal/ASCII.EXE new file mode 100644 index 0000000..a8f6626 Binary files /dev/null and b/original_turbopascal/ASCII.EXE differ diff --git a/original_turbopascal/ASCII.PIF b/original_turbopascal/ASCII.PIF new file mode 100644 index 0000000..b920c04 Binary files /dev/null and b/original_turbopascal/ASCII.PIF differ diff --git a/original_turbopascal/CODI.BAK b/original_turbopascal/CODI.BAK new file mode 100644 index 0000000..672da46 --- /dev/null +++ b/original_turbopascal/CODI.BAK @@ -0,0 +1,776 @@ +uses grafix, jinput, utext, tipos, crt; + +procedure FaseNova;forward; +{##############################################################} +{# O F F S E T M A P A #} +{##############################################################} +function OffsetMapa:longint; +var i:longint; + fich : file of byte; + buffer : byte; + marca : integer; + +begin + i := 0; + Assign(fich, 'runner.exe'); + Reset(fich); + marca := 0; + + repeat + Read(fich, buffer); + inc(i); + if buffer = ord('*') then + inc(marca) + else + marca := 0; + + until (marca = 10); + OffsetMapa := i; +end; +{##############################################################} +{# C A R R E G A R E C O R D S #} +{##############################################################} +procedure CarregaRecords; +var fich : file of byte; + buffer : byte; + +begin + Assign(fich, 'runner.exe'); + Reset(fich); + Seek(fich, FileSize(fich)-6); + + Read(fich, buffer); { centenes } + hi_score := buffer * 100; + Read(fich, buffer); { decenes } + hi_score := hi_score + (buffer * 10); + Read(fich, buffer); { unitats } + hi_score := hi_score + buffer; + + + Read(fich, buffer); { 1 lletra } + nom_hi_score := chr(buffer+45); + Read(fich, buffer); { 2 lletra } + nom_hi_score := nom_hi_score + chr(buffer+45); + Read(fich, buffer); { 3 lletra } + nom_hi_score := nom_hi_score + chr(buffer+45); + + Close(fich); +end; +{##############################################################} +{# G U A R D A R E C O R D S #} +{##############################################################} +procedure GuardaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'runner.exe'); + Reset(fich); + Seek(fich, FileSize(fich)-6); + + buffer := score div 100; + Write(fich, buffer); { centenes } + buffer := (score - (buffer*100)) div 10; + Write(fich, buffer); { decenes } + buffer := (score - (buffer*10)); + Write(fich, buffer); { unitats } + + buffer := ord(nom_hi_score[1])-45; + Write(fich, buffer); { 1 lletra } + buffer := ord(nom_hi_score[2])-45; + Write(fich, buffer); { 2 lletra } + buffer := ord(nom_hi_score[3])-45; + Write(fich, buffer); { 3 lletra } + + Close(fich); +end; +{##############################################################} +{# T R A G A P A N T A L L A #} +{##############################################################} +procedure TragaPantalla; +begin + for k:=0 to 23 do + begin + { desplaa cap avall } + for i:=0 to 39 do + for j:=23 downto 1 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j-1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j-1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(13,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + end; +end; +{##############################################################} +{# P O S A R N O M #} +{##############################################################} +procedure PosarNom; +var index : integer; + Key : byte; + Tecla : Pchar; +begin + nom_hi_score := '...'; + index := 1; + PutStringCENTERED(13, 15, 'Enhorabona, has'); + PutStringCENTERED(14, 15, 'aconseguit un nou record'); + PutStringCENTERED(16, 15, nom_hi_score); + repeat + if QTeclaPuls then + begin + Key := AgarrarTecla; + Tecla := nomTECLES[Key]; + nom_hi_score[index] := Tecla^; + inc(index); + PutStringCENTERED(16, 15, nom_hi_score); + repeat until not(QTeclaPuls); + end; + until (index = 4); + GuardaRecords; +end; +{##############################################################} +{# G A M E O V E R #} +{##############################################################} +procedure GameOver; +begin + pepe.vides := 0; + TragaPantalla; + cls($B800); + PutStringCENTERED(10, 15, 'G A M E O V E R'); + for i:=0 to 100 do espera_VGA; + if score > hi_score then PosarNom; + GetPaleta(paleta); + FadeDown(0,0,0,0); + cls($B800); + SetPaleta(paleta); +end; +{##############################################################} +{# F I N A L P A N T A L L A #} +{##############################################################} +procedure FinalPantalla; +begin + TragaPantalla; + FaseNova; +end; +{##############################################################} +{# M O R T #} +{##############################################################} +procedure Mort; +begin + dec(pepe.vides); + pepe.posX := 19; + pepe.posY := 23; +end; +{##############################################################} +{# M O R T M A L O #} +{##############################################################} +procedure MortMalo(num: byte); +begin + malo[num].posX := 39; + malo[num].posY := 1; + malo[num].color := 3; + malo[num].estat := caent; + malo[num].IAclock := 0; + mapa[malo[num].carrega.posX, malo[num].carrega.posY].tipo := diners; + malo[num].carrega.OK := false; + malo[num].carrega.posX := 0; + malo[num].carrega.posY := 0; +end; +{##############################################################} +{# F O R A D A R #} +{##############################################################} +procedure Foradar(posX, posY : word); +begin +{ mapa[posX, posY].tipo := buit;} + mapa[posX, posY].temps := bloc_out; +end; +{##############################################################} +{# M O U P E P E #} +{##############################################################} +procedure MouPepe; +var hi_ha_malo_baix : boolean; +begin + if TeclaPuls(KeyQ) then + begin + if mapa[pepe.posX, pepe.posY].tipo=escala then + begin + dec(pepe.posY); + end; + end + else + if TeclaPuls(KeyA) then + begin + if (mapa[pepe.posX, pepe.posY+1].tipo=escala) or (mapa[pepe.posX, pepe.posY+1].tipo=buit) then + inc(pepe.posY); + end; + + if TeclaPuls(KeyO) then + begin + if (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + dec(pepe.posX); + end + else + if TeclaPuls(KeyP) then + begin + if (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + inc(pepe.posX); + end + else + if TeclaPuls(KeySPACE) then + begin + if (mapa[pepe.posX-1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX-1, pepe.posY+1); + end + else + if TeclaPuls(KeyM) then + begin + if (mapa[pepe.posX+1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX+1, pepe.posY+1); + end; + + if TeclaPuls(KeyH) then + begin + repeat until not(TeclaPuls(KeyH)); + repeat until TeclaPuls(KeyH); + repeat until not(TeclaPuls(KeyH)); + end; + + + { si no passa res... } + pepe.estat := normal; + + { final pantalla } + if pepe.posY = 1 then FinalPantalla; + + { emparedat } + if mapa[pepe.posX, pepe.posY].tipo = pedra then + Mort; + + { agarra diners } + if mapa[pepe.posX, pepe.posY].tipo = diners then + begin + mapa[pepe.posX, pepe.posY].tipo := buit; + inc(score); + dec(diners_pantalla); + end; + + { bordes X pantalla } + if pepe.posX<0 then pepe.posX:=0; + if pepe.posX>39 then pepe.posX:=39; + + { gravetat } + if ((mapa[pepe.posX, pepe.posY+1].tipo<>escala) and (mapa[pepe.posX, pepe.posY+1].tipo<>pedra)) + and ((mapa[pepe.posX, pepe.posY].tipo=buit) or (mapa[pepe.posX, pepe.posY].tipo=diners)) then + begin + hi_ha_malo_baix := FALSE; + for i:=0 to num_malos-1 do + if (pepe.posX = malo[i].posX) and (pepe.posY+1 = malo[i].posY) then + hi_ha_malo_baix := TRUE; + + if not(hi_ha_malo_baix) then + begin + inc(pepe.posY); + pepe.estat := caent; + end; + end; + + { bordes Y pantalla } + if pepe.posY<0 then pepe.posY:=0; + if pepe.posY>24 then pepe.posY:=24; + +end; +{##############################################################} +{# S E L E C T E S T A T #} +{##############################################################} +function SelectEstat(num: byte):byte; +var nou_estat : byte; + Sestat:byte; + x:byte; + estat_pX,estat_pY:byte; + buscar:byte; +begin + nou_estat := 0; + Sestat:=0; + if mapa[malo[num].posX+1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+dreta; + + if mapa[malo[num].posX-1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+esquerra; + + if mapa[malo[num].posX, malo[num].posY].tipo = escala then + nou_estat := nou_estat + pujar; + + if mapa[malo[num].posX, malo[num].posY+1].tipo = escala then + nou_estat := nou_estat + baixar; + + if nou_estat=0 then Sestat:=10; {no pot moure's} + + if malo[num].posX>pepe.posX then estat_pX:=esquerra + else estat_pX:=dreta; + if malo[num].posY>pepe.posY then estat_pY:=pujar + else estat_pY:=baixar; + + x:=random(4); + buscar:=random(100); + if (buscar<50) and ((nou_estat and estat_PX=estat_PX) or + (nou_estat and estat_PY=estat_PY)) then + begin + if (nou_estat and estat_PX=estat_PX) then Sestat:=estat_PX + else Sestat:=estat_PY; + end + else + repeat + case x of + 0:if nou_estat and dreta =dreta then Sestat:=dreta; + 1:if nou_estat and esquerra =esquerra then Sestat:=esquerra; + 2:if nou_estat and pujar =pujar then Sestat:=pujar; + 3:if nou_estat and baixar =baixar then Sestat:=baixar; + end; + inc(x); + x:=x and $03; + until Sestat<>0; + + SelectEstat:=Sestat; + + if (mapa[malo[num].posX, malo[num].posY+1].tipo <> pedra) + and (mapa[malo[num].posX, malo[num].posY+1].tipo <> escala) then + SelectEstat:=caent; +end; +{##############################################################} +{# A G A F A R E S C A L A #} +{##############################################################} +function AgafarEscala(num:byte):byte; +var x:byte; + ag:boolean; + estat:byte; +begin + estat:=malo[num].estat; + if (estat=dreta) or (estat=esquerra) then + begin + x:=random(100); + if x<80 then ag:=True else ag:=false; + if ag then + begin + if (mapa[malo[num].posX, malo[num].posY].tipo = escala) then + estat:=pujar + else + if (mapa[malo[num].posX, malo[num].posY+1].tipo = escala) then + estat:=baixar; + end; + end; + AgafarEscala:=estat; +end; + +{##############################################################} +{# M O U M A L O S #} +{##############################################################} +procedure MouMalos; +begin + for i:=0 to num_malos-1 do + begin + if malo[i].IAclock = 0 then + malo[i].estat := SelectEstat(i); + + malo[i].estat:=AgafarEscala(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo <> pedra) and + (mapa[malo[i].posX, malo[i].posY+1].tipo <> escala)) and + (mapa[malo[i].posX, malo[i].posY].tipo <> corda) then + malo[i].estat:=caent; + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) or + (mapa[malo[i].posX, malo[i].posY+1].tipo = escala)) and + (malo[i].estat=caent) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY].tipo = buit) and + (malo[i].estat=pujar)) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) and + (malo[i].estat=baixar)) then + malo[i].estat:=SelectEstat(i); + + case malo[i].estat of + dreta : inc(malo[i].posX); + esquerra : dec(malo[i].posX); + pujar : dec(malo[i].posY); + baixar : inc(malo[i].posY); + caent : inc(malo[i].posY); + end; + + { bordes X } + if malo[i].posX<0 then + begin + malo[i].posX:=0; + malo[i].estat := dreta; + end; + if malo[i].posX>39 then + begin + malo[i].posX:=39; + malo[i].estat := esquerra; + end; + + { bordes Y } + if malo[i].posY<0 then + begin + malo[i].posY:=0; + end; + if malo[i].posY>24 then + begin + malo[i].posY:=24; + end; + + { agarrar diners } + if (mapa[malo[i].posX, malo[i].posY].tipo = diners) + and not(malo[i].carrega.OK) then + begin + mapa[malo[i].posX, malo[i].posY].tipo := buit; + malo[i].color := 11; + malo[i].carrega.OK := TRUE; + malo[i].carrega.posX := malo[i].posX; + malo[i].carrega.posY := malo[i].posY; + end; + + { emparedat } + if mapa[malo[i].posX, malo[i].posY].tipo = pedra then + MortMalo(i); + + inc(malo[i].IAclock); + if malo[i].IAclock = temps_IA then malo[i].IAclock := 0; + end; +end; +{##############################################################} +{# C A R R E G A M A P A #} +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'runner.exe'); + Reset(fich); + Seek(fich, (level * 1000)+offset_mapa); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo:=buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +{# C H E C K M O R T P E R M A L O S #} +{##############################################################} +procedure CheckMortPerMalos; +begin + for i:=0 to num_malos-1 do + if (malo[i].posX = pepe.posX) and (malo[i].posY = pepe.posY) then + Mort; +end; +{##############################################################} +{# C H E C K M A P A C O M P L E T #} +{##############################################################} +procedure CheckMapaComplet; +begin + if diners_pantalla = 0 then + for j:=1 to 23 do + begin + if mapa[0,j].tipo <> pedra then + begin + mapa[0,j].tipo := escala; + mapa[0,j].color := color_escala; + end + else + break; + end; +end; +{##############################################################} +{# C H E C K M A P A #} +{##############################################################} +procedure CheckMapa; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + case mapa[i,j].temps of + + 0 : begin + mapa[i,j].temps := -1; + mapa[i,j].tipo := pedra; + end; + + 1,bloc_out-1 : begin + mapa[i,j].tipo := bloc3; + dec(mapa[i,j].temps) + end; + + 2,bloc_out-2 : begin + mapa[i,j].tipo := bloc2; + dec(mapa[i,j].temps) + end; + + 3,bloc_out-3 : begin + mapa[i,j].tipo := bloc1; + dec(mapa[i,j].temps) + end; + + 4,bloc_out-4 : begin + mapa[i,j].tipo := buit; + dec(mapa[i,j].temps) + end; + + -1 : ; + + else dec(mapa[i,j].temps) + + end; + end; + CheckMapaComplet; +end; +{##############################################################} +{# F A S E N O V A #} +{##############################################################} +procedure FaseNova; +begin + inc(level); + if level = (num_fases + 1) then + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# I N I C I A L I T Z A C I O #} +{##############################################################} +procedure Inicialitzacio; +begin + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + pepe.vides := 3; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# T I T O L #} +{##############################################################} +procedure Titol; +begin + getpaleta(paleta); + blackout; + + PutStringCENTERED(10, 15, 'JAILDESIGNER'); + PutStringCENTERED(12, 15, 'presenta'); + + FadeUp(paleta, 1); + + for i:=0 to 100 do espera_VGA; + + Fadedown(0,0,0,0); + level := 0; + CarregaMapa; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + move(mem[pant1:0], mem[$B800:0], 2000); + + FadeUp(paleta, 0); + + for i:=0 to 100 do espera_VGA; + + for k:=0 to 2 do + begin + { desplaa cap amunt } + for i:=0 to 39 do + for j:=0 to 23 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j+1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j+1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + end; + + + +end; +{##############################################################} +{# M E N U #} +{##############################################################} +procedure Menu; +var num : integer; +begin + num := 1; + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + + repeat + + repeat until QteclaPuls; + + if (TeclaPuls(KeyArrowDown)) or (TeclaPuls(KeyA)) then + num := 2; + if (TeclaPuls(KeyArrowUp)) or (TeclaPuls(KeyQ)) then + num := 1; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + if num = 1 then + begin + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + end + else + begin + PutStringCENTERED(18, 15, 'COMENAR JOC'); + PutStringWINDOWED(20, 14, 'EIXIR'); + end; + + until TeclaPuls(KeyENTER); + + if num = 1 then + { joc } + begin + Inicialitzacio; + + CarregaRecords; + + repeat + MouPepe; + CheckMortPerMalos; + if (Clock mod 4) = 0 then MouMalos; + CheckMortPerMalos; + PintaPantalla; + CheckMapa; + until TeclaPuls(KeyESC) or (Pepe.vides<0); + if TeclaPuls(keyESC) then + score := 0; + + GameOver; + end; + + if num = 2 then + { menu d'opcions } + exit_game := TRUE; + +end; +{##############################################################} +begin + instalarKB; + setmode(1); + HideCursor; + SetUpVirtual(ptrpant1, pant1); + randomize; + offset_mapa := OffsetMapa; + exit_game := FALSE; + + Titol; + + repeat + + Menu; + + until exit_game; + + TancarVirtual(ptrpant1); + setmode(3); + desinstalarKB; +end. \ No newline at end of file diff --git a/original_turbopascal/CODI.EXE b/original_turbopascal/CODI.EXE new file mode 100644 index 0000000..2fccf8a Binary files /dev/null and b/original_turbopascal/CODI.EXE differ diff --git a/original_turbopascal/CODI.PAS b/original_turbopascal/CODI.PAS new file mode 100644 index 0000000..d6b62b4 --- /dev/null +++ b/original_turbopascal/CODI.PAS @@ -0,0 +1,776 @@ +uses grafix, jinput, utext, tipos, crt; + +procedure FaseNova;forward; +{##############################################################} +{# O F F S E T M A P A #} +{##############################################################} +function OffsetMapa:longint; +var i:longint; + fich : file of byte; + buffer : byte; + marca : integer; + +begin + i := 0; + Assign(fich, 'runner.exe'); + Reset(fich); + marca := 0; + + repeat + Read(fich, buffer); + inc(i); + if buffer = ord('*') then + inc(marca) + else + marca := 0; + + until (marca = 10); + OffsetMapa := i; +end; +{##############################################################} +{# C A R R E G A R E C O R D S #} +{##############################################################} +procedure CarregaRecords; +var fich : file of byte; + buffer : byte; + +begin + Assign(fich, 'runner.exe'); + Reset(fich); + Seek(fich, FileSize(fich)-6); + + Read(fich, buffer); { centenes } + hi_score := buffer * 100; + Read(fich, buffer); { decenes } + hi_score := hi_score + (buffer * 10); + Read(fich, buffer); { unitats } + hi_score := hi_score + buffer; + + + Read(fich, buffer); { 1 lletra } + nom_hi_score := chr(buffer+45); + Read(fich, buffer); { 2 lletra } + nom_hi_score := nom_hi_score + chr(buffer+45); + Read(fich, buffer); { 3 lletra } + nom_hi_score := nom_hi_score + chr(buffer+45); + + Close(fich); +end; +{##############################################################} +{# G U A R D A R E C O R D S #} +{##############################################################} +procedure GuardaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'runner.exe'); + Reset(fich); + Seek(fich, FileSize(fich)-6); + + buffer := score div 100; + Write(fich, buffer); { centenes } + buffer := (score - (buffer*100)) div 10; + Write(fich, buffer); { decenes } + buffer := (score - (buffer*10)); + Write(fich, buffer); { unitats } + + buffer := ord(nom_hi_score[1])-45; + Write(fich, buffer); { 1 lletra } + buffer := ord(nom_hi_score[2])-45; + Write(fich, buffer); { 2 lletra } + buffer := ord(nom_hi_score[3])-45; + Write(fich, buffer); { 3 lletra } + + Close(fich); +end; +{##############################################################} +{# T R A G A P A N T A L L A #} +{##############################################################} +procedure TragaPantalla; +begin + for k:=0 to 23 do + begin + { desplaa cap avall } + for i:=0 to 39 do + for j:=23 downto 1 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j-1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j-1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(13,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + end; +end; +{##############################################################} +{# P O S A R N O M #} +{##############################################################} +procedure PosarNom; +var index : integer; + Key : byte; + Tecla : Pchar; +begin + nom_hi_score := '...'; + index := 1; + PutStringCENTERED(13, 15, 'Enhorabona, has'); + PutStringCENTERED(14, 15, 'aconseguit un nou record'); + PutStringCENTERED(16, 15, nom_hi_score); + repeat + if QTeclaPuls then + begin + Key := AgarrarTecla; + Tecla := nomTECLES[Key]; + nom_hi_score[index] := Tecla^; + inc(index); + PutStringCENTERED(16, 15, nom_hi_score); + repeat until not(QTeclaPuls); + end; + until (index = 4); + GuardaRecords; +end; +{##############################################################} +{# G A M E O V E R #} +{##############################################################} +procedure GameOver; +begin + pepe.vides := 0; + TragaPantalla; + cls($B800); + PutStringCENTERED(10, 15, 'G A M E O V E R'); + for i:=0 to 100 do espera_VGA; + if score > hi_score then PosarNom; + GetPaleta(paleta); + FadeDown(0,0,0,0); + cls($B800); + SetPaleta(paleta); +end; +{##############################################################} +{# F I N A L P A N T A L L A #} +{##############################################################} +procedure FinalPantalla; +begin + TragaPantalla; + FaseNova; +end; +{##############################################################} +{# M O R T #} +{##############################################################} +procedure Mort; +begin + dec(pepe.vides); + pepe.posX := 19; + pepe.posY := 23; +end; +{##############################################################} +{# M O R T M A L O #} +{##############################################################} +procedure MortMalo(num: byte); +begin + malo[num].posX := 39; + malo[num].posY := 1; + malo[num].color := 3; + malo[num].estat := caent; + malo[num].IAclock := 0; + mapa[malo[num].carrega.posX, malo[num].carrega.posY].tipo := diners; + malo[num].carrega.OK := false; + malo[num].carrega.posX := 0; + malo[num].carrega.posY := 0; +end; +{##############################################################} +{# F O R A D A R #} +{##############################################################} +procedure Foradar(posX, posY : word); +begin +{ mapa[posX, posY].tipo := buit;} + mapa[posX, posY].temps := bloc_out; +end; +{##############################################################} +{# M O U P E P E #} +{##############################################################} +procedure MouPepe; +var hi_ha_malo_baix : boolean; +begin + if TeclaPuls(KeyQ) then + begin + if mapa[pepe.posX, pepe.posY].tipo=escala then + begin + dec(pepe.posY); + end; + end + else + if TeclaPuls(KeyA) then + begin + if (mapa[pepe.posX, pepe.posY+1].tipo=escala) or (mapa[pepe.posX, pepe.posY+1].tipo=buit) then + inc(pepe.posY); + end; + + if TeclaPuls(KeyO) then + begin + if (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + dec(pepe.posX); + end + else + if TeclaPuls(KeyP) then + begin + if (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + inc(pepe.posX); + end + else + if TeclaPuls(KeySPACE) then + begin + if (mapa[pepe.posX-1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX-1, pepe.posY+1); + end + else + if TeclaPuls(KeyM) then + begin + if (mapa[pepe.posX+1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX+1, pepe.posY+1); + end; + + if TeclaPuls(KeyH) then + begin + repeat until not(TeclaPuls(KeyH)); + repeat until TeclaPuls(KeyH); + repeat until not(TeclaPuls(KeyH)); + end; + + + { si no passa res... } + pepe.estat := normal; + + { final pantalla } + if pepe.posY = 1 then FinalPantalla; + + { emparedat } + if mapa[pepe.posX, pepe.posY].tipo = pedra then + Mort; + + { agarra diners } + if mapa[pepe.posX, pepe.posY].tipo = diners then + begin + mapa[pepe.posX, pepe.posY].tipo := buit; + inc(score); + dec(diners_pantalla); + end; + + { bordes X pantalla } + if pepe.posX<0 then pepe.posX:=0; + if pepe.posX>39 then pepe.posX:=39; + + { gravetat } + if ((mapa[pepe.posX, pepe.posY+1].tipo<>escala) and (mapa[pepe.posX, pepe.posY+1].tipo<>pedra)) + and ((mapa[pepe.posX, pepe.posY].tipo=buit) or (mapa[pepe.posX, pepe.posY].tipo=diners)) then + begin + hi_ha_malo_baix := FALSE; + for i:=0 to num_malos-1 do + if (pepe.posX = malo[i].posX) and (pepe.posY+1 = malo[i].posY) then + hi_ha_malo_baix := TRUE; + + if not(hi_ha_malo_baix) then + begin + inc(pepe.posY); + pepe.estat := caent; + end; + end; + + { bordes Y pantalla } + if pepe.posY<0 then pepe.posY:=0; + if pepe.posY>24 then pepe.posY:=24; + +end; +{##############################################################} +{# S E L E C T E S T A T #} +{##############################################################} +function SelectEstat(num: byte):byte; +var nou_estat : byte; + Sestat:byte; + x:byte; + estat_pX,estat_pY:byte; + buscar:byte; +begin + nou_estat := 0; + Sestat:=0; + if mapa[malo[num].posX+1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+dreta; + + if mapa[malo[num].posX-1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+esquerra; + + if mapa[malo[num].posX, malo[num].posY].tipo = escala then + nou_estat := nou_estat + pujar; + + if mapa[malo[num].posX, malo[num].posY+1].tipo = escala then + nou_estat := nou_estat + baixar; + + if nou_estat=0 then Sestat:=10; {no pot moure's} + + if malo[num].posX>pepe.posX then estat_pX:=esquerra + else estat_pX:=dreta; + if malo[num].posY>pepe.posY then estat_pY:=pujar + else estat_pY:=baixar; + + x:=random(4); + buscar:=random(100); + if (buscar<50) and ((nou_estat and estat_PX=estat_PX) or + (nou_estat and estat_PY=estat_PY)) then + begin + if (nou_estat and estat_PX=estat_PX) then Sestat:=estat_PX + else Sestat:=estat_PY; + end + else + repeat + case x of + 0:if nou_estat and dreta =dreta then Sestat:=dreta; + 1:if nou_estat and esquerra =esquerra then Sestat:=esquerra; + 2:if nou_estat and pujar =pujar then Sestat:=pujar; + 3:if nou_estat and baixar =baixar then Sestat:=baixar; + end; + inc(x); + x:=x and $03; + until Sestat<>0; + + SelectEstat:=Sestat; + + if (mapa[malo[num].posX, malo[num].posY+1].tipo <> pedra) + and (mapa[malo[num].posX, malo[num].posY+1].tipo <> escala) then + SelectEstat:=caent; +end; +{##############################################################} +{# A G A F A R E S C A L A #} +{##############################################################} +function AgafarEscala(num:byte):byte; +var x:byte; + ag:boolean; + estat:byte; +begin + estat:=malo[num].estat; + if (estat=dreta) or (estat=esquerra) then + begin + x:=random(100); + if x<80 then ag:=True else ag:=false; + if ag then + begin + if (mapa[malo[num].posX, malo[num].posY].tipo = escala) then + estat:=pujar + else + if (mapa[malo[num].posX, malo[num].posY+1].tipo = escala) then + estat:=baixar; + end; + end; + AgafarEscala:=estat; +end; + +{##############################################################} +{# M O U M A L O S #} +{##############################################################} +procedure MouMalos; +begin + for i:=0 to num_malos-1 do + begin + if malo[i].IAclock = 0 then + malo[i].estat := SelectEstat(i); + + malo[i].estat:=AgafarEscala(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo <> pedra) and + (mapa[malo[i].posX, malo[i].posY+1].tipo <> escala)) and + (mapa[malo[i].posX, malo[i].posY].tipo <> corda) then + malo[i].estat:=caent; + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) or + (mapa[malo[i].posX, malo[i].posY+1].tipo = escala)) and + (malo[i].estat=caent) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY].tipo = buit) and + (malo[i].estat=pujar)) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) and + (malo[i].estat=baixar)) then + malo[i].estat:=SelectEstat(i); + + case malo[i].estat of + dreta : inc(malo[i].posX); + esquerra : dec(malo[i].posX); + pujar : dec(malo[i].posY); + baixar : inc(malo[i].posY); + caent : inc(malo[i].posY); + end; + + { bordes X } + if malo[i].posX<0 then + begin + malo[i].posX:=0; + malo[i].estat := dreta; + end; + if malo[i].posX>39 then + begin + malo[i].posX:=39; + malo[i].estat := esquerra; + end; + + { bordes Y } + if malo[i].posY<0 then + begin + malo[i].posY:=0; + end; + if malo[i].posY>24 then + begin + malo[i].posY:=24; + end; + + { agarrar diners } + if (mapa[malo[i].posX, malo[i].posY].tipo = diners) + and not(malo[i].carrega.OK) then + begin + mapa[malo[i].posX, malo[i].posY].tipo := buit; + malo[i].color := 11; + malo[i].carrega.OK := TRUE; + malo[i].carrega.posX := malo[i].posX; + malo[i].carrega.posY := malo[i].posY; + end; + + { emparedat } + if mapa[malo[i].posX, malo[i].posY].tipo = pedra then + MortMalo(i); + + inc(malo[i].IAclock); + if malo[i].IAclock = temps_IA then malo[i].IAclock := 0; + end; +end; +{##############################################################} +{# C A R R E G A M A P A #} +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'runner.exe'); + Reset(fich); + Seek(fich, (level * 1000)+offset_mapa); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo:=buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +{# C H E C K M O R T P E R M A L O S #} +{##############################################################} +procedure CheckMortPerMalos; +begin + for i:=0 to num_malos-1 do + if (malo[i].posX = pepe.posX) and (malo[i].posY = pepe.posY) then + Mort; +end; +{##############################################################} +{# C H E C K M A P A C O M P L E T #} +{##############################################################} +procedure CheckMapaComplet; +begin + if diners_pantalla = 0 then + for j:=1 to 23 do + begin + if mapa[0,j].tipo <> pedra then + begin + mapa[0,j].tipo := escala; + mapa[0,j].color := color_escala; + end + else + break; + end; +end; +{##############################################################} +{# C H E C K M A P A #} +{##############################################################} +procedure CheckMapa; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + case mapa[i,j].temps of + + 0 : begin + mapa[i,j].temps := -1; + mapa[i,j].tipo := pedra; + end; + + 1,bloc_out-1 : begin + mapa[i,j].tipo := bloc3; + dec(mapa[i,j].temps) + end; + + 2,bloc_out-2 : begin + mapa[i,j].tipo := bloc2; + dec(mapa[i,j].temps) + end; + + 3,bloc_out-3 : begin + mapa[i,j].tipo := bloc1; + dec(mapa[i,j].temps) + end; + + 4,bloc_out-4 : begin + mapa[i,j].tipo := buit; + dec(mapa[i,j].temps) + end; + + -1 : ; + + else dec(mapa[i,j].temps) + + end; + end; + CheckMapaComplet; +end; +{##############################################################} +{# F A S E N O V A #} +{##############################################################} +procedure FaseNova; +begin + inc(level); + if level = (num_fases + 1) then + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# I N I C I A L I T Z A C I O #} +{##############################################################} +procedure Inicialitzacio; +begin + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + pepe.vides := 3; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# T I T O L #} +{##############################################################} +procedure Titol; +begin + getpaleta(paleta); + blackout; + + PutStringCENTERED(10, 15, 'JAILDESIGNER'); + PutStringCENTERED(12, 15, 'presenta'); + + FadeUp(paleta, 1); + + for i:=0 to 100 do espera_VGA; + + Fadedown(0,0,0,0); + level := 0; + CarregaMapa; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + move(mem[pant1:0], mem[$B800:0], 2000); + + FadeUp(paleta, 0); + + for i:=0 to 100 do espera_VGA; + + for k:=0 to 2 do + begin + { desplaa cap amunt } + for i:=0 to 39 do + for j:=0 to 23 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j+1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j+1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + end; + + + +end; +{##############################################################} +{# M E N U #} +{##############################################################} +procedure Menu; +var num : integer; +begin + num := 1; + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + + repeat + + repeat until QteclaPuls; + + if (TeclaPuls(KeyArrowDown)) or (TeclaPuls(KeyA)) then + num := 2; + if (TeclaPuls(KeyArrowUp)) or (TeclaPuls(KeyQ)) then + num := 1; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + if num = 1 then + begin + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + end + else + begin + PutStringCENTERED(18, 15, 'COMENAR JOC'); + PutStringWINDOWED(20, 14, 'EIXIR'); + end; + + until TeclaPuls(KeyENTER); + + if num = 1 then + { joc } + begin + Inicialitzacio; + + CarregaRecords; + + repeat + MouPepe; + CheckMortPerMalos; + if (Clock mod 4) = 0 then MouMalos; + CheckMortPerMalos; + PintaPantalla; + CheckMapa; + until TeclaPuls(KeyESC) or (Pepe.vides<0); + if TeclaPuls(keyESC) then + score := 0; + + GameOver; + end; + + if num = 2 then + { menu d'opcions } + exit_game := TRUE; + +end; +{##############################################################} +begin + instalarKB; + setmode(1); + HideCursor; + SetUpVirtual(ptrpant1, pant1); + randomize; + offset_mapa := OffsetMapa; + exit_game := FALSE; + + repeat + + Titol; + + Menu; + + until exit_game; + + TancarVirtual(ptrpant1); + setmode(3); + desinstalarKB; +end. \ No newline at end of file diff --git a/original_turbopascal/CREA.pif b/original_turbopascal/CREA.pif new file mode 100644 index 0000000..f65f789 Binary files /dev/null and b/original_turbopascal/CREA.pif differ diff --git a/original_turbopascal/CURSOR.BAK b/original_turbopascal/CURSOR.BAK new file mode 100644 index 0000000..c7f056f --- /dev/null +++ b/original_turbopascal/CURSOR.BAK @@ -0,0 +1,17 @@ +procedure HideCursor;assembler; +asm + mov ax,0100h + mov cx,0100h + int 10h +end; + +procedure ShowCursor;assembler; +asm + mov ax,0100h + mov cx,0607h + int 10h +end; + +begin + HideCursor; +end. \ No newline at end of file diff --git a/original_turbopascal/CURSOR.EXE b/original_turbopascal/CURSOR.EXE new file mode 100644 index 0000000..cd0488f Binary files /dev/null and b/original_turbopascal/CURSOR.EXE differ diff --git a/original_turbopascal/CURSOR.PAS b/original_turbopascal/CURSOR.PAS new file mode 100644 index 0000000..3657c11 --- /dev/null +++ b/original_turbopascal/CURSOR.PAS @@ -0,0 +1,18 @@ +procedure HideCursor;assembler; +asm + mov ax,0100h + mov cx,0100h + int 10h +end; + +procedure ShowCursor;assembler; +asm + mov ax,0100h + mov cx,0607h + int 10h +end; + +begin + HideCursor; + ShowCursor; +end. \ No newline at end of file diff --git a/original_turbopascal/EDITOR.BAK b/original_turbopascal/EDITOR.BAK new file mode 100644 index 0000000..ca242b1 --- /dev/null +++ b/original_turbopascal/EDITOR.BAK @@ -0,0 +1,99 @@ +uses jinput, grafix, crt, tipos; + +var + item : byte; + num_fase : string; + +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'03.map'); + Reset(fich); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo := buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +procedure PintaPantalla; +var i,j : word; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + mem[pant1:((GetmouseX) div 8)+(((GetmouseY) div 8)*80)]:=88; + mem[pant1:((GetmouseX) div 8)+(((GetmouseY) div 8)*80)+1]:=7; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); + Write('X: ',(GetmouseX) div 16:2, ' Y: ', (GetmouseY) div 8:2, ' ITEM: ', chr(llista_items[item])); +end; +{##############################################################} +procedure SalvaMapa(numero : string); +var nom : string; + fich : file of byte; +begin + nom := numero+'.map'; + Assign(fich, nom); + Rewrite(fich); + for i:=0 to 39 do + for j:=0 to 24 do + Write(fich, mapa[i,j].tipo); + Close(fich); +end; +{##############################################################} + +begin + setmode(1); + SetMousePos(320,100); + SetMouseZone(0,16,640-16,200-8); + SetMouseSensitivity(10,10); + SetMouseInterruptRate(0); + SetUpVirtual(ptrpant1, pant1); + item := 1; + + for i:=0 to 39 do + for j:=0 to 24 do + mapa[i,j].tipo:=buit; + + {CarregaMapa;} + + repeat + PintaPantalla; + if (estatboto(MBLeft)<>0) then + begin + mapa[(GetmouseX) div 16, (GetmouseY) div 8].tipo := llista_items[item]; + mapa[(GetmouseX) div 16, (GetmouseY) div 8].color := color_items[item]; + end; + if (estatboto(MBRight)<>0) then + begin + item := (item+1) mod num_items; + repeat until (estatboto(MBRight)=0); + end; + until keypressed; + + gotoXY(10,10); + write('NUMERO DE FASE? '); + read(num_fase); + + SalvaMapa(num_fase); + + TancarVirtual(ptrpant1); + setmode(3); +end. + diff --git a/original_turbopascal/EDITOR.EXE b/original_turbopascal/EDITOR.EXE new file mode 100644 index 0000000..76176c7 Binary files /dev/null and b/original_turbopascal/EDITOR.EXE differ diff --git a/original_turbopascal/EDITOR.PAS b/original_turbopascal/EDITOR.PAS new file mode 100644 index 0000000..ca242b1 --- /dev/null +++ b/original_turbopascal/EDITOR.PAS @@ -0,0 +1,99 @@ +uses jinput, grafix, crt, tipos; + +var + item : byte; + num_fase : string; + +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'03.map'); + Reset(fich); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo := buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +procedure PintaPantalla; +var i,j : word; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + mem[pant1:((GetmouseX) div 8)+(((GetmouseY) div 8)*80)]:=88; + mem[pant1:((GetmouseX) div 8)+(((GetmouseY) div 8)*80)+1]:=7; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); + Write('X: ',(GetmouseX) div 16:2, ' Y: ', (GetmouseY) div 8:2, ' ITEM: ', chr(llista_items[item])); +end; +{##############################################################} +procedure SalvaMapa(numero : string); +var nom : string; + fich : file of byte; +begin + nom := numero+'.map'; + Assign(fich, nom); + Rewrite(fich); + for i:=0 to 39 do + for j:=0 to 24 do + Write(fich, mapa[i,j].tipo); + Close(fich); +end; +{##############################################################} + +begin + setmode(1); + SetMousePos(320,100); + SetMouseZone(0,16,640-16,200-8); + SetMouseSensitivity(10,10); + SetMouseInterruptRate(0); + SetUpVirtual(ptrpant1, pant1); + item := 1; + + for i:=0 to 39 do + for j:=0 to 24 do + mapa[i,j].tipo:=buit; + + {CarregaMapa;} + + repeat + PintaPantalla; + if (estatboto(MBLeft)<>0) then + begin + mapa[(GetmouseX) div 16, (GetmouseY) div 8].tipo := llista_items[item]; + mapa[(GetmouseX) div 16, (GetmouseY) div 8].color := color_items[item]; + end; + if (estatboto(MBRight)<>0) then + begin + item := (item+1) mod num_items; + repeat until (estatboto(MBRight)=0); + end; + until keypressed; + + gotoXY(10,10); + write('NUMERO DE FASE? '); + read(num_fase); + + SalvaMapa(num_fase); + + TancarVirtual(ptrpant1); + setmode(3); +end. + diff --git a/original_turbopascal/EDITOR.PIF b/original_turbopascal/EDITOR.PIF new file mode 100644 index 0000000..1a505f6 Binary files /dev/null and b/original_turbopascal/EDITOR.PIF differ diff --git a/original_turbopascal/FUSIO.BAK b/original_turbopascal/FUSIO.BAK new file mode 100644 index 0000000..c61db24 --- /dev/null +++ b/original_turbopascal/FUSIO.BAK @@ -0,0 +1,90 @@ +uses crt; + +const + num_map = 6; + +var + fich_exe, fich_map, fich_rec, fich_d : file of byte; + buffer : byte; + j : integer; + i : longint; + nom : string; + total : longint; + etiqueta : string; + +begin + ClrScr; + + asm { hide cursor } + mov ax,0100h + mov cx,0100h + int 10h + end; + + etiqueta := '*mapa*'; + + Assign(fich_exe,'codi.exe'); + Writeln('CODI.EXE'); + Assign(fich_map,'total.map'); + Writeln('TOTAL.MAP'); + Assign(fich_rec,'records'); + Writeln('RECORDS'); + Assign(fich_d,'runner.exe'); + Reset(fich_exe); + Reset(fich_map); + Reset(fich_rec); + Rewrite(fich_d); + Writeln; + Writeln; + Writeln('Escribint...'); + GotoXY(14,6); + Write('RUNNER.EXE'); + + total := FileSize(fich_exe); + for i:=1 to FileSize(fich_exe) do + begin + Read(fich_exe,buffer); + Write(fich_d,buffer); + GotoXY(20,1); + Write(((i*100) div total):3,'%'); + end; + + for i:=1 to length(etiqueta) do + begin + buffer := ord(etiqueta[i]); + Write(fich_d,buffer); + end; + + total := FileSize(fich_map); + for i:=1 to FileSize(fich_map) do + begin + Read(fich_map,buffer); + Write(fich_d,buffer); + GotoXY(20,2); + Write(((i*100) div total):3,'%'); + end; + + total := FileSize(fich_rec); + for i:=1 to FileSize(fich_rec) do + begin + Read(fich_rec,buffer); + Write(fich_d,buffer); + GotoXY(20,3); + Write(((i*100) div total):3,'%'); + end; + + close(fich_exe); + close(fich_map); + close(fich_rec); + close(fich_d); + + GotoXY(1,6); + Writeln('Complet. '); + GotoXY(14,6); + Writeln('RUNNER.EXE'); + + Writeln; + Writeln('Pulsa una tecla per a eixir'); + + ReadKey; +end. \ No newline at end of file diff --git a/original_turbopascal/FUSIO.EXE b/original_turbopascal/FUSIO.EXE new file mode 100644 index 0000000..845ac36 Binary files /dev/null and b/original_turbopascal/FUSIO.EXE differ diff --git a/original_turbopascal/FUSIO.PAS b/original_turbopascal/FUSIO.PAS new file mode 100644 index 0000000..2879e9a --- /dev/null +++ b/original_turbopascal/FUSIO.PAS @@ -0,0 +1,90 @@ +uses crt; + +const + num_map = 6; + +var + fich_exe, fich_map, fich_rec, fich_d : file of byte; + buffer : byte; + j : integer; + i : longint; + nom : string; + total : longint; + etiqueta : string; + +begin + ClrScr; + + asm { hide cursor } + mov ax,0100h + mov cx,0100h + int 10h + end; + + etiqueta := '*mapa*'; + + Assign(fich_exe,'codi.exe'); + Writeln('CODI.EXE'); + Assign(fich_map,'total.map'); + Writeln('TOTAL.MAP'); + Assign(fich_rec,'records'); + Writeln('RECORDS'); + Assign(fich_d,'runner.exe'); + Reset(fich_exe); + Reset(fich_map); + Reset(fich_rec); + Rewrite(fich_d); + Writeln; + Writeln; + Writeln('Escribint...'); + GotoXY(14,6); + Write('RUNNER.EXE'); + + total := FileSize(fich_exe); + for i:=1 to FileSize(fich_exe) do + begin + Read(fich_exe,buffer); + Write(fich_d,buffer); + GotoXY(20,1); + Write(((i*100) div total):3,'%'); + end; + + for i:=1 to 10 do + begin + buffer := ord('*'); + Write(fich_d,buffer); + end; + + total := FileSize(fich_map); + for i:=1 to FileSize(fich_map) do + begin + Read(fich_map,buffer); + Write(fich_d,buffer); + GotoXY(20,2); + Write(((i*100) div total):3,'%'); + end; + + total := FileSize(fich_rec); + for i:=1 to FileSize(fich_rec) do + begin + Read(fich_rec,buffer); + Write(fich_d,buffer); + GotoXY(20,3); + Write(((i*100) div total):3,'%'); + end; + + close(fich_exe); + close(fich_map); + close(fich_rec); + close(fich_d); + + GotoXY(1,6); + Writeln('Complet. '); + GotoXY(14,6); + Writeln('RUNNER.EXE'); + + Writeln; + Writeln('Pulsa una tecla per a eixir'); + + ReadKey; +end. \ No newline at end of file diff --git a/original_turbopascal/FUSIO.PIF b/original_turbopascal/FUSIO.PIF new file mode 100644 index 0000000..1c4ca48 Binary files /dev/null and b/original_turbopascal/FUSIO.PIF differ diff --git a/original_turbopascal/GRAFIX.PAS b/original_turbopascal/GRAFIX.PAS new file mode 100644 index 0000000..87ab186 --- /dev/null +++ b/original_turbopascal/GRAFIX.PAS @@ -0,0 +1,4592 @@ +{Unitat Grafica per al mode 13h} +{Ultima actualitzacio 19-02-2000} +{$G+} +unit grafix; + +interface + +const _32bit =$66; + MAXFRAMES=3; + +type + TRGB=record + red:byte; + green:byte; + blue:byte; + end; + + Tpaleta=array[0..255] of TRGB; {tipus per guardar paletes} + + t_pantalla = array[1..64000] of byte; {pantalla del tamany de la VGA} + ptr_pantalla = ^t_pantalla; + + TDoubleBuffer=record + PDBuffer:pointer; {Punter al DBuffer} + AltDBuffer:word; {Alt del Dbuffer} + SizeDBuffer:word; {Tamany en Dwords} + MDBuffer:word; {segment de memoria del DBuffer} + end; + + TSPRITE=record + x, + y, + xold, + yold:integer; + ample, + alt, + {camps d'animacio} + anim_clock, + anim_speed, + motion_clock, + motion_speed:word; + {gestio de frames} + curr_frame, + num_frames, + estat:word; + frames:array[1..MAXFRAMES] of pointer; + end; + + PTSPRITE=^TSPRITE; + +var + ys:array [0..199] of word; + DBuffer:TDoubleBuffer;{El DoubleBuffer ha de ser global} + +procedure Put_Sprite_ICE(mem_orig,mem_dest,x_orig,y_orig,ample,alt,posx,posy : word); +procedure Put_Sprite_ICE_dreta(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx,posy:integer); +procedure Put_Sprite_ICE_esquerra(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx,posy:integer); +procedure Put_Sprite_ICE_dalt(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); +procedure Put_Sprite_ICE_baix(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); + +procedure putpix(x,y:word;color:byte;zona_mem:word); {Rapida} +{Entrada: x,y -> coordenades on possar el pixel; + color -> color del pixel; + zona_mem-> Zona de memoria on possar el pixel; + Funcio : Possar un pixel en una zona de memoria} +procedure putpixel(x,y:word;color:byte;zona_mem:word); +{Entrada: x,y -> coordenades on possar el pixel; + color -> color del pixel; + zona_mem-> Zona de memoria on possar el pixel; + Funcio : Possar un pixel en una zona de memoria} +procedure espera_vga; +{Funcio : Esperar el reta vertical de la VGA} +procedure GetPaleta(var paleta:tpaleta); +{Funcio : Guardar la paleta activa} +procedure SetPaleta(paleta:tpaleta); +{Funcio : Possar una paleta en la VGA} +procedure SetMode(mode:word); +{Funcio : Canviar el mode actual} +procedure SetVGA; +{Funcio : Canviar al mode grafic 320x200x256} +procedure SetText; +{Funcio : Canviar al mode text 80x25} +procedure putpixel_trans(x,y:word;color,trans:byte;zona_mem:word); +{Entrada: x,y -> coordenades on possar el pixel; + color -> color del pixel; + trans -> color transparent; + zona_mem-> Zona de memoria on possar el pixel; + Funcio : Possar un pixel en una zona de memoria} +procedure SetupVirtual(var screen:ptr_pantalla;var virtual_addr:word); +{Entrada: screen -> punter a un vector de 64000 posicions; + Eixida : virtual_addr -> adrea de memoria reservada; + Funcio : Reservar una zona de memoria de 64000 posicions} +procedure TancarVirtual(var screen:ptr_pantalla); +{Entrada: screen -> punter a un vector de 64000 posicions; + Funcio : Alliberar una zona de memoria previament reservada} +procedure volcar32(mem_orig,mem_dest:word); +{Entrada: mem_orig -> memoria des d'on copiar; + mem_dest -> memoria on copiar; + Funcio : copiar una zona de memoria a un altra} +procedure volcar_pantalla(mem_orig,mem_dest:word); +{Entrada: mem_orig -> memoria des d'on copiar; + mem_dest -> memoria on copiar; + Funcio : copiar una zona de memoria a un altra} +procedure LoadPCX(name:string;MemD:word); +{Entrada: name -> nom del arxiu que volem carregar; + MemD -> adrea de memoria on possar el dibuix; + Funcio : Carregar un PCX} +procedure SavePCX(name:string); +{Entrada: name -> nom del arxiu que volem carregar; + Funcio : Guardar en un fitxer PCX el contingut de la pantalla} +procedure LoadBMP(name:string;MemD:word); +{Entrada: name -> nom del arxiu que volem carregar; + MemD -> adrea de memoria on possar el dibuix; + Funcio : Carregar un BMP} +procedure GetColor(color:byte;var red,green,blue:byte); {Rapida} +{Entrada : color -> numero del color del qual volem aconseguir RGB; + Eixida : red -> intensitat de Roig del color; + green -> intensitat de Green del color; + blue -> intensitat de Blue del color; + Funcio : Aconseguir els valors RGB d'un color} +procedure get_color(color:byte;var red,green,blue:byte); +{Entrada : color -> numero del color del qual volem aconseguir RGB; + Eixida : red -> intensitat de Roig del color; + green -> intensitat de Green del color; + blue -> intensitat de Blue del color; + Funcio : Aconseguir els valors RGB d'un color} +procedure SetColor(color,red,green,blue:byte); {Rapida} +{Entrada : color -> numero del color del qual volem aconseguir RGB; + Eixida : red -> intensitat de Roig del color; + green -> intensitat de Green del color; + blue -> intensitat de Blue del color; + Funcio : Aconseguir els valors RGB d'un color} +procedure set_color(color,red,green,blue:byte); +{Entrada : color -> numero del color al qual volem posar el RGB; + red -> intensitat de Roig del color; + green -> intensitat de Green del color; + blue -> intensitat de Blue del color; + Funcio : Possar els valors RGB a un color} +procedure cls32(color:byte;zona_mem:word); {Rapida} +{Entrada : color -> color del qual volem omplir una zona de memoria; + zona_mem -> Zona de memoria que volem "netejar"; + Funcio : Omplir una zona de memoria d'un color} +procedure cls(color:byte;zona_mem:word); +{Entrada : color -> color del qual volem omplir una zona de memoria; + zona_mem -> Zona de memoria que volem "netejar"; + Funcio : Omplir una zona de memoria d'un color} +procedure FadeUp(var paleta_e:tpaleta;espera:byte); +{Entrada: paleta_e -> paleta a la que volem arribar; + espera -> temps de retard; + Funcio : Fade Up} +procedure FadeDown(red,green,blue,espera:byte); +{Entrada: red -> valor de roig del color al que volem arribar + green -> valor de verd del color al que volem arribar + blue -> valor de blau del color al que volem arribar + espera -> temps de retard; + Funcio : Fade Down} +Procedure FadeDown_C(color,red,green,blue,espera:byte); +{Entrada: color -> color del que volem fer fade + red -> valor de roig del color al que volem arribar + green -> valor de verd del color al que volem arribar + blue -> valor de blau del color al que volem arribar + espera -> temps de retard; + Funcio : Fade Down d'un color} +procedure Line(x1, y1, x2, y2 : integer; color : byte;z_mem:word); + +procedure blackout; +{Funcio -> possar la paleta a Negre} +procedure parallax_scroll(mem_orig,mem_dest,desplasament:word); +{Entrada: Mem_orig -> zona de memoria on esta guardat el dibuix + Mem_dest -> zona de memoria on volem possar el dibuix + desplasament -> posicio en la memoria desti on comensarem a volcar + el dibuix + Funcio : possar una pantalla damunt d'un altra amb transparencies} +procedure put_sprite(mem_orig,mem_dest,m_offset,ample,alt,posx,posy:word); +{Entrada: Mem_orig -> zona de memoria on esta guardat el sprite + Mem_dest -> zona de memoria on volem possar el sprite + m_offset -> offset on es troba el sprite + ample -> ample del sprite + alt -> alt del sprite + posx -> posicio en l'eix x on volem possar el sprite + posy -> posicio en l'eix y on volem possar el sprite + Funcio : possar un sprite amb transparencies, color transparent = 0} +procedure PutSprite(mem_orig,mem_dest,m_offset,ample,alt,posx,posy:word); +{Entrada: Mem_orig -> zona de memoria on esta guardat el sprite + Mem_dest -> zona de memoria on volem possar el sprite + m_offset -> offset on es troba el sprite + ample -> ample del sprite + alt -> alt del sprite + posx -> posicio en l'eix x on volem possar el sprite + posy -> posicio en l'eix y on volem possar el sprite + Funcio : possar un sprite amb transparencies, color transparent = 0 + Nota : Mes rapida que put_sprite} +procedure scroll_v(mem_orig,mem_dest,desplasament:word); +{Entrada: Mem_orig -> zona de memoria on esta guardat el dibuix + Mem_dest -> zona de memoria on volem possar el dibuix + desplasament -> posicio en la memoria desti on comensarem a volcar + el dibuix + Funcio : volcar una pantalla a un offset d'un altra} +procedure PutBloc(mem_orig,m_offset,mem_dest,ample,alt,posx,posy:word); +{Entrada: Mem_orig -> zona de memoria on esta guardat el sprite + m_offset -> offset on es troba el sprite + Mem_dest -> zona de memoria on volem possar el sprite + ample -> ample del sprite + alt -> alt del sprite + posx -> posicio en l'eix x on volem possar el sprite + posy -> posicio en l'eix y on volem possar el sprite + Funcio : possar un sprite} +Function GetPix(tmem,x, y : Word) : Byte; +{Entrada: tmem -> zona de memoria on esta el pixel + x -> coordenada x + y -> coordenada y + Funcio : obtindre el color d'un pixel d'una zona de memoria} +procedure Escalat(Mem1,Mem2,Xini,Yini,Xfi,Yfi,PosX,PosY:word;escala:integer); +{Entrada: Mem1 -> Memoria on es troba la imatge orige + Mem2 -> Memoria on posarem la imatge desti + Xini -> X inicial de la imatge orige + Yini -> Y inicial de la imatge orige + Xfi -> X final de la imatge orige + Yfi -> Y final de la imatge orige + PosX -> Coordenada X on volem comenar a posar l'imatge + PosY -> Coordenada Y on volem comenar a posar l'imatge + escala -> escala que li volem aplicar a l'imatge + Funcio : Escalar una imatge + Nota : Per a escales de reduccio aplicar el zoom en negatiu + Ex: escala 1/4 = escala -4} +procedure BlitString(cadena:string;xc,yc,color,tamany:word); +{Entrada: cadena -> text que volem escriure + xc -> coordenada x + yc -> coordenada y + color -> color del text + tamany -> tamany del text + Funcio : Escriu una cadena de text en mode grafic + Nota : la cadena sols pot contindre codi ascii (0-127)} +procedure BlitChar(c:char;xc,yc,color,tamany:word); +{Entrada: c -> lletra que volem escriure + xc -> coordenada x + yc -> coordenada y + color -> color del text + tamany -> tamany del text + Funcio : Escriu una lletra en mode grafic + Nota : la lletra sols pot ser codi ascii (0-127)} +procedure RotatePal(index1,index2:word); +{Entrada : index1 -> index del primer color + index2 -> index del segon color + Funcio : rota la paleta (Sols un desplasament) + Ex: 1234 -> 4123} +procedure GWindow(x1,y1,x2,y2:word;color:byte;Zmem:word); +{Entrada : x1 -> x inicial de la finestra + y1 -> y inicial de la finestra + x2 -> x final de la finestra + y2 -> y final de la finestra + color -> color del marc de la finestra + Zmem -> zona de memoria on crear la finestra + Funcio : Crea un marc de color i per deixar visible una zona de memoria} +procedure Out(NumOut,Color,velocitat:byte;separacio:word); +{Entrada : NumOut -> index del tipus de transicio que volem fer + Color -> color al que arriben alguns outs al final + velocitat -> velocitat de la transicio + Separacio -> separacio entre quadres per a l'out11 + Funcio : Transicio entre pantalles + Nota : Index de les trancisions i definicions + 1:Fa uns zoom per fer l'imatge xicoteta i despres la fa molt gran + 2:Va creant un rombo fins "apagar" la pantalla + 3:"Cortina" d'esquerra a dreta + 4:"Cortina" de dreta a esquerra + 5:"Cortina" d'amunt a avall + 6:"Cortina" d'avall a amunt + 7:"Cortina" d'avall a amunt i d'amunt a avall + 8:"Cortina" del centre a amunt i avall + 9:"Cortina" d'esquerra a dreta i de dreta a esquerra + 10:"Cortina" del centre a esquerra i dreta + 11:"Quadretjat" + 12:Disolve} +function Colisio(x1,y1,w1,h1, x2,y2,w2,h2 :integer):boolean; +{Entrada : x1 -> coordena x inicial de la primera regio + y1 -> coordena y inicial de la primera regio + w1 -> ample de la primera regio + h1 -> alt de la primera regio + x2 -> coordena x inicial de la segona regio + y2 -> coordena y inicial de la segona regio + w2 -> ample de la segona regio + h2 -> alt de la segona regio + Eixida : TRUE si hi ha colisio, FALSE si no hi ha colisio + Funcio : calcular la colisio entre dos regions rectangulars} +procedure CreateDB(NumLines:word); +{Entrada: NumLinies -> nombre de linies de alt del doble buffer + Funcio : Reserva una zona de memoria per crear un doble Buffer a la VGA} +procedure ClearDB(color:byte); +{Entrada: color -> color en el que omplirem el doble buffer + Funcio : "Netejar" el doble buffer de un color} +procedure FlipDB; +{Funcio : Volcar el doble buffer a la VGA} +procedure DeleteDB; +{Funcio : Alliberar la zona de memoria ocupada pel doble buffer} +procedure Scale2D(font,desti,ample,alt,posx,posy:word;zoom:real); +{Entrada: Font -> Zona de memoria orige + desti-> Zona de meoria desti + ample-> Ample del Sprite + alt -> Alt del Sprite + posx -> posicio inicial en X + posy -> posicio inicial en Y + zoom -> Valor de l'escala del nou sprite + Funcio : Escalar un sprite} +procedure Scale2DClipped(font,desti,ample,alt,posx,posy:word;zoom:real); +{Entrada: Font -> Zona de memoria orige + desti-> Zona de meoria desti + ample-> Ample del Sprite + alt -> Alt del Sprite + posx -> posicio inicial en X + posy -> posicio inicial en Y + zoom -> Valor de l'escala del nou sprite + Funcio : Escalar un sprite amb clipping} +procedure Scale2DMasked(font,desti,ample,alt,posx,posy:word;zoom:real); +{Entrada: Font -> Zona de memoria orige + desti-> Zona de meoria desti + ample-> Ample del Sprite + alt -> Alt del Sprite + posx -> posicio inicial en X + posy -> posicio inicial en Y + zoom -> Valor de l'escala del nou sprite + Funcio : Escalar un sprite amb transparencies} +procedure Scale2DMaskedClipped(font,desti,ample,alt,posx,posy:word;zoom:real); +{Entrada: Font -> Zona de memoria orige + desti-> Zona de meoria desti + ample-> Ample del Sprite + alt -> Alt del Sprite + posx -> posicio inicial en X + posy -> posicio inicial en Y + zoom -> Valor de l'escala del nou sprite + Funcio : Escalar un sprite amb transparencies i clipping} +procedure GrabFrame(font,x0,y0:word;var Sprite:PTSprite);far; +{Entrada: Font -> Zona de memoria on es troba guardada l'imatge + x0 -> posicio x inicial de l'imatge + y0 -> posicio y inicial de l'imatge + x1 -> posicio x final de l'imatge + y1 -> posicio y final de l'imatge + Sprite-> Sprite al que volem afegir el frame + Funcio : Agafar un frame per a un sprite d'una zona de memoria} +procedure CreateSprite(var Sprite:PTSprite; + x0,y0:integer; + width,height,a_sp,m_sp,state:word);far; +{Entrada: x0 -> posicio x inicial + y0 -> posicio y inicial + width -> ample del Sprite + height -> alt del Sprite + a_sp -> velocitat de animacio + M_Sp -> velocitat de moviment + state -> estat del Sprite (Ex VIU,MORT,MORINT) + Eixida : Sprite -> Punter al sprite + Funcio : Inicialitzar un Sprite} +procedure DeleteSprite(Sprite:ptsprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Alliberar una zona de memoria ocupada per un sprite} + +procedure DrawSprite(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla el Sprite} +procedure DrawSpriteM(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill del Sprite} +procedure DrawSpriteF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'invertit del Sprite} +procedure DrawSpriteMF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill invertit del Sprite} +procedure MaskedSprite(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla el Sprite amb transparencies} +procedure MaskedSpriteM(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill del Sprite amb transparencies} +procedure MaskedSpriteF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'invertit del Sprite amb transparencies} +procedure MaskedSpriteMF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill invertit del Sprite amb transparencies} +procedure DrawSpriteDB(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer el Sprite} +procedure DrawSpriteDBM(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doblebuffer l'espill del Sprite} +procedure DrawSpriteDBF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer l'invertit del Sprite} +procedure DrawSpriteDBMF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DoubleBuffer l'espill invertit del Sprite} +procedure MaskedSpriteDB(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer el Sprite amb transparencies} +procedure MaskedSpriteDBM(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doblebuffer l'espill del Sprite amb transparencies} +procedure MaskedSpriteDBF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doble buffer l'invertit del Sprite amb transparencies} +procedure MaskedSpriteDBMF(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DoubleBuffer l'espill invertit del Sprite amb transparencies} +procedure DrawSpriteC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla el Sprite} +procedure DrawSpriteMC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill del Sprite} +procedure DrawSpriteFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'invertit del Sprite} +procedure DrawSpriteMFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill invertit del Sprite} +procedure MaskedSpriteC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla el Sprite amb transparencies} +procedure MaskedSpriteMC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill del Sprite amb transparencies} +procedure MaskedSpriteFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'invertit del Sprite amb transparencies} +procedure MaskedSpriteMFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Traure per pantalla l'espill invertit del Sprite amb transparencies} +procedure DrawSpriteDBC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer el Sprite} +procedure DrawSpriteDBMC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doblebuffer l'espill del Sprite} +procedure DrawSpriteDBFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer l'invertit del Sprite} +procedure DrawSpriteDBMFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DoubleBuffer l'espill invertit del Sprite} +procedure MaskedSpriteDBC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DobleBuffer el Sprite amb transparencies} +procedure MaskedSpriteDBMC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doblebuffer l'espill del Sprite amb transparencies} +procedure MaskedSpriteDBFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al doble buffer l'invertit del Sprite amb transparencies} +procedure MaskedSpriteDBMFC(sprite:PTSprite);far; +{Entrada: Sprite -> Punter al Sprite + Funcio : Possar al DoubleBuffer l'espill invertit del Sprite amb transparencies} +implementation + +{------------------------------------------------------------------} +procedure Put_Sprite_ICE_dreta(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); +var i,j : word; +begin + for j:=0 to alt-1 do + for i:=0 to ample-1 do + if (posx+i<320) and not((mem[mem_orig:x_orig+i+((y_orig+j)*320)])=0) then mem[mem_dest:posx+i+((posy+j)*320)]:= + (mem[mem_orig:x_orig+i+((y_orig+j)*320)]); +end; +{------------------------------------------------------------------} +procedure Put_Sprite_ICE_esquerra(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); +var i,j : word; +begin + for j:=0 to alt-1 do + for i:=0 to ample-1 do + if (posx+i>0) and not((mem[mem_orig:x_orig+i+((y_orig+j)*320)])=0) then mem[mem_dest:posx+i+((posy+j)*320)]:= + (mem[mem_orig:x_orig+i+((y_orig+j)*320)]); +end; +{------------------------------------------------------------------} +procedure Put_Sprite_ICE_dalt(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); +var i,j : word; +begin + for j:=0 to alt-1 do + for i:=0 to ample-1 do + if (posy+j>0) and not((mem[mem_orig:x_orig+i+((y_orig+j)*320)])=0) then mem[mem_dest:posx+i+((posy+j)*320)]:= + (mem[mem_orig:x_orig+i+((y_orig+j)*320)]); +end; +{------------------------------------------------------------------} +procedure Put_Sprite_ICE_baix(mem_orig,mem_dest,x_orig,y_orig,ample,alt : word; posx, posy:integer); +var i,j : word; +begin + for j:=0 to alt-1 do + for i:=0 to ample-1 do + if (posy+j<200) and not((mem[mem_orig:x_orig+i+((y_orig+j)*320)])=0) then mem[mem_dest:posx+i+((posy+j)*320)]:= + (mem[mem_orig:x_orig+i+((y_orig+j)*320)]); +end; +{------------------------------------------------------------------} +procedure Put_Sprite_ICE(mem_orig,mem_dest,x_orig,y_orig,ample,alt,posx, posy : word); +var i,j : word; +begin + for j:=0 to alt-1 do + for i:=0 to ample-1 do + {if not((mem[mem_orig:x_orig+i+((y_orig+j)*320)])=0) then} + mem[mem_dest:posx+i+((posy+j)*320)]:=(mem[mem_orig:x_orig+i+((y_orig+j)*320)]); +end; +{------------------------------------------------------------------} + +{} +Function GetPix(tmem,x, y : Word) : Byte; Assembler; +Asm + mov bx,y + shl bx,1 + mov ax,tmem + mov es,ax + mov di,x + add di,word ptr ys[bx] + nop + mov al,es:[di] +End; + +{} +procedure PutBloc(mem_orig,m_offset,mem_dest,ample,alt,posx,posy:word); +begin + asm + push ds; + + mov si,m_offset; + + mov ax,mem_orig; + mov ds,ax; {memoria orige} + mov ax,mem_dest; + mov es,ax; {memoria desti} + + mov di,posx; {DI = X} + mov dx,posy; {DX = Y} + shl dx,8; {DX = 256*Y} + add di,dx; {DI = 256*Y+BX} + shr dx,2; {DX = 64*Y} + add di,dx; {DI = 320*Y+X} + + mov cx,alt; {guarde el alt} + + @1: push cx; {guarde el alt} + push di; {guarde el offset desti} + push si; {guarde el offset orige} + + mov cx,ample; {carregue el ample} + shr cx,2; + + db _32bit + rep movsw; {mentres no siga l'ample continuar} + + pop si; {recuperem l'offset orige} + pop di; {recuperem l'offset desti} + add si,320; {segent linia orige} + add di,320; {segent linia desti} + pop cx; {recuperem l'alt} + dec cx; {una linia menys} + cmp cx,0; {Queden linies?} + jnz @1; {Si.Anar a @1} + + pop ds; + end; +end; + +{} +procedure cls32(color:byte;zona_mem:word);assembler; +asm + mov ax,zona_mem + mov es,ax + xor di,di + mov al,color + mov ah,al + mov bx,ax + mov cx,16000 + db _32bit + shl ax,16 + mov ax,bx + db _32bit + rep stosw +end; + + +procedure cls(color:byte;zona_mem:word);assembler; +asm + mov ax,zona_mem; + mov es,ax; + xor di,di; + mov al,color; + mov ah,al; + mov cx,32000; + rep stosw; +end; + +{} +procedure espera_vga;assembler; +label + l1,l2; +asm + mov dx,3dah; + l1: + in al,dx; + test al,8; + jne l1; + l2: + in al,dx; + test al,8; + je l2; + end; + +{} +procedure GetPaleta(var paleta:tpaleta); +var count:word; +begin + port[$3C7]:=0; + for count:=0 to 255 do + begin + paleta[count].red:=port[$3C9]; + paleta[count].green:=port[$3C9]; + paleta[count].blue:=port[$3C9]; + end; +end; + +{} +procedure SetPaleta(paleta:tpaleta); +var count:word; +begin + port[$3C8]:=0; + for count:=0 to 255 do + begin + port[$3C9]:=paleta[count].red; + port[$3C9]:=paleta[count].green; + port[$3C9]:=paleta[count].blue; + end; +end; + + +{} +procedure putpix(x,y:word;color:byte;zona_mem:word);assembler; +asm + mov bx,y + mov di,x + shl bx,1 + mov es,[zona_mem] + add di,word ptr ys[bx] + mov al,color + stosb +end; + +procedure putpixel(x,y:word;color:byte;zona_mem:word);assembler; +asm + mov ax,zona_mem + mov es,ax + mov di,x + mov dx,y + shl dx,8 + add di,dx + shr dx,2 + add di,dx + mov al,color + mov es:[di],al +end; + +{} +procedure setmode(mode:word);assembler; +{Canviar a un cert mode} +asm + mov ax,mode; + int 10h; +end; + +procedure SetVGA;assembler; +asm + mov ax,13h + int 10h +end; + +procedure SetText;assembler; +asm + mov ax,3 + int 10h +end; + +{} +procedure putpixel_trans(x,y:word;color,trans:byte;zona_mem:word);assembler; +asm + {Guardar en ES la zona de memoria} + mov ax,zona_mem; + mov es,ax; + {Calcular el offset} + mov di,x; {DI = X} + mov dx,y; {DX = Y} + shl dx,8; {DX = 256*Y} + add di,dx; {DI = 256*Y+BX} + shr dx,2; {DX = 64*Y} + add di,dx; {DI = 320*Y+X} + mov al,color; {Possem el color en AL} + xor al,trans; {si color=trans...} + jnz @paint; {... saltem a @paint} + + inc(di); {Avancem el punter de pantalla} + jmp @exit; {anem a l'eixida} + +@Paint: mov es:[di],al; {posem al segment de memoria el color} + +@exit: +end; + +{} +procedure Volcar32(mem_orig,mem_dest:word);assembler; +asm + push ds; + mov cx,16000; + mov ds,word ptr mem_orig + mov es,word ptr mem_dest + xor di,di; + xor si,si; + db _32bit; + rep movsw; + pop ds; +end; + + +procedure volcar_pantalla(mem_orig,mem_dest:word);assembler; +asm + push ds; + mov ax,mem_orig; + mov ds,ax; + xor di,di; + mov ax,mem_dest; + mov es,ax; + xor si,si; + mov cx,32000; + rep movsw; + pop ds; +end; + +{} +procedure SetupVirtual(var screen:ptr_pantalla;var virtual_addr:word); +begin + getmem(screen,64000); + virtual_addr:=seg(screen^); +end; + +{} +procedure TancarVirtual(var screen:ptr_pantalla); +begin + freemem(screen,64000); +end; + +{} +procedure get_color(color:byte;var red,green,blue:byte); +begin + port[$3C7]:=color; + red:= port[$3C9]; + green:= port[$3C9]; + blue:= port[$3C9]; +end; + +{} +procedure set_color(color,red,green,blue:byte); +begin + port[$3C8]:=color; + port[$3C9]:=red; + port[$3C9]:=green; + port[$3C9]:=blue; +end; + +{} +Procedure Fadeup(var paleta_e:tpaleta;espera:byte); +VAR loop1,i:integer; + color:word; + n_color:byte; + Tmp : Array [1..3] of byte; + { Per a guardar temporalment un color } +BEGIN + For loop1:=1 to 64 do BEGIN + { A color value for Red, green or blue is 0 to 63, so this loop only + need be executed a maximum of 64 times } + for i:=0 to espera do Espera_Vga; + color:=0; + n_color:=0; + repeat + Get_color(n_color,Tmp[1],Tmp[2],Tmp[3]); + If Tmp[1]red then dec (Tmp[1]); + If Tmp[2]>green then dec (Tmp[2]); + If Tmp[3]>blue then dec (Tmp[3]); + { If the Red, Green or Blue values of color loop2 are not yet zero, + then, decrease them by one. } + set_color (loop2,Tmp[1],Tmp[2],Tmp[3]); + { Set the new, altered pallette color. } + END; + END; +END; + +{} +Procedure FadeDown_C(color,red,green,blue,espera:byte); + { This procedure fades one color to another } +VAR loop1,loop2,i:integer; + Tmp : Array [1..3] of byte; + { This is temporary storage for the values of a color } +BEGIN + For loop1:=1 to 64 do + BEGIN + for i:=0 to espera do Espera_vga; + + Get_color (color,Tmp[1],Tmp[2],Tmp[3]); + If Tmp[1]>red then dec (Tmp[1]); + If Tmp[2]>green then dec (Tmp[2]); + If Tmp[3]>blue then dec (Tmp[3]); + { If the Red, Green or Blue values of color loop2 are not yet zero, + then, decrease them by one. } + set_color (color,Tmp[1],Tmp[2],Tmp[3]); + { Set the new, altered pallette color. } + END; +END; + + +{} +procedure Line(x1, y1, x2, y2 : integer; color : byte;z_mem:word); +var i, deltax, deltay, numpixels, + d, dinc1, dinc2, + x, xinc1, xinc2, + y, yinc1, yinc2 : integer; +begin + + { Calculate deltax and deltay for initialisation } + deltax := abs(x2 - x1); + deltay := abs(y2 - y1); + + { Initialize all vars based on which is the independent variable } + if deltax >= deltay then + begin + + { x is independent variable } + numpixels := deltax + 1; + d := (2 * deltay) - deltax; + dinc1 := deltay Shl 1; + dinc2 := (deltay - deltax) shl 1; + xinc1 := 1; + xinc2 := 1; + yinc1 := 0; + yinc2 := 1; + end + else + begin + + { y is independent variable } + numpixels := deltay + 1; + d := (2 * deltax) - deltay; + dinc1 := deltax Shl 1; + dinc2 := (deltax - deltay) shl 1; + xinc1 := 0; + xinc2 := 1; + yinc1 := 1; + yinc2 := 1; + end; + + { Make sure x and y move in the right directions } + if x1 > x2 then + begin + xinc1 := - xinc1; + xinc2 := - xinc2; + end; + if y1 > y2 then + begin + yinc1 := - yinc1; + yinc2 := - yinc2; + end; + + { Start drawing at } + x := x1; + y := y1; + + { Draw the pixels } + for i := 1 to numpixels do + begin + PutPixel(x, y, color,z_mem); + if d < 0 then + begin + d := d + dinc1; + x := x + xinc1; + y := y + yinc1; + end + else + begin + d := d + dinc2; + x := x + xinc2; + y := y + yinc2; + end; + end; +end; + +{} +procedure blackout; +var loop:byte; +begin + for loop:=0 to 255 do setcolor(loop,0,0,0); +end; + +{} +procedure parallax_scroll(mem_orig,mem_dest,desplasament:word);assembler; + asm + push ds; + {inicialitzar l'acces a les memories orige i desti} + mov ax,mem_orig; + mov ds,ax; + xor si,si; + + mov ax,mem_dest; + mov es,ax; + mov di,desplasament; + + {comenar a copiar primer tros} + mov cx,64000; {bytes en una pantalla} + sub cx,desplasament; {bytes a copiar} + shr cx,1; {words a copiar} + jz @part2; + +@pintar1: + mov ax,ds:[si]; + or al,00h; + jz @next1; + mov es:[di],al; +@next1: + inc di; + or ah,00h; + jz @next2; + mov es:[di],ah; +@next2: + inc si; + inc di; + inc si; + loop @pintar1; + +@part2: + {comenar a copiar segon tros} + mov cx,desplasament; + shr cx,1; + jz @fi; + xor di,di; + +@pintar2: + mov ax,ds:[si]; + or al,00h; + jz @next3; + mov es:[di],al; +@next3: + inc di; + or ah,00h; + jz @next4; + mov es:[di],ah; +@next4: + inc si; + inc di; + inc si; + loop @pintar2; + +@fi: pop ds; + end; + +{} +procedure PutSprite(mem_orig,mem_dest,m_offset,ample,alt,posx,posy:word); + begin + asm + push ds; + + mov si,m_offset; + + mov ax,mem_orig; + mov ds,ax; {memoria orige} + mov ax,mem_dest; + mov es,ax; {memoria desti} + mov bx,320 + sub bx,ample + mov di,posx; {DI = X} + mov dx,posy; {DX = Y} + shl dx,8; {DX = 256*Y} + add di,dx; {DI = 256*Y+BX} + shr dx,2; {DX = 64*Y} + add di,dx; {DI = 320*Y+X} + + mov cx,alt; {guarde el alt} + + @1: push cx; {guarde el alt} + + mov cx,ample; {carregue el ample} + + @nou_pixel: + mov al,ds:[si] {color del pixel orige en al} + cmp al,00h; {AL=0?} + jnz @paint; + jmp @new; {altre pixel} + + @paint: + mov es:[di],al; {pintar pixel} + + @new: + inc di; {augmentar punter pantalla} + inc si; {augmentar punter font} + loop @nou_pixel; {mentres no siga l'ample continuar} + + add si,bx + add di,bx + pop cx; {recuperem l'alt} + {loop @1;} + dec cx; {una linia menys} + cmp cx,0; {Queden linies?} + jnz @1; {Si.Anar a @1} + + pop ds; + end; +end; + + +procedure put_sprite(mem_orig,mem_dest,m_offset,ample,alt,posx,posy:word); + begin + asm + push ds; + + mov si,m_offset; + + mov ax,mem_orig; + mov ds,ax; {memoria orige} + mov ax,mem_dest; + mov es,ax; {memoria desti} + + mov di,posx; {DI = X} + mov dx,posy; {DX = Y} + shl dx,8; {DX = 256*Y} + add di,dx; {DI = 256*Y+BX} + shr dx,2; {DX = 64*Y} + add di,dx; {DI = 320*Y+X} + + mov cx,alt; {guarde el alt} + + @1: push cx; {guarde el alt} + push di; {guarde el offset desti} + push si; {guarde el offset orige} + + mov cx,ample; {carregue el ample} + + @nou_pixel: + mov al,ds:[si] {color del pixel orige en al} + or al,00h; {AL=0?} + jnz @paint; + jmp @new; {altre pixel} + + @paint: + mov es:[di],al; {pintar pixel} + + @new: + inc di; {augmentar punter pantalla} + inc si; {augmentar punter font} + loop @nou_pixel; {mentres no siga l'ample continuar} + pop si; {recuperem l'offset orige} + pop di; {recuperem l'offset desti} + add si,320; {segent linia orige} + add di,320; {segent linia desti} + pop cx; {recuperem l'alt} + dec cx; {una linia menys} + cmp cx,0; {Queden linies?} + jnz @1; {Si.Anar a @1} + pop ds; + end; +end; + +{} +procedure scroll_v(mem_orig,mem_dest,desplasament:word);assembler; + asm + push ds; + {inicialitzar l'acces a les memories orige i desti} + mov ax,mem_orig; + mov ds,ax; + xor si,si; + + mov ax,mem_dest; + mov es,ax; + mov di,desplasament; + + mov cx,64000; {bytes en una pantalla} + sub cx,desplasament; {bytes a copiar} + shr cx,1; {words a copiar} + {comenar a copiar primer tros} + rep movsw; + + mov cx,desplasament; + shr cx,1; + xor di,di; + {comenar a copiar segon tros} + rep movsw; + + pop ds; + end; + +{} +procedure BlitChar(c:char;xc,yc,color,tamany:word); +const ROM_SET = $F000; + ROM_SET_OFFSET =$FA6E; + +var i,j,offset,x,y,x1:word; + bit_mask:byte; + +begin + bit_mask:=$80; + offset:=(yc shl 8) + (yc shl 6) +xc; + + if tamany>0 then + for y:=0 to 7 do + begin + for j:=1 to tamany do + begin + bit_mask:=$80; + for x:=0 to 7 do + begin + x1:=x*tamany; + for i:=1 to tamany do + begin + if ((mem[ROM_SET:ROM_SET_OFFSET+(ord(c)*8)+y] and bit_mask)<>0) then + mem[$a000:offset+x1]:=color; + inc(x1); + end; + bit_mask:=bit_mask shr 1; + end; + offset:=offset+320; + end; + end + else + for y:=0 to 7 do + begin + bit_mask:=$80; + x1:=0; + for x:=0 to 7 do + begin + if x1 mod 2=0 then + if ((mem[ROM_SET:ROM_SET_OFFSET+(ord(c)*8)+y] and bit_mask)<>0) then + mem[$a000:offset+(x1 div 2)]:=color; + bit_mask:=bit_mask shr 1; + inc(x1); + end; + offset:=offset+320; + end; +end; + +{} +procedure BlitString(cadena:string;xc,yc,color,tamany:word); +var i:word; +begin + for i:=1 to length(cadena) do + begin + blitchar(cadena[i],xc,yc,color,tamany); + inc(xc,8*tamany); + if (xc>319) then + begin + inc(yc,(8*tamany)+1); + xc:=0; + end; + if tamany=0 then inc(xc,5); + end; +end; + +{} +procedure Escalar(x,y,z,Distance:word;var xp,yp:word); +begin + xp:=Distance*x div z; + yp:=Distance*y div z +end; + +procedure Escalat(Mem1,Mem2,Xini,Yini,Xfi,Yfi,PosX,PosY:word;escala:integer); +var x,y,x1,y1:word; + color:byte; + i,j,k,l:word; + z,d:word; +begin + if escala>0 then + begin + d:=escala; + z:=1; + end + else + begin + z:=-escala; + d:=1; + end; + for j:=Yfi downto Yini do + for i:=Xfi downto Xini do + begin + color:=getpix(mem1,i,j); + Escalar(i-Xini,j-Yini,z,d,x,y); + if (Xini+x<320) and (Yini+y<200) then putpix(Xini+x,Yini+y+PosY,color,Mem2); + if (d>z) then + begin + for l:=1 to d-z do + begin + for k:=1 to d-z do + begin + inc(x); + if (Xini+x<320) and (Yini+y<200) then putpix(Xini+x,Yini+y+PosY,color,Mem2); + end; + inc(y); + if (Xini+x<320) and (Yini+y<200) then putpix(Xini+x,Yini+y+PosY,color,Mem2); + for k:=1 to d-z do + begin + dec(x); + if (Xini+x<320) and (Yini+y<200) then putpix(Xini+x,Yini+y+PosY,color,Mem2); + end; + + end; + end; + end; +end; + +{} +procedure GetColor(color:byte;var red,green,blue:byte); +var r,g,b:byte; +begin + asm + mov dx,3C7h + mov al,color + out dx,al + mov dx,3C9h + in al,dx + mov r,al + in al,dx + mov g,al + in al,dx + mov b,al + end; + red:=r;green:=g;blue:=b; +end; + +{} +procedure SetColor(color,red,green,blue:byte);assembler; +asm + mov dx,3C8h + mov al,color + out dx,al + mov dx,3C9h + mov al,red + out dx,al + mov al,green + out dx,al + mov al,blue + out dx,al +end; + +{} +procedure RotatePal(index1,index2:word); +var i:word; + color,aux:array[1..3] of byte; +begin + if index1>index2 then + begin + i:=index1; + index1:=index2; + index2:=i; + end; + getcolor(index1,color[1],color[2],color[3]); + for i:=index1+1 to index2 do + begin + getcolor(i,aux[1],aux[2],aux[3]); + setcolor(i-1,aux[1],aux[2],aux[3]); + end; + setcolor(index2,color[1],color[2],color[3]); +end; + +{} +procedure zoom05(mem_orig,mem_dest:word); +var i,j,offset:word; +begin + for i:=0 to 159 do + for j:=0 to 99 do + begin + offset:=320*j+i; + mem[mem_dest:offset]:=mem[mem_orig:320*(j*2)+(i*2)]; + mem[mem_dest:offset+1]:=mem[mem_orig:320*(j*2)+(i*2)]; + mem[mem_dest:offset+320]:=mem[mem_orig:320*(j*2)+(i*2)]; + mem[mem_dest:offset+321]:=mem[mem_orig:320*(j*2)+(i*2)] + end; +end; + +procedure zoomx2(mem_orig,mem_dest:word); +var i,j:word; +begin + for i:=0 to 159 do + for j:=0 to 99 do + begin + mem[mem_dest:320*(j*2)+(i*2)]:=mem[mem_orig:320*(j)+(i)]; + mem[mem_dest:320*(j*2)+((i*2)+1)]:=mem[mem_orig:320*(j)+(i)]; + mem[mem_dest:320*((j*2)+1)+(i*2)]:=mem[mem_orig:320*(j)+(i)]; + mem[mem_dest:320*((j*2)+1)+((i*2)+1)]:=mem[mem_orig:320*(j)+(i)] + end; +end; + +procedure out1; +var i,j,a:word; + v:ptr_pantalla; +begin + setupvirtual(v,a); + for i:=1 to 8 do + begin + espera_vga; + zoom05($a000,$a000); + end; + volcar32($a000,a); + for i:=1 to 8 do + begin + for j:=1 to 3 do espera_vga; + zoomx2(a,$a000); + volcar32($a000,a); + end; + tancarvirtual(v); +end; + +procedure out2(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 160 do + begin + line(0,199,2*x1,0,color,$a000); + line(0,199,2*x1+1,0,color,$a000); + + line(0,0,2*x1,199,color,$a000); + line(0,0,2*x1+1,199,color,$a000); + + line(319,0,319-(2*x1),199,color,$a000); + line(319,0,319-(2*x1+1),199,color,$a000); + + line(319,199,319-(2*x1),0,color,$a000); + line(319,199,319-(2*x1+1),0,color,$a000); + + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out3(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 160 do + begin + line(2*x1,199,2*x1,0,color,$a000); + line(2*x1+1,199,2*x1+1,0,color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out4(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 160 do + begin + line(319-(2*x1),199,319-(2*x1),0,color,$a000); + line(319-(2*x1+1),199,319-(2*x1+1),0,color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out5(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 100 do + begin + line(0,2*x1,319,2*x1,color,$a000); + line(0,2*x1+1,319,2*x1+1,color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out6(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 100 do + begin + line(0,199-(2*x1),319,199-(2*x1),color,$a000); + line(0,199-(2*x1+1),319,199-(2*x1+1),color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out7(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 100 do + begin + line(0,x1,319,x1,color,$a000); + line(0,200-(x1+1),319,200-(x1+1),color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out8(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 100 do + begin + line(0,100-x1,319,100-x1,color,$a000); + line(0,100+(x1+1),319,100+(x1+1),color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out9(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 160 do + begin + line(x1,0,x1,199,color,$a000); + line(320-(x1+1),0,320-(x1+1),199,color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out10(color,velocitat:byte); +var x1,loop:word; +begin + for x1:=0 to 160 do + begin + line(160-x1,0,160-x1,199,color,$a000); + line(160+(x1+1),0,160+(x1+1),199,color,$a000); + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure out11(color:byte;separacio:word;velocitat:byte); +var x1,x2,y2,loop:word; +begin + x2:=320 div separacio; + y2:=200 div separacio; + for x1:=0 to separacio do + begin + for loop:=0 to x2 do + begin + line(x1+(separacio*loop),199,x1+(separacio*loop),0,color,$a000); + end; + for loop:=0 to y2 do + begin + line(0,x1+(separacio*loop),319,x1+(separacio*loop),color,$a000); + end; + for loop:=0 to velocitat do espera_vga; + end; +end; + +procedure disolve(color:byte;velocitat:byte); +var i,j:word; + offset:word; +begin + randomize; + for i:=1 to 300 do + begin + if velocitat>=1 then espera_vga; + for j:=1 to 1000 do + putpixel(random(320),random(200),color,$a000); + end; + cls(color,$a000); +end; + +procedure Out(NumOut,color,velocitat:byte;separacio:word); +begin + case NumOut of + 1:out1; + 2:out2(color,velocitat); + 3:out3(color,velocitat); + 4:out4(color,velocitat); + 5:out5(color,velocitat); + 6:out6(color,velocitat); + 7:out7(color,velocitat); + 8:out8(color,velocitat); + 9:out9(color,velocitat); + 10:out10(color,velocitat); + 11:out11(color,separacio,velocitat); + 12:Disolve(color,velocitat); + end; +end; + +{} +procedure GWindow(x1,y1,x2,y2:word;color:byte;Zmem:word);assembler; +asm + mov ax,zmem; + mov es,ax; {ES=ZMEM} + {for i:=0 to y1 do line(0,i,319,i,color,z_mem);} + xor di,di; {DI=0} + + mov ax,y1; {AX=Y1} + shl ax,8; {AX=256*AX} + mov cx,ax; {CX=AX} + shr ax,2; {AX=AX div 4} + add cx,ax; {CX=CX+AX} + + mov al,color; + rep stosb; + + {for i:=y2 to 199 do line(0,i,319,i,color,z_mem);} + mov ax,y2; + shl ax,8; + mov di,ax; + shr ax,2; + add di,ax; + + + mov ax,200; + sub ax,y2; + shl ax,8; {AX=256*AX} + mov cx,ax; {CX=AX} + shr ax,2; {AX=AX div 4} + add cx,ax; {CX=CX+AX} + + mov al,color; + rep stosb; + + {for i:=0 to x1 do line(i,0+y1,i,199-(199-y2),color,z_mem);} + mov al,color + + mov cx,y2 + sub cx,y1 + @bucle1: + mov dx,cx{push cx} + mov bx,y2 + sub bx,cx + shl bx,8 + mov di,bx + shr bx,2 + add di,bx + mov cx,x1 + rep stosb + mov cx,dx{pop cx} + loop @bucle1 + + {for i:=x2 to 319 do line(i,0+y1,i,199-(199-y2),color,z_mem);} + mov al,color + + mov cx,y2 + sub cx,y1 + + @bucle2: + mov dx,cx{push cx} + + mov bx,y2 + sub bx,cx + shl bx,8 + mov di,bx + shr bx,2 + add di,bx + add di,x2 + + mov bx,320 + sub bx,x2 + mov cx,bx + rep stosb + mov cx,dx{pop cx} + loop @bucle2 +end; + +{Gestio del DoubleBuffer } +procedure CreateDB(NumLines:word); +begin + GetMem(Dbuffer.PDbuffer,NumLines*320); + Dbuffer.AltDbuffer:=NumLines; + Dbuffer.SizeDBuffer:=(320*NumLines) div 4;{El tamany expresat en DWORDs} + DBuffer.MDbuffer:=seg(Dbuffer.PDbuffer^); +end; + +procedure ClearDB(color:byte);assembler; +asm + mov dx,seg [Dbuffer] + mov ds,dx + mov si,offset [Dbuffer+6] + mov cx,word ptr [ds:si] {cx conte el tamany de DBuffer} + mov ax,word ptr [ds:si+2] + mov es,ax + xor di,di + mov al,color + mov ah,al + mov bx,ax + mov cx,Dbuffer.SizeDbuffer + db _32bit + shl ax,16 + mov ax,bx + db _32bit + rep stosw +end; + +procedure FlipDB;assembler; +asm + push ds {Guardar l'adrea del segment de dades} + mov dx,seg [Dbuffer] + mov ds,dx + mov si,offset [Dbuffer+6] + mov cx,word ptr [ds:si] {cx conte el tamany de DBuffer} + mov ax,$a000 + xor di,di {di=0} + mov es,ax {es=VGA} + mov ds,word ptr [ds:si+2] + mov si,di {si=0} + cld {Asegurarse que l'increment no siga decrement} + db _32bit {Mode 32bits} + rep movsw {movsdw} + pop ds {Restaurar l'adrea del segment de dades} +end; + +procedure DeleteDB; +begin + FreeMem(DBuffer.PDBuffer,DBuffer.SizeDBuffer); +end; + +{} +procedure Scale2D(font,desti,ample,alt,posx,posy:word;zoom:real); +var IndexEscalaY,IndexEscalaX,PasEscalaY,PasEscalaX:real; + TamanyDesti:word; + offset:word; + x,y:word; + data:byte; + Pdibuix:word; + fiY,fiX:longint; + +begin + IndexEscalaY:=0; {Posar l'orige del primer pixel} + PasEscalaY:=alt/(alt*zoom); {calcular el pas} + PasEscalaX:=ample/(ample*zoom); + Pdibuix:=0; {punter al dibuix} + offset:=320*PosY+PosX; {calcular el offset desti} + fiY:=trunc(alt*zoom); + fiX:=Trunc(ample*zoom); + {escalar l'objecte fila a fila} + for y:=0 to fiY do + begin + {copiar la proxima fila en el desti usant copia de memoria rapida} + IndexEscalaX:=0; + for x:=0 to fiX do + begin + {comprobar transparencies} + data:=mem[font:Pdibuix+trunc(IndexEscalaX)]; + {if data<>0 then} mem[desti:offset+x]:=data; + IndexEscalaX:=IndexEscalaX+PasEscalaX; + end; {final per a les x} + {usant el pas de l'escala calculem el proxim pixel font} + IndexEscalaY:=IndexEscalaY+PasEscalaY; + {moure el punter a la seguent linia desti} + offset:=offset+320; + Pdibuix:=ample*trunc(IndexEscalaY); + end;{final per a les Y} +end;{final de l'escalat} + +procedure Scale2DClipped(font,desti,ample,alt,posx,posy:word;zoom:real); +var IndexEscalaY,IndexEscalaX,PasEscalaY,PasEscalaX:real; + TamanyDesti:word; + offset:word; + x,y:word; + data:byte; + Pdibuix:word; + fiY,fiX,Cclip:longint; + +begin + IndexEscalaY:=0; {Posar l'orige del primer pixel} + PasEscalaY:=1/zoom; {calcular el pas} + PasEscalaX:=1/zoom; + Pdibuix:=0; {punter al dibuix} + offset:=320*PosY+PosX; {calcular el offset desti} + fiY:=trunc((alt-1)*zoom); {Nou Alt} + fiX:=Trunc((ample-1)*zoom);{nou ample} + {comprobar que no ix de la pantalla + i corregir en cas contrari -> optimitzar} + if fiY>200 then fiY:=199; + if fiX>320 then fiX:=319; + {escalar l'objecte fila a fila} + for y:=0 to fiY do + begin + {copiar la proxima fila en el desti usant copia de memoria rapida} + IndexEscalaX:=0; + for x:=0 to fiX do + begin + data:=mem[font:Pdibuix+trunc(IndexEscalaX)]; + {comprobar transparencies} + {if data<>0 then} mem[desti:offset+x]:=data; + IndexEscalaX:=IndexEscalaX+PasEscalaX; + end; {final per a les x} + {usant el pas de l'escala calculem el proxim pixel font} + IndexEscalaY:=IndexEscalaY+PasEscalaY; + {moure el punter a la seguent linia desti} + offset:=offset+320; + Pdibuix:=ample*trunc(IndexEscalaY); + end;{final per a les Y} +end;{final de l'escalat} + +procedure Scale2DMasked(font,desti,ample,alt,posx,posy:word;zoom:real); +var IndexEscalaY,IndexEscalaX,PasEscalaY,PasEscalaX:real; + TamanyDesti:word; + offset:word; + x,y:word; + data:byte; + Pdibuix:word; + fiY,fiX:longint; + +begin + IndexEscalaY:=0; {Posar l'orige del primer pixel} + PasEscalaY:=alt/(alt*zoom); {calcular el pas} + PasEscalaX:=ample/(ample*zoom); + Pdibuix:=0; {punter al dibuix} + offset:=320*PosY+PosX; {calcular el offset desti} + fiY:=trunc(alt*zoom); + fiX:=Trunc(ample*zoom); + {escalar l'objecte fila a fila} + for y:=0 to fiY do + begin + {copiar la proxima fila en el desti usant copia de memoria rapida} + IndexEscalaX:=0; + for x:=0 to fiX do + begin + {comprobar transparencies} + data:=mem[font:Pdibuix+trunc(IndexEscalaX)]; + if data<>0 then mem[desti:offset+x]:=data; + IndexEscalaX:=IndexEscalaX+PasEscalaX; + end; {final per a les x} + {usant el pas de l'escala calculem el proxim pixel font} + IndexEscalaY:=IndexEscalaY+PasEscalaY; + {moure el punter a la seguent linia desti} + offset:=offset+320; + Pdibuix:=ample*trunc(IndexEscalaY); + end;{final per a les Y} +end;{final de l'escalat} + +procedure Scale2DMaskedClipped(font,desti,ample,alt,posx,posy:word;zoom:real); +var IndexEscalaY,IndexEscalaX,PasEscalaY,PasEscalaX:real; + TamanyDesti:word; + offset:word; + x,y:word; + data:byte; + Pdibuix:word; + fiY,fiX,Cclip:longint; + +begin + IndexEscalaY:=0; {Posar l'orige del primer pixel} + PasEscalaY:=1/zoom; {calcular el pas} + PasEscalaX:=1/zoom; + Pdibuix:=0; {punter al dibuix} + offset:=320*PosY+PosX; {calcular el offset desti} + fiY:=trunc((alt-1)*zoom); {Nou Alt} + fiX:=Trunc((ample-1)*zoom);{nou ample} + {comprobar que no ix de la pantalla + i corregir en cas contrari -> optimitzar} + if fiY>200 then fiY:=199; + if fiX>320 then fiX:=319; + {escalar l'objecte fila a fila} + for y:=0 to fiY do + begin + {copiar la proxima fila en el desti usant copia de memoria rapida} + IndexEscalaX:=0; + for x:=0 to fiX do + begin + data:=mem[font:Pdibuix+trunc(IndexEscalaX)]; + {comprobar transparencies} + if data<>0 then mem[desti:offset+x]:=data; + IndexEscalaX:=IndexEscalaX+PasEscalaX; + end; {final per a les x} + {usant el pas de l'escala calculem el proxim pixel font} + IndexEscalaY:=IndexEscalaY+PasEscalaY; + {moure el punter a la seguent linia desti} + offset:=offset+320; + Pdibuix:=ample*trunc(IndexEscalaY); + end;{final per a les Y} +end;{final de l'escalat} + +{Sprites} + +procedure GrabFrame(font,x0,y0:word;var Sprite:PTSprite); +var i,j:word; +begin + with sprite^ do + begin + inc(num_frames); {aumentar el frames que te} + Getmem(frames[num_frames],ample*alt); {reservar memoria per a un frame} + for j:=y0 to y0+alt-1 do + for i:=x0 to x0+ample-1 do + mem[seg(Frames[num_frames]^):(ample*j)+i+ofs(Frames[num_frames]^)]:= + mem[font:320*j+i]; + end; +end; + + +procedure CreateSprite(var Sprite:PTSprite; + x0,y0:integer; + width,height,a_sp,m_sp,state:word); +var i:word; +begin + getmem(sprite,sizeof(Sprite^)); + with sprite^ do + begin + x:=x0; + y:=y0; + xold:=x0; + yold:=y0; + ample:=width; + alt:=height; + anim_clock:=0; + anim_speed:=a_sp; + motion_clock:=0; + motion_speed:=m_sp; + curr_frame:=1; + num_frames:=0; + estat:=state; + For i:=1 to MAXFRAMES do frames[i]:=nil; + end; +end; + +procedure DeleteSprite(Sprite:PTsprite); +var i:word; +begin + with sprite^ do + for i:=1 to num_frames do + begin + Freemem(frames[i],ample*alt); + Dispose(frames[i]); + end; + freemem(sprite,sizeof(sprite)); +end; + +procedure DrawSprite(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + mov bx,320 + sub bx,dx {bx conte el desplaament de DI quan acabe de pintar + una linia} + @loopY: + push cx + mov cx,dx + rep movsb + add di,bx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteDB(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + mov bx,320 + sub bx,dx {bx conte el desplaament de DI quan acabe de pintar + una linia} + @loopY: + push cx + mov cx,dx + rep movsb + add di,bx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteM(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteDBM(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteF(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + add bx,cx + mov es:[bx],dl + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteDBF(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + add bx,cx + mov es:[bx],dl + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteMF(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteDBMF(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSprite(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,cx + add bx,di + mov es:[bx],dl + @transparent: + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteDB(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,cx + add bx,di + mov es:[bx],dl + @transparent: + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteM(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteDBM(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + add di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteF(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + dec di {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + add bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteDBF(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + dec di {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + add bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteMF(sprite:PTSprite);assembler; +asm + push ds + mov ax,$a000 + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure MaskedSpriteDBMF(sprite:PTSprite);assembler; +asm + push ds + mov ax,Dbuffer.MDBuffer + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov dx,[bp+8] + mov es,dx {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + add bx,cx {nova y=y+alt-1} + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx + add di,dx {*di conte l'offset de pantalla} + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+X} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + sub di,320 + pop dx + add ax,dx {AX=AX+Sprite^.ample} + pop cx + loop @loopY + pop ds +end; + +procedure DrawSpriteC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,cx + mov es:[di+bx],dl + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure DrawSpriteDBC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,cx + mov es:[di+bx],dl + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure DrawSpriteMC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx {possar DI al final del dibuix} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+x} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure DrawSpriteDBMC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov es,ax {*ES conte el segment del DB} + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx {possar DI al final del dibuix} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+x} + add bx,si + dec bx + mov dl,ds:[bx] + mov bx,di + sub bx,cx + mov es:[bx],dl + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure DrawSpriteFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,cx + mov es:[di+bx],dl + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + + +procedure DrawSpriteDBFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,cx + mov es:[di+bx],dl + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure DrawSpriteMFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,di + sub bx,cx + inc bx + mov es:[bx],dl + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + + +procedure DrawSpriteDBMFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + mov bx,di + sub bx,cx + inc bx + mov es:[bx],dl + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,cx + mov es:[di+bx],dl + @transparent: + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteDBC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,cx + mov es:[di+bx],dl + @transparent: + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteMC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx {possar DI al final del dibuix} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+x} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteDBMC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov es,ax {*ES conte el segment del DB} + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor ax,ax + sub ax,bx {ax=-y} + mov bx,ax {bx=-y} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx + @EndClip: + + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx {possar DI al final del dibuix} + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,ax {BX=Pdib} + add bx,cx {BX=Pdib+x} + add bx,si + dec bx + mov dl,ds:[bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + mov es:[bx],dl + @transparent: + loop @loopX + pop dx + pop cx + add di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,cx + mov es:[di+bx],dl + @transparent: + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + + +procedure MaskedSpriteDBFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub si,di {nou offset orige} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,cx + mov es:[di+bx],dl + @transparent: + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + +procedure MaskedSpriteMFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + mov ax,$a000 + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + inc bx + mov es:[bx],dl + @transparent: + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + + +procedure MaskedSpriteDBMFC(sprite:PTSprite);assembler; +asm + push ds + {obtindre posicio de l'estructura sprite a la memoria} + mov di,[bp+6] {DI=ofs(sprite)} + mov ax,[bp+8] + mov es,ax {ES=seg(sprite)} + mov bx,es:[di+20] {Curr_frame} + shl bx,2 + sub bx,4 {ao es per saber el desplaament dins el vector + de punters} + mov ax,Dbuffer.MDBuffer {si ho possem mes tard al haver modificat DS + no sabem quin valor pot recuperat} + mov si,es:[di+bx+26] {*offset del frame} + mov ds,es:[di+bx+28] {*segment del frame} + mov cx,es:[di+10] {sprite^.alt} + mov dx,es:[di+8] {*sprite^.ample} + mov bx,es:[di+2] {bx=sprite^.y} + mov di,es:[di] {di=sprite^.x} + {mov ax,$a000} + + mov es,ax {*ES conte el segment de la pantalla} + + push dx + {Clipping} + test di,$8000 {x<0?} + jz @ClipXdreta + add dx,di {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + xor di,di + jmp @ClipY + @clipXdreta: + mov ax,di + add ax,dx + cmp ax,320 + jl @clipY + add si,dx + mov dx,320 {!! atencio hem modificat DX que contenia Sprite^.ample i + ara conte el nou ample} + sub dx,di + sub si,dx + @clipY: + test bx,$8000 + jz @ClipYavall + add cx,bx {Ai encara que hem modificat CX no importa} + xor bx,bx + jmp @EndClip + @ClipYavall: + mov ax,bx + add ax,cx + cmp ax,200 + jle @endClip + mov cx,200 + sub cx,bx {CX=nou alt} + pop ax + push ax + push dx {la multiplicacio canvia el valor del registre DX!} + mul bx + pop dx + add si,ax {ample*y+x} + @EndClip: + + add bx,cx + dec bx + shl bx,8 + add di,bx + shr bx,2 + add di,bx {*di conte l'offset de pantalla} + add di,dx + dec di + xor ax,ax {*AX=0=Pdib} + @loopY: + push cx + mov cx,dx + push dx + @loopX: + mov bx,cx {BX=X} + add bx,ax {BX=Pdib+x} + dec bx + mov dl,ds:[si+bx] + cmp dl,0 + jz @transparent + mov bx,di + sub bx,cx + inc bx + mov es:[bx],dl + @transparent: + loop @loopX + pop dx + pop cx + sub di,320 + + pop bx + add ax,bx {AX=AX+Sprite^.ample} + push bx + + loop @loopY + pop bx + pop ds +end; + + +{} +function Colisio(x1,y1,w1,h1, x2,y2,w2,h2 :integer):boolean; +var xd,yd : boolean; +Begin + xd:=false; + yd:=false; + if ((x1 <=x2) and (x1+w1>=x2)) then xd:=true else + if ((x1 <=x2+w2) and (x1+w1>=x2+w2)) then xd:=true else + if ((x1 >=x2) and (x1+w1<=x2+w2)) then xd:=true; + if ((y1 <=y2) and (y1+h1>=y2)) then yd:=true else + if ((y1 <=y2+h2) and (y1+h1>=y2+h2)) then yd:=true else + if ((y1 >=y2) and (y1+h1<=y2+h2)) then yd:=true; + Colisio:=xd and yd; +end; + +{} +procedure LoadPCX(Name:String;MemD:word); +Const MAX_BUFFER=2047; + COMPRESS = $C0; + COUNT = $3F; + +type + TPCXHEADER = Record + Manufacturer:byte; + Version:byte; + Encoding:byte; + BitsXPix:byte; + Xmin:word; + YMin:word; + XMax:word; + YMAx:word; + HDpi:word; + VDpi:word; + Colormap:array[0..47]of byte; + Reserved:byte; + Planes:byte; + BytesPerLine:word; + PaletteInfo:word; + HScrSize:word; + VScrSize:word; + Filler:array[0..53] of byte; + end; + + TRGBPCX = Record + red:byte; + green:byte; + blue:byte; + end; + +var f:file; + Buffer:array[0..MAX_BUFFER] of byte; + Paleta:array[0..255] of TRGBPCX; + PBuf,Pscr,BytesInLine,Reps,i:word; + PCXheader:TPCXHEADER; + DataSize:longint; + +begin + assign(f,name); + reset(f,1); + DataSize:=Filesize(f)-128-769; + blockread(f,PCXheader,sizeof(PCXHeader)); + + Pscr:=0; + bytesInLine:=0; + repeat + if DataSize>=MAX_BUFFER+1 then + begin + Pbuf:=0; + blockread(f,buffer,Sizeof(buffer)); + dec(DataSize,MAX_BUFFER+1); + repeat + if (Buffer[Pbuf] and COMPRESS = COMPRESS) then + begin + Reps:=Buffer[Pbuf] and COUNT; + inc(Pbuf); + if Pbuf>MAX_BUFFER then + begin + dec(Pbuf); + blockread(f,buffer[Pbuf],1); + dec(DataSize); + end; + for i:=1 to Reps do + begin + mem[memD:Pscr]:=buffer[Pbuf]; + inc(BytesInLine); + if BytesInLine=PcxHeader.BytesPerLine then + begin + Pscr:=Pscr+320-PcxHeader.BytesPerLine+1; + BytesInLine:=0; + end + else inc(Pscr); + end; + inc(Pbuf); + end + else + begin + mem[memD:Pscr]:=buffer[Pbuf]; + inc(BytesInLine); + if BytesInLine=PcxHeader.BytesPerLine then + begin + Pscr:=Pscr+320-PcxHeader.BytesPerLine+1; + BytesInLine:=0; + end + else inc(Pscr); + inc(Pbuf); + end; + until Pbuf=MAX_BUFFER+1; + end + else + begin + Pbuf:=0; + blockread(f,buffer,DataSize); + repeat + if (Buffer[Pbuf] and COMPRESS = COMPRESS) then + begin + Reps:=Buffer[Pbuf] and COUNT; + inc(Pbuf); + for i:=1 to Reps do + begin + mem[memD:Pscr]:=buffer[Pbuf]; + inc(BytesInLine); + if BytesInLine=PcxHeader.BytesPerLine then + begin + Pscr:=Pscr+320-PcxHeader.BytesPerLine+1; + BytesInLine:=0; + end + else inc(Pscr); + end; + inc(Pbuf); + end + else + begin + mem[memD:Pscr]:=buffer[Pbuf]; + inc(BytesInLine); + if BytesInLine=PcxHeader.BytesPerLine then + begin + Pscr:=Pscr+320-PcxHeader.BytesPerLine+1; + BytesInLine:=0; + end + else inc(Pscr); + inc(Pbuf); + end; + until Pbuf=DataSize; + DataSize:=0; + end; + until DataSize=0; + + + blockread(f,buffer,1); {llegir un dotze que indica la paleta} + blockread(f,Paleta,Sizeof(Paleta)); + port[$3c8]:=0; + for i:=0 to 255 do + begin + port[$3c9]:=paleta[i].red shr 2; + port[$3c9]:=paleta[i].green shr 2; + port[$3c9]:=paleta[i].blue shr 2; + end; + close(f); +end; + +{} +procedure SavePCX(name:string); +type + TPCXHEADER = Record + Manufacturer:byte; + Version:byte; + Encoding:byte; + BitsXPix:byte; + Xmin:word; + YMin:word; + XMax:word; + YMAx:word; + HDpi:word; + VDpi:word; + Colormap:array[0..47]of byte; + Reserved:byte; + Planes:byte; + BytesPerLine:word; + PaletteInfo:word; + HScrSize:word; + VScrSize:word; + Filler:array[0..53] of byte; + end; + + TRGBPCX = Record + red:byte; + green:byte; + blue:byte; + end; + +var SCRLINE:array [0..319] of byte; + Paleta:array [0..255] of TRGBPCX; + PLINE,PSCR,i:word; + Header:TPCXHEADER; + f:file; + Count,Data:byte; + +begin + assign(f,name); + rewrite(f,1); + {escriure capalera} + Header.manufacturer:=10; + Header.version:=5; + Header.encoding:=1; + Header.bitsxpix:=8; + Header.xmin:=0; + Header.ymin:=0; + Header.xmax:=319; + Header.ymax:=199; + Header.hdpi:=72; + Header.vdpi:=72; + for i:=0 to 47 do + Header.colormap[i]:=0; + Header.reserved:=0; + Header.planes:=1; + Header.bytesperline:=320; + Header.paletteinfo:=1; + Header.Hscrsize:=320; + Header.vscrsize:=200; + for i:=0 to 53 do + Header.filler[i]:=0; + blockwrite(f,header,sizeof(header)); + {codificar i escriure cada linea de la pantalla} + PLINE:=0; + repeat + move(mem[$a000:PLINE*320],SCRLINE,320); {una linea al buffer} + PSCR:=0; + repeat + Data:=SCRLINE[PSCR]; + Count:=0; + while (Data=SCRLINE[PSCR]) and (PSCR<320) and (Count<63) do + begin + inc(pscr); + inc(count); + end; + {algorisme de compresio del PCX} + if (count=1) and ($C0 <> ($C0 and data)) then blockwrite(f,data,1) + else + begin + count:=count or $C0; + blockwrite(f,count,1); + blockwrite(f,data,1); + end; + {==============================} + until PSCR=320; + inc(Pline); + until PLINE=200; + {escriure la paleta activa} + Data:=12; + blockwrite(f,Data,1); + Port[$3c7]:=0; + for i:=0 to 255 do + begin + paleta[i].red:=Port[$3c9]; + paleta[i].green:=Port[$3c9]; + paleta[i].blue:=Port[$3c9]; + paleta[i].red:=paleta[i].red shl 2; + paleta[i].green:=paleta[i].green shl 2; + paleta[i].blue:=paleta[i].blue shl 2; + end; + blockwrite(f,paleta,sizeof(paleta)); + close(f); +end; + +{} +procedure LoadBMP(name:string;MemD:word); +(* Format BMP -> Windows, 256 Colors, 320x200 maxim, RLE *) +Const MAX_BUFFER=2047; {2K de Buffer} + +type TBITMAPFILEHEADER=record + Sign:word; + Size:longint; + Reserved1:word; + Reserved2:word; + OffBits:longint; + end; + + TBITMAPINFOHEADER=record + Size:longint; + Ample:longint; + Alt:longint; + Planes:word; + BitsXPix:word; + Compresio:longint; + SizeImage:longint; + XPelsPerMeter:longint; + YPelsPerMeter:longint; + ColorsUsed:longint; + ColorImportant:longint; + end; + + TRGBBM=record + Blue:byte; + Green:byte; + Red:byte; + Reserved:byte; + end; + +var buffer:array[0..MAX_BUFFER] of byte; + paleta:array[0..255] of TRGBBM; + f:file; + fileheader:TbitmapFileHeader; + InfoHeader:TbitmapInfoHeader; + DataSize:longint; + PBuf,PScr,i,X,Y:word; + {MovX,MovY:byte; proximes versions} + nocomp,reps:byte; + +begin + assign(f,name); + reset(f,1); + blockread(f,fileheader,sizeof(fileheader)); + blockread(f,infoheader,sizeof(infoheader)); + + seek(f,54); + blockread(f,paleta,sizeof(paleta)); + port[$3C8]:=0; + for i:=0 to 255 do + begin + port[$3c9]:=paleta[i].red shr 2; + port[$3c9]:=paleta[i].green shr 2; + port[$3c9]:=paleta[i].blue shr 2; + end; + + seek(f,fileheader.offbits); + {Descomprimir i escriure imatge} + DataSize:=infoheader.SizeImage; + Pscr:=320*(infoheader.alt-1); + repeat + if DataSize>=MAX_BUFFER+1 then + begin + PBuf:=0; + Blockread(f,buffer,sizeof(buffer)); + DataSize:=DataSize-Sizeof(buffer); + repeat + if Buffer[PBuf]=0 then + begin + inc(Pbuf); + if Pbuf>MAX_BUFFER then + begin + dec(pbuf); + blockread(f,buffer[Pbuf],1); + dec(Datasize); + end; + case Buffer[Pbuf] of + 0:{eol}begin Pscr:=Pscr-320-infoheader.ample;inc(Pbuf);end; + 1:inc(Pbuf); + 2:; + else + begin + nocomp:=buffer[Pbuf]; + inc(Pbuf); + if Pbuf>MAX_BUFFER then + begin + dec(Pbuf); + blockread(f,buffer[pbuf],1); + dec(Datasize); + end; + For i:=1 to nocomp do + begin + mem[MemD:Pscr]:=Buffer[Pbuf]; + inc(Pscr); + inc(Pbuf); + if Pbuf>MAX_BUFFER then + begin + dec(Pbuf); + blockread(f,buffer[Pbuf],1); + dec(DataSize); + end; + end; + if nocomp mod 2 =1 then inc(Pbuf); + end; + end; + end + else + begin + reps:=Buffer[Pbuf]; + inc(Pbuf); + if Pbuf>MAX_BUFFER then + begin + dec(Pbuf); + blockread(f,buffer[Pbuf],1); + dec(DataSize); + end; + For i:=1 to reps do + begin + mem[memd:Pscr]:=Buffer[Pbuf]; + inc(Pscr); + end; + inc(PBuf); + end; + until PBuf=MAX_BUFFER+1; + end + else + begin + PBuf:=0; + Blockread(f,buffer,DataSize); + repeat + if Buffer[PBuf]=0 then + begin + case Buffer[Pbuf+1] of + 0:{eol}begin Pscr:=Pscr-320-infoheader.ample;inc(Pbuf,2);end; + 1:{eof}inc(Pbuf,2); + 2:; + else + begin + nocomp:=buffer[Pbuf+1]; + inc(pbuf,2); + for i:=1 to nocomp do + begin + mem[memd:Pscr]:=Buffer[Pbuf]; + inc(Pscr); + inc(pbuf); + end; + if nocomp mod 2 =1 then inc(pbuf);{consumir un byte si dades no comp. son impars} + end; + end; + end + else + begin + For i:=1 to Buffer[Pbuf] do + begin + mem[memd:Pscr]:=Buffer[Pbuf+1]; + inc(Pscr); + end; + inc(PBuf,2); + end; + until PBuf=DataSize; + DataSize:=0; + end; + until DataSize=0; + close(f); +end; + +{} +procedure init_ys; +var i:word; +begin + for i:=0 to 199 do + ys[i]:=320*i; +end; + +{} +begin + init_ys; +end. \ No newline at end of file diff --git a/original_turbopascal/GRAFIX.TPU b/original_turbopascal/GRAFIX.TPU new file mode 100644 index 0000000..4c32ee1 Binary files /dev/null and b/original_turbopascal/GRAFIX.TPU differ diff --git a/original_turbopascal/INPUT.PAS b/original_turbopascal/INPUT.PAS new file mode 100644 index 0000000..35b4a15 --- /dev/null +++ b/original_turbopascal/INPUT.PAS @@ -0,0 +1,156 @@ +unit input; + +interface + +uses jinput; + +const + T_UP = KeyQ; + T_DOWN = KeyA; + T_LEFT = KeyO; + T_RIGHT = KeyP; + T_OK = KeySPACE; + T_NOK = KeyM; + + retard_tecla = 10; { per a controlar les pulsacions de tecles } + +var + tecla : word; { per a controlar les pulsacions de tecles } + J_OK : boolean; { indica la disponibilitat del Gamepad } + +procedure Check_Joystick; +{ Funcio: Coloca en la variable global J_OK si esta el gamepad conectat } +function i_amunt:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_avall:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_esquerra:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_dreta:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_ok:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_nok:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +function i_esc:boolean; +{ Funcio: mira si hem pulsat ESC } + +implementation +{############################################################################ + ##### C H E C K J O Y S T I C K ##### + ############################################################################} +procedure Check_Joystick; +{ Funcio: Coloca en la variable global J_OK si esta el gamepad conectat } +begin + if (joyavaliable(joystick1)) then J_OK := TRUE else J_OK := FALSE; +end; +{############################################################################ + ##### A M U N T ##### + ############################################################################} +function i_amunt:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_amunt := FALSE; + if tecla=0 then + if ((J_OK) and (joystick(joystick1_Y)=joy1_MIN_Y)) + or (TeclaPuls(T_UP)) then + begin + i_amunt := TRUE; + tecla := retard_tecla; + end; +end; +{############################################################################ + ##### A V A L L ##### + ############################################################################} +function i_avall:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_avall := FALSE; + if tecla=0 then + if ((J_OK) and (joystick(joystick1_Y)=joy1_MAX_Y)) + or (TeclaPuls(T_DOWN)) then + begin + i_avall := TRUE; + tecla := retard_tecla; + end; +end; +{############################################################################ + ##### D R E T A ##### + ############################################################################} +function i_dreta:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_dreta := FALSE; + if tecla=0 then + if ((J_OK) and (joystick(joystick1_X)=joy1_MAX_X)) + or (TeclaPuls(T_RIGHT)) then + begin + i_dreta := TRUE; + tecla := retard_tecla; + end; +end; +{############################################################################ + ##### E S Q U E R R A ##### + ############################################################################} +function i_esquerra:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_esquerra := FALSE; + if tecla=0 then + if ((J_OK) and (joystick(joystick1_X)=joy1_MIN_X)) + or (TeclaPuls(T_LEFT)) then + begin + i_esquerra := TRUE; + tecla := retard_tecla; + end; +end; +{############################################################################ + ##### B O T O O K ##### + ############################################################################} +function i_ok:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_ok := FALSE; + if tecla=0 then + if ((J_OK) and (jbotons(button1_2)<>0)) + or (TeclaPuls(T_OK)) then + begin + i_ok := TRUE; + tecla := retard_tecla+5; + end; +end; +{############################################################################ + ##### B O T O N O K ##### + ############################################################################} +function i_nok:boolean; +{ Funcio: mira si hem pulsat la tecla o el Gamepad } +begin + i_nok := FALSE; + if tecla=0 then + if ((J_OK) and (jbotons(button1_1)<>0)) + or (TeclaPuls(T_NOK)) then + begin + i_nok := TRUE; + tecla := retard_tecla+5; + end; +end; +{############################################################################ + ##### B O T O E S C ##### + ############################################################################} +function i_esc:boolean; +{ Funcio: mira si hem pulsat el ESC } +begin + i_esc := FALSE; + if TeclaPuls(KeyESC) then + i_esc := TRUE; +end; +{############################################################################} + +begin + + Joy1_MAX_X := 144; + Joy1_MIN_X := 17; + Joy1_MAX_Y := 144; + Joy1_MIN_Y := 17; + +end. \ No newline at end of file diff --git a/original_turbopascal/INPUT.TPU b/original_turbopascal/INPUT.TPU new file mode 100644 index 0000000..244f5f8 Binary files /dev/null and b/original_turbopascal/INPUT.TPU differ diff --git a/original_turbopascal/JINPUT.PAS b/original_turbopascal/JINPUT.PAS new file mode 100644 index 0000000..7b79ea2 --- /dev/null +++ b/original_turbopascal/JINPUT.PAS @@ -0,0 +1,638 @@ +{Unitat per al teclat, joystick i mouse} +{Ultima actualitzacio 19-02-2000} + +unit JInput; + +interface +const +(*//////////////////////////CONSTANTS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*) + {El codi de SCAN es que s'activa quan es polsa una tecla} + keySysReq = $54; + keyCapsLock = $3A; + keyNumLock = $45; + keyScrollLock = $46; + keyLeftCtrl = $1D; + keyLeftAlt = $38; + keyLeftShift = $2A; + keyRightCtrl = $9D; + keyAltGr = $B8; + keyRightShift = $36; + keyEsc = $01; + keyBackspace = $0E; + keyEnter = $1C; + keySpace = $39; + keyTab = $0F; + keyF1 = $3B; + keyF2 = $3C; + keyF3 = $3D; + keyF4 = $3E; + keyF5 = $3F; + keyF6 = $40; + keyF7 = $41; + keyF8 = $42; + keyF9 = $43; + keyF10 = $44; + keyF11 = $57; + keyF12 = $58; + keyA = $1E; + keyB = $30; + keyC = $2E; + keyD = $20; + keyE = $12; + keyF = $21; + keyG = $22; + keyH = $23; + keyI = $17; + keyJ = $24; + keyK = $25; + keyL = $26; + keyM = $32; + keyN = $31; + keyO = $18; + keyP = $19; + keyQ = $10; + keyR = $13; + keyS = $1F; + keyT = $14; + keyU = $16; + keyV = $2F; + keyW = $11; + keyX = $2D; + keyY = $15; + keyZ = $2C; + key1 = $02; + key2 = $03; + key3 = $04; + key4 = $05; + key5 = $06; + key6 = $07; + key7 = $08; + key8 = $09; + key9 = $0A; + key0 = $0B; + keyMinus = $0C; + keyEqual = $0D; + keyLBracket = $1A; + keyRBracket = $1B; + keySemicolon = $27; + keyTick = $28; + keyApostrophe = $29; + keyBackslash = $2B; + keyComma = $33; + keyPeriod = $34; + keySlash = $35; + keyInsert = $D2; + keyDelete = $D3; + keyHome = $C7; + keyEnd = $CF; + keyPageUp = $C9; + keyArrowLeft = $CB; + keyArrowRight = $CD; + keyArrowUp = $C8; + keyArrowDown = $D0; + keyKeypad0 = $52; + keyKeypad1 = $4F; + keyKeypad2 = $50; + keyKeypad3 = $51; + keyKeypad4 = $4B; + keyKeypad5 = $4C; + keyKeypad6 = $4D; + keyKeypad7 = $47; + keyKeypad8 = $48; + keyKeypad9 = $49; + keyKeypadComma = $53; + keyKeypadStar = $37; + keyKeypadMinus = $4A; + keyKeypadPlus = $4E; + keyKeypadEnter = $9C; + keyCtrlPrtScr = $B7; + keyShiftPrtScr = $B7; + keyKeypadSlash = $B5; + + {El codi de BREAK es el que s'activa quan es solta una tecla} + BREAK_Esc=1+128; + BREAK_1=2+128; + BREAK_2=3+128; + BREAK_3=4+128; + BREAK_4=5+128; + BREAK_5=6+128; + BREAK_6=7+128; + BREAK_7=8+128; + BREAK_8=9+128; + BREAK_9=10+128; + BREAK_0=11+128; + BREAK_Menos=12+128; {potser este siga l'apostrof} + BREAK_Igual=13+128; {potser este siga l'exclamacio} + BREAK_Backsp=14+128; + BREAK_Tab=15+128; + BREAK_Q=16+128; + BREAK_W=17+128; + BREAK_E=18+128; + BREAK_R=19+128; + BREAK_T=20+128; + BREAK_Y=21+128; + BREAK_U=22+128; + BREAK_I=23+128; + BREAK_O=24+128; + BREAK_P=25+128; + BREAK_LeftBraket=26+128; + BREAK_RightBraket=27+128; + BREAK_Enter=28+128; + BREAK_Control=29+128; + BREAK_A=30+128; + BREAK_S=31+128; + BREAK_D=32+128; + BREAK_F=33+128; + BREAK_G=34+128; + BREAK_H=35+128; + BREAK_J=36+128; + BREAK_K=37+128; + BREAK_L=38+128; + BREAK_SemiColon=39+128;{potser la } + BREAK_Apostrof=40+128;{potser } + BREAK_Tilde=41+128;{potser } + BREAK_LeftShift=42+128; + BREAK_Back_Slash=43+128;{potser < } + BREAK_Z=44+128; + BREAK_X=45+128; + BREAK_C=46+128; + BREAK_V=47+128; + BREAK_B=48+128; + BREAK_N=49+128; + BREAK_M=50+128; + BREAK_Coma=51+128; + BREAK_Punt=52+128; + BREAK_ForwardSlash=53+128;{potser -} + BREAK_RightShift=54+128; + BREAK_PrintScrn=55+128; + BREAK_Alt=56+128; + BREAK_Sp=57+128; + BREAK_CapsLock=58+128; + BREAK_F1=59+128; + BREAK_F2=60+128; + BREAK_F3=61+128; + BREAK_F4=62+128; + BREAK_F5=63+128; + BREAK_F6=64+128; + BREAK_F7=65+128; + BREAK_F8=66+128; + BREAK_F9=67+128; + BREAK_F10=68+128; + BREAK_F11=87+128; + BREAK_F12=88+128; + BREAK_NumLock=69+128; + BREAK_ScrollLock=70+128; + BREAK_Home=71+128; + BREAK_Up=72+128; + BREAK_PgUp=73+128; + BREAK_NumMenos=74+128; + BREAK_Left=75+128; + BREAK_Num5=76+128; + BREAK_Right=77+128; + BREAK_NumMes=78+128; + BREAK_End=79+128; + BREAK_Down=80+128; + BREAK_PgDn=81+128; + BREAK_Ins=82+128; + BREAK_Del=83+128; + + {Mascares per a tecles de control cridant a int 16h} + SHIFT_R=$0001; + SHIFT_L=$0002; + CONTROL=$0004; + ALT =$0008; + SCROLL_LOCK_ON=$0010; + NUM_LOCK_ON=$0020; + CAPS_LOCK_ON=$0040; + INSERT_MODE=$0080; + CONTROL_L=$0100; + ALT_L=$0200; + CONTROL_R=$0400; + ALT_R=$0800; + SCROLL_LOCK_OFF=$1000; + NUM_LOCK_OFF=$2000; + CAPS_LOCK_OFF=$4000; + SYS_REQ_DWN=$8000; + + KEYBOARD_INT=$09; + KEY_BUFFER=$60; + KEY_CONTROL=$61; + INT_CONTROL=$20; + + NomTECLES:array[1..101] of PChar= + {1}('Esc','1','2','3','4','5','6','7','8','9' + {11},'0','-','=','Backsp','Tab','Q','W','E','R','T' + {21},'Y','U','I','O','P','[',']','Enter','Control','A' + {31},'S','D','F','G','H','J','K','L',';','Apostrof' + {41},'Tilde','LeftShift','\','Z','X','C','V','B','N','M' + {51},',','.','/','RightShift','Print Screen','Alt',' ','CapsLock','F1','F2' + {61},'F3','F4','F5','F6','F7','F8','F9','F10','NumLock','ScrollLock' + {71},'Home','Up','PgUp','-','Left','Num5','Right','+','End','Down' + {81},'Page Down','Insert','Del',nil,nil,nil,'F11','F12',nil,nil + {91},nil,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil); + +(*//////////////////////////CONSTANTS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*) + MBLeft=$01; {Boto esquerre del mouse} + MBRight=$02; {Boto dret del mouse} + +(*/////////////////////////CONSTANTS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*) + JoyPort=$201; {Port del Joystick} + Button1_1=$10; {boto 1 del Joystick 1} + Button1_2=$20; {boto 2 del Joystick 1} + Button2_1=$40; {boto 1 del Joystick 2} + Button2_2=$80; {boto 2 del Joystick 2} + Joystick1=$01; {ID del Joystick 1} + Joystick2=$02; {ID del Joystick 2} + Joystick1_X=$01; {Eix X del Joystick 1} + Joystick1_Y=$02; {Eix Y del Joystick 1} + Joystick2_X=$04; {Eix X del Joystick 2} + Joystick2_Y=$08; {Eix Y del Joystick 2} + Joy1_CAL=1; {ID Calibrar Joystick 1} + Joy2_CAL=2; {ID Calibrar Joystick 2} + + +var +{ ATENCIO TOTES ESTES VARIABLES SON UNICAMENT DE LECTURA !!} +{QUALSEVOL MODIFICACIO SOBRE ELLES POT CAUSAR DESASTRES I FINS I TOT + CATASTROFRES MUNDIALS.SI LES MODIFIQUES ES BAIX LA TEUA RESPONASABILITAT} +(*/////////////////////////VARIABLES DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*) + TECLA:word; {RESERVED} + TAULATECLES:array[1..101] of byte;{RESERVED} + OLD_KB_ISR:pointer; {Punter al antic vector d'interrupcio} + +(*/////////////////////////VARIABLES DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*) + {les variables joy* guarden els valors despres de la calibracio} + {valors per al JOYSTICK1} + joy1_MAX_X, {Valor quan X es maxima DRETA} + joy1_MAX_Y, {Valor quan Y es maxima AVALL} + joy1_MIN_X, {Valor quan X es minima ESQUERRA} + joy1_MIN_Y, {Valor quan Y es minima AMUNT} + joy1_cx, {Valor quan X esta centrat} + joy1_cy, {Valor quan Y esta centrat} + {valors per al JOYSTICK2} + joy2_MAX_X, {Valor quan X es maxima DRETA} + joy2_MAX_Y, {Valor quan Y es maxima AVALL} + joy2_MIN_X, {Valor quan X es minima ESQUERRA} + joy2_MIN_Y, {Valor quan Y es minima AMUNT} + joy2_cx, {Valor quan X esta centrat} + joy2_cy:word; {Valor quan Y esta centrat} + +(*/////////////////////////FUNCIONS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*) +procedure InstalarKB; +{Funcio : Activa la nova interrupcio del teclat} +procedure DesinstalarKB; +{Funcio : Restaura l'antiga interrupcio del teclat} +Function TeclaPuls(Key:byte):boolean; +{Entrada: Key -> codi SCAN de tecla + Eixida : TRUE si esta polsada, FALSE si no + Funcio : Saber si una tecla esta siguent polsada} +Function QTeclaPuls:boolean; +{Eixida : TRUE si hi ha alguna tecla polsada, FALSE si no + Funcio : Saber si alguna tecla esta siguent polsada} +function AgarrarTecla:byte; +{Eixida : Codi SCAN de la tecla que esta siguent polsada + Funcio : Tornar el codi SCAN de la tecla que esta siguent polsada} +procedure EscriuTecla; +{Funcio : Escriure una cadena en pantalla depenent de la tecla} + +(*/////////////////////////FUNCIONS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*) +Function MouseReset:word; +{Eixida : 0,Driver installat , $FFFF driver no installat + Funcio : intentar activar el mouse} +Function NumButtons:word; +{Eixida : nombre de botons + Funcio : averiguar el nombre de botons del mouse} +Procedure ShowMouse; +{Funcio : Mostra el mouse en la pantalla} +Procedure HideMouse; +{Funcio : oculta el mouse} +Function GetMouseX:word; +{Eixida : Coordenada en l'eix X on es troba el mouse + Funcio : Obtindre la coordenada X del Mouse} +Function GetMouseY:word; +{Eixida : Coordenada en l'eix Y on es troba el mouse + Funcio : Obtindre la coordenada Y del Mouse} +function EstatBoto(button:word):word; +{Entrada: Codi de boto del mouse, definit en les constants + Eixida : 0 si no esta polsat, distint en cas contrari + Funcio : Saber si hi ha un boto polsat o no} +procedure SetMousePos(x,y:word); +{Entrada: Coordenada x i y on volem posar el mouse + Funcio : Colocar el mouse} +procedure SetMouseZone(x0,y0,x1,y1:word); +{Entrada: x0 -> x minima per definir la zona + y0 -> y minima per definir la zona + x1 -> x maxima per definir la zona + y1 -> y maxima per definir la zona + Funcio : Tancar al mouse dins d'una zona per que no isca} +procedure SetMouseInterruptRate(Code:word); +{Entrada: Code + 0 No interrupts + 1 30 ints per second + 2 50 ints per second + 3 100 ints per second + 4 200 ints per second + Funcio : Canviar les peticions d'interrupcio que fa el mouse} +procedure SetMouseSensitivity(Xsens,Ysens:word); +{Entrada: XSens -> (1..32767) + Ysens -> (1..32767) + Funcio : Canviar la sensitivitat de mouse} +procedure SetMouseDoubleSpeed(Speed:word); +{Entrada: Speed -> velocitat en mickeys per segon + Funcio : Canviar la velocitat} + +(*/////////////////////////FUNCIONS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*) +function JBotons(button:word):word; +{Entrada: button -> Codi del boto + Eixida : 0, boto no polsat <>0,boto polsat + Funcio : Averiguar si un boto esta polsat} +function Joystick(stick:word):word; +{Entrada: Stick -> JOYSTICK?_? constants dalt definides + Eixida : Valor que podem comparar en el valor de les variables de calibracio + Funcio : Torna un valor depenent de l'estat de l'eix } +Procedure JoyCalibrate(stick:word); +{Entrada: stick -> Codi del Joystick (Joy1_CAL o Joy2_CAL) + Funcio : Calibrar el joystick} +function JoyAvaliable(stick:word):boolean; +{Entrada: stick -> Codi del Joystick (Joystick1 o Joystick2) + Eixida : FLASE si no hi detecta un joystick + Funcio : Averiguar si hi ha un joystick} + +implementation +uses dos; + +(*/////////////////////////FUNCIONS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*) +procedure NEWKB;interrupt;assembler; +asm + cli + in al, KEY_BUFFER {obtindre la tecla polsada} + xor ah,ah + mov TECLA,ax {guardar la tecla} + in al,KEY_CONTROL {accedir al registre de control} + or al,82h {posar els bits adequats per fer un reset + en el biestable del teclat} + out KEY_CONTROL,al {enviar les noves dades al registre} + and al,7Fh + out KEY_CONTROL,al {Fer el reset} + + {Actualitzacio de la taula de tecles} + mov bx,tecla + cmp bx,128 + jg @breakcode + mov byte ptr TAULATECLES[bx-1],1 + jmp @end + @breakcode: + sub bx,128 + mov byte ptr TAULATECLES[bx-1],0 + + @end: + mov al,20h + out INT_CONTROL,al + sti +end; + +procedure waitACS; +begin + asm + mov ah,2 + int 16h + and al,00001111b + jz @fi + @espera: + mov ah,2 + int 16h + and al,00001111b {al->bit 7=Insert On + 6=Caps Lock on + 5=Num Lock on + 4=scroll lock on + 3=Alt key down + 2=Control key down + 1=left shift down + 0=right shift down} + jnz @espera + @fi: + end; +end; + +procedure InstalarKB; +var i:word; +begin + waitACS; + getintvec(KEYBOARD_INT,Old_KB_ISR); + setintvec(KEYBOARD_INT,@NEWKB); + Fillchar(TAULATECLES,sizeof(Taulatecles),0); +end; + +procedure desinstalarKB; +begin + setintvec(KEYBOARD_INT,OLD_KB_ISR); +end; + +Function TeclaPuls(Key:byte):boolean; +begin + if TAULATECLES[KEY]=1 then TeclaPuls:=TRUE else TeclaPuls:=FALSE; +end; + +Function QTeclaPuls:boolean; +begin + if tecla>=128 then QTeclaPuls:=false else QTeclaPuls:=true; +end; + +function AgarrarTecla:byte; +begin + if tecla<101 then AgarrarTecla:=tecla; +end; + +procedure EscriuTecla; +begin + if tecla<128 then write(NomTecles[tecla]); +end; + + +(*/////////////////////////FUNCIONS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*) +Function MouseReset:word;assembler; +{MouseReset=0 Driver no installat} +{MouseReset=65535 Driver installat} +asm + xor ax,ax + int 33h +end; + +Function NumButtons:word;assembler; +asm + xor ax,ax + int 33h + mov ax,bx +end; + +Procedure ShowMouse;assembler; +asm + mov ax,0001h + int 33h +end; + +Procedure HideMouse;assembler; +asm + mov ax,0002h + int 33h +end; + +Function GetMouseX:word;assembler; +{x -> (0..639)} +asm + mov ax,$0003 + int 33h + mov ax,cx +end; + +Function GetMouseY:word;assembler; +{y -> (0..199)} +asm + mov ax,$0003 + int 33h + mov ax,dx +end; + +function EstatBoto(button:word):word;assembler; +{Torna <>0 si esta polsat} +asm + mov ax,$0003 + int 33h + mov ax,bx + and ax,button +end; + +procedure SetMousePos(x,y:word);assembler; +asm + mov ax,$0004 + mov cx,x + mov dx,y + int 33h +end; + +procedure SetMouseZone(x0,y0,x1,y1:word);assembler; +asm + mov ax,$0007 + mov cx,x0 + mov dx,x1 + int 33h + mov ax,$0008 + mov cx,y0 + mov dx,y1 + int 33h +end; + +procedure SetMouseInterruptRate(Code:word);assembler; +{Code + 0 No interrupts + 1 30 ints per second + 2 50 ints per second + 3 100 ints per second + 4 200 ints per second +} +asm + mov ax,$001C + mov bx,code + int 33h +end; + +procedure SetMouseSensitivity(Xsens,Ysens:word);assembler; +{XSens (1..32767} +{Ysens (1..32767} +asm + mov ax,$000F + mov cx,Xsens + mov dx,Ysens + int 33h +end; + +procedure SetMouseDoubleSpeed(Speed:word);assembler; +asm + mov ax,$0013 + mov dx,speed + int 33h +end; + + +(*/////////////////////////FUNCIONS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*) +function JBotons(button:word):word; +begin + Port[Joyport]:=0; + JBotons:=(not Port[Joyport]) and Button; +end; + +function Joystick(stick:word):word;assembler; +asm + cli + mov ah,byte ptr stick + xor al,al + xor cx,cx + mov dx,JOYPORT + out dx,al + + @discharge: + in al,dx + test al,ah + loopne @discharge + + sti + xor ax,ax + sub ax,cx +end; + +Procedure JoyCalibrate(stick:word); +var xnew,ynew:word; +begin + if (Stick=JOY1_CAL) then + begin + joy1_MAX_X:=0; + joy1_MAX_Y:=0; + joy1_MIN_X:=10000; + joy1_MIN_Y:=10000; + {girar, deixar neutral i polsar un boto} + while (JBotons(button1_1) or JBotons(button1_2))=0 do + begin + xnew:=Joystick(Joystick1_X); + ynew:=Joystick(Joystick1_Y); + if (xnew>=joy1_Max_x) then joy1_Max_X:=xnew; + if (xnew<=joy1_Min_x) then joy1_Min_X:=xnew; + if (ynew>=joy1_Max_y) then joy1_Max_y:=ynew; + if (ynew<=joy1_Min_y) then joy1_Min_y:=ynew; + end; + {com l'usuari ha deixat el pad al centre deu estar al centre} + Joy1_cx:=xnew; + Joy1_cy:=ynew; + end + else if (stick=JOY2_CAL) then + begin + joy2_MAX_X:=0; + joy2_MAX_Y:=0; + joy2_MIN_X:=10000; + joy2_MIN_Y:=10000; + while (JBotons(button2_1) or JBotons(button2_2))=0 do + begin + xnew:=Joystick(Joystick2_X); + ynew:=Joystick(Joystick2_Y); + if (xnew>=joy2_Max_x) then joy2_Max_X:=xnew; + if (xnew<=joy2_Min_x) then joy2_Min_X:=xnew; + if (ynew>=joy2_Max_y) then joy2_Max_y:=ynew; + if (ynew<=joy2_Min_y) then joy2_Max_y:=ynew; + end; + {com l'usuari ha deixat el pad al centre deu estar al centre} + Joy2_cx:=xnew; + Joy2_cy:=ynew; + end; +end; + +function JoyAvaliable(stick:word):boolean; +{torna un valor distint de 0 si existeix} +begin + if (stick=JOYSTICK1) then + JoyAvaliable:=(Joystick(Joystick1_X)<>$0000) + else if (stick=JOYSTICK2) then + JoyAvaliable:=(Joystick(Joystick2_X)<>$0000); +end; + +begin + tecla:=128; +end. \ No newline at end of file diff --git a/original_turbopascal/JINPUT.TPU b/original_turbopascal/JINPUT.TPU new file mode 100644 index 0000000..6ec6213 Binary files /dev/null and b/original_turbopascal/JINPUT.TPU differ diff --git a/original_turbopascal/KEYBOARD.TPU b/original_turbopascal/KEYBOARD.TPU new file mode 100644 index 0000000..28bfc7b Binary files /dev/null and b/original_turbopascal/KEYBOARD.TPU differ diff --git a/original_turbopascal/MUSICA.PAS b/original_turbopascal/MUSICA.PAS new file mode 100644 index 0000000..69c7a30 --- /dev/null +++ b/original_turbopascal/MUSICA.PAS @@ -0,0 +1,1060 @@ +{**************************************************************************** +** Background MIDI unit ** +** by Steven H Don ** +** Personalitzada per ICEKAS per al Final Tech ** +***************************************************************************** +** The file FM.DAT is necessary to play through Sound Blaster/compatible ** +***************************************************************************** +** Unit for playing MIDI files in the background through either an FM ** +** sound card, such as the Sound Blaster (any version) or a General MIDI ** +** device, such as the Roland cards or a Gravis UltraSound using MegaEM. ** +** It does not implement all of the MIDI effects and asynchronous files ** +** are not supported. It works with most files I have, however. As you can ** +** see from the size of the file, as well as the complexity of the code, ** +** MIDI is no easy stuff. This file should be useful though. ** +** ** +** For questions, feel free to e-mail me. ** +** ** +** shd@earthling.net ** +** http://shd.cjb.net ** +** ** +** Arranged by The JailDoctor. ** +** ** +** Now General Midi initializes by itself & other fixes. ** +** ** +** e-mail me if you vols to jaildoctor@jazzfree.com ** +** ** +*****************************************************************************} +unit musica; + +interface + +{ + Functions available to the calling program are: + LoadMIDI : loads the MIDI file into memory. + Expects a filename including .MID extension + Returns TRUE if successful + UnloadMIDI : unloads the MIDI file and fress the memory. + PlayMIDI : starts MIDI playback + StopMIDI : stops MIDI playback + SetGM : sets the playback device to General MIDI. + SetFM : sets the playback device to the FM synthesizer + SetVol : sets the playback volume, from 0..255 + Playing : returns FALSE when the MIDI file has ended +} + +var + { cont el arxiu que ha de tocar-se } + midi : string[12]; + { Midi ON / OFF } + midiOK : boolean; + { midi en memoria } + midiMEM : boolean; + +procedure IniMidi; +{ Funci: Prepara el General Midi } +procedure StartMidi(nom : string); +{ Funci: comena a tocar un midi } +procedure KeepMidi; +{ Funci: Mantin el midi en marxa } +procedure EndMidi; +{ Funci: Allibera la memoria del midi } + +function LoadMidi (FileName : String) : Boolean; +procedure UnloadMIDI; +procedure PlayMIDI; +procedure StopMIDI; +procedure SetVol (NewVol : Byte); +function SetFM : Boolean; +function SetGM : Boolean; +function Playing : Boolean; + +implementation + +uses DOS, Crt; + +const + {At compile time, allow for 64 tracks, increase if necessary (this requires + more memory)} + MaxTracks = 64; + {Used to distinguish between General MIDI devices and FM synthesizers} + None = 0; FM = 1; GM = 2; + {Used to activate tremolo and vibrato amplification} + AM = 1; VIB = 0; ByteBD : Byte = AM shl 7 or VIB shl 6 or $20; + +type + {Almost 64K of memory to hold the data for each individual track} + SixtyFour = Array [0..65534] of Byte; + + {The MIDI File's header} + FileHeaderType = record + MTHd : LongInt; {6468544Dh = "MTHd"} + HeaderSize : LongInt; + FileFormat, NumberOfTracks, TicksPerQNote : Word; + end; + + {The header of a track} + TrackHeaderType = record + MTrk : LongInt; {6468544Dh = "MTrd"} + TrackSize : LongInt; + end; + +{Variables for reading the MIDI file} +var + + {How many tracks are there in the file} + NumberOfTracks : Byte; + {This is used to determine whether a track needs attention} + WaitingFor : Array [1..MaxTracks] of LongInt; + {Stores the actual MIDI data} + TrackData : Array [1..MaxTracks] of ^SixtyFour; + {Stores the byte length of each track} + TrackSize : Array [1..MaxTracks] of Word; + {Which byte is to be read next} + NextBytePtr : Array [1..MaxTracks] of Word; + {Stores the last MIDI command sent, this is necessary for "running" mode} + LastCommand : Array [1..MaxTracks] of Byte; + + {This stores a pointer to the original timer handler} + BIOSTimerHandler : procedure; + {This is used for counting the clock ticks} + TicksPerQNote : LongInt; + ClockTicks, TickCounter, MIDICounter : LongInt; + {This is used in case Windows is active} + WinTick : LongInt; + Windows : Boolean; + +{Variables and constants necessary for playing the MIDI file through an FM +based sound card such as Sound Blaster} +const + {Addresses of the operators used to form voice data} + OpAdr : Array [0..8] of Byte = (0, 1, 2, 8, 9, 10, 16, 17, 18); + {F numbers - to form a specific note} + FNr : Array [0..127] of Word = (86,91,96,102,108,114,121,128,136,144, + 153,162,172,182,192,204,108,114,121, + 128,136,144,153,162,172,182,192,204, + 216,229,242,257,136,144,153,162,172, + 182,192,204,216,229,242,257,272,288, + 306,324,172,182,192,204,216,229,242, + 257,272,288,306,324,343,363,385,408, + 216,229,242,257,272,288,306,324,343, + 363,385,408,432,458,485,514,272,288, + 306,324,343,363,385,408,432,458,485, + 514,544,577,611,647,343,363,385,408, + 432,458,485,514,544,577,611,647,686, + 726,770,816,432,458,485,514,544,577, + 611,647,686,726,770,816,864,916,970,1023); + {Some operators are reserved for percussion. They are at the end of the + SB's operators which means they're in the middle of the SB Pro's. The main + program doesn't take this into account so this is used to convert from + virtual voice number to real voice number} + RealVoice : Array [0..14] of Byte = (0, 1, 2, 3, 4, 5, 9, 10, + 11, 12, 13, 14, 15, 16, 17); + +var + {There is a total of 15 melodic channels available of the SB Pro, hence the 14} + InUse : Array [0..14] of Boolean; + Activated : Array [0..17] of LongInt; + MIDILink, + NoteNumber, + NoteVelocity : Array [0..14] of Byte; + NoteOffData : Array [0..17, 0..1] of Byte; + {This stores which instrument is currently in use on a MIDI channel} + Instrument : Array [0..15] of Byte; + {This stores the FM instrument definitions} + M2, M4, M6, M8, ME, MC, C2, C4, C6, C8, CE : Array [0..127] of Byte; + +var + {This indicates whether the file should be played through a General MIDI + device or through an FM synthesizer, such as the Sound Blaster} + Device : Byte; + {This indicates whether we have a Sound Blaster (6 voices) or an SB Pro or + better (15 voices) - the 5 drums are always available} + Voices : Byte; + {This stores the Base address of the Sound Blaster and GM device} + FMBase, GMBase : Word; + {The master volume. Normal volume is 128.} + MasterVolume : LongInt; + +{This procedure compensates a given volume for the master volume} +function DoVolume (Before : Byte) : Byte; +var + After : LongInt; + +begin + After := Before; + After := After * MasterVolume; + After := After shr 7; + if After > 127 then After := 127; + DoVolume := After and $FF; +end; + +{This procedure changes the speed of the timer to adjust the tempo of a song +NewSpeed gives the amount of microseconds per quarter note} +procedure ChangeSpeed (NewSpeed : LongInt); +var + QuarterNotesPerSecond : Real; + Divisor : Real; + +begin + {Calculate the amount of quarter notes in a second} + QuarterNotesPerSecond := (1000000 / NewSpeed); + {For every quarternote, we have TicksPerQNote ticks} + Divisor := QuarterNotesPerSecond * TicksPerQNote; + {If Windows is present, the timer frequency must remain below 1000} + if Windows then begin + if Divisor > 1000 then begin + WinTick := 1 + trunc (Divisor / 1000); + Divisor := Divisor / WinTick; + end + end else WinTick := 1; + {Set the appropriate values for the timer interrupt} + TickCounter := trunc ($1234DD / Divisor); + Port[$43] := $34; + Port[$40] := lo (TickCounter); + Port[$40] := hi (TickCounter); +end; + +{Writes a value to a specified index register on the FM card} +procedure WriteFM (Chip, Register, Value : Byte); +var + Counter, Temp : Byte; + Address : Word; + +begin + case Chip of + 0 : Address := FMBase; + 1 : Address := FMBase + 2; + end; + {Select register} + Port [Address] := Register; + {Wait for card to accept value} + for Counter := 1 to 25 do Temp := Port [Address]; + {Send value} + Port [Address + 1] := Value; + {Wait for card to accept value} + for Counter := 1 to 100 do Temp := Port [Address]; +end; + +{Sets a channel on the FM synthesizer to a specific instrument} +procedure SetInstr (Voice, I, Volume : Byte); + +var + Chip, Value : LongInt; + +begin + if Voice > 8 then begin + Chip := 1; + dec (Voice, 9); + end else Chip := 0; + {Correction for volume} + Value := 63 - (M4 [I] and 63); + Value := Value * Volume div 127; + if Value > 63 then Value := 0 else Value := 63 - Value; + Value := (M4 [I] and $C0) or Value; + {Set up voice modulator} + WriteFM (Chip, $20 + OpAdr [Voice], M2 [I]); + WriteFM (Chip, $40 + OpAdr [Voice], Value); + WriteFM (Chip, $60 + OpAdr [Voice], M6 [I]); + WriteFM (Chip, $80 + OpAdr [Voice], M8 [I]); + WriteFM (Chip, $E0 + OpAdr [Voice], ME [I]); + {The "or 3 shl 4" is enables the voice on the OPL3} + WriteFM (Chip, $C0 + OpAdr [Voice], MC [I] or 3 shl 4); + + {Correction for volume} + Value := 63 - (C4 [I] and 63); + Value := Value * Volume div 127; + if Value > 63 then Value := 0 else Value := 63 - Value; + Value := (C4 [I] and $C0) or Value; + {Set up voice carrier} + WriteFM (Chip, $23 + OpAdr [Voice], C2 [I]); + WriteFM (Chip, $43 + OpAdr [Voice], Value); + WriteFM (Chip, $63 + OpAdr [Voice], C6 [I]); + WriteFM (Chip, $83 + OpAdr [Voice], C8 [I]); + WriteFM (Chip, $E3 + OpAdr [Voice], CE [I]); +end; + +{Sets up a drum channel, in much the same way as a normal voice} +procedure SetDrum (Operator, O2, O4, O6, O8, OE, OC : Byte); +begin + WriteFM (0, $20 + Operator, O2); + WriteFM (0, $40 + Operator, O4); + WriteFM (0, $60 + Operator, O6); + WriteFM (0, $80 + Operator, O8); + WriteFM (0, $E0 + Operator, OE); + WriteFM (0, $C0 + Operator, OC); +end; + +{Enables a note on the FM synthesizer} +procedure EnableNote (Voice, Number : Byte); +var + Chip, Note, Block : Byte; + {For simulating high octaves} + FNumber : Word; + +begin + {Calculate which part of the OPL3 chip should receive the data} + if Voice > 8 then begin + Chip := 1; + dec (Voice, 9); + end else Chip := 0; + {Calculate appropriate data for FM synthesizer} + FNumber := FNr [Number]; + Block := Number shr 4; + {Store data to disable the note when necessary} + NoteOffData [Voice, 0] := lo(FNumber); + NoteOffData [Voice, 1] := hi(FNumber) + (Block shl 2); + {Write data to FM synthesizer} + WriteFM (Chip, $A0+Voice, lo(FNumber)); + WriteFM (Chip, $B0+Voice, hi(FNumber) + (Block shl 2) + 32); +end; + +{Disables a note on the FM synthesizer} +procedure DisableNote (Voice : Byte); +var + Chip : Byte; + +begin + {Calculate which part of the OPL3 chip should receive the data} + if Voice > 8 then begin + Chip := 1; + dec (Voice, 9); + end else Chip := 0; + {Write data to FM synthesizer} + WriteFM (Chip, $A0+Voice, NoteOffData [Voice, 0]); + WriteFM (Chip, $B0+Voice, NoteOffData [Voice, 1]); +end; + +{Cuts a note on the FM synthesizer immediately} +procedure CutNote (Voice : Byte); +var + Chip : Byte; + +begin + {Calculate which part of the OPL3 chip should receive the data} + if Voice > 8 then begin + Chip := 1 + end else Chip := 0; + {Set decay rate to fast - to avoid "plink" sound} + WriteFM (Chip, $80 + OpAdr [Voice mod 9], $F); + WriteFM (Chip, $83 + OpAdr [Voice mod 9], $F); + {Disable the note} + DisableNote (Voice); +end; + +{Processes a "NoteOff" event for the FM synthesizer} +procedure NoteOff (MIDIChannel, Number, Velocity : Byte); +var + FoundChannel, FMChannel : Byte; + +begin + {Assume the note can't be found} + FoundChannel := 255; + {Scan for note on FM channels} + for FMchannel := 0 to Voices do begin + if InUse[FMChannel] = true then begin + {Is this the correct channel?} + if (MIDILink [FMChannel] = MIDIChannel) + and (NoteNumber [FMChannel] = Number) then begin + {If the correct channel has been found then report that} + FoundChannel := FMChannel; + Break; + end; + end; + end; + if FoundChannel <> 255 then begin + {Disable the note} + DisableNote (RealVoice [FoundChannel]); + {Store appropriate information} + InUse [FoundChannel] := false; {InUse flag} + end; +end; + +{Processes a "NoteOn" event for the FM synthesizer} +procedure NoteOn (MIDIChannel, Number, Velocity : Byte); +var + FreeChannel, FMChannel : Byte; + Oldest : LongInt; + +begin + {Velocity of zero means note off} + if Velocity = 0 then begin + NoteOff (MIDIChannel, Number, Velocity); + Exit; + end; + {Assume no free channel} + FreeChannel := 255; + {Scan for free channel} + for FMchannel := 0 to Voices do begin + if InUse[FMChannel] = false then begin + {If a free channel has been found then report that} + FreeChannel := FMChannel; + break; + end; + end; + {If there was no free channel, the SB's 6/15 voice polyphony + has been exceeded and the "oldest" note must be deactivated} + if FreeChannel = 255 then begin + Oldest := MaxLongInt; + {Scan for the oldest note} + for FMChannel := 0 to Voices do begin + if Activated [FMChannel] < Oldest then begin + FreeChannel := FMChannel; + Oldest := Activated [FMChannel]; + end; + end; + {Disable the note currently playing} + CutNote (RealVoice [FreeChannel]); + end; + {Change the instrument settings for the FM channel chosen} + SetInstr (RealVoice [FreeChannel], Instrument [MIDIChannel], Velocity); + {Start playing the note} + EnableNote (RealVoice [FreeChannel], Number); + {Store appropriate information} + InUse [FreeChannel] := true; {InUse flag} + Activated [FreeChannel] := MIDICounter; {Activation time} + MIDILink [FreeChannel] := MIDIChannel; {Link FM channel to MIDI channel} + NoteNumber [FreeChannel] := Number; {Note number (which note is being played)} + NoteVelocity [FreeChannel] := Velocity; {Velocity (=volume)} +end; + +{Plays a drum note} +procedure DrumOn (MIDIChannel, Number, Velocity : Byte); +begin + {If velocity is 0, note is turned off, this is ignored} + if Velocity = 0 then Exit; + {Convert velocity to "level" needed by SB and reduce the volume slightly} + Velocity := word(Velocity shl 3) div 10; + Velocity := 63 - (Velocity shr 1); + {Bass drum} + if Number in [35, 36, 41, 43] then begin + {Set channel 6 to bass, allowing for volume} + SetDrum (16, 0, 13, 248, 102, 0, 48); + SetDrum (19, 0, Velocity, 246, 87, 0, 16); + {Enable bass and immediately deactivate} + WriteFM (0, $BD, ByteBD or 16); + WriteFM (0, $BD, ByteBD); + end; + {HiHat} + if Number in [37, 39, 42, 44, 46, 56, 62, 69, 70, 71, 72, 78] then begin + {Set channel 7 to hihat, allowing for volume} + SetDrum (17, 0, Velocity, 240, 6, 0, 16); + {Enable hihat and immediately deactivate} + WriteFM (0, $BD, ByteBD or 1); + WriteFM (0, $BD, ByteBD); + end; + {Snare drum} + if Number in [38, 40] then begin + {Set channel 7 to snare drum, allowing for volume} + SetDrum (20, 0, Velocity, 240, 7, 2, 16); + {Enable hihat and immediately deactivate} + WriteFM (0, $BD, ByteBD or 8); + WriteFM (0, $BD, ByteBD); + end; + {TomTom} + if Number in [45, 47, 48, 50, 60, 61, 63, 64, 65, 66, 67, 68, 73, 74, 75, 76, 77] then begin + {Set channel 8 to tomtom, allowing for volume} + SetDrum (18, 2, Velocity, 240, 6, 0, 16); + {Enable tomtom and immediately deactivate} + WriteFM (0, $BD, ByteBD or 4); + WriteFM (0, $BD, ByteBD); + end; + {Cymbal} + if Number in [49, 51, 52, 53, 54, 55, 57, 58, 59, 79, 80, 81] then begin + {Set channel 8 to cymbal, allowing for volume} + SetDrum (21, 4, Velocity, 240, 6, 0, 16); + {Enable cymbal and immediately deactivate} + WriteFM (0, $BD, ByteBD or 2); + WriteFM (0, $BD, ByteBD); + end; +end; + +{Disables a drum note, well, it actually does nothing since drum notes +do not need to be disabled} +procedure DrumOff (MIDIChannel, Number, Velocity : Byte); +begin +end; + +{Sends a GM command to the GM device} +procedure SendGM (c : Byte); +var + Value : Byte; + +begin + repeat until ((Port [GMBase + 1] and $40) = 0); + Port [GMBase] := c; +end; + +{This function reads a byte from a specific track} +function ReadByte (TrackNumber : Byte) : Byte; +begin + if WaitingFor [TrackNumber] < $FFFFFF then begin + ReadByte := TrackData [TrackNumber]^[NextBytePtr [TrackNumber]]; + inc (NextBytePtr [TrackNumber]); + end else ReadByte := 0; +end; + +{This function reads a Variable Length Encoded (VLE) number from the track} +function GetVLE (TrackNumber : Byte) : LongInt; +var + ByteRead : Byte; + Result : LongInt; + +begin + {Assume zero} + Result := 0; + repeat + {Read first byte} + ByteRead := ReadByte (TrackNumber); + {Store 7bit part} + Result := (Result shl 7) or (ByteRead and $7F); + until (ByteRead and $80) = 0; + GetVLE := Result; +end; + +{This procedure stores the time for the next event} +procedure GetDeltaTime (TrackNumber : Byte); +begin + inc (WaitingFor [TrackNumber], GetVLE (TrackNumber)); +end; + +{This procedure handles the MIDI events} +procedure DoEvent (TrackNumber : Byte); +var + MIDICommand : Byte; + MetaEvent : Byte; + DataLength : LongInt; + Data : LongInt; + Counter : Byte; + P1, P2 : Byte; + +begin + {Get the MIDI event command from the track} + MIDICommand := ReadByte (TrackNumber); + {If this is not a command, we are in "running" mode and the last + command issued on the track is assumed} + if MIDICommand and $80 = 0 then begin + MIDICommand := LastCommand [TrackNumber]; + dec (NextBytePtr [TrackNumber]); + end; + {Store the command for running mode} + LastCommand [TrackNumber] := MIDICommand; + { + META-EVENTS + =========== + Special commands controlling timing etc. + } + if MIDICommand = $FF then begin + MetaEvent := ReadByte (TrackNumber); + DataLength := GetVLE (TrackNumber); + case MetaEvent of + $2F : begin {End of track} + WaitingFor [TrackNumber] := $FFFFFF; + end; + $51 : begin {Tempo change} + Data := ReadByte (TrackNumber); + Data := (Data shl 8) or ReadByte (TrackNumber); + Data := (Data shl 8) or ReadByte (TrackNumber); + ChangeSpeed (Data); + end; + else begin {Others (text events, track sequence numbers etc. - ignore} + for Counter := 1 to DataLength do ReadByte (TrackNumber); + end; + end; + end; + { + CHANNEL COMMANDS + ================ + Upper nibble contains command, lower contains channel + } + case (MIDICommand shr 4) of + $8 : begin {Note off} + {This allows the use of a wavetable General Midi instrument (such + as the Roland SCC1 (or an emulation thereof) or the FM synthesizer} + P1 := ReadByte (TrackNumber); + P2 := DoVolume (ReadByte (TrackNumber)); + case Device of + {FM - Sound Blaster or AdLib} + FM : begin + case MIDICommand and $F of + 9, 15 : DrumOff (MIDICommand and $F, P1, P2); + else NoteOff (MIDICommand and $F, P1, P2); + end; + end; + {GM - General MIDI device} + GM : begin + SendGM (MIDICommand); SendGM (P1); SendGM (P2); + end; + end; + end; + $9 : begin {Note on} + P1 := ReadByte (TrackNumber); + P2 := DoVolume (ReadByte (TrackNumber)); + case Device of + FM : begin + case MIDICommand and $F of + 9, 15 : DrumOn (MIDICommand and $F, P1, P2); + else NoteOn (MIDICommand and $F, P1, P2); + end; + end; + GM : begin + SendGM (MIDICommand); SendGM (P1); SendGM (P2); + end; + end; + end; + $A : begin {Key Aftertouch - only supported for GM device} + P1 := ReadByte (TrackNumber); + P2 := DoVolume (ReadByte (TrackNumber)); + if Device = GM then begin + SendGM (MIDICommand); SendGM (P1); SendGM (P2); + end; + end; + $B : begin {Control change - only supported for GM device} + case Device of + FM : begin + ReadByte (TrackNumber); ReadByte (TrackNumber); + end; + GM : begin + SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); SendGM (ReadByte (TrackNumber)); + end; + end; + end; + $C : begin {Patch change - this changes the instrument on a channel} + case Device of + FM : begin + Instrument [MIDICommand and $F] := ReadByte (TrackNumber); + end; + GM : begin + SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); + end; + end; + end; + $D : begin {Channel aftertouch - only supported on GM device} + case Device of + FM : begin + ReadByte (TrackNumber); + end; + GM : begin + SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); + end; + end; + end; + $E : begin {Pitch wheel change - only supported on GM device} + case Device of + FM : begin + ReadByte (TrackNumber); ReadByte (TrackNumber); + end; + GM : begin + SendGM (MIDICommand); SendGM (ReadByte (TrackNumber)); SendGM (ReadByte (TrackNumber)); + end; + end; + end; + end; + { + SYSTEM COMMANDS + =============== + These are ignored. + } + if (MIDICommand shr 4 = $F) then begin + case MIDICommand of + $F0 : repeat until ReadByte (TrackNumber) = $F7; {System Exclusive} + $F2 : begin ReadByte (TrackNumber); ReadByte (TrackNumber); end; {Song Position Pointer} + $F3 : ReadByte (TrackNumber); {Song Select} + end; + end; +end; + +{Returns TRUE if the MIDI file is still playing. FALSE if it has stopped} +function Playing : Boolean; +var + CurrentTrack : Byte; + Result : Boolean; + +begin + {Assume it has stopped} + Result := false; + {Check for at least one track still playing} + for CurrentTrack := 1 to NumberOfTracks do + Result := Result or (WaitingFor [CurrentTrack] < $FFFFFF); + Playing := Result; +end; + +{This is the new timer interrupt handler} +{$F+} +procedure TimerHandler; interrupt; +var + CurrentTrack : Byte; + +begin + {Increase MIDI counter, compensating for Windows if necessary} + inc (MIDICounter, WinTick); + {Check all the channels for MIDI events} + for CurrentTrack := 1 to NumberOfTracks do begin + {If it is time to handle an event, do so} + if NextBytePtr [CurrentTrack] < TrackSize [CurrentTrack] then + while MIDICounter >= WaitingFor [CurrentTrack] do begin + {Call the event handler} + DoEvent (CurrentTrack); + {Store the time for the next event} + GetDeltaTime (CurrentTrack); + end; + end; + {Check whether we need to call the original timer handler} + ClockTicks := ClockTicks + TickCounter; + {Do so if required} + if ClockTicks > 65535 then begin + dec (ClockTicks, 65536); + asm pushf end; + BIOSTimerHandler; + end else + Port [$20] := $20; +end; +{$F-} + +{Installs the MIDI timer handler} +procedure InstallTimer; +begin + TickCounter := 0; + {Assume tempo 120 according to MIDI spec} + ChangeSpeed (TicksPerQNote * 25000 div 3); + {Install new timer handler} + SetIntVec(8, Addr(TimerHandler)); +end; + +{Restores the BIOS timer handler} +procedure RestoreTimer; +begin + {Return to 18.2 times a second} + Port[$43] := $34; + Port[$40] := 0; + Port[$40] := 0; + {Install old timer handler} + SetIntVec(8, @BIOSTimerHandler); +end; + +{This converts a 32bit number from little-endian (Motorola) to big-endian +(Intel) format} +function L2B32 (L : LongInt) : LongInt; +var + B : LongInt; + T : Byte; + +begin + for T := 0 to 3 do begin + B := (B shl 8) or (L and $FF); + L := L shr 8; + end; + L2B32 := B; +end; + +{This converts a 16bit number from little-endian (Motorola) to big-endian +(Intel) format} +function L2B16 (L : Word) : Word; +begin + L2B16 := lo (L) shl 8 + hi (L); +end; + +{This loads the MIDI file into memory} +function LoadMidi (FileName : String) : Boolean; +var + {To access the file itself} + MIDIFile : File; + MIDIHeader : FileHeaderType; + TrackHeader : TrackHeaderType; + {For loading the tracks} + CurrentTrack,t : Byte; + +begin + {Assume failure} + LoadMIDI := false; + + {Open the file} + Assign (MIDIFile, FileName); + Reset (MIDIFile, 1); + + {Read in the header} + BlockRead (MIDIFile, MIDIHeader, SizeOf (MIDIHeader)); + {If the first four bytes do not constiture "MTHd", this is not a MIDI file} + if MIDIHeader.MTHd = $6468544D then begin + {If the header size is other than 6, this is an unknown + type of MIDI file} + if L2B32(MIDIHeader.HeaderSize) = 6 then begin + {Convert file format identifier} + MIDIHeader.FileFormat := L2B16(MIDIHeader.FileFormat); + {If it is an asynchronous file (type 2), I don't know how to play it} + if MIDIHeader.FileFormat <> 2 then begin + {Store the tempo of the file} + TicksPerQNote := L2B16(MIDIHeader.TicksPerQNote); + {Store the number of tracks in the file} + NumberOfTracks := L2B16(MIDIHeader.NumberOfTracks); + if MIDIHeader.FileFormat = 0 then NumberOfTracks := 1; + {When we reach this, we can start loading} + for CurrentTrack := 1 to NumberOfTracks do begin + {Load track header} + BlockRead (MIDIFIle, TrackHeader, SizeOf (TrackHeader)); + {If the first 4 bytes do not form "MTrk", the track is invalid} + if TrackHeader.MTrk <> $6B72544D then Exit; + {We need to convert little-endian to big endian} + TrackHeader.TrackSize := L2B32 (TrackHeader.TrackSize); + {If it's too big, we can't load it} + if TrackHeader.TrackSize > 65534 then Exit; + TrackSize [CurrentTrack] := TrackHeader.TrackSize; + {Assign memory for the track} + GetMem(TrackData [CurrentTrack], TrackSize [CurrentTrack]); + BlockRead (MIDIFile, TrackData [CurrentTrack]^, TrackSize [CurrentTrack]); + end; + LoadMIDI := true; + end; + end; + end; + + {Close it} + Close (MIDIFile); +end; + +{This unloads the MIDI file from memory} +procedure UnLoadMidi; +var + CurrentTrack : Byte; + +begin + StopMIDI; + for CurrentTrack := 1 to NumberOfTracks do + if TrackSize [CurrentTrack] <> 0 then begin + FreeMem(TrackData [CurrentTrack], TrackSize [CurrentTrack]); + TrackSize [CurrentTrack] := 0; + end; +end; + +{This resets the drums} +procedure EnableDrums; +begin + {Enable waveform select} + WriteFM (0, 1, $20); + {Enable percussion mode, amplify AM & VIB} + WriteFM (0, $BD, ByteBD); + {Set drums frequencies} + WriteFM (0, $A6, lo(400)); + WriteFM (0, $B6, hi(400) + (2 shl 2)); + WriteFM (0, $A7, lo(500)); + WriteFM (0, $B7, hi(500) + (2 shl 2)); + WriteFM (0, $A8, lo(650)); + WriteFM (0, $B8, hi(650) + (2 shl 2)); +end; + +{This starts playing the MIDI file} +procedure PlayMIDI; +var + CurrentTrack : Byte; +begin + {MIDI might already be playing, so stop it first} + StopMIDI; + {Clear read pointers for every track} + for CurrentTrack := 1 to NumberOfTracks do begin + NextBytePtr [CurrentTrack] := 0; + WaitingFor [CurrentTrack] := 0; + LastCommand [CurrentTrack] := $FF; + GetDeltaTime (CurrentTrack); + end; + MIDICounter := 0; + WinTick := 1; + EnableDrums; + InstallTimer; +end; + +{Guess!!} +procedure StopMIDI; +var + CurrentChannel : Byte; +begin + RestoreTimer; + {Send "All notes off" to each channel} + case Device of + FM : for CurrentChannel := 0 to 14 do begin + if InUse [CurrentChannel] then DisableNote (CurrentChannel); + end; + GM : for CurrentChannel := 0 to 15 do begin + SendGM ($B0 or CurrentChannel); + SendGM (123); + SendGM (0); + end; + end; +end; + +{Set the playback volume} +procedure SetVol (NewVol : Byte); +begin + MasterVolume := NewVol; +end; + +{Check for the existence of an OPL2/3 chip} +function TestOPL (Test : Word) : Byte; +var + A, B : Byte; + +begin + {Assume no OPL was found} + TestOPL := 0; + + {Find it} + Port [Test] := 0; Delay (1); Port [Test + 1] := 0; Delay (1); + Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1); + Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1); + A := Port [Test]; + Port [Test] := 2; Delay (1); Port [Test + 1] := $FF; Delay (1); + Port [Test] := 4; Delay (1); Port [Test + 1] := $21; Delay (1); + B := Port [Test]; + Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1); + Port [Test] := 4; Delay (1); Port [Test + 1] := $60; Delay (1); + + if ((A and $E0)=0) and ((B and $E0)=$C0) then + {This might be an OPL2} + TestOPL := 2 + else + {There's nothing here, so stop looking} + Exit; + + {Check for OPL3} + if Port [Test] and $06 = 0 then TestOPL := 3; +end; + +{This function returns true if a GM device is detected at the specified port} +function TestGM (Base : Word) : Boolean; +begin + TestGM := false; + Delay (10); + if ((Port [Base + 1] and $40) = 0) then begin + Port [Base] := $F8; + Delay (10); + if ((Port [Base + 1] and $40) = 0) then TestGM := true; + Port [Base] := $FF; + Delay (10); + Port [Base+1] := $3F; + end; +end; + +{This function reports whether Windows is present. Windows interferes with +the timer interrupt and measures have to be taken.} +function MSWindows : Boolean; assembler; +asm + mov ax, $1600 + int $2F +end; + +{Initialize FM driver} +function SetFM : Boolean; +var + Bnk : File; + +begin + {Assume a standard SB or AdLib: 6 melodic voices, 5 percussion voices} + Voices := 5; + {Check for FM card} + if TestOPL ($388) > 0 then FMBase := $388; + {Check for OPL3 at $220 and $240} + case TestOPL ($240) of + 2 : FMBase := $240; + 3 : begin FMBase := $240; Voices := 14; end; + end; + case TestOPL ($220) of + 2 : FMBase := $220; + 3 : begin FMBase := $220; Voices := 14; end; + end; + if FMBase <> 0 then begin + {Enable OPL3 if present} + if Voices <> 5 then begin + WriteFM (1, 5, 1); + WriteFM (1, 4, 0); + end; + {Load FM instrument definitions} + Assign (Bnk, 'FM.DAT'); + Reset (Bnk, 1); + BlockRead (Bnk, M2, SizeOf (M2)); + BlockRead (Bnk, M4, SizeOf (M4)); + BlockRead (Bnk, M6, SizeOf (M6)); + BlockRead (Bnk, M8, SizeOf (M8)); + BlockRead (Bnk, ME, SizeOf (ME)); + BlockRead (Bnk, MC, SizeOf (MC)); + BlockRead (Bnk, C2, SizeOf (C2)); + BlockRead (Bnk, C4, SizeOf (C4)); + BlockRead (Bnk, C6, SizeOf (C6)); + BlockRead (Bnk, C8, SizeOf (C8)); + BlockRead (Bnk, CE, SizeOf (CE)); + Close (Bnk); + Device := FM; + end; + SetFM := Device = FM; +end; + +{Initialize GM driver} +function SetGM : Boolean; +begin + {Try detecting a GM device} + GMBase := 0; + if TestGM ($300) then GMBase := $300; + if TestGM ($330) then GMBase := $330; + {If it is detected, use it} + if GMBase <> 0 then Device := GM; + SetGM := Device = GM; +end; + +{###########################################################################} +{### L E S M E U E S F U N C I O N S ###} +{###########################################################################} +procedure IniMidi; +{ Funci: Prepara el General Midi } +begin + if midiOK then + begin + repeat until SetGM; + SetVol(255); + end; +end; +{###########################################################################} +procedure StartMidi(nom : string); +{ Funci: comena a tocar un midi } +begin + if midiOK then + begin + midi := nom; + if midiMEM then UnloadMidi; + LoadMidi(midi); + midiMEM := TRUE; + PlayMidi; + end; +end; +{###########################################################################} +procedure KeepMidi; +{ Funci: Mantin el midi en marxa } +begin + if midiOK then + begin + if not(playing) then + begin + StartMidi(midi); + PlayMidi; + end; + end; +end; +{###########################################################################} +procedure EndMidi; +{ Funci: Allibera la memoria del midi } +begin + if midiOK then + begin + if midiMEM then UnloadMidi; + midiMEM := FALSE; + end; +end; +{###########################################################################} + +begin + {No device found yet} + Device := None; + {Start at normal volume} + SetVol (128); + {Check whether Windows is present} + Windows := MSWindows; + {Save old timer handler} + GetIntVec(8, @BIOSTimerHandler); +end. \ No newline at end of file diff --git a/original_turbopascal/MUSICA.TPU b/original_turbopascal/MUSICA.TPU new file mode 100644 index 0000000..35e06c3 Binary files /dev/null and b/original_turbopascal/MUSICA.TPU differ diff --git a/original_turbopascal/RUNNER.BAK b/original_turbopascal/RUNNER.BAK new file mode 100644 index 0000000..b27c744 --- /dev/null +++ b/original_turbopascal/RUNNER.BAK @@ -0,0 +1,756 @@ +uses grafix, jinput, utext, tipos, crt; + +procedure FaseNova;forward; +{##############################################################} +{# O F F S E T M A P A #} +{##############################################################} +function OffsetMapa:longint; +var i:longint; + marca : integer; + fich : file of byte; + buffer : byte; +begin + Assign(fich, 'runner.exe'); + Reset(fich); + marca := 0; + repeat + Read(fich, buffer); + if buffer = ord('*') then + inc(marca) + else + marca := 0; + inc(i); + until (marca = 10); + OffsetMapa := i; +end; +{##############################################################} +{# C A R R E G A R E C O R D S #} +{##############################################################} +procedure CarregaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'records'); + Reset(fich); + {Seek(fich, FileSize(fich)-6);} + + Read(fich, buffer); { centenes } + hi_score := buffer * 100; + Read(fich, buffer); { decenes } + hi_score := score + (buffer * 10); + Read(fich, buffer); { unitats } + hi_score := score + buffer; + + + Read(fich, buffer); { 1 lletra } + nom_hi_score := chr(buffer); + Read(fich, buffer); { 2 lletra } + nom_hi_score := nom_hi_score + chr(buffer); + Read(fich, buffer); { 3 lletra } + nom_hi_score := nom_hi_score + chr(buffer); + + Close(fich); +end; +{##############################################################} +{# G U A R D A R E C O R D S #} +{##############################################################} +procedure GuardaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'records'); + Reset(fich); + {Seek(fich, FileSize(fich)-6);} + + buffer := score div 100; + Write(fich, buffer); { centenes } + buffer := (score - (buffer*100)) div 10; + Write(fich, buffer); { decenes } + buffer := (score - (buffer*10)); + Write(fich, buffer); { unitats } + + buffer := ord(nom_hi_score[1]); + Write(fich, buffer); { 1 lletra } + buffer := ord(nom_hi_score[2]); + Write(fich, buffer); { 2 lletra } + buffer := ord(nom_hi_score[3]); + Write(fich, buffer); { 3 lletra } + + Close(fich); +end; +{##############################################################} +{# T R A G A P A N T A L L A #} +{##############################################################} +procedure TragaPantalla; +begin + for k:=0 to 23 do + begin + { desplaa cap avall } + for i:=0 to 39 do + for j:=23 downto 1 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j-1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j-1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(13,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + end; +end; +{##############################################################} +{# P O S A R N O M #} +{##############################################################} +procedure PosarNom; +var index : integer; + Key : byte; + Tecla : Pchar; +begin + nom_hi_score := '...'; + index := 1; + PutStringCENTERED(13, 15, 'Enhorabona, has'); + PutStringCENTERED(14, 15, 'aconseguit un nou record'); + PutStringCENTERED(16, 15, nom_hi_score); + repeat + if QTeclaPuls then + begin + Key := AgarrarTecla; + Tecla := nomTECLES[Key]; + nom_hi_score[index] := Tecla^; + inc(index); + PutStringCENTERED(16, 15, nom_hi_score); + repeat until not(QTeclaPuls); + end; + until (index = 4); + GuardaRecords; +end; +{##############################################################} +{# G A M E O V E R #} +{##############################################################} +procedure GameOver; +begin + TragaPantalla; + cls($B800); + PutStringCENTERED(10, 15, 'G A M E O V E R'); + for i:=0 to 100 do espera_VGA; + if score > hi_score then PosarNom; + FadeDown(0,0,0,0); +end; +{##############################################################} +{# F I N A L P A N T A L L A #} +{##############################################################} +procedure FinalPantalla; +begin + TragaPantalla; + FaseNova; +end; +{##############################################################} +{# M O R T #} +{##############################################################} +procedure Mort; +begin + dec(pepe.vides); + pepe.posX := 19; + pepe.posY := 23; +end; +{##############################################################} +{# M O R T M A L O #} +{##############################################################} +procedure MortMalo(num: byte); +begin + malo[num].posX := 39; + malo[num].posY := 1; + malo[num].color := 3; + malo[num].estat := caent; + malo[num].IAclock := 0; + mapa[malo[num].carrega.posX, malo[num].carrega.posY].tipo := diners; + malo[num].carrega.OK := false; + malo[num].carrega.posX := 0; + malo[num].carrega.posY := 0; +end; +{##############################################################} +{# F O R A D A R #} +{##############################################################} +procedure Foradar(posX, posY : word); +begin +{ mapa[posX, posY].tipo := buit;} + mapa[posX, posY].temps := bloc_out; +end; +{##############################################################} +{# M O U P E P E #} +{##############################################################} +procedure MouPepe; +var hi_ha_malo_baix : boolean; +begin + if TeclaPuls(KeyQ) then + begin + if mapa[pepe.posX, pepe.posY].tipo=escala then + begin + dec(pepe.posY); + end; + end + else + if TeclaPuls(KeyA) then + begin + if (mapa[pepe.posX, pepe.posY+1].tipo=escala) or (mapa[pepe.posX, pepe.posY+1].tipo=buit) then + inc(pepe.posY); + end; + + if TeclaPuls(KeyO) then + begin + if (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + dec(pepe.posX); + end + else + if TeclaPuls(KeyP) then + begin + if (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + inc(pepe.posX); + end + else + if TeclaPuls(KeySPACE) then + begin + if (mapa[pepe.posX-1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX-1, pepe.posY+1); + end + else + if TeclaPuls(KeyM) then + begin + if (mapa[pepe.posX+1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX+1, pepe.posY+1); + end; + + + + { si no passa res... } + pepe.estat := normal; + + { final pantalla } + if pepe.posY = 1 then FinalPantalla; + + { emparedat } + if mapa[pepe.posX, pepe.posY].tipo = pedra then + Mort; + + { agarra diners } + if mapa[pepe.posX, pepe.posY].tipo = diners then + begin + mapa[pepe.posX, pepe.posY].tipo := buit; + inc(score); + dec(diners_pantalla); + end; + + { bordes X pantalla } + if pepe.posX<0 then pepe.posX:=0; + if pepe.posX>39 then pepe.posX:=39; + + { gravetat } + if ((mapa[pepe.posX, pepe.posY+1].tipo<>escala) and (mapa[pepe.posX, pepe.posY+1].tipo<>pedra)) + and ((mapa[pepe.posX, pepe.posY].tipo=buit) or (mapa[pepe.posX, pepe.posY].tipo=diners)) then + begin + hi_ha_malo_baix := FALSE; + for i:=0 to num_malos-1 do + if (pepe.posX = malo[i].posX) and (pepe.posY+1 = malo[i].posY) then + hi_ha_malo_baix := TRUE; + + if not(hi_ha_malo_baix) then + begin + inc(pepe.posY); + pepe.estat := caent; + end; + end; + + { bordes Y pantalla } + if pepe.posY<0 then pepe.posY:=0; + if pepe.posY>24 then pepe.posY:=24; + +end; +{##############################################################} +{# S E L E C T E S T A T #} +{##############################################################} +function SelectEstat(num: byte):byte; +var nou_estat : byte; + Sestat:byte; + x:byte; + estat_pX,estat_pY:byte; + buscar:byte; +begin + nou_estat := 0; + Sestat:=0; + if mapa[malo[num].posX+1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+dreta; + + if mapa[malo[num].posX-1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+esquerra; + + if mapa[malo[num].posX, malo[num].posY].tipo = escala then + nou_estat := nou_estat + pujar; + + if mapa[malo[num].posX, malo[num].posY+1].tipo = escala then + nou_estat := nou_estat + baixar; + + if nou_estat=0 then Sestat:=10; {no pot moure's} + + if malo[num].posX>pepe.posX then estat_pX:=esquerra + else estat_pX:=dreta; + if malo[num].posY>pepe.posY then estat_pY:=pujar + else estat_pY:=baixar; + + x:=random(4); + buscar:=random(100); + if (buscar<50) and ((nou_estat and estat_PX=estat_PX) or + (nou_estat and estat_PY=estat_PY)) then + begin + if (nou_estat and estat_PX=estat_PX) then Sestat:=estat_PX + else Sestat:=estat_PY; + end + else + repeat + case x of + 0:if nou_estat and dreta =dreta then Sestat:=dreta; + 1:if nou_estat and esquerra =esquerra then Sestat:=esquerra; + 2:if nou_estat and pujar =pujar then Sestat:=pujar; + 3:if nou_estat and baixar =baixar then Sestat:=baixar; + end; + inc(x); + x:=x and $03; + until Sestat<>0; + + SelectEstat:=Sestat; + + if (mapa[malo[num].posX, malo[num].posY+1].tipo <> pedra) + and (mapa[malo[num].posX, malo[num].posY+1].tipo <> escala) then + SelectEstat:=caent; +end; +{##############################################################} +{# A G A F A R E S C A L A #} +{##############################################################} +function AgafarEscala(num:byte):byte; +var x:byte; + ag:boolean; + estat:byte; +begin + estat:=malo[num].estat; + if (estat=dreta) or (estat=esquerra) then + begin + x:=random(100); + if x<80 then ag:=True else ag:=false; + if ag then + begin + if (mapa[malo[num].posX, malo[num].posY].tipo = escala) then + estat:=pujar + else + if (mapa[malo[num].posX, malo[num].posY+1].tipo = escala) then + estat:=baixar; + end; + end; + AgafarEscala:=estat; +end; + +{##############################################################} +{# M O U M A L O S #} +{##############################################################} +procedure MouMalos; +begin + for i:=0 to num_malos-1 do + begin + if malo[i].IAclock = 0 then + malo[i].estat := SelectEstat(i); + + malo[i].estat:=AgafarEscala(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo <> pedra) and + (mapa[malo[i].posX, malo[i].posY+1].tipo <> escala)) and + (mapa[malo[i].posX, malo[i].posY].tipo <> corda) then + malo[i].estat:=caent; + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) or + (mapa[malo[i].posX, malo[i].posY+1].tipo = escala)) and + (malo[i].estat=caent) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY].tipo = buit) and + (malo[i].estat=pujar)) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) and + (malo[i].estat=baixar)) then + malo[i].estat:=SelectEstat(i); + + case malo[i].estat of + dreta : inc(malo[i].posX); + esquerra : dec(malo[i].posX); + pujar : dec(malo[i].posY); + baixar : inc(malo[i].posY); + caent : inc(malo[i].posY); + end; + + { bordes X } + if malo[i].posX<0 then + begin + malo[i].posX:=0; + malo[i].estat := dreta; + end; + if malo[i].posX>39 then + begin + malo[i].posX:=39; + malo[i].estat := esquerra; + end; + + { bordes Y } + if malo[i].posY<0 then + begin + malo[i].posY:=0; + end; + if malo[i].posY>24 then + begin + malo[i].posY:=24; + end; + + { agarrar diners } + if (mapa[malo[i].posX, malo[i].posY].tipo = diners) + and not(malo[i].carrega.OK) then + begin + mapa[malo[i].posX, malo[i].posY].tipo := buit; + malo[i].color := 11; + malo[i].carrega.OK := TRUE; + malo[i].carrega.posX := malo[i].posX; + malo[i].carrega.posY := malo[i].posY; + end; + + { emparedat } + if mapa[malo[i].posX, malo[i].posY].tipo = pedra then + MortMalo(i); + + inc(malo[i].IAclock); + if malo[i].IAclock = temps_IA then malo[i].IAclock := 0; + end; +end; +{##############################################################} +{# C A R R E G A M A P A #} +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'total.map'); + Reset(fich); + Seek(fich, (level * 1000)+offset_mapa); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo:=buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +{# C H E C K M O R T P E R M A L O S #} +{##############################################################} +procedure CheckMortPerMalos; +begin + for i:=0 to num_malos-1 do + if (malo[i].posX = pepe.posX) and (malo[i].posY = pepe.posY) then + Mort; +end; +{##############################################################} +{# C H E C K M A P A C O M P L E T #} +{##############################################################} +procedure CheckMapaComplet; +begin + if diners_pantalla = 0 then + for j:=1 to 23 do + begin + if mapa[0,j].tipo <> pedra then + begin + mapa[0,j].tipo := escala; + mapa[0,j].color := color_escala; + end + else + break; + end; +end; +{##############################################################} +{# C H E C K M A P A #} +{##############################################################} +procedure CheckMapa; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + case mapa[i,j].temps of + + 0 : begin + mapa[i,j].temps := -1; + mapa[i,j].tipo := pedra; + end; + + 1,bloc_out-1 : begin + mapa[i,j].tipo := bloc3; + dec(mapa[i,j].temps) + end; + + 2,bloc_out-2 : begin + mapa[i,j].tipo := bloc2; + dec(mapa[i,j].temps) + end; + + 3,bloc_out-3 : begin + mapa[i,j].tipo := bloc1; + dec(mapa[i,j].temps) + end; + + 4,bloc_out-4 : begin + mapa[i,j].tipo := buit; + dec(mapa[i,j].temps) + end; + + -1 : ; + + else dec(mapa[i,j].temps) + + end; + end; + CheckMapaComplet; +end; +{##############################################################} +{# F A S E N O V A #} +{##############################################################} +procedure FaseNova; +begin + inc(level); + if level=(num_fases + 1) then + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# I N I C I A L I T Z A C I O #} +{##############################################################} +procedure Inicialitzacio; +begin + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + pepe.vides := 0; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# T I T O L #} +{##############################################################} +procedure Titol; +begin + getpaleta(paleta); + blackout; + + PutStringCENTERED(10, 15, 'JAILDESIGNER'); + PutStringCENTERED(12, 15, 'presenta'); + + FadeUp(paleta, 1); + + for i:=0 to 100 do espera_VGA; + + Fadedown(0,0,0,0); + level := 0; + CarregaMapa; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + move(mem[pant1:0], mem[$B800:0], 2000); + + FadeUp(paleta, 0); + + for i:=0 to 100 do espera_VGA; + + for k:=0 to 2 do + begin + { desplaa cap amunt } + for i:=0 to 39 do + for j:=0 to 23 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j+1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j+1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + end; + + + +end; +{##############################################################} +{# M E N U #} +{##############################################################} +procedure Menu; +var num : integer; +begin + num := 1; + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'OPCIONS'); + + repeat + + repeat until QteclaPuls; + + if (TeclaPuls(KeyA)) then + num := 2; + if (TeclaPuls(KeyQ)) then + num := 1; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + if num = 1 then + begin + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + end + else + begin + PutStringCENTERED(18, 15, 'COMENAR JOC'); + PutStringWINDOWED(20, 14, 'EIXIR'); + end; + + until TeclaPuls(KeyENTER); + + if num = 2 then + { menu d'opcions } + exit_game := TRUE; + ; + +end; +{##############################################################} +begin + instalarKB; + setmode(1); + HideCursor; + SetUpVirtual(ptrpant1, pant1); + randomize; + offset_mapa := OffsetMapa; + exit_game := FALSE; + + repeat + + Titol; + + Menu; + + Inicialitzacio; + + CarregaRecords; + + repeat + MouPepe; + CheckMortPerMalos; + if (Clock mod 4) = 0 then MouMalos; + CheckMortPerMalos; + PintaPantalla; + CheckMapa; + until TeclaPuls(KeyESC) or (Pepe.vides<0); + + GameOver; + + until exit_game; + + TancarVirtual(ptrpant1); + setmode(3); + desinstalarKB; +end. \ No newline at end of file diff --git a/original_turbopascal/RUNNER.EXE b/original_turbopascal/RUNNER.EXE new file mode 100644 index 0000000..cefcc00 Binary files /dev/null and b/original_turbopascal/RUNNER.EXE differ diff --git a/original_turbopascal/RUNNER.PAS b/original_turbopascal/RUNNER.PAS new file mode 100644 index 0000000..5735cab --- /dev/null +++ b/original_turbopascal/RUNNER.PAS @@ -0,0 +1,756 @@ +uses grafix, jinput, utext, tipos, crt; + +procedure FaseNova;forward; +{##############################################################} +{# O F F S E T M A P A #} +{##############################################################} +function OffsetMapa:longint; +var i:longint; + marca : integer; + fich : file of byte; + buffer : byte; +begin + Assign(fich, 'runner.exe'); + Reset(fich); + marca := 0; + repeat + Read(fich, buffer); + if buffer = ord('*') then + inc(marca) + else + marca := 0; + inc(i); + until (marca = 10); + OffsetMapa := i; +end; +{##############################################################} +{# C A R R E G A R E C O R D S #} +{##############################################################} +procedure CarregaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'records'); + Reset(fich); + {Seek(fich, FileSize(fich)-6);} + + Read(fich, buffer); { centenes } + hi_score := buffer * 100; + Read(fich, buffer); { decenes } + hi_score := score + (buffer * 10); + Read(fich, buffer); { unitats } + hi_score := score + buffer; + + + Read(fich, buffer); { 1 lletra } + nom_hi_score := chr(buffer); + Read(fich, buffer); { 2 lletra } + nom_hi_score := nom_hi_score + chr(buffer); + Read(fich, buffer); { 3 lletra } + nom_hi_score := nom_hi_score + chr(buffer); + + Close(fich); +end; +{##############################################################} +{# G U A R D A R E C O R D S #} +{##############################################################} +procedure GuardaRecords; +var fich : file of byte; + buffer : byte; +begin + Assign(fich, 'records'); + Reset(fich); + {Seek(fich, FileSize(fich)-6);} + + buffer := score div 100; + Write(fich, buffer); { centenes } + buffer := (score - (buffer*100)) div 10; + Write(fich, buffer); { decenes } + buffer := (score - (buffer*10)); + Write(fich, buffer); { unitats } + + buffer := ord(nom_hi_score[1]); + Write(fich, buffer); { 1 lletra } + buffer := ord(nom_hi_score[2]); + Write(fich, buffer); { 2 lletra } + buffer := ord(nom_hi_score[3]); + Write(fich, buffer); { 3 lletra } + + Close(fich); +end; +{##############################################################} +{# T R A G A P A N T A L L A #} +{##############################################################} +procedure TragaPantalla; +begin + for k:=0 to 23 do + begin + { desplaa cap avall } + for i:=0 to 39 do + for j:=23 downto 1 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j-1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j-1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(13,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + end; +end; +{##############################################################} +{# P O S A R N O M #} +{##############################################################} +procedure PosarNom; +var index : integer; + Key : byte; + Tecla : Pchar; +begin + nom_hi_score := '...'; + index := 1; + PutStringCENTERED(13, 15, 'Enhorabona, has'); + PutStringCENTERED(14, 15, 'aconseguit un nou record'); + PutStringCENTERED(16, 15, nom_hi_score); + repeat + if QTeclaPuls then + begin + Key := AgarrarTecla; + Tecla := nomTECLES[Key]; + nom_hi_score[index] := Tecla^; + inc(index); + PutStringCENTERED(16, 15, nom_hi_score); + repeat until not(QTeclaPuls); + end; + until (index = 4); + GuardaRecords; +end; +{##############################################################} +{# G A M E O V E R #} +{##############################################################} +procedure GameOver; +begin + TragaPantalla; + cls($B800); + PutStringCENTERED(10, 15, 'G A M E O V E R'); + for i:=0 to 100 do espera_VGA; + if score > hi_score then PosarNom; + FadeDown(0,0,0,0); +end; +{##############################################################} +{# F I N A L P A N T A L L A #} +{##############################################################} +procedure FinalPantalla; +begin + TragaPantalla; + FaseNova; +end; +{##############################################################} +{# M O R T #} +{##############################################################} +procedure Mort; +begin + dec(pepe.vides); + pepe.posX := 19; + pepe.posY := 23; +end; +{##############################################################} +{# M O R T M A L O #} +{##############################################################} +procedure MortMalo(num: byte); +begin + malo[num].posX := 39; + malo[num].posY := 1; + malo[num].color := 3; + malo[num].estat := caent; + malo[num].IAclock := 0; + mapa[malo[num].carrega.posX, malo[num].carrega.posY].tipo := diners; + malo[num].carrega.OK := false; + malo[num].carrega.posX := 0; + malo[num].carrega.posY := 0; +end; +{##############################################################} +{# F O R A D A R #} +{##############################################################} +procedure Foradar(posX, posY : word); +begin +{ mapa[posX, posY].tipo := buit;} + mapa[posX, posY].temps := bloc_out; +end; +{##############################################################} +{# M O U P E P E #} +{##############################################################} +procedure MouPepe; +var hi_ha_malo_baix : boolean; +begin + if TeclaPuls(KeyQ) then + begin + if mapa[pepe.posX, pepe.posY].tipo=escala then + begin + dec(pepe.posY); + end; + end + else + if TeclaPuls(KeyA) then + begin + if (mapa[pepe.posX, pepe.posY+1].tipo=escala) or (mapa[pepe.posX, pepe.posY+1].tipo=buit) then + inc(pepe.posY); + end; + + if TeclaPuls(KeyO) then + begin + if (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + dec(pepe.posX); + end + else + if TeclaPuls(KeyP) then + begin + if (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) and (pepe.estat<>caent) then + inc(pepe.posX); + end + else + if TeclaPuls(KeySPACE) then + begin + if (mapa[pepe.posX-1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX-1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX-1, pepe.posY+1); + end + else + if TeclaPuls(KeyM) then + begin + if (mapa[pepe.posX+1, pepe.posY+1].tipo=pedra) + and (mapa[pepe.posX+1, pepe.posY].tipo<>pedra) + and (pepe.estat=normal) then + Foradar(pepe.posX+1, pepe.posY+1); + end; + + + + { si no passa res... } + pepe.estat := normal; + + { final pantalla } + if pepe.posY = 1 then FinalPantalla; + + { emparedat } + if mapa[pepe.posX, pepe.posY].tipo = pedra then + Mort; + + { agarra diners } + if mapa[pepe.posX, pepe.posY].tipo = diners then + begin + mapa[pepe.posX, pepe.posY].tipo := buit; + inc(score); + dec(diners_pantalla); + end; + + { bordes X pantalla } + if pepe.posX<0 then pepe.posX:=0; + if pepe.posX>39 then pepe.posX:=39; + + { gravetat } + if ((mapa[pepe.posX, pepe.posY+1].tipo<>escala) and (mapa[pepe.posX, pepe.posY+1].tipo<>pedra)) + and ((mapa[pepe.posX, pepe.posY].tipo=buit) or (mapa[pepe.posX, pepe.posY].tipo=diners)) then + begin + hi_ha_malo_baix := FALSE; + for i:=0 to num_malos-1 do + if (pepe.posX = malo[i].posX) and (pepe.posY+1 = malo[i].posY) then + hi_ha_malo_baix := TRUE; + + if not(hi_ha_malo_baix) then + begin + inc(pepe.posY); + pepe.estat := caent; + end; + end; + + { bordes Y pantalla } + if pepe.posY<0 then pepe.posY:=0; + if pepe.posY>24 then pepe.posY:=24; + +end; +{##############################################################} +{# S E L E C T E S T A T #} +{##############################################################} +function SelectEstat(num: byte):byte; +var nou_estat : byte; + Sestat:byte; + x:byte; + estat_pX,estat_pY:byte; + buscar:byte; +begin + nou_estat := 0; + Sestat:=0; + if mapa[malo[num].posX+1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+dreta; + + if mapa[malo[num].posX-1, malo[num].posY].tipo <> pedra then + nou_estat := nou_estat+esquerra; + + if mapa[malo[num].posX, malo[num].posY].tipo = escala then + nou_estat := nou_estat + pujar; + + if mapa[malo[num].posX, malo[num].posY+1].tipo = escala then + nou_estat := nou_estat + baixar; + + if nou_estat=0 then Sestat:=10; {no pot moure's} + + if malo[num].posX>pepe.posX then estat_pX:=esquerra + else estat_pX:=dreta; + if malo[num].posY>pepe.posY then estat_pY:=pujar + else estat_pY:=baixar; + + x:=random(4); + buscar:=random(100); + if (buscar<50) and ((nou_estat and estat_PX=estat_PX) or + (nou_estat and estat_PY=estat_PY)) then + begin + if (nou_estat and estat_PX=estat_PX) then Sestat:=estat_PX + else Sestat:=estat_PY; + end + else + repeat + case x of + 0:if nou_estat and dreta =dreta then Sestat:=dreta; + 1:if nou_estat and esquerra =esquerra then Sestat:=esquerra; + 2:if nou_estat and pujar =pujar then Sestat:=pujar; + 3:if nou_estat and baixar =baixar then Sestat:=baixar; + end; + inc(x); + x:=x and $03; + until Sestat<>0; + + SelectEstat:=Sestat; + + if (mapa[malo[num].posX, malo[num].posY+1].tipo <> pedra) + and (mapa[malo[num].posX, malo[num].posY+1].tipo <> escala) then + SelectEstat:=caent; +end; +{##############################################################} +{# A G A F A R E S C A L A #} +{##############################################################} +function AgafarEscala(num:byte):byte; +var x:byte; + ag:boolean; + estat:byte; +begin + estat:=malo[num].estat; + if (estat=dreta) or (estat=esquerra) then + begin + x:=random(100); + if x<80 then ag:=True else ag:=false; + if ag then + begin + if (mapa[malo[num].posX, malo[num].posY].tipo = escala) then + estat:=pujar + else + if (mapa[malo[num].posX, malo[num].posY+1].tipo = escala) then + estat:=baixar; + end; + end; + AgafarEscala:=estat; +end; + +{##############################################################} +{# M O U M A L O S #} +{##############################################################} +procedure MouMalos; +begin + for i:=0 to num_malos-1 do + begin + if malo[i].IAclock = 0 then + malo[i].estat := SelectEstat(i); + + malo[i].estat:=AgafarEscala(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo <> pedra) and + (mapa[malo[i].posX, malo[i].posY+1].tipo <> escala)) and + (mapa[malo[i].posX, malo[i].posY].tipo <> corda) then + malo[i].estat:=caent; + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) or + (mapa[malo[i].posX, malo[i].posY+1].tipo = escala)) and + (malo[i].estat=caent) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY].tipo = buit) and + (malo[i].estat=pujar)) then + malo[i].estat:=SelectEstat(i); + + if ((mapa[malo[i].posX, malo[i].posY+1].tipo = pedra) and + (malo[i].estat=baixar)) then + malo[i].estat:=SelectEstat(i); + + case malo[i].estat of + dreta : inc(malo[i].posX); + esquerra : dec(malo[i].posX); + pujar : dec(malo[i].posY); + baixar : inc(malo[i].posY); + caent : inc(malo[i].posY); + end; + + { bordes X } + if malo[i].posX<0 then + begin + malo[i].posX:=0; + malo[i].estat := dreta; + end; + if malo[i].posX>39 then + begin + malo[i].posX:=39; + malo[i].estat := esquerra; + end; + + { bordes Y } + if malo[i].posY<0 then + begin + malo[i].posY:=0; + end; + if malo[i].posY>24 then + begin + malo[i].posY:=24; + end; + + { agarrar diners } + if (mapa[malo[i].posX, malo[i].posY].tipo = diners) + and not(malo[i].carrega.OK) then + begin + mapa[malo[i].posX, malo[i].posY].tipo := buit; + malo[i].color := 11; + malo[i].carrega.OK := TRUE; + malo[i].carrega.posX := malo[i].posX; + malo[i].carrega.posY := malo[i].posY; + end; + + { emparedat } + if mapa[malo[i].posX, malo[i].posY].tipo = pedra then + MortMalo(i); + + inc(malo[i].IAclock); + if malo[i].IAclock = temps_IA then malo[i].IAclock := 0; + end; +end; +{##############################################################} +{# C A R R E G A M A P A #} +{##############################################################} +procedure CarregaMapa; +var fich : file of byte; + i,j : word; + buffer : byte; +begin + Assign(fich,'total.map'); + Reset(fich); + Seek(fich, (level * 1000)+offset_mapa); + for i:=0 to 39 do + for j:=0 to 24 do + begin + Read(fich, buffer); + mapa[i,j].tipo:=buffer; + for k:=0 to num_items-1 do + if llista_items[k] = mapa[i,j].tipo then + mapa[i,j].color := color_items[k]; + end; + Close(fich); +end; +{##############################################################} +{# C H E C K M O R T P E R M A L O S #} +{##############################################################} +procedure CheckMortPerMalos; +begin + for i:=0 to num_malos-1 do + if (malo[i].posX = pepe.posX) and (malo[i].posY = pepe.posY) then + Mort; +end; +{##############################################################} +{# C H E C K M A P A C O M P L E T #} +{##############################################################} +procedure CheckMapaComplet; +begin + if diners_pantalla = 0 then + for j:=1 to 23 do + begin + if mapa[0,j].tipo <> pedra then + begin + mapa[0,j].tipo := escala; + mapa[0,j].color := color_escala; + end + else + break; + end; +end; +{##############################################################} +{# C H E C K M A P A #} +{##############################################################} +procedure CheckMapa; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + case mapa[i,j].temps of + + 0 : begin + mapa[i,j].temps := -1; + mapa[i,j].tipo := pedra; + end; + + 1,bloc_out-1 : begin + mapa[i,j].tipo := bloc3; + dec(mapa[i,j].temps) + end; + + 2,bloc_out-2 : begin + mapa[i,j].tipo := bloc2; + dec(mapa[i,j].temps) + end; + + 3,bloc_out-3 : begin + mapa[i,j].tipo := bloc1; + dec(mapa[i,j].temps) + end; + + 4,bloc_out-4 : begin + mapa[i,j].tipo := buit; + dec(mapa[i,j].temps) + end; + + -1 : ; + + else dec(mapa[i,j].temps) + + end; + end; + CheckMapaComplet; +end; +{##############################################################} +{# F A S E N O V A #} +{##############################################################} +procedure FaseNova; +begin + inc(level); + if level=(num_fases + 1) then + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# I N I C I A L I T Z A C I O #} +{##############################################################} +procedure Inicialitzacio; +begin + level := 1; + + pepe.posX := 19; + pepe.posY := 23; + pepe.dibuix := 2; + pepe.color := 15; + pepe.vides := 0; + + malo[0].posX := 9; + malo[0].posY := 2; + malo[0].dibuix := ord('X'); + malo[0].color := 3; + malo[0].carrega.OK := FALSE; + malo[0].estat := esquerra; + malo[0].IAclock := 0; + + malo[1].posX := 20; + malo[1].posY := 2; + malo[1].dibuix := ord('X'); + malo[1].color := 3; + malo[1].carrega.OK := FALSE; + malo[1].estat := esquerra; + malo[1].IAclock := 0; + + malo[2].posX := 39; + malo[2].posY := 2; + malo[2].dibuix := ord('X'); + malo[2].color := 3; + malo[2].carrega.OK := FALSE; + malo[2].estat := esquerra; + malo[2].IAclock := 0; + + CarregaMapa; + + clock := 0; + + diners_pantalla := 0; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mapa[i,j].temps := -1; + if mapa[i,j].tipo = diners then + inc(diners_pantalla); + end; +end; +{##############################################################} +{# T I T O L #} +{##############################################################} +procedure Titol; +begin + getpaleta(paleta); + blackout; + + PutStringCENTERED(10, 15, 'JAILDESIGNER'); + PutStringCENTERED(12, 15, 'presenta'); + + FadeUp(paleta, 1); + + for i:=0 to 100 do espera_VGA; + + Fadedown(0,0,0,0); + level := 0; + CarregaMapa; + + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + move(mem[pant1:0], mem[$B800:0], 2000); + + FadeUp(paleta, 0); + + for i:=0 to 100 do espera_VGA; + + for k:=0 to 2 do + begin + { desplaa cap amunt } + for i:=0 to 39 do + for j:=0 to 23 do + begin + mem[pant1:(i shl 1)+(j*80)] := mem[pant1:(i shl 1)+((j+1)*80)]; + mem[pant1:(i shl 1)+1+(j*80)] := mem[pant1:(i shl 1)+1+((j+1)*80)]; + end; + + espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + end; + + + +end; +{##############################################################} +{# M E N U #} +{##############################################################} +procedure Menu; +var num : integer; +begin + num := 1; + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'OPCIONS'); + + repeat + + repeat until QteclaPuls; + + if (TeclaPuls(KeyA)) then + num := 2; + if (TeclaPuls(KeyQ)) then + num := 1; + + espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + if num = 1 then + begin + PutStringWINDOWED(18, 14, 'COMENAR JOC'); + PutStringCENTERED(20, 15, 'EIXIR'); + end + else + begin + PutStringCENTERED(18, 15, 'COMENAR JOC'); + PutStringWINDOWED(20, 14, 'EIXIR'); + end; + + until TeclaPuls(KeyENTER); + + if num = 2 then + { menu d'opcions } + exit_game := TRUE; + ; + +end; +{##############################################################} +begin + instalarKB; + setmode(1); + HideCursor; + SetUpVirtual(ptrpant1, pant1); + randomize; + offset_mapa := OffsetMapa; + exit_game := FALSE; + + repeat + + {Titol; + + Menu;} + + Inicialitzacio; + + CarregaRecords; + + repeat + MouPepe; + CheckMortPerMalos; + if (Clock mod 4) = 0 then MouMalos; + CheckMortPerMalos; + PintaPantalla; + CheckMapa; + until TeclaPuls(KeyESC) or (Pepe.vides<0); + + GameOver; + + until exit_game; + + TancarVirtual(ptrpant1); + setmode(3); + desinstalarKB; +end. \ No newline at end of file diff --git a/original_turbopascal/RUNNER.PIF b/original_turbopascal/RUNNER.PIF new file mode 100644 index 0000000..c1c8cfc Binary files /dev/null and b/original_turbopascal/RUNNER.PIF differ diff --git a/original_turbopascal/Runner.TXT b/original_turbopascal/Runner.TXT new file mode 100644 index 0000000..33239b5 --- /dev/null +++ b/original_turbopascal/Runner.TXT @@ -0,0 +1,75 @@ + + PEPE RUNNER v1.0 per al ASCII TOURNAMENT + 21/10/00 Jaildesigner - Icekas + + _____________________________________________________________ + | | + | 1.- HISTORIA | + | | + + Inspirat en el clssic dels 80, LODE RUNNER, apareix la versi + ASCII-JAULERA d'aquell joc: el PEPE RUNNER. En un intent de rescatar + aquell joc clssic, he fet aquesta versi en ASCII. Espere que vos + agrade el joc. Com he tingut un poquet de pressa al fer-lo, posiblement + apareguen noves versions en un futur, amb bugs corregits, noves + features i tal volta DirectX... + + + _____________________________________________________________ + | | + | 2.- OBJECTIU | + | | + + Per als que no heu jugat mai, l'objectiu es agafar tots els + diners de la pantalla. Quan els tingueu tots, apareixer una + escala que vos permetr pujar al nivell superior. Aneu amb compte + ja que els enemics tamb poden pillar els dinerets. Si algun + enemic amb diners acaba mort per alguna ra, perdra els diners + que havia furtat i els deixar all on els va trobar. + + + _____________________________________________________________ + | | + | 3.- COM JUGAR | + | | + + Pepe pot fer forats en el piso. Aquests forats, es tornen a + omplir amb el pas del temps, i si hi ha alg en el forat quan + es reompli perd una vida. Pepe tamb pot pujar i baixar escales + i moures per les cordes per a pasar d'un lloc a un altre. Lamen- + tablement, els seus enemics tamb poden fer-ho. + + _____________________________________________________________ + | | + | 4.- TECLES | + | | + + Les tecles son les segents: + + Q - Amunt + A - Avall + O - Esquerra + P - Dreta + + SPACE - Forat a la esquerra + M - Forat a la dreta + + H - Pausa (hold) + ESC - Acaba la partida + + + _____________________________________________________________ + | | + | 5.- BUGS I FUTURES AMPLIACIONS | + | | + + De moment, el unic bug que conec i que em fa perea llevar es + el que fa que els enemics s'estavellen contra les parets i es + maten. + + Si algun dia torne a agafar el codi, millorare coses com + aquestes: + + - Opci de definir les tecles. + - Moltes mes fases, amb passwords i amb final. (de moment fa loop) + - Resposta del teclat. \ No newline at end of file diff --git a/original_turbopascal/SIZE.BAK b/original_turbopascal/SIZE.BAK new file mode 100644 index 0000000..f873a77 --- /dev/null +++ b/original_turbopascal/SIZE.BAK @@ -0,0 +1,9 @@ +var + fich : file of byte; + +begin + Assign(fich, 'codi.exe'); + reset(fich); + Write('CODI.EXE = ',filesize(fich)); + Close(fich); +end. \ No newline at end of file diff --git a/original_turbopascal/SIZE.EXE b/original_turbopascal/SIZE.EXE new file mode 100644 index 0000000..43ad5de Binary files /dev/null and b/original_turbopascal/SIZE.EXE differ diff --git a/original_turbopascal/SIZE.PAS b/original_turbopascal/SIZE.PAS new file mode 100644 index 0000000..f873a77 --- /dev/null +++ b/original_turbopascal/SIZE.PAS @@ -0,0 +1,9 @@ +var + fich : file of byte; + +begin + Assign(fich, 'codi.exe'); + reset(fich); + Write('CODI.EXE = ',filesize(fich)); + Close(fich); +end. \ No newline at end of file diff --git a/original_turbopascal/TIPOS.BAK b/original_turbopascal/TIPOS.BAK new file mode 100644 index 0000000..d8839af --- /dev/null +++ b/original_turbopascal/TIPOS.BAK @@ -0,0 +1,112 @@ +unit tipos; + +interface + +uses grafix; + +const + { numer de pantalles } + num_fases = 2; + + { estats } + normal = 0; + caent = 4; + pujar = $01; + baixar = $02; + esquerra = $10; + dreta = $20; + enganxat = 6; + + { codi ascii dels sprites } + escala = 205; + pedra = 219; + diners = 36; + buit = 0; + corda = 196; + bloc1 = 176; { son per al fade dels blocs } + bloc2 = 177; + bloc3 = 178; + + { color dels sprites } + color_escala = 7; + color_pedra = 6; + color_diners = 14; + color_buit = 0; + color_corda = 7; + + bloc_out = 100; { temps que est el bloc desaparegut } + + num_malos = 3; { obvi... } + + temps_IA = 30; { temps que tenen el mateix estat els malos } + + { utils editor i joc } + num_items = 5; + llista_items : ARRAY [0..num_items-1] of byte = (buit, pedra, escala, corda, diners); + color_items : ARRAY [0..num_items-1] of byte = (color_buit, color_pedra, color_escala, color_corda, color_diners); + + +type + + _tresor = RECORD + + posX, posY : byte; + OK : boolean; + + end; + + _pepe = RECORD + + posX, posY, dibuix, color, vides : integer; + estat : byte; + + end; + + _bloc = RECORD + + tipo : byte; + color : byte; + temps : integer; + + end; + + _malo = RECORD + + posX, posY, dibuix, color, ID : integer; + carrega : _tresor; + estat : byte; + IAclock : byte; + + end; + +var + i,j,k : word; { per a bucles } + + pepe : _pepe; + + pant1 : word; + ptrpant1 : ptr_pantalla; + + mapa : ARRAY [0..39,0..24] of _bloc; + + malo : ARRAY [0..num_malos-1] of _malo; + + diners_pantalla : word; { numero de diners que hi ha en la pantalla al comenar } + + score : word; { puntuacio de la partida } + hi_score : word; { maxima puntuacio } + nom_hi_score : string; + + level : integer; { numero de pantalla actual } + + clock : word; { contador per al joc } + + paleta : tpaleta; + + offset_mapa : longint; + + exit_game : boolean; + +implementation +begin +end. \ No newline at end of file diff --git a/original_turbopascal/TIPOS.PAS b/original_turbopascal/TIPOS.PAS new file mode 100644 index 0000000..a19d5cf --- /dev/null +++ b/original_turbopascal/TIPOS.PAS @@ -0,0 +1,112 @@ +unit tipos; + +interface + +uses grafix; + +const + { numer de pantalles } + num_fases = 10; + + { estats } + normal = 0; + caent = 4; + pujar = $01; + baixar = $02; + esquerra = $10; + dreta = $20; + enganxat = 6; + + { codi ascii dels sprites } + escala = 205; + pedra = 219; + diners = 36; + buit = 0; + corda = 196; + bloc1 = 176; { son per al fade dels blocs } + bloc2 = 177; + bloc3 = 178; + + { color dels sprites } + color_escala = 7; + color_pedra = 6; + color_diners = 14; + color_buit = 0; + color_corda = 7; + + bloc_out = 100; { temps que est el bloc desaparegut } + + num_malos = 3; { obvi... } + + temps_IA = 30; { temps que tenen el mateix estat els malos } + + { utils editor i joc } + num_items = 5; + llista_items : ARRAY [0..num_items-1] of byte = (buit, pedra, escala, corda, diners); + color_items : ARRAY [0..num_items-1] of byte = (color_buit, color_pedra, color_escala, color_corda, color_diners); + + +type + + _tresor = RECORD + + posX, posY : byte; + OK : boolean; + + end; + + _pepe = RECORD + + posX, posY, dibuix, color, vides : integer; + estat : byte; + + end; + + _bloc = RECORD + + tipo : byte; + color : byte; + temps : integer; + + end; + + _malo = RECORD + + posX, posY, dibuix, color, ID : integer; + carrega : _tresor; + estat : byte; + IAclock : byte; + + end; + +var + i,j,k : word; { per a bucles } + + pepe : _pepe; + + pant1 : word; + ptrpant1 : ptr_pantalla; + + mapa : ARRAY [0..39,0..24] of _bloc; + + malo : ARRAY [0..num_malos-1] of _malo; + + diners_pantalla : word; { numero de diners que hi ha en la pantalla al comenar } + + score : word; { puntuacio de la partida } + hi_score : word; { maxima puntuacio } + nom_hi_score : string; + + level : integer; { numero de pantalla actual } + + clock : word; { contador per al joc } + + paleta : tpaleta; + + offset_mapa : longint; + + exit_game : boolean; + +implementation +begin +end. \ No newline at end of file diff --git a/original_turbopascal/TIPOS.TPU b/original_turbopascal/TIPOS.TPU new file mode 100644 index 0000000..e16f430 Binary files /dev/null and b/original_turbopascal/TIPOS.TPU differ diff --git a/original_turbopascal/TOTAL.MAP b/original_turbopascal/TOTAL.MAP new file mode 100644 index 0000000..d4074b6 Binary files /dev/null and b/original_turbopascal/TOTAL.MAP differ diff --git a/original_turbopascal/Turbo Pascal 7.0.pif b/original_turbopascal/Turbo Pascal 7.0.pif new file mode 100644 index 0000000..27d4022 Binary files /dev/null and b/original_turbopascal/Turbo Pascal 7.0.pif differ diff --git a/original_turbopascal/UTEXT.BAK b/original_turbopascal/UTEXT.BAK new file mode 100644 index 0000000..eb97298 --- /dev/null +++ b/original_turbopascal/UTEXT.BAK @@ -0,0 +1,150 @@ +unit utext; + +interface +uses grafix; + +procedure PutSprite(posX, posY, color, lletra : word); +{ Funci: Coloca un caracter en pantalla } +procedure PutString(posX, posY, color : word; frase : string); +{ Funci: Coloca una frase en pantalla } +procedure PutStringCENTERED(posY, color : word; frase : string); +{ Funci: Coloca una frase en pantalla i centrada horitzontalment } +procedure PutStringWINDOWED(posY, color : word; frase : string); +{ Funci: Coloca una frase dins d'una finestra centrada } +procedure cls(pant : word); +{ Funci: Borra la pantalla } +procedure PintaPantalla; +{ Funci: Pinta la pantalla } +procedure SetupVirtualText(var screen:ptr_pantalla;var virtual_addr:word); +{ Funci: Crea una pantalla virtual de text (2K) } +procedure TancarVirtualText(var screen:ptr_pantalla); +{ Funci: Tanca la pantalla virtual de text (2k) } +procedure HideCursor; +procedure ShowCursor; +implementation +uses crt, tipos; + +{##############################################################} +procedure SetupVirtualText(var screen:ptr_pantalla;var virtual_addr:word); +begin + getmem(screen,2000); + virtual_addr:=seg(screen^); +end; +{##############################################################} +procedure TancarVirtualText(var screen:ptr_pantalla); +begin + freemem(screen,2000); +end; +{##############################################################} +procedure PutSprite(posX, posY, color, lletra : word); +var i : word; +begin + mem[$B800:((posX) shl 1)+(posY*80)]:=lletra; + mem[$B800:((posX) shl 1)+1+(posY*80)]:=color; +end; +{##############################################################} +procedure PutString(posX, posY, color : word; frase : string); +var i : word; +begin + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+posX) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+posX) shl 1)+1+(posY*80)]:=color; + end; +end; +{##############################################################} +procedure PutStringCENTERED(posY, color : word; frase : string); +var i : word; + ini : word; +begin + ini := (40 - LENGTH(frase)) div 2; + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+ini) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+ini) shl 1)+1+(posY*80)]:=color; + end; +end; +{##############################################################} +procedure PutStringWINDOWED(posY, color : word; frase : string); +var i : word; + ini : word; + ample : word; +begin + ini := (40 - LENGTH(frase)) div 2; + ample := LENGTH(frase) + 4; + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+ini) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+ini) shl 1)+1+(posY*80)]:=color; + end; + + for i:=0 to LENGTH(frase)+3 do + begin + mem[$B800:((i+ini-2) shl 1)+((posY-1)*80)]:=196; + mem[$B800:((i+ini-2) shl 1)+1+((posY-1)*80)]:=color; + + mem[$B800:((i+ini-2) shl 1)+((posY+1)*80)]:=196; + mem[$B800:((i+ini-2) shl 1)+1+((posY+1)*80)]:=color; + end; +end; +{##############################################################} +procedure cls(pant : word); +var i : word; +begin + for i:=0 to 1999 do mem[pant:i]:=0; +end; +{##############################################################} +procedure PintaPantalla; +var i,j : word; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + { pepe } + mem[pant1:((pepe.posX) shl 1)+(pepe.posY*80)]:=pepe.dibuix; + mem[pant1:((pepe.posX) shl 1)+(pepe.posY*80)+1]:=pepe.color; + + { malos } + mem[pant1:((malo[0].posX) shl 1)+(malo[0].posY*80)]:=malo[0].dibuix; + mem[pant1:((malo[0].posX) shl 1)+(malo[0].posY*80)+1]:=malo[0].color; + + mem[pant1:((malo[1].posX) shl 1)+(malo[1].posY*80)]:=malo[1].dibuix; + mem[pant1:((malo[1].posX) shl 1)+(malo[1].posY*80)+1]:=malo[1].color; + + mem[pant1:((malo[2].posX) shl 1)+(malo[2].posY*80)]:=malo[2].dibuix; + mem[pant1:((malo[2].posX) shl 1)+(malo[2].posY*80)+1]:=malo[2].color; + + + + + espera_VGA;espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(14,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + + inc(clock); +end; +{##############################################################} +procedure HideCursor;assembler; +asm + mov ax,0100h + mov cx,0100h + int 10h +end; +{##############################################################} +procedure ShowCursor;assembler; +asm + mov ax,0100h + mov cx,0607h + int 10h +end; +{##############################################################} +begin +end. \ No newline at end of file diff --git a/original_turbopascal/UTEXT.PAS b/original_turbopascal/UTEXT.PAS new file mode 100644 index 0000000..42a2dc1 --- /dev/null +++ b/original_turbopascal/UTEXT.PAS @@ -0,0 +1,150 @@ +unit utext; + +interface +uses grafix; + +procedure PutSprite(posX, posY, color, lletra : word); +{ Funci: Coloca un caracter en pantalla } +procedure PutString(posX, posY, color : word; frase : string); +{ Funci: Coloca una frase en pantalla } +procedure PutStringCENTERED(posY, color : word; frase : string); +{ Funci: Coloca una frase en pantalla i centrada horitzontalment } +procedure PutStringWINDOWED(posY, color : word; frase : string); +{ Funci: Coloca una frase dins d'una finestra centrada } +procedure cls(pant : word); +{ Funci: Borra la pantalla } +procedure PintaPantalla; +{ Funci: Pinta la pantalla } +procedure SetupVirtualText(var screen:ptr_pantalla;var virtual_addr:word); +{ Funci: Crea una pantalla virtual de text (2K) } +procedure TancarVirtualText(var screen:ptr_pantalla); +{ Funci: Tanca la pantalla virtual de text (2k) } +procedure HideCursor; +procedure ShowCursor; +implementation +uses crt, tipos; + +{##############################################################} +procedure SetupVirtualText(var screen:ptr_pantalla;var virtual_addr:word); +begin + getmem(screen,2000); + virtual_addr:=seg(screen^); +end; +{##############################################################} +procedure TancarVirtualText(var screen:ptr_pantalla); +begin + freemem(screen,2000); +end; +{##############################################################} +procedure PutSprite(posX, posY, color, lletra : word); +var i : word; +begin + mem[$B800:((posX) shl 1)+(posY*80)]:=lletra; + mem[$B800:((posX) shl 1)+1+(posY*80)]:=color; +end; +{##############################################################} +procedure PutString(posX, posY, color : word; frase : string); +var i : word; +begin + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+posX) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+posX) shl 1)+1+(posY*80)]:=color; + end; +end; +{##############################################################} +procedure PutStringCENTERED(posY, color : word; frase : string); +var i : word; + ini : word; +begin + ini := (40 - LENGTH(frase)) div 2; + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+ini) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+ini) shl 1)+1+(posY*80)]:=color; + end; +end; +{##############################################################} +procedure PutStringWINDOWED(posY, color : word; frase : string); +var i : word; + ini : word; + ample : word; +begin + ini := (40 - LENGTH(frase)) div 2; + ample := LENGTH(frase) + 4; + for i:=0 to LENGTH(frase)-1 do + begin + mem[$B800:((i+ini) shl 1)+(posY*80)]:=ord(frase[i+1]); + mem[$B800:((i+ini) shl 1)+1+(posY*80)]:=color; + end; + + for i:=0 to LENGTH(frase)+3 do + begin + mem[$B800:((i+ini-2) shl 1)+((posY-1)*80)]:=196; + mem[$B800:((i+ini-2) shl 1)+1+((posY-1)*80)]:=color; + + mem[$B800:((i+ini-2) shl 1)+((posY+1)*80)]:=196; + mem[$B800:((i+ini-2) shl 1)+1+((posY+1)*80)]:=color; + end; +end; +{##############################################################} +procedure cls(pant : word); +var i : word; +begin + for i:=0 to 1999 do mem[pant:i]:=0; +end; +{##############################################################} +procedure PintaPantalla; +var i,j : word; +begin + for i:=0 to 39 do + for j:=0 to 24 do + begin + mem[pant1:(i shl 1)+(j*80)]:=mapa[i,j].tipo; + mem[pant1:(i shl 1)+1+(j*80)]:=mapa[i,j].color; + end; + + { pepe } + mem[pant1:((pepe.posX) shl 1)+(pepe.posY*80)]:=pepe.dibuix; + mem[pant1:((pepe.posX) shl 1)+(pepe.posY*80)+1]:=pepe.color; + + { malos } + mem[pant1:((malo[0].posX) shl 1)+(malo[0].posY*80)]:=malo[0].dibuix; + mem[pant1:((malo[0].posX) shl 1)+(malo[0].posY*80)+1]:=malo[0].color; + + mem[pant1:((malo[1].posX) shl 1)+(malo[1].posY*80)]:=malo[1].dibuix; + mem[pant1:((malo[1].posX) shl 1)+(malo[1].posY*80)+1]:=malo[1].color; + + mem[pant1:((malo[2].posX) shl 1)+(malo[2].posY*80)]:=malo[2].dibuix; + mem[pant1:((malo[2].posX) shl 1)+(malo[2].posY*80)+1]:=malo[2].color; + + + + + espera_VGA;espera_VGA;espera_VGA;espera_VGA; + move(mem[pant1:0], mem[$B800:0], 2000); + + GotoXY(1,1); TextBackGround(Blue); TextColor(LightGray); + Write('LEVEL ', level:2, ' SCORE ', score:3, ' LIVES ', pepe.vides:1); + GotoXY(13,2); + Write('HI-SCORE ', hi_score:3, ' ', nom_hi_score); + + inc(clock); +end; +{##############################################################} +procedure HideCursor;assembler; +asm + mov ax,0100h + mov cx,0100h + int 10h +end; +{##############################################################} +procedure ShowCursor;assembler; +asm + mov ax,0100h + mov cx,0607h + int 10h +end; +{##############################################################} +begin +end. \ No newline at end of file diff --git a/original_turbopascal/UTEXT.TPU b/original_turbopascal/UTEXT.TPU new file mode 100644 index 0000000..6d73099 Binary files /dev/null and b/original_turbopascal/UTEXT.TPU differ diff --git a/original_turbopascal/crea.bat b/original_turbopascal/crea.bat new file mode 100644 index 0000000..bba08b5 --- /dev/null +++ b/original_turbopascal/crea.bat @@ -0,0 +1,2 @@ +append.exe +fusio.exe \ No newline at end of file diff --git a/original_turbopascal/records b/original_turbopascal/records new file mode 100644 index 0000000..d5b3b80 Binary files /dev/null and b/original_turbopascal/records differ