Created
October 22, 2018 21:12
-
-
Save specht/51c55f9cd3558378cef5a31de7e35822 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| uses Crt, Dos, VGA; | |
| var phi, rho, tau, scale, x, y: Real; | |
| ix, iy: Integer; | |
| tx, ty, sx, sy, i: Integer; | |
| u, v, ul, vl: LongInt; | |
| ut, vt: LongInt; | |
| dxu, dyu, dxv, dyv: LongInt; | |
| offset: Word; | |
| color: Integer; | |
| texture: Pointer; | |
| texseg: Word; | |
| { This is a rotozoomer. The procedure calc_uv returns u and v texture | |
| coordinates for a given screen space pixel x, y, using three angles | |
| phi, rho and tau. } | |
| procedure calc_uv(x, y: Integer; phi, rho, tau: Real; var u, v: LongInt); | |
| var ru, rv, tu, tv: Real; | |
| scale: Real; | |
| begin | |
| { transform to center of screen } | |
| ru := x - 160; | |
| rv := y - 100; | |
| { moving center } | |
| { move the center around} | |
| ru := ru - cos(tau) * 40; | |
| rv := rv - sin(tau) * 40; | |
| { scale } | |
| { scale according to some sine function value } | |
| scale := (((sin(rho) + 1.0) * 0.5) * 0.7 + 1.3); | |
| ru := ru / scale; | |
| rv := rv / scale; | |
| { rotate } | |
| { rotate by -phi } | |
| tu := ru; tv := rv; | |
| ru := tu * cos(-phi) - tv * sin(-phi); | |
| rv := tv * cos(-phi) + tu * sin(-phi); | |
| { convert to fixed point } | |
| { up to here, we have dealt with real numbers, let's convert them | |
| to fixed point (15.16)! } | |
| u := Trunc(ru * 65536); | |
| v := Trunc(rv * 65536); | |
| end; | |
| { This procedure loads a PCX file. } | |
| procedure LoadPCX(filename: String); | |
| var f: File; | |
| header: array[0..127] of Byte; | |
| count, i: Byte; | |
| color: array[0..2] of Byte; | |
| offset: LongInt; | |
| begin | |
| Assign(f, filename); | |
| Reset(f, 1); | |
| BlockRead(f, header, 128); | |
| { Basically we just skip the 128 header bytes and read the pixel | |
| values. } | |
| repeat | |
| { Read a pixel. } | |
| BlockRead(f, i, 1); | |
| { RLE compression: if the value is >= 192 (bits 6 and 7 are set), | |
| this is not a single pixel, but a span of pixels. To obtain the | |
| span length, subtract 192 (clear bits 6 and 7) and read the next | |
| byte in the file to obtain the pixel color. } | |
| if i >= 192 then begin | |
| count := i - 192; | |
| BlockRead(f, i, 1); | |
| { Draw the pixel count times. } | |
| while count > 0 do begin | |
| Mem[texseg:offset] := i; | |
| Inc(offset); | |
| Dec(count); | |
| end; | |
| end else begin | |
| { Not a span, just a plain old pixel. } | |
| Mem[texseg:offset] := i; | |
| Inc(offset); | |
| end; | |
| { We know our image is 128 x 128 pixels big. } | |
| until offset > 128 * 128; | |
| { Finally, read the palette. } | |
| Seek(f, FileSize(f) - 768); | |
| for i := 0 to 255 do begin | |
| BlockRead(f, color, 3); | |
| { RGB values are encoded with 8 bits in the PCX file, but | |
| our VGA mode requires 6 bits (0..63 only), so we shift | |
| values right by 2. } | |
| SetPalette(i, color[0] shr 2, color[1] shr 2, color[2] shr 2); | |
| end; | |
| Close(f); | |
| end; | |
| begin | |
| SetMode($13); | |
| { Allocate 16k of Heap memory } | |
| GetMem(texture, 128 * 128); | |
| texseg := Seg(texture^); | |
| { Load the texture. } | |
| LoadPCX('tex1.pcx'); | |
| { Initialize angles to zero. } | |
| phi := 0; rho := 0; tau := 0; | |
| repeat | |
| { Calculate u and v for the pixel in the upper left screen corner | |
| at 0, 0. } | |
| calc_uv(0, 0, phi, rho, tau, ul, vl); | |
| { Now we calculate the rate of change for u and v in regard to | |
| a step of one pixel to the right (dxu and dxv). To get the value, | |
| we calculate u and v for the pixel at 1, 0 and subtract the | |
| u and v values. } | |
| calc_uv(1, 0, phi, rho, tau, ut, vt); | |
| dxu := ut - ul; | |
| dxv := vt - vl; | |
| { Do the same for y increase: dyu, dyv. } | |
| calc_uv(0, 1, phi, rho, tau, ut, vt); | |
| dyu := ut - ul; | |
| dyv := vt - vl; | |
| offset := 0; | |
| { Wait for v blank! } | |
| WaitSync; | |
| { Now iterate through every screen line... } | |
| for sy := 0 to 199 do begin | |
| { Reset u and v to the values we calculated initially | |
| (they will later be increased by dyu and dyv). } | |
| u := ul; v := vl; | |
| { Iterate through every pixel in the screen line... } | |
| for sx := 0 to 319 do begin | |
| { Increase u and v. } | |
| u := u + dxu; v := v + dxv; | |
| { Calculate texture coordinates from u and v by shifting | |
| right by 16 (remember we had 16 bits decimal precision) | |
| and clamping the result to the texture range of 0..127. | |
| AND 0x7F means zero out all bits except the lowest 7. } | |
| tx := (u shr 16) and $7f; | |
| ty := (v shr 16) and $7f; | |
| { Fetch the color from the texture. } | |
| color := Mem[texseg:(ty shl 7 or tx)]; | |
| { Draw the pixel to the screen. } | |
| Mem[$A000:offset] := color; | |
| offset := offset + 1; | |
| end; | |
| { Advance ul and vl by one step in the y direction. } | |
| ul := ul + dyu; vl := vl + dyv; | |
| end; | |
| { Advance the angles. } | |
| phi := phi + (sin(rho + tau * 0.1) + 0.2) * 0.02; | |
| rho := rho + 0.0134; | |
| tau := tau + 0.03; | |
| until KeyPressed; | |
| SetMode(3); | |
| FreeMem(texture, 128 * 128); | |
| { That's all folks! } | |
| { Now let's try this thing out... :-) } | |
| end. |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| unit VGA; | |
| Interface | |
| procedure SetMode(mode: Integer); | |
| procedure Clear; | |
| procedure SetPixel(x, y: Integer; color: Byte); | |
| function GetPixel(x, y: Integer): Byte; | |
| procedure SetPalette(num,r,g,b: Byte); | |
| procedure GetPalette(num: Byte; var r,g,b: Byte); | |
| procedure WaitSync; | |
| procedure DrawLine(x1,y1,x2,y2: Integer; col: Byte); | |
| Implementation | |
| procedure SetMode(mode: Integer); Assembler; | |
| asm | |
| mov ax, mode | |
| int 10h | |
| end; | |
| procedure Clear; Assembler; | |
| asm | |
| push 0A000h | |
| pop es | |
| xor di, di | |
| mov cx, 16000 | |
| db 66h | |
| xor ax, ax | |
| db 66h | |
| rep stosw | |
| end; | |
| procedure SetPixel(x, y: Integer; color: Byte); Assembler; | |
| asm | |
| mov di, y | |
| mov bx, di | |
| shl di, 6 | |
| shl bx, 8 | |
| add di, bx | |
| add di, x | |
| mov al, color | |
| push 0A000h | |
| pop es | |
| stosb | |
| end; | |
| function GetPixel(x, y: Integer): Byte; Assembler; | |
| asm | |
| mov di, y | |
| mov bx, di | |
| shl di, 6 | |
| shl bx, 8 | |
| add di, bx | |
| add di, x | |
| push 0A000h | |
| pop es | |
| mov al, es:[di] | |
| end; | |
| procedure SetPalette(num,r,g,b: Byte); Assembler; | |
| asm | |
| mov dx,3C8h | |
| mov al,num | |
| out dx,al | |
| cli | |
| mov dx,3C9h | |
| mov al,r | |
| out dx,al | |
| mov al,g | |
| out dx,al | |
| mov al,b | |
| out dx,al | |
| sti | |
| end; | |
| procedure GetPalette(num: Byte; var r,g,b: Byte); Assembler; | |
| asm | |
| mov dx,3C7h | |
| mov al,num | |
| out dx,al | |
| cli | |
| mov dx,3C9h | |
| in al,dx | |
| les bx,r | |
| mov es:[bx],al | |
| in al,dx | |
| les bx,g | |
| mov es:[bx],al | |
| in al,dx | |
| les bx,b | |
| mov es:[bx],al | |
| sti | |
| end; | |
| procedure WaitSync; Assembler; | |
| asm | |
| mov dx,3DAh | |
| @l1: | |
| in al,dx | |
| test al,1 | |
| jnz @l1 | |
| @l2: | |
| in al,dx | |
| test al,8 | |
| jz @l2 | |
| end; | |
| procedure Swap(var x, y: Integer); | |
| var t: Integer; | |
| begin | |
| t := x; | |
| x := y; | |
| y := t; | |
| end; | |
| procedure DrawLine(x1, y1, x2, y2: Integer; col: Byte); | |
| var dx, dy, dab, inca, incb, x, y, h1, h2: Integer; | |
| begin | |
| if (x1 = x2) and (y1 = y2) then SetPixel(x1, y1, col) else begin | |
| if x1 > x2 then begin | |
| Swap(x1, x2); | |
| Swap(y1, y2); | |
| end; | |
| dx := x2 - x1; | |
| dy := y2 - y1; | |
| h1 := dx; | |
| h2 := dy; | |
| if (dx < -dy) and (dy < 0) then begin | |
| y1 := -y1; | |
| y2 := -y2; | |
| Swap(x1, y1); | |
| Swap(x2, y2); | |
| end; | |
| if (dx >= -dy) and (dy < 0) then begin | |
| y1 := -y1; | |
| y2 := -y2; | |
| end; | |
| if (dx <= dy) and (dy > 0) then begin | |
| Swap(x1, y1); | |
| Swap(x2, y2); | |
| end; | |
| dx := x2 - x1; | |
| dy := y2 - y1; | |
| dab := 2 * dy - dx; | |
| inca:=2 * (dy - dx); | |
| incb:=2 * dy; | |
| x := x1; | |
| y := y1; | |
| if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col); | |
| if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col); | |
| if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col); | |
| if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col); | |
| for x:=x1 + 1 to x2 do begin | |
| if dab < 0 then Inc(dab, incb) else begin | |
| Inc(dab, inca); | |
| Inc(y); | |
| end; | |
| if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col); | |
| if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col); | |
| if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col); | |
| if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col); | |
| end; | |
| end; | |
| end; | |
| end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Create texture with: