GearLanguage/ustandardcrt.pas at master · dryphon/GearLanguage · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
unit uStandardCRT;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, uInterpreter, uCallable, uToken, Variants, uMemory;

type

  TClrScr = class(TInterfacedObject, ICallable)
    function Call(Token: TToken; Interpreter: TInterpreter; ArgList: TArgList): Variant;
  end;

  TWindow = class(TInterfacedObject, ICallable)
    function Call(Token: TToken; Interpreter: TInterpreter; ArgList: TArgList): Variant;
  end;

  TGotoXY = class(TInterfacedObject, ICallable)
    function Call(Token: TToken; Interpreter: TInterpreter; ArgList: TArgList): Variant;
  end;


procedure StoreStandardCRTFunctions(GlobalSpace: TMemorySpace);


implementation
uses uFunc, CRT;

{ TWindow }

function TWindow.Call(Token: TToken; Interpreter: TInterpreter;
  ArgList: TArgList): Variant;
var
  x1,y1,x2,y2: Byte;
begin
  TFunc.CheckArity(Token, ArgList.Count, 4);
  x1 := Byte(ArgList[0].Value);
  y1 := Byte(ArgList[1].Value);
  x2 := Byte(ArgList[2].Value);
  y2 := Byte(ArgList[3].Value);

  Result := Null;
  Window(x1,y1,x2,y2);
end;

{ TClrScr }

function TClrScr.Call(Token: TToken; Interpreter: TInterpreter;
  ArgList: TArgList): Variant;
begin
  TFunc.CheckArity(Token, ArgList.Count, 0);
  Result := Null;
  ClrScr;
end;

{ TGotoXY }

function TGotoXY.Call(Token: TToken; Interpreter: TInterpreter;
  ArgList: TArgList): Variant;
var
  x,y: Byte;
begin
  TFunc.CheckArity(Token, ArgList.Count, 2);
  x := Byte(ArgList[0].Value);
  y := Byte(ArgList[1].Value);

  Result := Null;
  GotoXY(x,y);
end;


procedure StoreStandardCRTFunctions(GlobalSpace: TMemorySpace);
var
  Token: TToken;
begin
  Token := TToken.Create(ttIdentifier, '', Null, 0, 0);
  GlobalSpace.Store('window', ICallable(TWindow.Create), Token);
  GlobalSpace.Store('gotoXY', ICallable(TGotoXY.Create), Token);
  GlobalSpace.Store('clrScr', ICallable(TClrScr.Create), Token);
end;

end.