PC-01 Lviv

Code: Select all

  LOOP
    keys := Ctrl.Get();
    IF (Ctrl.Right IN keys) & (x < 51) THEN INC(x) END;
    IF (Ctrl.Left IN keys ) & (x >  0) THEN DEC(x) END;
    IF (Ctrl.Up IN keys   ) & (y >  0) THEN DEC(y) END;
    IF (Ctrl.Down IN keys ) & (y < 31) THEN INC(y) END;
    (* Lvov.FIL_BOX(x, y, x+5, y+5, 3); *)
    Gr.DrawTile(x, y, 8000H-1);
    RK86.WAIT(5000);
  END;

Code: Select all

{BEGIN}
LabelA(StartProgram0);
Call(L8009); //SetTable;
Call(L8057);

MviA($01);Sta(X);//   x := 1;
LxiHL($0001);MovAL;Sta(Y);//y := 1;

LabelA(LOOP1);//   LOOP
//Call(Ctrl_Get);//MovAL;//Sta(Keys);//	    keys := Ctrl.Get();

MviA($F7);Out_($D2);In_($D2);cma;Ani($F0);

{Down IN keys}
   Cpi($80);Jm(gKeyD_m1);  Lda(Y); Cpi(31);JP(gKeyD_m4);  InrA;Sta(Y);JMP(gKeyD_m4);

{Left IN keys}
LabelA(gKeyD_m1);  Cpi($40);Jm(gKeyD_m2);  Lda(X); Cpi(1);Jm(gKeyD_m4);
DcrA;Sta(X);JMP(gKeyD_m4);

{Up IN keys}
LabelA(gKeyD_m2); Cpi($20);Jm(gKeyD_m3);  Lda(Y); Cpi(1);Jm(gKeyD_m4);
DcrA;Sta(Y);JMP(gKeyD_m4);

{Right IN keys}
LabelA(gKeyD_m3);Cpi($10);Jm(gKeyD_m4); Lda(X); Cpi(51);JP(gKeyD_m4);
InrA;Sta(X);JMP(gKeyD_m4);

LabelA(gKeyD_m4);

LabelA(L818A); // Gr.DrawTile(x, y, 8000H-1);
Lda(X);Sta(L8027);   Lda(Y);Sta(L8028);   LxiHL($7FFF);  Call(Gr_DrawTile);

LxiHL($1388);Call(L81A9); //    RK86.WAIT(5000);
JMP(LOOP1);

Code: Select all

static void lmove (unsigned to, unsigned from)
/*Пересылка (копирование) линии from в to*/
{{
 struct line {char __[80];};
 struct line _es * Lto;
 struct line _es * Lfrom;

 if (to == from || !(to < 192 && from < 192))
  return;
 _ES = seg;
 to += 4;
 from += 4;
 Lto = (struct line _es *)((to >> 1) * 80 + ((to & 1) << 13));
 Lfrom = (struct line _es *)((from >> 1) * 80 + ((from & 1) << 13));
 *Lto = *Lfrom;
}}

static void lclr (unsigned line)
/*Очистка линии экрана с данным номером*/
{{
 unsigned e = line;
 long _es* L;

 if (e < 192) {
  e += 4;
  _ES = seg;
  L = (long _es*)((e >> 1) * 80 + ((e & 1) << 13));
  for (e = 20; e; e--)
   *L ++ = 0;
   }
}}

void cls (void)
{{
 unsigned char _es* i;
 unsigned j;

 _ES = seg;
 i = 0;
 for (j = 17; j; j--) {
  run_delay (1);
  while ((unsigned)i < 16384)
   *i = 0, i += 17;
  i = (unsigned char _es*)(0x3FFF & (unsigned)i);
  wait_delay ();
   }
 ttyx = ttyy = 0;
}}

void scroll (signed lines)
/* +UP, -DOWN */
{{
 unsigned media, line;

 if (lines == 0)
  return;
 if (abs (lines) >= 192) {
  cls ();
  return;
   }
 if (lines > 0) {
  media = 192 - lines;
  for (line = 0; line < media; line ++)
   lmove (line, line + lines);
  while (line < 192)
   lclr (line ++);
   }
 else {
  media = -lines;
  for (line = 191; line >= media; line --)
   lmove (line, line + lines);
  while (line < 192)
   lclr (line --);
   }
}}

Code: Select all

MODULE AsmTest; (*$MAIN*) IMPORT SYSTEM;

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN (*@
  #asm
        POP  DE           ; Снимаем адрес возврата
        POP  HL           ; Параметр color (он двухбайтовый, так решил zcc)
        PUSH HL           ; Возвращаем color обратно
        PUSH DE           ; Адрес возврата обратно
        LD   A, L         ; Вот это color, он в младшем байте. LD это аналог MOV (и MVI тоже)
        LD   (0xBE38), A  ; BORDER
        CALL 0xF836       ; CLS
  #endasm
*)
END Border;

BEGIN
  Border(25);
  LOOP END
END AsmTest.

Code: Select all

MODULE TestCalc;
IMPORT b := Basic, c := CalcZX;

BEGIN (*$MAIN*)
  b.Init;
  c.PushWord(1000); (* 1000 *)
  c.PushByte(24);   (*   24 *)
  c.Begin;
  c.add;            (*    + *)
  c.pi_div_2;       (* PI/2 *)
  c.duplicate;      (*  DUP *)
  c.add;            (*    + *)
  c.add;            (*    + *)
  c.End;
  b.PRSTR("1000 + 24 + PI = ");
  c.Print_PopReal();
  b.Quit
END TestCalc.

Code: Select all

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN @
  #asm
        POP  HL
        EX   (SP), HL
        LD   A, L
        LD   (0xBE38), A  ; BORDER
        CALL 0xF836       ; CLS
  #endasm
END Border;

Code: Select all

MODULE AsmTest;
IMPORT Asm;

PROCEDURE Border (color: INT8);
BEGIN
  Asm.Code("POP  BC    ");
  Asm.Code("POP  DE    ");
  Asm.Code("POP  HL    ");
  Asm.Code("PUSH HL    ");
  Asm.Code("PUSH DE    ");
  Asm.Code("PUSH BC    ");
  Asm.Code("LD   A,L   ");
  Asm.Code("CALL 0x229B");
END Border;

BEGIN (*$MAIN*)
  Border(2);
END AsmTest.

Code: Select all

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN (*@
  #asm
...
  #endasm
*)
END Border;

Code: Select all

PROCEDURE SetTable;
  VAR scr, tab: INT16; n, val: SYSTEM.BYTE;
BEGIN
  scr := 4708H; (* Рабочий адрес экрана (8 байт (32 точки) слева пропускаем) *)
  tab := 0;
  FOR n := 0 TO 254 DO
    val := scr MOD 100H; SYSTEM.PUT(tab, val);
    val := scr DIV 100H; SYSTEM.PUT(tab+100H, val); INC(tab);
    INC(scr, 256 DIV 4);
  END
END SetTable;

Code: Select all

procedure SYSTEM_PUT(c1,c2:Cardinal);
begin
Form1.mmo1.Lines.Add('$'+IntToHex(c1,4)+' - $'+IntToHex(c2,2));
end;

procedure TForm1.btn1Click(Sender: TObject);
  VAR scr, tab: word; n, val:BYTE;
begin
  scr := $4708;
  tab := 0;
  FOR n := 0 TO 254 DO begin
    val := scr MOD $100; SYSTEM_PUT(tab, val);
    val := scr DIV $100; SYSTEM_PUT(tab+$100, val); INC(tab);
    INC(scr, 256 DIV 4);    end;
END;

Code: Select all

FOR n := 0 TO 254 DO begin

Code: Select all

		  -------------------------------
	         | X | 6 | 5 | 4 | X | 2 | 1 | 0 |
		  -------------------------------
		   |		   |
		   |		   |
		    --------------------- информация об
					  одном пикселе:

				    0...0...-фон
				    0...1...-B(голубой)
				    1...0...-G(зелёный)
				    1...1...-R(красный)



	  3		    5		       ---------------
					      | 0 | 0 | 1 | 1 |
   ---------------   ---------------	       ---------------
  | 0 | 0 | 1 | 1 | | 0 | 1 | 0 | 1 |   --->    |   |   |   |
   ---------------   ---------------	       ---------------
					      | 0 | 1 | 0 | 1 |
					       ---------------
						|   |   |   |
					       фон  B   G   R

Code: Select all

pix1:=0;pix2:=0;pix3:=0;pix4:=0;
if (b and 128)=128 then pix1:=pix1+1; if (b and 8)=8 then pix1:=pix1+2;
if (b and 64)=64 then pix2:=pix2+1; if (b and 4)=4 then pix2:=pix2+2;
if (b and 32)=32 then pix3:=pix3+1; if (b and 2)=2 then pix3:=pix3+2;
if (b and 16)=16 then pix4:=pix4+1; if (b and 1)=1 then pix4:=pix4+2;

Code: Select all

Procedure VarSprite(var Sprite:TSpriteLV;Name:string255;cl0,cl1,cl2,cl3:Char;SpriteStr:string);
Var c1,lengthS:Cardinal;CountPix:Cardinal;{Счетчик пикселей}
TekByte:Byte;
Begin
If SpriteStr='' then begin
                       {!!!!!!!! Ошибка}
                     end else
 Begin
lengthS:=length(SpriteStr);CountPix:=0;TekByte:=0;
For c1:=1 to lengthS do    begin
if SpriteStr[c1]=cl0 then Begin CountPix:=CountPix+1; end else
if SpriteStr[c1]=cl1 then Begin CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+8;
    If CountPix=2 then TekByte:=TekByte+4;
    If CountPix=3 then TekByte:=TekByte+2;
    If CountPix=4 then TekByte:=TekByte+1;
                                end else
if SpriteStr[c1]=cl2 then Begin CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+128;
    If CountPix=2 then TekByte:=TekByte+64;
    If CountPix=3 then TekByte:=TekByte+32;
    If CountPix=4 then TekByte:=TekByte+16;
    end else

if SpriteStr[c1]=cl3 then Begin  CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+128+8;
    If CountPix=2 then TekByte:=TekByte+64+4;
    If CountPix=3 then TekByte:=TekByte+32+2;
    If CountPix=4 then TekByte:=TekByte+16+1;
                          end;
//1 пиксел цвет: 128+8//2 пиксел цвет: 64+4//3 пиксел цвет: 32+2//4 пиксел цвет: 16+1

If CountPix=4 then Begin  CountPix:=0;DB(TekByte);TekByte:=0; end;
                        end;
If CountPix<>0 then Begin DB(TekByte); end;
 end;
end;

Code: Select all

VarSprite(SPRITE241,'SPRITE241',' ','1','2','3',{Человечек}
'2      2'+
' 233332 '+
'  2222  '+
' 322223 '+
' 322223 '+
'  2222  '+
' 2 33 2 '+
'2      2'
);

VarSprite(SPRITE242,'SPRITE242',' ','1','2','3', {клад обычный242:}
'11111111'+
'12222221'+
'12111121'+
'12122121'+
'12122121'+
'12111121'+
'12222221'+
'11111111'
);
VarSprite(SPRITE243,'SPRITE243',' ','1','2','3',{Суперклад243:}
'33333333'+
'32222223'+
'32333323'+
'32322323'+
'32322323'+
'32333323'+
'32222223'+
'33333333'
);

VarSprite(SPRITE1,'SPRITE1',' ','1','2','3',{Голова змеи}
'3  33  3'+
' 333333 '+
' 333333 '+
'33333333'+
'33333333'+
' 333333 '+
' 333333 '+
'3  33  3'
);

VarSprite(SPRITE2,'SPRITE2',' ','1','2','3',{остальная часть змеи}
'   33   '+
'  3333  '+
' 33  33 '+
'33    33'+
'33    33'+
' 33  33 '+
'  3333  '+
'   33   '
);

VarSprite(SPRITE244,'SPRITE244',' ','1','2','3',{защита}
'  3  3  '+
'  3333  '+
'33233233'+
' 332233 '+
' 332233 '+
'33233233'+
'  3333  '+
'  3  3  '
);