*/ HCURSOR Image_To_Cursor(REBYTE* image, REBINT width, REBINT height)
/*
** Converts REBOL image! to Windows CURSOR
**
***********************************************************************/
{
int xHotspot = 0;
int yHotspot = 0;
HICON result = NULL;
HBITMAP hSourceBitmap;
BITMAPINFO BitmapInfo;
ICONINFO iconinfo;
//Get the system display DC
HDC hDC = GetDC(NULL);
//Create DIB
unsigned char* ppvBits;
int bmlen = width * height * 4;
int i;
BitmapInfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
BitmapInfo.bmiHeader.biWidth = width;
BitmapInfo.bmiHeader.biHeight = -(signed)height;
BitmapInfo.bmiHeader.biPlanes = 1;
BitmapInfo.bmiHeader.biBitCount = 32;
BitmapInfo.bmiHeader.biCompression = BI_RGB;
BitmapInfo.bmiHeader.biSizeImage = 0;
BitmapInfo.bmiHeader.biXPelsPerMeter = 0;
BitmapInfo.bmiHeader.biYPelsPerMeter = 0;
BitmapInfo.bmiHeader.biClrUsed = 0;
BitmapInfo.bmiHeader.biClrImportant = 0;
hSourceBitmap = CreateDIBSection(hDC, &BitmapInfo, DIB_RGB_COLORS, (void**)&ppvBits, NULL, 0);
//Release the system display DC
ReleaseDC(NULL, hDC);
//Copy the image content to DIB
COPY_MEM(ppvBits, image, bmlen);
//Invert alphachannel from the REBOL format
for (i = 3;i < bmlen;i+=4){
ppvBits[i] ^= 0xff;
}
//Create the cursor using the masks and the hotspot values provided
iconinfo.fIcon = FALSE;
iconinfo.xHotspot = xHotspot;
iconinfo.yHotspot = yHotspot;
iconinfo.hbmMask = hSourceBitmap;
iconinfo.hbmColor = hSourceBitmap;
result = CreateIconIndirect(&iconinfo);
DeleteObject(hSourceBitmap);
return result;
}
*/ DEVICE_CMD Read_DNS(REBREQ *sock)
/*
** Initiate the GetHost request and return immediately.
** Note the temporary results buffer (must be freed later).
**
***********************************************************************/
{
void *host;
#ifdef HAS_ASYNC_DNS
HANDLE handle;
#else
HOSTENT *he;
#endif
host = OS_Make(MAXGETHOSTSTRUCT); // be sure to free it
#ifdef HAS_ASYNC_DNS
if (!GET_FLAG(sock->modes, RST_REVERSE)) // hostname lookup
handle = WSAAsyncGetHostByName(Event_Handle, WM_DNS, sock->data, host, MAXGETHOSTSTRUCT);
else
handle = WSAAsyncGetHostByAddr(Event_Handle, WM_DNS, (char*)&(sock->net.remote_ip), 4, AF_INET, host, MAXGETHOSTSTRUCT);
if (handle != 0) {
sock->net.host_info = host;
sock->handle = handle;
return DR_PEND; // keep it on pending list
}
#else
// Use old-style blocking DNS (mainly for testing purposes):
if (GET_FLAG(sock->modes, RST_REVERSE)) {
he = gethostbyaddr((char*)&sock->net.remote_ip, 4, AF_INET);
if (he) {
sock->net.host_info = host; //???
sock->data = he->h_name;
SET_FLAG(sock->flags, RRF_DONE);
return DR_DONE;
}
}
else {
he = gethostbyname(sock->data);
if (he) {
sock->net.host_info = host; // ?? who deallocs?
COPY_MEM((char*)&(sock->net.remote_ip), (char *)(*he->h_addr_list), 4); //he->h_length);
SET_FLAG(sock->flags, RRF_DONE);
return DR_DONE;
}
}
#endif
OS_Free(host);
sock->net.host_info = 0;
sock->error = GET_ERROR;
//Signal_Device(sock, EVT_ERROR);
return DR_ERROR; // Remove it from pending list
}
*/ DEVICE_CMD Write_Clipboard(REBREQ *req)
/*
** Works for Unicode and ASCII strings.
** Length is number of bytes passed (not number of chars).
**
***********************************************************************/
{
HANDLE data;
REBYTE *bin;
REBCNT err;
REBINT len = req->length; // in bytes
req->actual = 0;
data = GlobalAlloc(GHND, len + 4);
if (data == NULL) {
req->error = 5;
return DR_ERROR;
}
// Lock and copy the string:
bin = GlobalLock(data);
if (bin == NULL) {
req->error = 10;
return DR_ERROR;
}
COPY_MEM(bin, req->data, len);
bin[len] = 0;
GlobalUnlock(data);
if (!OpenClipboard(NULL)) {
req->error = 20;
return DR_ERROR;
}
EmptyClipboard();
err = !SetClipboardData(GET_FLAG(req->flags, RRF_WIDE) ? CF_UNICODETEXT : CF_TEXT, data);
CloseClipboard();
if (err) {
req->error = 50;
return DR_ERROR;
}
req->actual = len;
return DR_DONE;
}
*/ DEVICE_CMD Poll_DNS(REBREQ *dr)
/*
** Check for completed DNS requests. These are marked with
** RRF_DONE by the windows message event handler (dev-event.c).
** Completed requests are removed from the pending queue and
** event is signalled (for awake dispatch).
**
***********************************************************************/
{
REBDEV *dev = (REBDEV*)dr; // to keep compiler happy
REBREQ **prior = &dev->pending;
REBREQ *req;
BOOL change = FALSE;
HOSTENT *host;
// Scan the pending request list:
for (req = *prior; req; req = *prior) {
// If done or error, remove command from list:
if (GET_FLAG(req->flags, RRF_DONE)) { // req->error may be set
*prior = req->next;
req->next = 0;
CLR_FLAG(req->flags, RRF_PENDING);
if (!req->error) { // success!
host = (HOSTENT*)req->net.host_info;
if (GET_FLAG(req->modes, RST_REVERSE))
req->data = host->h_name;
else
COPY_MEM((char*)&(req->net.remote_ip), (char *)(*host->h_addr_list), 4); //he->h_length);
Signal_Device(req, EVT_READ);
}
else
Signal_Device(req, EVT_ERROR);
change = TRUE;
}
else prior = &req->next;
}
return change;
}
*/ int Host_Address(char *hostname, char *hostaddr)
/*
** Simple lookup of a host address.
** The hostaddr must be at least 16 bytes in size (IPv6).
** This is a synchronous function and blocks during access.
**
** On success, returns length of address.
** On failure, returns 0.
**
** Current version is IPv4 only.
**
***********************************************************************/
{
struct hostent *he;
if (!(he = gethostbyname(hostname))) return DR_DONE;
COPY_MEM(hostaddr, (char *)(*he->h_addr_list), he->h_length);
return he->h_length;
}
*/ REBINT Text_Gob(void *richtext, REBSER *block)
/*
** Handles all commands for the TEXT dialect as specified
** in the system/dialects/text object.
**
** This function calls the REBOL_Dialect interpreter to
** parse the dialect and build and return the command number
** (the index offset in the text object above) and a block
** of arguments. (For now, just a REBOL block, but this could
** be changed to isolate it from changes in REBOL's internals).
**
** Each arg will be of the specified datatype (given in the
** dialect) or NONE when no argument of that type was given
** and this code must determine the proper default value.
**
** If the cmd result is zero, then it is either the end of
** the block, or an error has occurred. If the error value
** is non-zero, then it was an error.
**
***********************************************************************/
{
REBCNT index = 0;
REBINT cmd;
REBSER *args = 0;
REBVAL *arg;
REBCNT nargs;
//font object conversion related values
REBFNT* font;
REBVAL* val;
REBPAR offset;
REBPAR space;
//para object conversion related values
REBPRA* para;
REBPAR origin;
REBPAR margin;
REBPAR indent;
REBPAR scroll;
do {
cmd = Reb_Dialect(DIALECTS_TEXT, block, &index, &args);
if (cmd == 0) return 0;
if (cmd < 0) {
// Reb_Print("ERROR: %d, Index %d", -cmd, index);
return -((REBINT)index+1);
}
// else
// Reb_Print("TEXT: Cmd %d, Index %d, Args %m", cmd, index, args);
arg = BLK_HEAD(args);
nargs = SERIES_TAIL(args);
// Reb_Print("Number of args: %d", nargs);
switch (cmd) {
case TW_TYPE_SPEC:
if (IS_STRING(arg)) {
rt_text(richtext, ARG_STRING(0), index);
} else if (IS_TUPLE(arg)) {
rt_color(richtext, ARG_TUPLE(0));
}
break;
case TW_ANTI_ALIAS:
rt_anti_alias(richtext, ARG_OPT_LOGIC(0));
break;
case TW_SCROLL:
rt_scroll(richtext, ARG_PAIR(0));
break;
case TW_BOLD:
case TW_B:
rt_bold(richtext, ARG_OPT_LOGIC(0));
break;
case TW_ITALIC:
case TW_I:
rt_italic(richtext, ARG_OPT_LOGIC(0));
break;
case TW_UNDERLINE:
case TW_U:
rt_underline(richtext, ARG_OPT_LOGIC(0));
break;
case TW_CENTER:
rt_center(richtext);
break;
case TW_LEFT:
rt_left(richtext);
break;
case TW_RIGHT:
rt_right(richtext);
break;
case TW_FONT:
if (!IS_OBJECT(arg)) break;
font = (REBFNT*)rt_get_font(richtext);
val = BLK_HEAD(ARG_OBJECT(0))+1;
if (IS_STRING(val)) {
font->name = VAL_STRING(val);
}
// Reb_Print("font/name: %s", font->name);
val++;
if (IS_BLOCK(val)) {
REBSER* styles = VAL_SERIES(val);
REBVAL* slot = BLK_HEAD(styles);
REBCNT len = SERIES_TAIL(styles) ,i;
for (i = 0;i<len;i++){
if (IS_WORD(slot+i)){
set_font_styles(font, slot+i);
}
}
} else if (IS_WORD(val)) {
set_font_styles(font, val);
}
val++;
if (IS_INTEGER(val)) {
font->size = VAL_INT32(val);
}
// Reb_Print("font/size: %d", font->size);
val++;
if ((IS_TUPLE(val)) || (IS_NONE(val))) {
COPY_MEM(font->color,VAL_TUPLE(val), 4);
}
// Reb_Print("font/color: %d.%d.%d.%d", font->color[0],font->color[1],font->color[2],font->color[3]);
val++;
if ((IS_PAIR(val)) || (IS_NONE(val))) {
offset = VAL_PAIR(val);
font->offset_x = offset.x;
font->offset_y = offset.y;
}
// Reb_Print("font/offset: %dx%d", offset.x,offset.y);
val++;
if ((IS_PAIR(val)) || (IS_NONE(val))) {
space = VAL_PAIR(val);
font->space_x = space.x;
font->space_y = space.y;
}
// Reb_Print("font/space: %dx%d", space.x, space.y);
val++;
font->shadow_x = 0;
font->shadow_y = 0;
if (IS_BLOCK(val)) {
REBSER* ser = VAL_SERIES(val);
REBVAL* slot = BLK_HEAD(ser);
REBCNT len = SERIES_TAIL(ser) ,i;
for (i = 0;i<len;i++){
if (IS_PAIR(slot)) {
REBPAR shadow = VAL_PAIR(slot);
font->shadow_x = shadow.x;
font->shadow_y = shadow.y;
} else if (IS_TUPLE(slot)) {
COPY_MEM(font->shadow_color,VAL_TUPLE(slot), 4);
} else if (IS_INTEGER(slot)) {
font->shadow_blur = VAL_INT32(slot);
}
slot++;
}
} else if (IS_PAIR(val)) {
REBPAR shadow = VAL_PAIR(val);
font->shadow_x = shadow.x;
font->shadow_y = shadow.y;
}
rt_font(richtext, font);
break;
case TW_PARA:
if (!IS_OBJECT(arg)) break;
para = (REBPRA*)rt_get_para(richtext);
val = BLK_HEAD(ARG_OBJECT(0))+1;
if (IS_PAIR(val)) {
origin = VAL_PAIR(val);
para->origin_x = origin.x;
para->origin_y = origin.y;
}
// Reb_Print("para/origin: %dx%d", origin.x, origin.y);
val++;
if (IS_PAIR(val)) {
margin = VAL_PAIR(val);
para->margin_x = margin.x;
para->margin_y = margin.y;
}
// Reb_Print("para/margin: %dx%d", margin.x, margin.y);
val++;
if (IS_PAIR(val)) {
indent = VAL_PAIR(val);
para->indent_x = indent.x;
para->indent_y = indent.y;
}
// Reb_Print("para/indent: %dx%d", indent.x, indent.y);
val++;
if (IS_INTEGER(val)) {
para->tabs = VAL_INT32(val);
}
// Reb_Print("para/tabs: %d", para->tabs);
val++;
if (IS_LOGIC(val)) {
para->wrap = VAL_LOGIC(val);
}
// Reb_Print("para/wrap?: %d", para->wrap);
val++;
if (IS_PAIR(val)) {
scroll = VAL_PAIR(val);
para->scroll_x = scroll.x;
para->scroll_y = scroll.y;
}
// Reb_Print("para/scroll: %dx%d", scroll.x, scroll.y);
val++;
if (IS_WORD(val)) {
REBINT result = Reb_Find_Word(VAL_WORD_SYM(val), Symbol_Ids, 0);
switch (result){
case SW_RIGHT:
case SW_LEFT:
case SW_CENTER:
para->align = result;
break;
default:
para->align = SW_LEFT;
break;
}
}
val++;
if (IS_WORD(val)) {
REBINT result = Reb_Find_Word(VAL_WORD_SYM(val), Symbol_Ids, 0);
switch (result){
case SW_TOP:
case SW_BOTTOM:
case SW_MIDDLE:
para->valign = result;
break;
default:
para->valign = SW_TOP;
break;
}
}
rt_para(richtext, para);
break;
case TW_SIZE:
rt_font_size(richtext, ARG_INTEGER(0));
break;
case TW_SHADOW:
rt_shadow(richtext, &ARG_PAIR(0), ARG_TUPLE(1), ARG_INTEGER(2));
break;
case TW_DROP:
rt_drop(richtext, ARG_OPT_INTEGER(0));
break;
case TW_NEWLINE:
case TW_NL:
rt_newline(richtext, index);
break;
case TW_CARET:
{
REBPAR caret = {0,0};
REBPAR highlightStart = {0,0};
REBPAR highlightEnd = {0,0};
REBVAL *slot;
if (!IS_OBJECT(arg)) break;
val = BLK_HEAD(ARG_OBJECT(0))+1;
if (IS_BLOCK(val)) {
slot = BLK_HEAD(VAL_SERIES(val));
if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){
caret.x = 1 + slot->data.series.index;
caret.y = 1 + (slot+1)->data.series.index;;
//Reb_Print("caret %d, %d", caret.x, caret.y);
}
}
val++;
if (IS_BLOCK(val)) {
slot = BLK_HEAD(VAL_SERIES(val));
if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){
highlightStart.x = 1 + slot->data.series.index;
highlightStart.y = 1 + (slot+1)->data.series.index;;
//Reb_Print("highlight-start %d, %d", highlightStart.x, highlightStart.y);
}
}
val++;
if (IS_BLOCK(val)) {
slot = BLK_HEAD(VAL_SERIES(val));
if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){
highlightEnd.x = 1 + slot->data.series.index;
highlightEnd.y = 1 + (slot+1)->data.series.index;;
//Reb_Print("highlight-End %d, %d", highlightEnd.x, highlightEnd.y);
}
}
rt_caret(richtext, &caret, &highlightStart,&highlightEnd);
}
break;
}
} while (TRUE);
}
*/ DEVICE_CMD Lookup_Socket(REBREQ *sock)
/*
** Initiate the GetHost request and return immediately.
** This is very similar to the DNS device.
** The request will pend until the main event handler gets WM_DNS.
** Note the temporary results buffer (must be freed later).
** Note we use the sock->handle for the DNS handle. During use,
** we store the TCP socket in the length field.
**
***********************************************************************/
{
#ifdef TO_WIN32
HANDLE handle;
#endif
HOSTENT *host;
#ifdef HAS_ASYNC_DNS
// Check if we are polling for completion:
if (host = (HOSTENT*)(sock->net.host_info)) {
// The windows main event handler will change this when it gets WM_DNS event:
if (!GET_FLAG(sock->flags, RRF_DONE)) return DR_PEND; // still waiting
CLR_FLAG(sock->flags, RRF_DONE);
if (!sock->error) { // Success!
host = (HOSTENT*)sock->net.host_info;
COPY_MEM((char*)&(sock->net.remote_ip), (char *)(*host->h_addr_list), 4); //he->h_length);
Signal_Device(sock, EVT_LOOKUP);
}
else
Signal_Device(sock, EVT_ERROR);
OS_Free(host); // free what we allocated earlier
sock->socket = sock->length; // Restore TCP socket saved below
sock->net.host_info = 0;
return DR_DONE;
}
// Else, make the lookup request:
host = OS_Make(MAXGETHOSTSTRUCT); // be sure to free it
handle = WSAAsyncGetHostByName(Event_Handle, WM_DNS, sock->data, (char*)host, MAXGETHOSTSTRUCT);
if (handle != 0) {
sock->net.host_info = host;
sock->length = sock->socket; // save TCP socket temporarily
sock->handle = handle;
return DR_PEND; // keep it on pending list
}
OS_Free(host);
#else
// Use old-style blocking DNS (mainly for testing purposes):
host = gethostbyname(sock->data);
sock->net.host_info = 0; // no allocated data
if (host) {
COPY_MEM((char*)&(sock->net.remote_ip), (char *)(*host->h_addr_list), 4); //he->h_length);
CLR_FLAG(sock->flags, RRF_DONE);
Signal_Device(sock, EVT_LOOKUP);
return DR_DONE;
}
#endif
sock->error = GET_ERROR;
//Signal_Device(sock, EVT_ERROR);
return DR_ERROR; // Remove it from pending list
}
*/ REBINT Form_Int_Len(REBYTE *buf, REBI64 val, REBINT maxl)
/*
** Form an integer string into the given buffer. Result will
** not exceed maxl length, including terminator.
**
** Returns the length of the string.
**
** Notes:
** 1. If result is longer than maxl, returns 0 length.
** 2. Make sure you have room in your buffer!
**
***********************************************************************/
{
REBYTE tmp[MAX_NUM_LEN];
REBYTE *tp = tmp;
REBI64 n;
REBI64 r;
REBINT len = 0;
// defaults for problem cases
buf[0] = '?';
buf[1] = 0;
if (maxl == 0) return 0;
if (val == 0) {
*buf++ = '0';
*buf = 0;
return 1;
}
#define MIN_I64_STR "-9223372036854775808"
if (val == MIN_I64) {
len = strlen(MIN_I64_STR);
if (maxl < len + 1) return 0;
COPY_MEM(buf, MIN_I64_STR, len + 1);
return len;
}
if (val < 0) {
val = -val;
*buf++ = '-';
maxl--;
len = 1;
}
// Generate string in reverse:
*tp++ = 0;
while (val != 0 && maxl > 0 && tp < tmp + MAX_NUM_LEN) {
n = val / 10; // not using ldiv for easier compatibility
r = val % 10;
*tp++ = (REBYTE)('0' + (REBYTE)(r));
val = n;
maxl --;
}
tp--;
if (maxl == 0) {
return 0;
}
while (NZ(*buf++ = *tp--)) len++;
return len;
}
