/*
* Funkce volaná ze skriptu
*/
LUA_FUNC createBitmap(lua_State* L)
{
int width, height;
if (bmp)
{
LUA_ERROR("bitmap is already created");
}
/* Kontrola počtu parametrů */
NUMBER_OF_PARAMETERS(2);
/* Kontrola typu parametrů */
NUMBERP(1);
NUMBERP(2);
width = lua_tointeger(L, 1);
height = lua_tointeger(L, 2);
/* Kontrola hodnot parametrů */
CHECK_RANGE(width, 0, MAX_BITMAP_WIDTH, "bitmap width is out of range");
CHECK_RANGE(height, 0, MAX_BITMAP_HEIGHT, "bitmap height is out of range");
/* Vše v pořádku - vytvoříme bitmapu */
bmp = bitmapCreate(width, height);
if (bmp == NULL)
{
LUA_ERROR("bitmapCreate failed");
}
return LUA_OK;
}
int
w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
{
int cur_state = (GetKeyState (vk_code) & 1);
if (NILP (new_state)
|| (NUMBERP (new_state)
&& ((XUINT (new_state)) & 1) != cur_state))
{
faked_key = vk_code;
keybd_event ((BYTE) vk_code,
(BYTE) MapVirtualKey (vk_code, 0),
KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
keybd_event ((BYTE) vk_code,
(BYTE) MapVirtualKey (vk_code, 0),
KEYEVENTF_EXTENDEDKEY | 0, 0);
keybd_event ((BYTE) vk_code,
(BYTE) MapVirtualKey (vk_code, 0),
KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
cur_state = !cur_state;
}
return cur_state;
}
static float at_getf(gptr pt, size_t off)
{
at *p = ((at **)pt)[off];
ifn (NUMBERP(p))
error(NIL, "accessed element is not a number", p);
return Number(p);
}
static double at_getd(gptr pt, size_t off)
{
at *p = ((at **)pt)[off];
ifn (p && NUMBERP(p))
error(NIL, "accessed element is not a number", NIL);
return Number(p);
}
/*
* Funkce volaná ze skriptu
*/
LUA_FUNC putpixel(lua_State* L)
{
int i, x, y, r, g, b;
if (bmp == NULL)
{
LUA_ERROR("bitmap does not exist");
}
/* Kontrola počtu parametrů */
NUMBER_OF_PARAMETERS(5);
/* Kontrola typu parametrů - 5 číselných hodnot */
for (i=1; i<=5; i++)
{
NUMBERP(i);
}
/* Kontrola hodnot parametrů */
x = lua_tointeger(L, 1);
y = lua_tointeger(L, 2);
r = lua_tointeger(L, 3);
g = lua_tointeger(L, 4);
b = lua_tointeger(L, 5);
CHECK_RANGE(x, 0, bmp->width-1, "x coordinate is out of range");
CHECK_RANGE(y, 0, bmp->height-1, "y coordinate is out of range");
#if defined(CHECK_COLOR_COMPONENTS)
CHECK_RANGE(r, 0, 255, "red color component outside 0-255");
CHECK_RANGE(g, 0, 255, "green color component outside 0-255");
CHECK_RANGE(b, 0, 255, "blue color component outside 0-255");
#endif
bitmapPutPixel(bmp, x, y, (unsigned char)r, (unsigned char)g, (unsigned char)b);
return LUA_OK;
}
static void Number_setat(storage_t *st, size_t off, at *x)
{
get_write_permit(st);
ifn (NUMBERP(x))
error(NIL, "not a number", x);
void (*set)(gptr,size_t,real) = storage_setd[st->type];
(*set)(st->data, off, Number(x));
}
void ev_parsedesc(at *desc)
{
if (CONSP(desc)) {
ev_parsedesc(Car(desc));
ev_parsedesc(Cdr(desc));
} else if (GPTRP(desc))
evdesc = (const char *)String(desc);
else if (NUMBERP(desc))
evmods = (unsigned char)Number(desc);
}
void
ev_parsedesc(at *desc)
{
if (CONSP(desc)) {
ev_parsedesc(desc->Car);
ev_parsedesc(desc->Cdr);
} else if (GPTRP(desc))
evdesc = (const char *)(desc->Gptr);
else if (NUMBERP(desc))
evmods = (unsigned char)(desc->Number);
}
lref_t lbinary_write_flonum(lref_t v, lref_t port)
{
if (!NUMBERP(v))
vmerror_wrong_type_n(1, v);
if (!BINARY_PORTP(port))
vmerror_wrong_type_n(2, port);
uint8_t bytes[sizeof(flonum_t)];
io_encode_flonum(bytes, get_c_flonum(v));
if (write_bytes(port, bytes, sizeof(flonum_t)) != sizeof(flonum_t))
vmerror_io_error(_T("error writing to port."), port);
return port;
}
lref_t lread_binary_string(lref_t l, lref_t port)
{
_TCHAR buf[STACK_STRBUF_LEN];
if (!BINARY_PORTP(port))
vmerror_wrong_type_n(2, port);
if (!NUMBERP(l))
vmerror_wrong_type_n(1, l);
fixnum_t remaining_length = get_c_fixnum(l);
if (remaining_length <= 0)
vmerror_arg_out_of_range(l, _T(">0"));
lref_t new_str = strcons();
size_t total_read = 0;
while (remaining_length > 0)
{
fixnum_t to_read = remaining_length;
if (to_read > STACK_STRBUF_LEN)
to_read = STACK_STRBUF_LEN;
size_t actual_read = read_bytes(port, buf, (size_t)(remaining_length * sizeof(_TCHAR)));
if (actual_read <= 0)
break;
string_appendd(new_str, buf, actual_read);
remaining_length -= actual_read;
total_read += actual_read;
}
if (total_read == 0)
return lmake_eof();
return new_str;
}
static at *storage_listeval(at *p, at *q)
{
storage_t *st = Mptr(p);
if (!st->data)
error(NIL, "unsized storage", p);
q = eval_arglist(Cdr(q));
ifn (CONSP(q) && Car(q) && NUMBERP(Car(q)))
error(NIL, "illegal subscript", q);
ssize_t off = Number(Car(q));
if (off<0 || off>=st->size)
error(NIL, "subscript out of range", q);
if (Cdr(q)) {
ifn (CONSP(Cdr(q)) && !Cddr(q))
error(NIL, "one or two arguments expected",q);
storage_setat[st->type](st, off, Cadr(q));
return st->backptr;
} else
return storage_getat[st->type](st, off);
}
/* return code -1 means that event_queue_ptr won't be incremented.
In other word, this event makes two key codes. (by himi) */
static int
key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
{
static int mod_key_state = 0;
int wParam;
*isdead = 0;
/* Skip key-up events. */
if (!event->bKeyDown)
{
switch (event->wVirtualKeyCode)
{
case VK_LWIN:
mod_key_state &= ~LEFT_WIN_PRESSED;
break;
case VK_RWIN:
mod_key_state &= ~RIGHT_WIN_PRESSED;
break;
case VK_APPS:
mod_key_state &= ~APPS_PRESSED;
break;
}
return 0;
}
/* Ignore keystrokes we fake ourself; see below. */
if (faked_key == event->wVirtualKeyCode)
{
faked_key = 0;
return 0;
}
/* To make it easier to debug this code, ignore modifier keys! */
switch (event->wVirtualKeyCode)
{
case VK_LWIN:
if (NILP (Vw32_pass_lwindow_to_system))
{
/* Prevent system from acting on keyup (which opens the Start
menu if no other key was pressed) by simulating a press of
Space which we will ignore. */
if ((mod_key_state & LEFT_WIN_PRESSED) == 0)
{
if (NUMBERP (Vw32_phantom_key_code))
faked_key = XUINT (Vw32_phantom_key_code) & 255;
else
faked_key = VK_SPACE;
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
mod_key_state |= LEFT_WIN_PRESSED;
if (!NILP (Vw32_lwindow_modifier))
return 0;
break;
case VK_RWIN:
if (NILP (Vw32_pass_rwindow_to_system))
{
if ((mod_key_state & RIGHT_WIN_PRESSED) == 0)
{
if (NUMBERP (Vw32_phantom_key_code))
faked_key = XUINT (Vw32_phantom_key_code) & 255;
else
faked_key = VK_SPACE;
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
mod_key_state |= RIGHT_WIN_PRESSED;
if (!NILP (Vw32_rwindow_modifier))
return 0;
break;
case VK_APPS:
mod_key_state |= APPS_PRESSED;
if (!NILP (Vw32_apps_modifier))
return 0;
break;
case VK_CAPITAL:
/* Decide whether to treat as modifier or function key. */
if (NILP (Vw32_enable_caps_lock))
goto disable_lock_key;
return 0;
case VK_NUMLOCK:
/* Decide whether to treat as modifier or function key. */
if (NILP (Vw32_enable_num_lock))
goto disable_lock_key;
return 0;
case VK_SCROLL:
/* Decide whether to treat as modifier or function key. */
if (NILP (Vw32_scroll_lock_modifier))
goto disable_lock_key;
return 0;
disable_lock_key:
/* Ensure the appropriate lock key state is off (and the
indicator light as well). */
wParam = event->wVirtualKeyCode;
if (GetAsyncKeyState (wParam) & 0x8000)
{
/* Fake another press of the relevant key. Apparently, this
really is the only way to turn off the indicator. */
faked_key = wParam;
keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
KEYEVENTF_EXTENDEDKEY | 0, 0);
keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
}
break;
case VK_MENU:
case VK_CONTROL:
case VK_SHIFT:
return 0;
case VK_CANCEL:
/* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
which is confusing for purposes of key binding; convert
VK_CANCEL events into VK_PAUSE events. */
event->wVirtualKeyCode = VK_PAUSE;
break;
case VK_PAUSE:
/* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
for purposes of key binding; convert these back into
VK_NUMLOCK events, at least when we want to see NumLock key
presses. (Note that there is never any possibility that
VK_PAUSE with Ctrl really is C-Pause as per above.) */
if (NILP (Vw32_enable_num_lock)
&& (event->dwControlKeyState
& (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED)) != 0)
event->wVirtualKeyCode = VK_NUMLOCK;
break;
}
/* Recognize state of Windows and Apps keys. */
event->dwControlKeyState |= mod_key_state;
/* Distinguish numeric keypad keys from extended keys. */
event->wVirtualKeyCode =
map_keypad_keys (event->wVirtualKeyCode,
(event->dwControlKeyState & ENHANCED_KEY));
if (lispy_function_keys[event->wVirtualKeyCode] == 0)
{
if (!NILP (Vw32_recognize_altgr)
&& (event->dwControlKeyState & LEFT_CTRL_PRESSED)
&& (event->dwControlKeyState & RIGHT_ALT_PRESSED))
{
/* Don't try to interpret AltGr key chords; ToAscii seems not
to process them correctly. */
}
/* Handle key chords including any modifiers other than shift
directly, in order to preserve as much modifier information as
possible. */
else if (event->dwControlKeyState
& ( RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED
| RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED
| (!NILP (Vw32_lwindow_modifier) ? LEFT_WIN_PRESSED : 0)
| (!NILP (Vw32_rwindow_modifier) ? RIGHT_WIN_PRESSED : 0)
| (!NILP (Vw32_apps_modifier) ? APPS_PRESSED : 0)
| (!NILP (Vw32_scroll_lock_modifier) ? SCROLLLOCK_ON : 0)))
{
/* Don't translate modified alphabetic keystrokes, so the user
doesn't need to constantly switch layout to type control or
meta keystrokes when the normal layout translates
alphabetic characters to non-ascii characters. */
if ('A' <= event->wVirtualKeyCode && event->wVirtualKeyCode <= 'Z')
{
event->uChar.AsciiChar = event->wVirtualKeyCode;
if ((event->dwControlKeyState & SHIFT_PRESSED) == 0)
event->uChar.AsciiChar += ('a' - 'A');
}
/* Try to handle unrecognized keystrokes by determining the
base character (ie. translating the base key plus shift
modifier). */
else if (event->uChar.AsciiChar == 0)
w32_kbd_patch_key (event, -1);
}
if (event->uChar.AsciiChar == 0)
{
emacs_ev->kind = NO_EVENT;
return 0;
}
else if (event->uChar.AsciiChar > 0)
{
/* Pure ASCII characters < 128. */
emacs_ev->kind = ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.AsciiChar;
}
else if (event->uChar.UnicodeChar > 0
&& w32_console_unicode_input)
{
/* Unicode codepoint; only valid if we are using Unicode
console input mode. */
emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.UnicodeChar;
}
else
{
/* Fallback handling of non-ASCII characters for non-Unicode
versions of Windows, and for non-Unicode input on NT
family of Windows. Only characters in the current
console codepage are supported by this fallback. */
wchar_t code;
char dbcs[2];
int cpId;
/* Get the current console input codepage to interpret this
key with. Note that the system defaults for the OEM
codepage could have been changed by calling SetConsoleCP
or w32-set-console-codepage, so using GetLocaleInfo to
get LOCALE_IDEFAULTCODEPAGE is not TRT here. */
cpId = GetConsoleCP ();
dbcs[0] = dbcs_lead;
dbcs[1] = event->uChar.AsciiChar;
if (dbcs_lead)
{
dbcs_lead = 0;
if (!MultiByteToWideChar (cpId, 0, dbcs, 2, &code, 1))
{
/* Garbage */
DebPrint (("Invalid DBCS sequence: %d %d\n",
dbcs[0], dbcs[1]));
emacs_ev->kind = NO_EVENT;
}
}
else if (IsDBCSLeadByteEx (cpId, dbcs[1]))
{
dbcs_lead = dbcs[1];
emacs_ev->kind = NO_EVENT;
}
else
{
if (!MultiByteToWideChar (cpId, 0, &dbcs[1], 1, &code, 1))
{
/* Garbage */
DebPrint (("Invalid character: %d\n", dbcs[1]));
emacs_ev->kind = NO_EVENT;
}
}
emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
emacs_ev->code = code;
}
}
else
{
/* Function keys and other non-character keys. */
emacs_ev->kind = NON_ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->wVirtualKeyCode;
}
XSETFRAME (emacs_ev->frame_or_window, get_frame ());
emacs_ev->modifiers = w32_kbd_mods_to_emacs (event->dwControlKeyState,
event->wVirtualKeyCode);
emacs_ev->timestamp = GetTickCount ();
return 1;
}
cell_t *evaluate(cell_t *exp, environ_t *env) {
++__tl_eval_level;
// push a frame
eval_stack_t s;
s.next = eval_stack;
s.value = env;
eval_stack = &s;
if (DFLAG) {
printf("Eval (%d) got : ", __tl_eval_level);
pretty_print(exp);
}
if (NULL == exp) {
DRETURN(RET_VAL, NULL);
} else if (NILP(exp)) {
DRETURN(RET_VAL, nil_cell);
} else if (ATOMP(exp)) {
if (SYMBOLP(exp)) {
DRETURN(RET_VAL, find_value(env, exp));
} else if (STRINGP(exp) || NUMBERP(exp)) {
DRETURN(RET_VAL, exp);
} else {
DEBUGPRINT_("Expression not valid.\n");
pretty_print(orig_sexpr);
GOTO_TOPLEVEL();
return NULL; /* unreachable */
}
} else { /* list */
handle_t *he = handle_push(exp);
cell_t *first = evaluate(CAR(exp), env); // exp handled
exp = handle_get(he);
handle_pop(he);
cell_t *rest = CDR(exp);
if (DFLAG) {
printf("First is: ");
pretty_print(first);
printf("Rest is: ");
pretty_print(rest);
}
if (NULL == first) {
fast_error(" malformed expression.");
/* This is unreachable */
} else if (PRIMITIVEP(first)) {
cell_t *(*f)(cell_t *, environ_t *) = CELL_PRIMITIVE(first);
DRETURN(RET_PRIM, (*f)(rest, env));
} else if (FUNCTIONP(first)) { /* function call */
cell_t *t;
handle_t *hf;
hf = handle_push(first);
t = evargs(rest, env); // first handled
first = handle_get(hf);
handle_pop(hf);
DRETURN(RET_FUNCALL, invoke(first, t, env)); // no need for handles
}
undefun_error(first, exp); /* Not primitive or funcall, error.*/
return NULL; /* Unreachable, undefun_error() does not return. */
}
}
