Keskustelu: Koodit: Pascal: Shadebob

(**********************************************)
(**             SHADEDBOB effect             **)
(**********************************************)
(**        Compiled in Turbo Pascal 7        **)
(**********************************************)

PROGRAM shadebob;

USES crt;

PROCEDURE doshadebob ( x, y : word ); ASSEMBLER;
asm
  mov ax,0a000h
  mov es,ax { es-rekisteriin videomuistin osoite }
  mov di,x
  mov bx,320 { ruudun leveys 320 pikseliä }
  mov ax,y
  mul bx
  add di,ax { di sisältää nyt osoitteen ruudulla }
  mov cx,32 { korkeus }
@vertical:
  push cx
  mov cx,32 { leveys }
  mov bx,di
@horizontal:
  inc byte ptr [es:bx] { lisätään pisteen väriä }
  inc bx
  loop @horizontal
  add di,320 { seuraava rivi }
  pop cx
loop @vertical
end;

PROCEDURE setRGBpalette ( color, red, green, blue : byte );
begin
  PORT [ $3C8 ] := COLOR; { värin numero 0-255 }
  PORT [ $3C9 ] := RED; { punainen 0-63 }
  PORT [ $3C9 ] := GREEN; { vihreä 0-63 }
  PORT [ $3C9 ] := BLUE; { sininen 0-63 }
end;

PROCEDURE makepalette; { alustetaan väripaletti }
var b,b2 : byte;
begin
  b := 0;
  for b2 := 0 to 31 do begin
    setRGBpalette ( b, b2*2, b2, 0 ); { oranssi }
    inc ( b );
  end;
  for b2 := 31 downto 0 do begin
    setRGBpalette ( b, b2*2, b2, 0 );
    inc ( b );
  end;
  for b2 := 0 to 31 do begin
    setRGBpalette ( b, b2, b2*2, 0 ); { vihreä }
    inc ( b );
  end;
  for b2 := 31 downto 0 do begin
    setRGBpalette ( b, b2, b2*2, 0 );
    inc ( b );
  end;
  for b2 := 0 to 31 do begin
    setRGBpalette ( b, 0, b2, b2*2 ); { sininen }
    inc ( b );
  end;
  for b2 := 31 downto 0 do begin
    setRGBpalette ( b, 0, b2, b2*2 );
    inc ( b );
  end;
  for b2 := 0 to 31 do begin
    setRGBpalette ( b, b2, b2, b2 ); { harmaa }
    inc ( b );
  end;
  for b2 := 31 downto 0 do begin
    setRGBpalette ( b, b2, b2, b2 );
    inc ( b );
  end;
end;

VAR x,y,frame : word;
    s,c       : real;

begin
  asm
    mov ax,13h { alustetaan näyttötila 320x200 pistettä 256 väriä }
    int 10h
  end;

  makepalette;

  x := 0; { tyhjennetään muuttujat }
  y := 0;
  frame := 0;

  repeat
    inc (frame); { lisätään framelaskuria }
    s := sin ( frame*0.001 ) * 0.01;
    c := cos ( frame*0.001 ) * 0.01;
    x := round ( sin ( frame*s ) * 128 ) + 144; { x-koordinaatti }
    y := round ( cos ( frame*c ) * 64 ) + 84; { y-koordinaatti }
    doshadebob (x,y); { piirretään shadebob }
  until keypressed;

  while keypressed do readkey;

  asm
    mov ax,03h
    int 10h
  end;
end.