*/ 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; }