home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / AVTWRITE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  86 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 267 of 323
  3. From : Sean Palmer                         1:104/123.0          05 Jun 93  01:22
  4. To   : All
  5. Subj : Avatar interpretation
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Using the state-driven approach, I came up with this simplistic
  8. Avatar/0 interpreter as an example. Do with it as you wish...}
  9.  
  10. {by Sean L. Palmer}
  11. {Public Domain}
  12.  
  13. program avtWrite;  {example to do avatar/0 (FSC-0025) interpretation}
  14.   {could easily be extended to handle /0+ and /1 codes}
  15.  
  16. uses crt;
  17.  
  18. {this part of the program controls the state-driven part of the display
  19.  handler.}
  20.  
  21. var saveAdr:pointer;  {where state handler is now}
  22. var
  23.  c:char;    {char accessed by state handler}
  24.  b:byte absolute c;
  25.  
  26. procedure avtWriteCh(c2:char);Inline(
  27.   $8F/$06/>C/            {pop byte ptr [>c]}
  28.   $FF/$1E/>SAVEADR);     {call dword ptr [>saveAdr]}  {continue where handler l
  29.  
  30. {call this procedure from StateHandler to suspend execution until next time}
  31.  
  32. procedure wait; near; assembler; asm {wait for next char}
  33.  pop word ptr saveAdr  {save where to continue next time}
  34.  retF    {simulate exit from calling proc}
  35.  end;
  36.  
  37. {a stateHandler procedure should never ever exit (only by calling 'wait'),
  38.  shouldn't have any local variables or parameters, and shouldn't call
  39.  'wait' with anything on the stack (like from a subroutine).
  40.  This routine is using the caller's stack, so be careful}
  41.  
  42. var
  43.  avc:char;
  44.  avb:byte absolute avc;
  45.  
  46. procedure stateHandler; begin
  47.  repeat
  48.   case c of
  49.    ^L:begin clrscr; textattr:=3; end;
  50.    ^Y:begin
  51.     wait; avc:=c;
  52.     wait;
  53.     while c<>#0 do begin dec(c); write(avc); end;
  54.     end;
  55.    ^V:begin
  56.     wait;
  57.     case c of
  58.      ^A:begin
  59.       wait;
  60.       textattr:=byte(c);
  61.       end;
  62.      ^B:textattr:=textattr or $80;
  63.      ^C:if whereY>1 then gotoxy(whereX,whereY-1);
  64.      ^D:if whereY<25 then gotoxy(whereX,whereY+1);
  65.      ^E:if whereX>1 then gotoxy(whereX-1,whereY);
  66.      ^F:if whereX<80 then gotoxy(whereX+1,whereY);
  67.      ^G:clreol;
  68.      ^H:begin
  69.       wait; avb:=b;
  70.       wait; gotoxy(b+1,avb+1);
  71.       end;
  72.      else write(^V,c)
  73.      end;
  74.     end;
  75.    else write(c);
  76.    end;
  77.   wait;
  78.   until false;
  79.  end;
  80.  
  81. var i:integer;
  82. const s:string='Oh my'^V^D^V^D^V^F^V^A#1'it works'^V^A#4',see?';
  83. begin  {could do something like attach it to Output's InOutFunc...}
  84.  saveAdr:=ptr(seg(stateHandler),ofs(stateHandler)+3); {skip header}
  85.  for i:=1 to length(s) do avtWriteCh(s[i]);
  86.  end.