Created
September 26, 2013 07:21
-
-
Save joates/6710852 to your computer and use it in GitHub Desktop.
This file contains 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,palettes; | |
var vgmptr : pointer; | |
vgmseg : word; | |
sintab, | |
costab : array[0..255] of shortint; | |
procedure initmode13h; assembler; | |
asm | |
mov ax,0013h | |
int 10h | |
end; | |
procedure rettext; assembler; | |
asm | |
mov ax,0003h | |
int 10h | |
end; | |
procedure putpixel(x,y : integer; c : byte); assembler; | |
asm | |
mov ax,vgmseg; | |
mov es,ax | |
mov ax,320 | |
mul y | |
add ax,x | |
mov di,ax | |
mov cl,c | |
mov al,es:[di] | |
or al,cl | |
mov es:[di],al | |
end; | |
procedure waitcrt; assembler; | |
asm | |
mov dx,3dah | |
@wait1: | |
in al,dx | |
test al,08h | |
jnz @wait1 | |
@wait2: | |
in al,dx | |
test al,08h | |
jz @wait2 | |
end; | |
procedure refresh; assembler; | |
asm | |
push es | |
push ds | |
mov ax,0a000h; | |
mov es,ax | |
mov ds,vgmseg | |
xor di,di | |
xor si,si | |
mov cx,8000h | |
rep movsw | |
pop ds | |
pop es | |
end; | |
procedure clearvgm; assembler; | |
asm | |
mov es,vgmseg | |
xor di,di | |
mov ax,0 | |
mov cx,8000h | |
rep stosw | |
end; | |
function cosa(value : integer): shortint; | |
var erg : byte; | |
begin | |
asm | |
lea si,costab | |
mov ax,value | |
mov ah,0 | |
add si,ax | |
mov al,ds:[si] | |
mov erg,al | |
end; | |
cosa := erg; | |
end; | |
function sina(value : integer): shortint; | |
var erg : byte; | |
begin | |
asm | |
lea si,sintab | |
mov ax,value | |
mov ah,0 | |
add si,ax | |
mov al,ds:[si] | |
mov erg,al | |
end; | |
sina := erg; | |
end; | |
procedure main; | |
var c,a,x,y : integer; | |
cx,cy : byte; | |
e : byte; | |
offs : word; | |
sc,tc : byte; | |
zwcolor : shortint; | |
color : byte; | |
apal,pal,pal2 : paltype; | |
begin | |
for a := 0 to 255 do sintab[a] := round(sin(a / 40.743665)*64); | |
for a := 0 to 255 do costab[a] := round(cos(a / 40.743665)*64); | |
clearvgm; | |
fillchar(pal,768,0); | |
for e := 0 to 63 do begin | |
pal[e].r := 0; | |
pal[e].g := 0; | |
pal[e].b := e; | |
end; | |
for e := 0 to 63 do begin | |
pal[e+64].r := e; | |
pal[e+64].g := e; | |
pal[e+64].b := 63; | |
end; | |
pal[128].r := 63; | |
pal[128].g := 63; | |
pal[128].b := 63; | |
fillchar(pal2,768,0); | |
for a := 1 to 32 do begin | |
pal2[a].r := (a-1)*2; | |
pal2[a].g := 0; | |
pal2[a].b := 0; | |
end; | |
for a := 32 to 64 do begin | |
pal2[a].r := 63; | |
pal2[a].g := (a-32)*2; | |
pal2[a].b := 0; | |
end; | |
for a := 64 to 96 do begin | |
pal2[a].r := 63; | |
pal2[a].g := 63; | |
pal2[a].b := (a-64)*2; | |
end; | |
for a := 96 to 255 do begin | |
pal2[a].r := 63; | |
pal2[a].g := 63; | |
pal2[a].b := 63; | |
end; | |
setpal(pal); | |
e := 0; | |
repeat | |
clearvgm; | |
offs := 640; | |
asm; | |
mov es,vgmseg | |
end; | |
for y := 1 to 100 do begin | |
for x := 1 to 160 do begin | |
zwcolor := sina( y+sina(x-y)+e+e)+e+ | |
cosa( x+sina(y+x)-e-e+sina(e)); | |
asm | |
mov al,zwcolor | |
inc al | |
dec al | |
jns @noneg | |
neg al | |
mov zwcolor,al | |
@noneg: | |
end; | |
color := zwcolor; | |
asm | |
mov di,offs | |
mov al,color | |
mov ah,al | |
mov es:[di],al | |
mov es:[di+321],al | |
mov ax,word ptr es:[di] | |
add ax,word ptr es:[di+319] | |
add ax,word ptr es:[di-2] | |
add ax,word ptr es:[di-321] | |
shr ax,2 | |
mov es:[di-1],al | |
mov ax,es:[di] | |
add ax,es:[di-319] | |
add ax,es:[di-321] | |
add ax,es:[di-321] | |
shr ax,2 | |
mov es:[di-320],al | |
add offs,2 | |
end; | |
end; | |
offs := offs + 320; | |
end; | |
inc(e,2); | |
delay(10); | |
waitcrt; | |
refresh; | |
until keypressed; | |
end; | |
begin | |
initmode13h; | |
getmem(vgmptr,64000); | |
vgmseg := seg(vgmptr^); | |
main; | |
freemem(vgmptr,64000); | |
rettext; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
code test for potential employers:
Note: my time is not for sale, knowledge is a commodity that i do respect.