Skip to content

Instantly share code, notes, and snippets.

@joates
Created September 26, 2013 07:21
Show Gist options
  • Save joates/6710852 to your computer and use it in GitHub Desktop.
Save joates/6710852 to your computer and use it in GitHub Desktop.
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;
@joates
Copy link
Author

joates commented Sep 26, 2013

code test for potential employers:

  1. which language(s) ?
  2. describe what this produces in a single word ?
  3. what is the heap space requirement (Kb)
  4. show me it running on your laptop.. (this is the tie-breaker)

Note: my time is not for sale, knowledge is a commodity that i do respect.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment