WinWorkstation.st
author Claus Gittinger <cg@exept.de>
Wed, 19 Mar 1997 23:03:37 +0100
changeset 1467 9629ce710c53
parent 1461 6d8b022bfcd8
child 1482 04cd5f3e49bf
permissions -rw-r--r--
added type argument to createWindowFor - prepare for native window support (windows)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     1
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     2
COPYRIGHT (c) 1996 by Claus Gittinger
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     3
	      All Rights Reserved
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     4
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     5
 This software is furnished under a license and may be used
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     6
 only in accordance with the terms of that license and with the
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
     9
 other person.  No title to or ownership of the software is
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    10
 hereby transferred.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    11
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    12
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    13
DeviceWorkstation subclass:#WinWorkstation
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    14
	instanceVariableNames:'blackpixel whitepixel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    15
		listOfFonts rootWin rootDC
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    16
		buttonsPressed eventTrace
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    17
		eventBuffer
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    18
		usingSystemPalette
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    19
		resizeFrameWidth resizeFrameHeight'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    20
	classVariableNames:'RawKeysymTranslation BeepFrequency BeepDuration'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    21
	poolDictionaries:''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    22
	category:'Interface-Graphics'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    23
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    24
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    25
!WinWorkstation primitiveDefinitions!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    26
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    27
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    28
# undef INT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    29
# define INT WIN_INT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    30
# undef Array
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    31
# define Array WIN_Array
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    32
# undef Number
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    33
# define Number WIN_Number
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    34
# undef Method
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    35
# define Method WIN_Method
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    36
# undef Point
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    37
# define Point WIN_Point
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    38
# undef Rectangle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    39
# define Rectangle WIN_Rectangle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    40
# undef True
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    41
# define True WIN_True
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    42
# undef False
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    43
# define False WIN_False
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    44
# undef Block
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    45
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    46
# undef xxCONTEXT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    47
# define xxCONTEXT        WIN_CONTEXT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    48
# undef _xxCONTEXT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    49
# define _xxCONTEXT       _WIN_CONTEXT
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    50
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    51
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    52
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    53
#include <stdio.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    54
/* #include <malloc.h> */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    55
/* #include <math.h> */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    56
/* #include <string.h> */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    57
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    58
#include <stdarg.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    59
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    60
/* #include <h/windows.h> */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    61
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    62
#  include <windef.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    63
#  include <winbase.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    64
#  include <wingdi.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    65
#  include <winuser.h>
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    66
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    67
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    68
#   ifdef __DEF_Array
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    69
#    undef Array
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    70
#    define Array __DEF_Array
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    71
#   endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    72
#   ifdef __DEF_Number
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    73
#    undef Number
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    74
#    define Number __DEF_Number
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    75
#   endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    76
#   ifdef __DEF_Method
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    77
#    undef Method
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    78
#    define Method __DEF_Method
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    79
#   endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    80
#   ifdef __DEF_Point
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    81
#    undef Point
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    82
#    define Point __DEF_Point
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    83
#   endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    84
#   ifdef __DEF_Block
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    85
#    define Block __DEF_Block
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    86
#   endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    87
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    88
/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    89
 * some defines - tired of typing ...
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    90
 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    91
#define _HANDLEVal(o)        (HANDLE)(__MKCP(o))
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    92
#define _HBITMAPVAL(o)       (HBITMAP)(__MKCP(o))
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    93
#define _HWNDVal(o)          (HWND)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    94
#define _HPALETTEVal(o)      (HPALETTE)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    95
#define _HCURSORVal(o)       (HCURSOR)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    96
#define _HGDIOBJVal(o)       (HGDIOBJ)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    97
#define _LOGPALETTEVal(o)    (LOGPALETTE *)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    98
#define _COLORREFVal(o)      (COLORREF)(__MKCP(o))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
    99
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   100
#define _GCDATA(o)           ((struct gcData *)(__MKCP(o)))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   101
#define _HDCVal(o)           (_GCDATA(o)->hDC)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   102
#define _HPENVal(o)          (_GCDATA(o)->hPen)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   103
#define _HBRUSHVal(o)        (_GCDATA(o)->hBrush)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   104
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   105
#define __rootDC             (HDC)(__MKCP(__INST(rootDC)))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   106
#define ISCONNECTED          (__INST(rootDC) != nil)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   107
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   108
struct gcData {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   109
    HDC         hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   110
    HPEN        hPen;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   111
    HBRUSH      hBrush;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   112
    COLORREF    fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   113
    COLORREF    bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   114
    int         brushType;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   115
    int         lineWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   116
    int         lineStyle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   117
    int         joinStyle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   118
    int         capStyle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   119
    int         fontAscent;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   120
};
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   121
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   122
/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   123
 * some synthetic values
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   124
 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   125
# define Button1MotionMask      1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   126
# define Button2MotionMask      2
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   127
# define Button3MotionMask      4
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   128
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   129
# define Button1Mask            Button1MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   130
# define Button2Mask            Button2MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   131
# define Button3Mask            Button3MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   132
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   133
# define ControlMask            8
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   134
# define ShiftMask              16
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   135
# define LeftAltMask            32
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   136
# define RightAltMask           64
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   137
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   138
# define TRANSLATED_KEY         256
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   139
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   140
int AltMask = RightAltMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   141
int MetaMask = LeftAltMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   142
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   143
# define WhitePixel     RGB(0xFF, 0xFF, 0xFF)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   144
# define BlackPixel     RGB(0, 0, 0)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   145
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   146
#ifdef DEBUG
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   147
# define DPRINTF(x)             printf x
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   148
# define DDPRINTF(x)            /* nothing */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   149
# define EVENT_PRINTF(x)        printf x
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   150
# define EVENT_PRINTF1(x)       /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   151
# define EVENT_PRINTF2(x)       printf x
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   152
#else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   153
# define DPRINTF(x)             /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   154
# define DDPRINTF(x)            /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   155
# define EVENT_PRINTF(x)        /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   156
# define EVENT_PRINTF1(x)       /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   157
# define EVENT_PRINTF2(x)       /* */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   158
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   159
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   160
# define BR_SOLID       0
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   161
# define BR_PATTERN     1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   162
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   163
# define LINE_SOLID     0
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   164
# define LINE_DASH      1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   165
# define LINE_DDASH     2
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   166
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   167
# define _C_ARROW       1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   168
# define _C_CROSS       2
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   169
# define _C_IBEAM       3
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   170
# define _C_ICON        4
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   171
# define _C_NO          5
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   172
# define _C_SIZE        6
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   173
# define _C_SIZEALL     7
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   174
# define _C_SIZENESW    8
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   175
# define _C_SIZENS      9
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   176
# define _C_SIZENWSE    10
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   177
# define _C_UPARROW     11
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   178
# define _C_WAIT        12
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   179
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   180
static HCURSOR H_C_ARROW = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   181
static HCURSOR H_C_CROSS = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   182
static HCURSOR H_C_IBEAM = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   183
static HCURSOR H_C_ICON = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   184
static HCURSOR H_C_NO = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   185
static HCURSOR H_C_SIZE = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   186
static HCURSOR H_C_SIZEALL = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   187
static HCURSOR H_C_SIZENESW = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   188
static HCURSOR H_C_SIZENS = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   189
static HCURSOR H_C_SIZENWSE = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   190
static HCURSOR H_C_UPARROW = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   191
static HCURSOR H_C_WAIT = (HCURSOR)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   192
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   193
static int evRootX, evRootY;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   194
static HWND buttonWindow = (HWND)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   195
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   196
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   197
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   198
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   199
!WinWorkstation primitiveVariables!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   200
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   201
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   202
static HANDLE hInstance = (HANDLE)0, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   203
	  hPrevInstance = (HANDLE)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   204
static int firstInstance = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   205
static char *app_name = "ST/X";
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   206
static int __debug__ = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   207
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   208
static int __inCreate = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   209
static int create_topView;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   210
static int create_minWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   211
static int create_maxWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   212
static int create_minHeight;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   213
static int create_maxHeight;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   214
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   215
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   216
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   217
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   218
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   219
!WinWorkstation primitiveFunctions!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   220
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   221
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   222
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   223
struct queuedEvent {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   224
	struct queuedEvent     *ev_next;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   225
	HWND                    ev_hWnd;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   226
	UINT                    ev_message;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   227
	UINT                    ev_wParam;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   228
	int                     ev_arg1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   229
	int                     ev_arg2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   230
	int                     ev_arg3;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   231
	int                     ev_arg4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   232
	int                     filler;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   233
};
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   234
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   235
#define ev_x    ev_arg1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   236
#define ev_y    ev_arg2
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   237
#define ev_w    ev_arg3
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   238
#define ev_h    ev_arg4
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   239
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   240
#define ev_keyCode   ev_wParam
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   241
#define ev_scanCode  ev_arg3
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   242
#define ev_modifiers ev_arg4
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   243
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   244
#define EV_CHUNK_SZ     1024
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   245
#define EV_CHUNK_CNT    (1024/sizeof(struct queuedEvent))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   246
struct queuedEvent *eventFreeList = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   247
struct queuedEvent *eventQueueHead = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   248
struct queuedEvent *eventQueueTail = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   249
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   250
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   251
enqEvent(hWnd, message, wParam, arg1, arg2, arg3, arg4)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   252
    HWND hWnd;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   253
    UINT message;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   254
    UINT wParam;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   255
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   256
    struct queuedEvent *ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   257
    struct queuedEvent *bulk;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   258
    int i;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   259
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   260
    ev = eventFreeList;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   261
    if (ev) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   262
	eventFreeList = ev->ev_next;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   263
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   264
	bulk = (struct queuedEvent *) malloc(EV_CHUNK_SZ);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   265
	for (i=1; i<EV_CHUNK_CNT; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   266
	    bulk[i-1].ev_next = &(bulk[i]);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   267
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   268
	bulk[EV_CHUNK_CNT-1].ev_next = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   269
	ev = bulk;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   270
	eventFreeList = &(bulk[1]);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   271
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   272
    ev->ev_next = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   273
    ev->ev_hWnd = hWnd;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   274
    ev->ev_message = message;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   275
    ev->ev_wParam = wParam;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   276
    ev->ev_arg1 = arg1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   277
    ev->ev_arg2 = arg2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   278
    ev->ev_arg3 = arg3;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   279
    ev->ev_arg4 = arg4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   280
    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   281
    if (eventQueueTail) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   282
	eventQueueTail->ev_next = ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   283
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   284
	eventQueueHead = ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   285
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   286
    eventQueueTail = ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   287
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   288
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   289
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   290
struct queuedEvent *
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   291
deqEvent() {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   292
    struct queuedEvent *ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   293
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   294
    ev = eventQueueHead;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   295
    if (ev) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   296
	eventQueueHead = ev->ev_next;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   297
	if (! eventQueueHead) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   298
	    eventQueueTail = (struct queuedEvent *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   299
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   300
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   301
    return ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   302
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   303
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   304
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   305
freeEvent(ev)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   306
    struct queuedEvent *ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   307
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   308
    ev->ev_next = eventFreeList;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   309
    eventFreeList = ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   310
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   311
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   312
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   313
getModifiers()
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   314
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   315
    int modifiers;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   316
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   317
    modifiers = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   318
    if (GetKeyState(VK_SHIFT) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   319
	modifiers |= ShiftMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   320
    if (GetKeyState(VK_CONTROL) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   321
	modifiers |= ControlMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   322
    if (GetKeyState(VK_RMENU) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   323
	modifiers |= RightAltMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   324
    if (GetKeyState(VK_LMENU) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   325
	modifiers |= LeftAltMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   326
    if (GetKeyState(VK_LBUTTON) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   327
	modifiers |= Button1Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   328
    if (GetKeyState(VK_MBUTTON) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   329
	modifiers |= Button2Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   330
    if (GetKeyState(VK_RBUTTON) & 0x8000)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   331
	modifiers |= Button3Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   332
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   333
    return modifiers;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   334
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   335
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   336
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   337
getAllWinEvents()
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   338
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   339
    MSG msg;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   340
    int more;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   341
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   342
    if (PeekMessage(&msg, (HWND)0, 0, 0, PM_NOREMOVE)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   343
	more = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   344
	while (more) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   345
	    GetMessage(&msg, (HWND)0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   346
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   347
	    if ((msg.message == WM_KEYDOWN) || (msg.message == WM_KEYUP)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   348
	     || (msg.message == WM_SYSKEYDOWN) || (msg.message == WM_SYSKEYUP)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   349
		if (((msg.wParam >= '0') && (msg.wParam <= 'Z'))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   350
		 || (msg.wParam == 0x20)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   351
		 || (msg.wParam >= 0xB0)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   352
		    /* 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   353
		     * translate to a WM_CHAR message
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   354
		     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   355
		    if (TranslateMessage(&msg))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   356
			continue;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   357
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   358
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   359
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   360
	    evRootX = msg.pt.x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   361
	    evRootY = msg.pt.y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   362
	    DispatchMessage(&msg);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   363
	    more = PeekMessage(&msg, (HWND)0, 0, 0, PM_NOREMOVE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   364
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   365
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   366
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   367
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   368
static
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   369
winEventProcessing(hWnd, message, wParam, lParam, pDefault)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   370
    HWND hWnd;                /* window handle                   */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   371
    UINT message;             /* type of message                 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   372
    UINT wParam;              /* additional information          */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   373
    LONG lParam;              /* additional information          */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   374
    int *pDefault;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   375
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   376
    LPMINMAXINFO lpmmi;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   377
    WINDOWPOS *posStruct;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   378
    int modifiers;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   379
    int x, y, w, h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   380
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   381
/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   382
    EVENT_PRINTF(("winEvent hWin=0x%x message=0x%x wP=0x%x lP=0x%x\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   383
			hWnd, message, wParam, lParam));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   384
*/
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   385
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   386
    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   387
     * messages which are handled right here 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   388
     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   389
    if (__inCreate) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   390
	EVENT_PRINTF(("in create\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   391
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   392
	switch (message) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   393
	    case WM_GETMINMAXINFO:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   394
		if (create_topView) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   395
		    lpmmi = (LPMINMAXINFO) lParam;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   396
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   397
		    DPRINTF(("WM_GETMINMAXINFO handle=%x got min: %d/%d\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   398
				hWnd,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   399
				lpmmi->ptMinTrackSize.x,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   400
				lpmmi->ptMinTrackSize.y));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   401
                                 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   402
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   403
		    lpmmi->ptMaxSize.x = create_maxWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   404
		    lpmmi->ptMaxSize.y = create_maxHeight;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   405
		    lpmmi->ptMaxTrackSize.x = create_maxWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   406
		    lpmmi->ptMaxTrackSize.y = create_maxHeight;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   407
		    lpmmi->ptMinTrackSize.x = create_minWidth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   408
		    lpmmi->ptMinTrackSize.y = create_minHeight;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   409
		    DPRINTF(("WM_GETMINMAXINFO handle=%x return min: %d/%d max: %d/%d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   410
				    hWnd,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   411
				    create_minWidth, create_minHeight,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   412
				    create_maxWidth, create_maxHeight));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   413
		    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   414
		    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   415
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   416
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   417
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   418
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   419
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   420
    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   421
     * messages which are enqueued to be handled by the view thread
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   422
     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   423
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   424
    switch (message) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   425
	case WM_SETCURSOR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   426
	    *pDefault = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   427
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   428
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   429
	case WM_WINDOWPOSCHANGED:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   430
	    EVENT_PRINTF(("WM_WINDOWPOSCHANGED\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   431
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   432
	    posStruct = (WINDOWPOS *)lParam;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   433
	    if (! posStruct) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   434
		DPRINTF(("oops - no posStruct passed\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   435
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   436
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   437
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   438
	    {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   439
		RECT rct;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   440
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   441
		GetClientRect(hWnd, &rct);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   442
		enqEvent(hWnd, message, wParam,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   443
			       rct.left, rct.top,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   444
			       rct.right-rct.left+1,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   445
			       rct.bottom-rct.top+1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   446
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   447
#if 0
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   448
	    enqEvent(hWnd, message, wParam,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   449
			   posStruct->x, posStruct->y, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   450
			   posStruct->cx, posStruct->cy);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   451
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   452
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   453
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   454
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   455
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   456
	case WM_ERASEBKGND:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   457
	    EVENT_PRINTF(("WM_ERASEBKGND\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   458
	    goto paint;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   459
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   460
	case WM_PAINT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   461
	    EVENT_PRINTF(("WM_PAINT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   462
	paint:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   463
	    {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   464
		RECT upd;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   465
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   466
		if (GetUpdateRect(hWnd, &upd, 0)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   467
		    if ((upd.left == upd.right) && (upd.top == upd.bottom)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   468
			DPRINTF(("WM_PAINT: null rectangle\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   469
			ValidateRect(hWnd, NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   470
			break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   471
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   472
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   473
		    x = upd.left;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   474
		    y = upd.top;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   475
		    w = upd.right - upd.left + 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   476
		    h = upd.bottom - upd.top + 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   477
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   478
		    ValidateRect(hWnd, NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   479
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   480
		    enqEvent(hWnd, message, wParam, x, y, w, h);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   481
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   482
		    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   483
		    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   484
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   485
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   486
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   487
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   488
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   489
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   490
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   491
	case WM_SHOWWINDOW:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   492
	    EVENT_PRINTF(("WM_SHOWWINDOW\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   493
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   494
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   495
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   496
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   497
	case WM_DESTROY:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   498
	    EVENT_PRINTF2(("WM_DESTROY\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   499
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   500
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   501
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   502
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   503
	case WM_MOUSEACTIVATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   504
	    EVENT_PRINTF2(("WM_MOUSEACTIVATE h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   505
	    SetFocus(hWnd);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   506
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   507
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   508
	    return MA_ACTIVATE;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   509
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   510
	case WM_ACTIVATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   511
	    EVENT_PRINTF2(("WM_ACTIVATE %s h=%x\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   512
			    LOWORD(wParam) ? "active" : "inactive",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   513
			    hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   514
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   515
	    switch (LOWORD(wParam)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   516
		case WA_INACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   517
		    EVENT_PRINTF2(("WM_ACTIVATE inactive h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   518
		    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   519
		case WA_ACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   520
		    EVENT_PRINTF2(("WM_ACTIVATE active h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   521
		    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   522
		case WA_CLICKACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   523
		    EVENT_PRINTF2(("WM_ACTIVATE clkactive h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   524
		    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   525
		default:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   526
		    EVENT_PRINTF2(("WM_ACTIVATE ? h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   527
		    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   528
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   529
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   530
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   531
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   532
	case WM_SYSCHAR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   533
	    EVENT_PRINTF2(("WM_SYSCHAR h=%x %x\n", hWnd, wParam));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   534
	    goto commonChar;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   535
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   536
	case WM_CHAR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   537
	    EVENT_PRINTF2(("WM_CHAR h=%x %x\n", hWnd, wParam));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   538
	commonChar:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   539
	    modifiers = getModifiers();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   540
	    {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   541
		POINT p;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   542
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   543
		p.x = evRootX;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   544
		p.y = evRootY;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   545
		ScreenToClient(hWnd, &p);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   546
		x = p.x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   547
		y = p.y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   548
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   549
	    enqEvent(hWnd, WM_KEYDOWN, wParam, x, y, lParam, modifiers | TRANSLATED_KEY);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   550
	    enqEvent(hWnd, WM_KEYUP, wParam, x, y, lParam, modifiers | TRANSLATED_KEY);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   551
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   552
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   553
         
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   554
	case WM_SYSKEYUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   555
	    EVENT_PRINTF2(("WM_SYSKEYUP %x\n, wParam"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   556
	    goto commonKey;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   557
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   558
	case WM_SYSKEYDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   559
	    EVENT_PRINTF2(("WM_SYSKEYDOWN %x\n, wParam"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   560
	    goto commonKey;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   561
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   562
	case WM_KEYUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   563
	    EVENT_PRINTF2(("WM_KEYUP h=%x %x\n", hWnd, wParam));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   564
	    goto commonKey;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   565
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   566
	case WM_KEYDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   567
	    EVENT_PRINTF2(("WM_KEYDOWN h=%x %x\n", hWnd, wParam));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   568
	commonKey:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   569
	    modifiers = getModifiers();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   570
	    {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   571
		POINT p;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   572
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   573
		p.x = evRootX;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   574
		p.y = evRootY;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   575
		ScreenToClient(hWnd, &p);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   576
		x = p.x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   577
		y = p.y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   578
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   579
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   580
	    enqEvent(hWnd, message, wParam, x, y, lParam, modifiers);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   581
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   582
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   583
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   584
	case WM_MOUSEMOVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   585
	    EVENT_PRINTF2(("WM_MOUSEMOVE h=%x\n", hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   586
	    {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   587
		short x, y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   588
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   589
		x = LOWORD(lParam);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   590
		y = HIWORD(lParam);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   591
		enqEvent(hWnd, message, wParam, x, y, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   592
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   593
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   594
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   595
            
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   596
	case WM_LBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   597
	case WM_MBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   598
	case WM_RBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   599
	    SetCapture(hWnd);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   600
	    goto commonButton;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   601
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   602
	case WM_LBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   603
	case WM_MBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   604
	case WM_RBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   605
	    ReleaseCapture();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   606
	    goto commonButton;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   607
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   608
	case WM_LBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   609
	case WM_MBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   610
	case WM_RBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   611
	commonButton:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   612
	    modifiers = getModifiers();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   613
	    EVENT_PRINTF2(("WM_BUTTONUP/DOWN h=%x pos=%d/%d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   614
			   hWnd, LOWORD(lParam), HIWORD(lParam)));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   615
	    enqEvent(hWnd, message, wParam, LOWORD(lParam),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   616
					    HIWORD(lParam),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   617
					    wParam,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   618
					    modifiers);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   619
	    *pDefault = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   620
	    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   621
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   622
	case WM_KILLFOCUS:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   623
	    EVENT_PRINTF(("WM_KILLFOCUS\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   624
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   625
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   626
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   627
	case WM_SETFOCUS:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   628
	    EVENT_PRINTF(("WM_SETFOCUS\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   629
	    enqEvent(hWnd, message, wParam, 0, 0, 0, 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   630
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   631
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   632
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   633
    switch (message) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   634
	case WM_GETTEXT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   635
	    EVENT_PRINTF(("WM_GETTEXT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   636
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   637
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   638
	case WM_GETTEXTLENGTH:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   639
	    EVENT_PRINTF(("WM_GETTEXTLENGTH\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   640
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   641
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   642
	case WM_NCCREATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   643
	    EVENT_PRINTF(("WM_NCCREATE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   644
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   645
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   646
	case WM_GETMINMAXINFO:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   647
	    EVENT_PRINTF(("WM_GETMINMAXINFO\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   648
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   649
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   650
	case WM_NCHITTEST:
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   651
	    EVENT_PRINTF2(("WM_NCHITTEST\n"));
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   652
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   653
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   654
	case WM_NCMOUSEMOVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   655
	    EVENT_PRINTF(("WM_NCMOUSEMOVE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   656
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   657
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   658
	case WM_PARENTNOTIFY:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   659
	    EVENT_PRINTF2(("WM_PARENTNOTIFY h=%x hChild=%x %d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   660
				hWnd, lParam, LOWORD(wParam)));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   661
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   662
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   663
	case WM_SETCURSOR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   664
	    EVENT_PRINTF(("WM_SETCURSOR\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   665
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   666
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   667
	case WM_NCLBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   668
	    EVENT_PRINTF(("WM_NCLBUTTONDOWN\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   669
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   670
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   671
	case WM_SETTEXT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   672
	    EVENT_PRINTF(("WM_SETTEXT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   673
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   674
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   675
	case 0x88:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   676
	    EVENT_PRINTF(("0x88 (undoc)\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   677
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   678
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   679
	case 0x231:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   680
	    EVENT_PRINTF(("0x231 (undoc)\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   681
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   682
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   683
	case 0x232:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   684
	    EVENT_PRINTF(("0x232 (undoc)\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   685
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   686
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   687
	case WM_SIZE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   688
	    EVENT_PRINTF(("WM_SIZE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   689
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   690
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   691
	case WM_CREATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   692
	    EVENT_PRINTF(("WM_CREATE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   693
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   694
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   695
	case WM_NCCALCSIZE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   696
	    EVENT_PRINTF(("WM_NCCALCSIZE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   697
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   698
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   699
	case WM_NCPAINT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   700
	    EVENT_PRINTF(("WM_NCPAINT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   701
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   702
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   703
	case WM_SYSCOMMAND:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   704
	    EVENT_PRINTF2(("WM_SYSCOMMAND\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   705
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   706
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   707
	case WM_INITMENU:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   708
	    EVENT_PRINTF(("WM_INITMENU\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   709
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   710
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   711
	case WM_INITMENUPOPUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   712
	    EVENT_PRINTF(("WM_INITMENUPOPUP\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   713
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   714
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   715
	case WM_ENTERIDLE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   716
	    EVENT_PRINTF(("WM_ENTERIDLE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   717
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   718
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   719
	case WM_ENTERMENULOOP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   720
	    EVENT_PRINTF(("WM_ENTERMENULOOP\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   721
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   722
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   723
	case WM_EXITMENULOOP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   724
	    EVENT_PRINTF(("WM_EXITMENULOOP\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   725
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   726
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   727
	case WM_MENUSELECT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   728
	    EVENT_PRINTF(("WM_MENUSELECT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   729
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   730
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   731
	case WM_QUIT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   732
	    EVENT_PRINTF(("WM_QUIT\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   733
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   734
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   735
	case WM_CLOSE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   736
	    EVENT_PRINTF(("WM_CLOSE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   737
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   738
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   739
	case WM_NCDESTROY:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   740
	    EVENT_PRINTF(("WM_NCDESTROY\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   741
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   742
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   743
	case WM_QUERYNEWPALETTE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   744
	    EVENT_PRINTF(("WM_QUERYNEWPALETTE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   745
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   746
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   747
	case WM_PALETTECHANGED:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   748
	    EVENT_PRINTF(("WM_PALETTECHANGED\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   749
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   750
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   751
	case WM_NCACTIVATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   752
	    EVENT_PRINTF(("WM_NCACTIVATE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   753
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   754
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   755
	case WM_ACTIVATEAPP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   756
	    EVENT_PRINTF1(("WM_ACTIVATEAPP %s\n", wParam ? "active" : "inactive"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   757
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   758
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   759
	case WM_MOVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   760
	    EVENT_PRINTF(("WM_MOVE\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   761
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   762
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   763
	case WM_SYSDEADCHAR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   764
	    EVENT_PRINTF2(("WM_SYSDEADCHAR %x\n, wParam"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   765
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   766
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   767
	case WM_DEADCHAR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   768
	    EVENT_PRINTF2(("WM_DEADCHAR %x\n, wParam"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   769
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   770
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   771
	case WM_PAINTICON:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   772
	    EVENT_PRINTF(("WM_PAINTICON\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   773
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   774
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   775
	case WM_ICONERASEBKGND:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   776
	    EVENT_PRINTF(("WM_ICONERASEBKGND\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   777
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   778
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   779
	case WM_WINDOWPOSCHANGING:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   780
	    EVENT_PRINTF(("WM_WINDOWPOSCHANGING\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   781
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   782
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   783
	case WM_QUERYOPEN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   784
	    EVENT_PRINTF(("WM_QUERYOPEN\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   785
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   786
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   787
	case WM_QUERYENDSESSION:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   788
	    EVENT_PRINTF(("WM_QUERYENDSESSION\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   789
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   790
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   791
	default:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   792
	    EVENT_PRINTF(("msg = %x\n", message));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   793
	    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   794
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   795
    return 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   796
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   797
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   798
LONG APIENTRY
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   799
MainWndProc(hWnd, message, wParam, lParam) 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   800
    HWND hWnd;                /* window handle                   */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   801
    UINT message;             /* type of message                 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   802
    UINT wParam;              /* additional information          */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   803
    LONG lParam;              /* additional information          */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   804
{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   805
    int wantDefault = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   806
    int retVal;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   807
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   808
    DDPRINTF((">> MainWndProc\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   809
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   810
    retVal = winEventProcessing(hWnd, message, wParam, lParam, &wantDefault);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   811
    if (wantDefault) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   812
	DDPRINTF(("DefWindowProc\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   813
	retVal = DefWindowProc(hWnd, message, wParam, lParam);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   814
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   815
    DDPRINTF(("<< MainWndProc (%d)\n", retVal));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   816
    return retVal;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   817
}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   818
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   819
int CALLBACK
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   820
EnumFPTypeFace( lplf, lptm, dwType, lpData )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   821
	LOGFONT*        lplf;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   822
	TEXTMETRIC*     lptm;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   823
	DWORD           dwType;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   824
	LPARAM          lpData;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   825
{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   826
	OBJ t;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   827
	OBJ* refToList;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   828
	OBJ  typeFaceList;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   829
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   830
	t = __MKSTRING( lplf->lfFaceName );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   831
	refToList = (OBJ*) lpData;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   832
	typeFaceList = *refToList;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   833
	__SSEND1( typeFaceList, @symbol(add:), 0, t );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   834
	return 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   835
}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   836
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   837
int CALLBACK 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   838
EnumFontsProc( lplf, lptm, dwType, lpData )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   839
	LOGFONT*      lplf;     /* address of logical-font data */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   840
	TEXTMETRIC*   lptm;     /* address of physical font data */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   841
	DWORD         dwType;   /* font type */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   842
	LPARAM        lpData;   /* address of application supplied data */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   843
{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   844
	OBJ newArray, t;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   845
	OBJ *refToList;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   846
	OBJ list;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   847
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   848
	DPRINTF(("EnumFontProc\n\n\n\n"));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   849
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   850
	if( lplf )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   851
	{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   852
	DPRINTF((" lfHeight          %d\n", lplf->lfHeight ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   853
	DPRINTF((" lfWidth           %d\n", lplf->lfWidth  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   854
	DPRINTF((" lfEscapement      %d\n", lplf->lfEscapement  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   855
	DPRINTF((" lfOrientation     %d\n", lplf->lfOrientation  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   856
	DPRINTF((" lfWeight          %d\n", lplf->lfWeight  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   857
	DPRINTF((" lfItalic          %d\n", lplf->lfItalic  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   858
	DPRINTF((" lfUnderline       %d\n", lplf->lfUnderline  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   859
	DPRINTF((" lfStrikeOut       %d\n", lplf->lfStrikeOut  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   860
	DPRINTF((" lfCharSet         %d\n", lplf->lfCharSet  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   861
	DPRINTF((" lfOutPrecision    %d\n", lplf->lfOutPrecision  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   862
	DPRINTF((" lfClipPrecision   %d\n", lplf->lfClipPrecision  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   863
	DPRINTF((" lfQuality         %d\n", lplf->lfQuality  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   864
	DPRINTF((" lfPitchAndFamily  %d\n", lplf->lfPitchAndFamily  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   865
	DPRINTF((" lfFaceName        %s\n\n", lplf->lfFaceName  ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   866
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   867
	    newArray = __ARRAY_NEW_INT(16);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   868
	    __AT_PUT_(newArray, __MKSMALLINT(1), __MKSMALLINT(lplf->lfHeight));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   869
	    __AT_PUT_(newArray, __MKSMALLINT(2), __MKSMALLINT(lplf->lfWidth));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   870
	    __AT_PUT_(newArray, __MKSMALLINT(3), __MKSMALLINT(lplf->lfEscapement));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   871
	    __AT_PUT_(newArray, __MKSMALLINT(4), __MKSMALLINT(lplf->lfOrientation));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   872
	    __PROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   873
	    if( lplf->lfWeight == FW_NORMAL ) t = __MKSTRING("normal");
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   874
	    if( lplf->lfWeight == FW_BOLD )   t = __MKSTRING("bold");
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   875
	    if( lplf->lfWeight == FW_MEDIUM ) t = __MKSTRING("medium");
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   876
	    if( lplf->lfWeight == FW_LIGHT )  t = __MKSTRING("demi");
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   877
	    __UNPROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   878
	    __AT_PUT_(newArray, __MKSMALLINT(5), t );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   879
	    __PROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   880
	    if( lplf->lfItalic == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   881
		if( lplf->lfUnderline == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   882
		    if( lplf->lfStrikeOut == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   883
			t = __MKSTRING( "italic-underline-strikeOut" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   884
		    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   885
			t = __MKSTRING( "italic-underline" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   886
		    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   887
		} else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   888
		    if( lplf->lfStrikeOut == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   889
			t = __MKSTRING( "italic-strikeOut" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   890
		    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   891
			t = __MKSTRING( "italic" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   892
		    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   893
		}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   894
	    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   895
		if( lplf->lfUnderline == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   896
		    if( lplf->lfStrikeOut == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   897
			t = __MKSTRING( "underline-strikeOut" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   898
		    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   899
			t = __MKSTRING( "underline" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   900
		    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   901
		} else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   902
		    if( lplf->lfStrikeOut == TRUE ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   903
			t = __MKSTRING( "strikeOut" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   904
		    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   905
			t = __MKSTRING( "normal" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   906
		    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   907
		}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   908
	    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   909
	    __UNPROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   910
	    __AT_PUT_(newArray, __MKSMALLINT(16), t );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   911
                
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   912
	    __AT_PUT_(newArray, __MKSMALLINT(6), __MKSMALLINT(lplf->lfItalic));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   913
	    __AT_PUT_(newArray, __MKSMALLINT(7), __MKSMALLINT(lplf->lfUnderline));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   914
	    __AT_PUT_(newArray, __MKSMALLINT(8), __MKSMALLINT(lplf->lfStrikeOut));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   915
	    __AT_PUT_(newArray, __MKSMALLINT(9), __MKSMALLINT(lplf->lfCharSet));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   916
	    __AT_PUT_(newArray, __MKSMALLINT(10), __MKSMALLINT(lplf->lfOutPrecision));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   917
	    __AT_PUT_(newArray, __MKSMALLINT(11), __MKSMALLINT(lplf->lfClipPrecision));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   918
	    __AT_PUT_(newArray, __MKSMALLINT(12), __MKSMALLINT(lplf->lfQuality));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   919
	    __AT_PUT_(newArray, __MKSMALLINT(13), __MKSMALLINT(lplf->lfPitchAndFamily));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   920
	    /* ... */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   921
	    __PROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   922
	    t = __MKSTRING(lplf->lfFaceName);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   923
	    __UNPROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   924
	    __AT_PUT_(newArray, __MKSMALLINT(14), t);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   925
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   926
	    __PROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   927
	    if( dwType == DEVICE_FONTTYPE ) t = __MKSTRING( "device" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   928
	    if( dwType == RASTER_FONTTYPE ) t = __MKSTRING( "raster" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   929
	    if( dwType == TRUETYPE_FONTTYPE ) t = __MKSTRING( "typetype" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   930
	    __UNPROTECT__(newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   931
            
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   932
	    __AT_PUT_(newArray, __MKSMALLINT(15), t);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   933
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   934
	    refToList = (OBJ*) lpData;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   935
	    list = *refToList;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   936
	    __SSEND1(list, @symbol(add:), 0, newArray);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   937
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   938
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   939
	DPRINTF((" dwType            %d\n", dwType ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   940
	return 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   941
}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
   942
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   943
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   944
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   945
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   946
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   947
!WinWorkstation  class methodsFor:'documentation'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   948
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   949
copyright
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   950
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   951
COPYRIGHT (c) 1996 by Claus Gittinger
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   952
	      All Rights Reserved
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   953
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   954
 This software is furnished under a license and may be used
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   955
 only in accordance with the terms of that license and with the
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   956
 inclusion of the above copyright notice.   This software may not
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   957
 be provided or otherwise made available to, or used by, any
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   958
 other person.  No title to or ownership of the software is
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   959
 hereby transferred.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   960
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   961
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   962
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   963
documentation
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   964
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   965
    See more documentation in my superclass, DeviceWorkstation.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   966
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   967
    [author:]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   968
	Claus Gittinger
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   969
"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   970
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   971
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   972
!WinWorkstation  class methodsFor:'initialization'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   973
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   974
initialize
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   975
    |d|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   976
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   977
    super initialize.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   978
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   979
    BeepFrequency := 440.       "/ Hertz
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   980
    BeepDuration := 200.        "/ millis
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   981
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   982
    RawKeysymTranslation := d := Dictionary new.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   983
    d at:'Right Alt'     put:#'Alt_R'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   984
    d at:'Left Alt'      put:#'Alt_L'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   985
    d at:'Right Shift'   put:#'Shift_R'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   986
    d at:'Left Shift'    put:#'Shift_L'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   987
    d at:'Right Control' put:#'Ctrl_R'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   988
    d at:'Left Control'  put:#'Ctrl_L'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   989
    d at:'Control'       put:#'Ctrl'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   990
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   991
    d at:'Backspace'     put:#'BackSpace'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   992
    d at:'Up'            put:#'CursorUp'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   993
    d at:'Down'          put:#'CursorDown'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   994
    d at:'Right'         put:#'CursorRight'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   995
    d at:'Left'          put:#'CursorLeft'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   996
    d at:'Page Up'       put:#'PreviousPage'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   997
    d at:'Page Down'     put:#'NextPage'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   998
    d at:'Prnt Scrn'     put:#'Print'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
   999
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1000
    (self getSystemMetrics:#swapButton) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1001
	ButtonTranslation := #(2 2 1)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1002
    ] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1003
	ButtonTranslation := #(1 2 2)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1004
    ]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1005
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1006
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1007
!WinWorkstation  class methodsFor:'error handling'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1008
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1009
debug:aBoolean
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1010
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1011
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1012
    __debug__ = (aBoolean == true) ? 1 : 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1013
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1014
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1015
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1016
!WinWorkstation  class methodsFor:'queries'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1017
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1018
platformName
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1019
    "ST-80 compatibility.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1020
     Return a string describing the display systems platform."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1021
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1022
    ^ 'WIN32'  
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1023
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1024
    "Modified: 26.5.1996 / 15:32:46 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1025
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1026
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1027
getSystemMetrics:aSymbol
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1028
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1029
    int info = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1030
    int isBool = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1031
    int arg;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1032
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1033
    if (aSymbol == @symbol(swapButton)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1034
	arg = SM_SWAPBUTTON;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1035
	isBool = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1036
    } else if (aSymbol == @symbol(mouseButtons)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1037
	arg = SM_CMOUSEBUTTONS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1038
    } else if (aSymbol == @symbol(iconWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1039
	arg = SM_CXICON;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1040
    } else if (aSymbol == @symbol(iconHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1041
	arg = SM_CYICON;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1042
    } else if (aSymbol == @symbol(cursorWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1043
	arg = SM_CXCURSOR;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1044
    } else if (aSymbol == @symbol(cursorHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1045
	arg = SM_CYCURSOR;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1046
    } else if (aSymbol == @symbol(captionHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1047
	arg = SM_CYCAPTION;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1048
    } else if (aSymbol == @symbol(resizeFrameWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1049
	arg = SM_CXFRAME;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1050
    } else if (aSymbol == @symbol(resizeFrameHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1051
	arg = SM_CYFRAME;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1052
    } else if (aSymbol == @symbol(borderFrameWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1053
	arg = SM_CXBORDER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1054
    } else if (aSymbol == @symbol(borderFrameHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1055
	arg = SM_CYBORDER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1056
    } else if (aSymbol == @symbol(fullScreenWindowWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1057
	arg = SM_CXFULLSCREEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1058
    } else if (aSymbol == @symbol(fullScreenWindowHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1059
	arg = SM_CYFULLSCREEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1060
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1061
	RETURN (nil);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1062
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1063
    info = GetSystemMetrics(arg);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1064
    if (isBool) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1065
	RETURN (info ? true : false);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1066
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1067
    RETURN (__MKSMALLINT(info));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1068
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1069
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1070
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1071
!WinWorkstation methodsFor:'accessing & queries'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1072
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1073
anyButtonMotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1074
    "return the state-mask for any button in motion events' state-field.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1075
     This is the devices mask."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1076
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1077
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1078
    RETURN ( __MKSMALLINT(Button1MotionMask | Button2MotionMask | Button3MotionMask)); 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1079
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1080
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1081
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1082
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1083
blackpixel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1084
    "return the colornumber of black"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1085
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1086
    ^ blackpixel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1087
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1088
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1089
button1MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1090
    "return the state-mask for button1 in motion events' state-field.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1091
     For backward compatibility."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1092
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1093
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1094
    RETURN (__MKSMALLINT(Button1MotionMask)); 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1095
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1096
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1097
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1098
     Display button1MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1099
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1100
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1101
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1102
button2MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1103
    "return the state-mask for button2 in motion events' state-field
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1104
     For backward compatibility."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1105
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1106
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1107
    RETURN (__MKSMALLINT(Button2MotionMask)); 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1108
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1109
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1110
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1111
button3MotionMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1112
    "return the state-mask for button3 in motion events' state-field
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1113
     For backward compatibility."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1114
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1115
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1116
    RETURN (__MKSMALLINT(Button3MotionMask)); 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1117
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1118
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1119
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1120
buttonMotionMask:aButton
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1121
    "return the state-mask for button1 in motion events state-field.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1122
     This is the devices mask."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1123
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1124
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1125
    if (aButton == __MKSMALLINT(1)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1126
	RETURN (__MKSMALLINT(Button1MotionMask));    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1127
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1128
    if (aButton == __MKSMALLINT(2)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1129
	RETURN (__MKSMALLINT(Button2MotionMask));    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1130
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1131
    if (aButton == __MKSMALLINT(3)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1132
	RETURN (__MKSMALLINT(Button3MotionMask));    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1133
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1134
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1135
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1136
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1137
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1138
controlMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1139
    "return the state-mask for the CTRL modified in motion events' state-field."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1140
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1141
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1142
    RETURN (__MKSMALLINT(ControlMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1143
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1144
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1145
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1146
defaultEventMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1147
    "return a mask to enable some events by default."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1148
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1149
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1150
#ifdef XXX
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1151
    RETURN (__MKSMALLINT(ExposureMask | StructureNotifyMask |
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1152
			 KeyPressMask | KeyReleaseMask |
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1153
			 EnterWindowMask | LeaveWindowMask |
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1154
			 ButtonPressMask | ButtonMotionMask | ButtonReleaseMask ));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1155
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1156
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1157
    ^ 0
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1158
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1159
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1160
displayFileDescriptor
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1161
    "return the displays fileNumber - for select"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1162
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1163
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1164
    RETURN (nil);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1165
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1166
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1167
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1168
displayName
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1169
    "return the X-connections display name.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1170
     This is (currently) nil for the default display, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1171
     something like foo:0 for any other remote display.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1172
     Future versions may return non-nil strings for the default display as well."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1173
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1174
    ^ 'local'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1175
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1176
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1177
protocolVersion
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1178
    "return the X-servers protocol version - should normally not be of
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1179
     any interest"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1180
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1181
    ^ '1'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1182
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1183
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1184
     Display protocolVersion
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1185
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1186
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1187
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1188
serverVendor
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1189
    "return the X-server vendor string - this should normally not be of
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1190
     any interest, but can be for special cases
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1191
     (to avoid bugs in certain implementations)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1192
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1193
    ^ 'microsoft'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1194
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1195
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1196
     Display serverVendor
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1197
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1198
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1199
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1200
shiftMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1201
    "return the state-mask for the SHIFT modified in motion events' state-field."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1202
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1203
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1204
    RETURN (__MKSMALLINT(ShiftMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1205
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1206
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1207
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1208
translatePoint:aPoint from:windowId1 to:windowId2
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1209
    "given a point in window1, return the coordinate in window2.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1210
     This expects a device coordinate (relative to the first views origin)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1211
     in aPoint and returns a device coordinate relative to the 2nd views origin.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1212
     - use to xlate points from a window to rootwindow"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1213
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1214
    |x1 y1 x2 y2|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1215
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1216
    x1 := x2 := aPoint x truncated.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1217
    y1 := y2 := aPoint y truncated.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1218
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1219
    int xpos, ypos;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1220
    HWND w1, w2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1221
    RECT srcRect, dstRect;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1222
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1223
    if (__isExternalAddress(windowId1)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1224
     && __isExternalAddress(windowId2)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1225
     && __bothSmallInteger(x1, y1)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1226
	w1 = _HWNDVal(windowId1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1227
	w2 = _HWNDVal(windowId2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1228
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1229
	GetWindowRect(w1, &srcRect);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1230
	GetWindowRect(w2, &dstRect);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1231
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1232
printf("srcRect: %d/%d -> %d/%d   dstRect: %d/%d -> %d/%d\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1233
    srcRect.left, srcRect.top, srcRect.right, srcRect.bottom,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1234
    dstRect.left, dstRect.top, dstRect.right, dstRect.bottom);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1235
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1236
	xpos = srcRect.left - dstRect.left + __intVal(x1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1237
	ypos = srcRect.top - dstRect.top + __intVal(y1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1238
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1239
	x2 = __MKSMALLINT(xpos);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1240
	y2 = __MKSMALLINT(ypos);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1241
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1242
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1243
'translated ' print. aPoint print. ' from ' print. windowId1 address print.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1244
' -> ' print. (x2@y2) print. ' in ' print. windowId2 address printCR.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1245
    ^ (x2 @ y2)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1246
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1247
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1248
vendorRelease
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1249
    "return the X-servers vendor release - should normally not be of
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1250
     any interest, but can be for special cases.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1251
     (to avoid bugs in certain implementations)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1252
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1253
    ^ 1
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1254
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1255
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1256
     Display vendorRelease
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1257
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1258
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1259
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1260
whitepixel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1261
    "return the colornumber of white"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1262
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1263
    ^ whitepixel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1264
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1265
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1266
!WinWorkstation methodsFor:'accessing display capabilities'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1267
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1268
iconSizes
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1269
    "Get the preferred/supported icon sizes."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1270
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1271
    |d|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1272
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1273
    d := IdentityDictionary new.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1274
    d at:#minWidth put:32.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1275
    d at:#maxWidth put:32.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1276
    d at:#widthStep put:1.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1277
    d at:#minHeight put:32.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1278
    d at:#maxHeight put:32.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1279
    d at:#heightStep put:1.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1280
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1281
    ^ OrderedCollection with:d
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1282
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1283
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1284
     Display iconSizes
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1285
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1286
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1287
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1288
supportsIconViews
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1289
    "return true, if this device supports views as icons.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1290
     Only Xservers (currently) support this."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1291
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1292
    ^ true
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1293
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1294
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1295
     Display supportsIconViews 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1296
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1297
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1298
    "Modified: 10.6.1996 / 20:11:48 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1299
    "Created: 10.6.1996 / 21:08:18 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1300
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1301
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1302
!WinWorkstation methodsFor:'bitmap/window creation'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1303
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1304
createBitmapFromArray:anArray width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1305
    |bitmapId|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1306
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1307
    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1308
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1309
    bitmapId isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1310
	'WINWORKSTATION: cannot create bitmap' errorPrintCR.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1311
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1312
    ^ bitmapId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1313
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1314
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1315
createBitmapWidth:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1316
    "allocate a bitmap on the Xserver, the contents is undefined
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1317
     (i.e. random). Return a bitmap id or nil"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1318
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1319
%{  /* NOCONTEXT */
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1320
    HANDLE newBitmapHandle;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1321
    int b_width, b_height;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1322
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1323
    if (__bothSmallInteger(w, h)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1324
	b_width = __intVal(w);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1325
	b_height = __intVal(h);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1326
	newBitmapHandle = CreateBitmap(b_width, b_height, 1, 1, NULL);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1327
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1328
	DPRINTF(("empty bitmap handle = %x\n", newBitmapHandle));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1329
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1330
	RETURN ( (newBitmapHandle != NULL) ? __MKOBJ(newBitmapHandle) : nil );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1331
    }
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1332
%}.
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1333
    "/ invalid (non-smallInteger) arguments
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1334
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1335
    self primitiveFailed.
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1336
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1337
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1338
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1339
createPixmapWidth:w height:h depth:d
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1340
    "allocate a pixmap on the Xserver, the contents is undefined
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1341
     (i.e. random). Return a bitmap id or nil"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1342
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1343
%{  /* NOCONTEXT */
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1344
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1345
    HANDLE newBitmapHandle;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1346
 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1347
    if (__bothSmallInteger(w, h) && ISCONNECTED) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1348
	newBitmapHandle = CreateBitmap(__intVal(w), __intVal(h), 1, 16, NULL );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1349
#ifdef COUNT_RESOURCES
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1350
	if (newBitmapHandle)
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1351
	    __cnt_bitmap++;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1352
#endif
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1353
	RETURN ( (newBitmapHandle != NULL) ? __MKOBJ(newBitmapHandle) : nil );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1354
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1355
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1356
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1357
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1358
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1359
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1360
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1361
    "will vanish - for compatibility with previous versions"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1362
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1363
    ^ self 
1467
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1364
	createWindowFor:aView 
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1365
	type:nil
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1366
	origin:(xpos @ ypos)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1367
	extent:(wwidth @ wheight)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1368
	minExtent:(aView minExtent)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1369
	maxExtent:(aView maxExtent)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1370
	borderWidth:(aView borderWidth)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1371
	subViewOf:(aView superView)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1372
	onTop:(aView isPopUpView)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1373
	inputOnly:(aView isInputOnly)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1374
	label:(aView label)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1375
	cursor:(aView cursor)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1376
	icon:(aView icon)
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1377
	iconView:(aView iconView)
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1378
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1379
    "Modified: 1.6.1996 / 13:22:48 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1380
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1381
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1382
createWindowFor:aView
1418
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1383
                 origin:origin
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1384
                 extent:extent
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1385
                 minExtent:minExt 
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1386
                 maxExtent:maxExt
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1387
                 borderWidth:bWidth
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1388
                 subViewOf:wsuperView
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1389
                 onTop:wisPopUpView
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1390
                 inputOnly:winputOnly
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1391
                 label:wlabel
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1392
                 cursor:wcursor
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1393
                 icon:wicon
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1394
                 iconView:wiconView
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1395
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1396
    ^ self
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1397
	createWindowFor:aView
1467
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1398
	type:nil
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1399
        origin:origin
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1400
        extent:extent
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1401
        minExtent:minExt 
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1402
        maxExtent:maxExt
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1403
        borderWidth:bWidth
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1404
        subViewOf:wsuperView
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1405
        onTop:wisPopUpView
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1406
        inputOnly:winputOnly
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1407
        label:wlabel
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1408
        cursor:wcursor
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1409
        icon:wicon 
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1410
	iconMask:nil
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1411
        iconView:wiconView
1418
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1412
!
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1413
1467
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  1414
createWindowFor:aView type:typeSymbol
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1415
		 origin:origin
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1416
		 extent:extent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1417
		 minExtent:minExt 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1418
		 maxExtent:maxExt
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1419
		 borderWidth:bWidth
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1420
		 subViewOf:wsuperView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1421
		 onTop:wisPopUpView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1422
		 inputOnly:winputOnly
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1423
		 label:wlabel
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1424
		 cursor:wcursor
1418
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1425
		 icon:wicon 
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1426
	         iconMask:wiconMask
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1427
		 iconView:wiconView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1428
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1429
    |xpos ypos wwidth wheight minWidth minHeight maxWidth maxHeight 
1418
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1430
     bColorId wsuperViewId wcursorId wiconId wiconMaskId windowId
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1431
     weventMask wiconViewId bitGravity viewGravity vBgColor
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1432
     vBgForm deepForm preferredVisual preferredDepth wiconHeight 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1433
     wiconWidth|
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1434
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1435
    displayId isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1436
	self primitiveFailed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1437
	^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1438
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1439
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1440
    origin notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1441
	xpos := origin x.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1442
	ypos := origin y.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1443
    ] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1444
	xpos := ypos := 0.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1445
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1446
    extent notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1447
	wwidth := extent x.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1448
	wheight := extent y.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1449
    ] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1450
	wwidth := wheight := 100.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1451
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1452
    minExt notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1453
	minWidth := minExt x.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1454
	minHeight := minExt y
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1455
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1456
    maxExt notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1457
	maxWidth := maxExt x.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1458
	maxHeight := maxExt y
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1459
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1460
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1461
    wsuperView notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1462
	wsuperViewId := wsuperView id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1463
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1464
    wcursor isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1465
	'XWORKSTATION: cursor nil - defaulted' errorPrintNL
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1466
    ] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1467
	wcursorId := wcursor id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1468
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1469
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1470
    wicon notNil ifTrue:[
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1471
	wiconId := wicon id.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1472
	wiconHeight := wicon height.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1473
	wiconWidth  := wicon width.
1418
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1474
	wiconMask notNil ifTrue:[
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1475
	    wiconMaskId := wiconMask id
d21112d621a1 prepared for iconMasks
Claus Gittinger <cg@exept.de>
parents: 1416
diff changeset
  1476
	]
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1477
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1478
    wiconView notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1479
	wiconViewId := wiconView id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1480
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1481
    weventMask := aView eventMask.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1482
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1483
%{  /* STACK:16000 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1484
    extern void *__getHInstance(), *__getHPrevInstance();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1485
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1486
    WNDCLASS wc;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1487
    long bg, bd, bw;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1488
    int winStyle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1489
    int w, h, x, y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1490
    int ncW, ncH;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1491
    int min_width, min_height;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1492
    int max_width, max_height;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1493
    HANDLE parentHandle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1494
    HANDLE newWinHandle;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1495
    char *windowName = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1496
    int isTopWindow = 0;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1497
    int     iconFlag = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1498
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1499
    unsigned char* cp;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1500
    unsigned char* ep;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1501
    HBITMAP        xBitMap;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1502
    int            height, width;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1503
    int            nBytes, nBits;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1504
    int		   index;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1505
    HICON          xIcon;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1506
    
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1507
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1508
    bg = WhitePixel;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1509
    bd = BlackPixel;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1510
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1511
    /* get bitmap for icon */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1512
    if(  __isExternalAddress(wiconId) )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1513
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1514
	xBitMap = _HBITMAPVAL( wiconId );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1515
	if( xBitMap != 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1516
	{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1517
	    height = __intVal( wiconHeight );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1518
	    width  = __intVal( wiconWidth  );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1519
	    nBytes = height * 2 * ( width + 15 ) / 16;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1520
	    if( nBytes != 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1521
	    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1522
		cp = (unsigned char *) malloc(nBytes);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1523
		ep = (unsigned char *) malloc(nBytes);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1524
		if( ( cp != 0 ) && ( ep != 0 ) )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1525
		{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1526
		    for( index = 0; index < nBytes; index++ )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1527
			*ep++ = 0x00;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1528
	   	    nBits = GetBitmapBits( xBitMap, nBytes, cp );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1529
		    xIcon = CreateIcon( (HANDLE) __getHInstance(),
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1530
					width,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1531
					height,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1532
					1,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1533
					1,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1534
					ep,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1535
					cp );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1536
		    if( xIcon != 0 ) 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1537
			iconFlag = 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1538
		}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1539
		else
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1540
		{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1541
		    DPRINTF(( " malloc failed\n" ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1542
		}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1543
	    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1544
	    else
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1545
	    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1546
		DPRINTF(( " nBytes is zero \n" ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1547
	    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1548
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1549
	else
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1550
	{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1551
	    DPRINTF((" xBitMap is zero \n" ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1552
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1553
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1554
    else
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1555
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1556
	DPRINTF((" wiconId is not an external address\n"));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1557
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1558
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1559
    if (firstInstance) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1560
	DPRINTF(("first create - registerClass\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1561
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1562
	hInstance = (HANDLE) __getHInstance();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1563
	hPrevInstance = (HANDLE) __getHPrevInstance();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1564
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1565
	wc.style = /* CS_HREDRAW | CS_VREDRAW |*/ CS_OWNDC | CS_DBLCLKS;
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1566
	wc.lpfnWndProc = (WNDPROC) MainWndProc;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1567
	wc.cbClsExtra = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1568
	wc.cbWndExtra = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1569
	wc.hInstance = hInstance;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1570
	if( iconFlag != 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1571
	{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1572
		wc.hIcon   = xIcon;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1573
		/* wc.hIconSm = wiconId; */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1574
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1575
	else	wc.hIcon = LoadIcon(NULL, IDI_APPLICATION);
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1576
	wc.hCursor = LoadCursor(NULL, IDC_ARROW);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1577
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1578
	wc.hbrBackground = CreateSolidBrush (bg);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1579
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1580
	wc.lpszMenuName =  NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1581
	wc.lpszClassName = app_name;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1582
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1583
	if (!RegisterClass(&wc)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1584
	    DPRINTF(("RegisterClass failed\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1585
/*            return NULL;     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1586
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1587
	firstInstance = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1588
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1589
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1590
    if (__bothSmallInteger(wwidth, wheight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1591
	w = __intVal(wwidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1592
	h = __intVal(wheight);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1593
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1594
	w = h = 100;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1595
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1596
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1597
    if (__bothSmallInteger(xpos, ypos)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1598
	x = __intVal(xpos);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1599
	y = __intVal(ypos);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1600
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1601
	x = y = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1602
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1603
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1604
    if (__bothSmallInteger(minWidth, minHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1605
	min_width = __intVal(minWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1606
	min_height = __intVal(minHeight);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1607
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1608
	min_width = min_height = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1609
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1610
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1611
    if (__bothSmallInteger(maxWidth, maxHeight)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1612
	max_width = __intVal(maxWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1613
	max_height = __intVal(maxHeight);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1614
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1615
	max_width = max_height = 10000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1616
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1617
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1618
    winStyle = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1619
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1620
    if (__isSmallInteger(bWidth)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1621
	bw = __intVal(bWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1622
	if (bw) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1623
	    winStyle |= WS_BORDER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1624
	    bw = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1625
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1626
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1627
	bw = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1628
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1629
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1630
    if (__isExternalAddress(wsuperViewId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1631
	/* 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1632
	 * a child window
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1633
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1634
	parentHandle = _HANDLEVal(wsuperViewId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1635
	winStyle |= WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1636
	DPRINTF(("parent handle=%x\n", parentHandle));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1637
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1638
	create_topView = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1639
	ncW = bw * 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1640
	ncH = bw * 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1641
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1642
	/* 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1643
	 * a top window
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1644
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1645
	parentHandle = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1646
	isTopWindow = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1647
	DPRINTF(("topview\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1648
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1649
	create_topView = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1650
	create_minWidth = min_width;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1651
	create_maxWidth = max_width;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1652
	create_minHeight = min_height;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1653
	create_maxHeight = max_height;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1654
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1655
	winStyle |= WS_CLIPCHILDREN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1656
	if (wisPopUpView == true) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1657
	    winStyle |= WS_POPUP;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1658
	    ncW = bw * 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1659
	    ncH = bw * 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1660
	} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1661
	    winStyle |= WS_OVERLAPPEDWINDOW;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1662
	    ncW = __intVal(__INST(resizeFrameWidth));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1663
	    ncH = 32 + 4 + 4; /* __intVal(__INST(resizeFrameHeight)) */;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1664
DPRINTF(("fW=%d fH=%d\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1665
	    __intVal(__INST(resizeFrameWidth)),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1666
	    __intVal(__INST(resizeFrameHeight)) ));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1667
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1668
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1669
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1670
    DPRINTF(("create%s pos==%d/%d size=%d/%d bw=%d ...\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1671
		(wisPopUpView ? " popUp" : ""), x, y, w, h, bw));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1672
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1673
    __inCreate = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1674
    newWinHandle = CreateWindow(app_name, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1675
				"",     /* window class name */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1676
				winStyle,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1677
				x, y,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1678
				w + ncW, h + ncH,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1679
				parentHandle,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1680
				NULL, hInstance, NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1681
    __inCreate = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1682
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1683
    DPRINTF(("handle = %x\n", newWinHandle));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1684
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1685
    if (! newWinHandle) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1686
	RETURN ( nil );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1687
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1688
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1689
    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1690
     * define its icon and name
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1691
     * (only makes sense for topWindows)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1692
     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1693
    if (isTopWindow) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1694
	if (__isString(wlabel) || __isSymbol(wlabel)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1695
	    windowName = (char *) __stringVal(wlabel);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1696
	    DPRINTF(("title = %s\n", windowName));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1697
	    (void) SetWindowText(newWinHandle, windowName);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1698
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1699
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1700
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1701
    windowId = __MKOBJ(newWinHandle);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1702
    DPRINTF(("done - create\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1703
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1704
    self addKnownView:aView withId:windowId.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1705
    ^ windowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1706
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1707
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1708
destroyGC:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1709
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1710
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1711
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1712
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1713
	if (gcData->hDC) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1714
	    DeleteDC(gcData->hDC);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1715
	    gcData->hDC = (HDC)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1716
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1717
	if (gcData->hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1718
	    DeleteObject(gcData->hPen);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1719
	    gcData->hPen = (HPEN)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1720
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1721
	if (gcData->hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1722
	    DeleteObject(gcData->hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1723
	    gcData->hBrush = (HPEN)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1724
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1725
	free(gcData);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1726
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1727
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1728
    ^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1729
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1730
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1731
destroyPixmap:aDrawableId
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1732
%{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1733
    if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1734
	HANDLE bitmapHandle = _HANDLEVal(aDrawableId);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1735
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1736
	if (bitmapHandle) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1737
	    DeleteObject(bitmapHandle);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1738
#ifdef COUNT_RESOURCES
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1739
	    __cnt_bitmap--;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1740
#endif
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1741
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1742
	RETURN ( self );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1743
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1744
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1745
    "/ invalid argument or not yet opened
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1746
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1747
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1748
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1749
destroyView:aView withId:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1750
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1751
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1752
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1753
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1754
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1755
	    DestroyWindow(win);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1756
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1757
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1758
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1759
    self removeKnownView:aView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1760
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1761
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1762
gcFor:aDrawableId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1763
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1764
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1765
    HDC dc;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1766
    struct gcData *gcData;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1767
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1768
    if (__isExternalAddress(aDrawableId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1769
	dc = GetDC(_HWNDVal(aDrawableId));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1770
	if (! dc) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1771
	    RETURN (nil);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1772
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1773
	gcData = (struct gcData *)malloc(sizeof(struct gcData));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1774
	if (! gcData) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1775
	    RETURN (nil);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1776
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1777
	gcData->hDC = dc;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1778
	gcData->hPen = (HPEN)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1779
	gcData->hBrush = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1780
	gcData->fgColor = (COLORREF)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1781
	gcData->bgColor = (COLORREF)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1782
	gcData->brushType = BR_SOLID;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1783
	gcData->lineWidth = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1784
	gcData->lineStyle = PS_SOLID;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1785
	gcData->joinStyle = PS_JOIN_MITER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1786
	gcData->capStyle = PS_ENDCAP_FLAT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1787
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1788
	RETURN ( __MKOBJ(gcData) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1789
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1790
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1791
    self primitiveFailed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1792
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1793
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1794
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1795
gcForBitmap:aDrawableId
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1796
%{  /* NOCONTEXT */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1797
    HDC dc;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1798
    HDC rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1799
    struct gcData *gcData;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1800
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1801
    if (__isExternalAddress(aDrawableId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1802
	rootDC = __rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1803
	dc = CreateCompatibleDC(rootDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1804
	if (! dc) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1805
	    RETURN (nil);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1806
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1807
	gcData = (struct gcData *)malloc(sizeof(struct gcData));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1808
	if (! gcData) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1809
	    RETURN (nil);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1810
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1811
	gcData->hDC = dc;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1812
	gcData->hPen = (HPEN)0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1813
	gcData->hBrush = (HBRUSH)0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1814
	gcData->fgColor = (COLORREF)0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1815
	gcData->bgColor = (COLORREF)0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1816
	gcData->brushType = BR_SOLID;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1817
	gcData->lineWidth = 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1818
	gcData->lineStyle = PS_SOLID;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1819
	gcData->joinStyle = PS_JOIN_MITER;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1820
	gcData->capStyle = PS_ENDCAP_FLAT;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1821
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1822
	RETURN ( __MKOBJ(gcData) );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1823
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1824
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1825
    self primitiveFailed.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1826
    ^ nil
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1827
!
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1828
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1829
primCreateBitmapFromArray:anArray width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1830
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1831
%{  /* UNLIMITEDSTACK */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1832
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1833
    HBITMAP newBitmapHandle;
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1834
    unsigned char fastBits[10000];
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1835
    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1836
    int row, col;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1837
    unsigned char *cp, *bPits;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1838
    unsigned char *b_bits, *allocatedBits;
1137
6c416c419909 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1136
diff changeset
  1839
    unsigned char *pBits;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1840
    int index;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1841
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1842
    if (! ISCONNECTED) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1843
	RETURN (nil);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1844
    }
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1845
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1846
    if (__bothSmallInteger(w, h) && _isNonNilObject(anArray)) {
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1847
	b_width = __intVal(w);
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1848
	b_height = __intVal(h);
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1849
	bytesPerRowST = (b_width + 7) / 8;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1850
	bytesPerRowWN = (b_width + 15) / 16 * 2;
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1851
	padding = bytesPerRowWN - bytesPerRowST;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1852
	nBytes = b_height * bytesPerRowWN;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1853
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1854
	if (nBytes < sizeof(fastBits)) {
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1855
	    cp = b_bits = fastBits;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1856
	    allocatedBits = 0;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1857
	} else {
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1858
	    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1859
	    if (! cp) goto fail;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1860
	}
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1861
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1862
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1863
	if (__qClass(anArray) == @global(Array)) {
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1864
DPRINTF(("Array not supported\n"));
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1865
	    goto fail;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1866
	} else {
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1867
	    if (__qClass(anArray) == @global(ByteArray)) {
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1868
		pBits = __ByteArrayInstPtr(anArray)->ba_element;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1869
		for (row = b_height; row; row--) {
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1870
		    for (col = bytesPerRowST; col; col--) { 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1871
			*cp++ = ( *pBits++ ^ 0xFF );
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1872
		    }
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1873
		    cp += padding; 
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1874
		}
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1875
	    } else {
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1876
DPRINTF(("not a ByteArray\n"));
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1877
		goto fail;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1878
	    }
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1879
	}
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1880
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1881
	DPRINTF(("create bitmap ...\n"));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1882
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1883
	newBitmapHandle = CreateBitmap(b_width, b_height,       
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1884
				       1, 1, b_bits );
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1885
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1886
fail: ;
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1887
	if (allocatedBits)
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1888
	    free(allocatedBits);
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1889
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1890
	RETURN ( (newBitmapHandle != NULL) ? __MKOBJ(newBitmapHandle) : nil );
1136
0b22805c0fd0 bitmap creation
Claus Gittinger <cg@exept.de>
parents: 1127
diff changeset
  1891
    }
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1892
    DPRINTF(("returning nil ...\n"));
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1893
    RETURN ( nil );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1894
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1895
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1896
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1897
rootWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1898
    "return the id of the root window.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1899
     This is the window you see as background, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1900
     however, it may or may not be the real physical root window,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1901
     since some window managers install a virtual root window on top
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1902
     of the real one. If this is the case, that views id is returned here."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1903
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1904
    ^ rootWin
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1905
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1906
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1907
!WinWorkstation methodsFor:'color stuff'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1908
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1909
colorRed:redVal green:greenVal blue:blueVal
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1910
    "allocate a color with rgb values (0..100) - return the color index (i.e. colorID).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1911
     This method is obsoleted by #colorScaledRed:scaledGreen:scaledBlue:"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1912
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1913
    |r g b|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1914
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1915
    r := self percentToDeviceColorValue:redVal.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1916
    g := self percentToDeviceColorValue:greenVal.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1917
    b := self percentToDeviceColorValue:blueVal.
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1918
    ^ self colorScaledRed:r scaledGreen:g scaledBlue:b
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1919
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1920
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1921
colorScaledRed:r scaledGreen:g scaledBlue:b
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1922
    "allocate a color with rgb values (0..16rFFFF) - return the color index 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1923
     (i.e. colorID)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1924
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1925
    int id, ir, ig, ib;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1926
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1927
    if (__bothSmallInteger(r, g) 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1928
     && __isSmallInteger(b)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1929
	ir = __intVal(r) >> 8;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1930
	ig = __intVal(g) >> 8;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1931
	ib = __intVal(b) >> 8;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1932
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1933
	id = RGB ( ir, ig, ib);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1934
	DDPRINTF(("alloc color %d/%d/%d -> %x\n", ir, ig, ib, id));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1935
	RETURN ( __MKSMALLINT(id) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1936
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1937
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1938
    self primitiveFailed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1939
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1940
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1941
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1942
freeColor:colorIndex
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1943
    "free a display color when its no longer needed"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1944
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1945
    ^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1946
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1947
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1948
getRGBFrom:index into:aBlock
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1949
    "get rgb components (0..100) of color in map at:index,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1950
     and evaluate the 3-arg block, aBlock with them"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1951
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1952
    |val|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1953
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1954
    self getScaledRGBFrom:index into:[:r :g :b |
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1955
	val := aBlock 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1956
		value:(r * 100.0 / 16rFFFF)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1957
		value:(g * 100.0 / 16rFFFF)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1958
		value:(b * 100.0 / 16rFFFF)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1959
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1960
    ^ val
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1961
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1962
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1963
getScaledRGBFrom:index into:aBlock
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1964
    "get rgb components (0 .. 16rFFFF) of color in map at:index,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1965
     and evaluate the 3-arg block, aBlock with them"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1966
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1967
    |r g b|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1968
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1969
    int id = __intVal(index);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1970
    int iR, iG, iB;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1971
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1972
    if (__INST(usingSystemPalette) == true) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1973
	r = g = b = __MKSMALLINT(0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1974
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1975
	iR = id & 0xFF;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1976
	iG = (id >> 8) & 0xFF;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1977
	iB = (id >> 16) & 0xFF;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1978
	iR = (iR << 8) | iR;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1979
	iG = (iG << 8) | iG;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1980
	iB = (iB << 8) | iB;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1981
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1982
	r = __MKSMALLINT(iR);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1983
	g = __MKSMALLINT(iG);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1984
	b = __MKSMALLINT(iB);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1985
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1986
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1987
    ^ aBlock value:r value:g value:b
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1988
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1989
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  1990
percentToDeviceColorValue:aPercentage
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1991
    "given a color-component value in percent (0..100), return the corresponding
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1992
     WIN-component value (0..16rFFFF) as an integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1993
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1994
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1995
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1996
    if (__isSmallInteger(aPercentage)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1997
	RETURN ( __MKSMALLINT(0xFFFF * __intVal(aPercentage) / 100) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1998
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  1999
    if (__isFloat(aPercentage)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2000
	RETURN ( __MKSMALLINT(0xFFFF * (int)(__floatVal(aPercentage)) / 100) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2001
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2002
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2003
    ^ (16rFFFF * aPercentage / 100) rounded
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2004
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2005
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2006
!WinWorkstation methodsFor:'cursor stuff'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2007
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2008
createCursorShape:aShape
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2009
    "create a cursor given a shape-symbol"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2010
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2011
    |number id|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2012
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2013
    number := self shapeNumberFromSymbol:aShape.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2014
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2015
    HCURSOR newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2016
    LPCTSTR cId;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2017
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2018
    if (__isSmallInteger(number)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2019
	cId = (LPCTSTR)(__intVal(number));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2020
	newCursor = LoadCursor(NULL, cId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2021
	if (newCursor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2022
	    if (cId == IDC_ARROW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2023
		H_C_ARROW = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2024
	    else if (cId == IDC_CROSS)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2025
		H_C_CROSS = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2026
	    else if (cId == IDC_IBEAM)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2027
		H_C_IBEAM = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2028
	    else if (cId == IDC_ICON)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2029
		H_C_ICON = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2030
	    else if (cId == IDC_NO)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2031
		H_C_NO = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2032
	    else if (cId == IDC_SIZE)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2033
		H_C_SIZE = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2034
	    else if (cId == IDC_SIZEALL)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2035
		H_C_SIZEALL = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2036
	    else if (cId == IDC_SIZENESW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2037
		H_C_SIZENESW = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2038
	    else if (cId == IDC_SIZENS)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2039
		H_C_SIZENS = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2040
	    else if (cId == IDC_SIZENWSE)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2041
		H_C_SIZENWSE = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2042
	    else if (cId == IDC_UPARROW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2043
		H_C_UPARROW = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2044
	    else if (cId == IDC_WAIT)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2045
		H_C_WAIT = newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2046
        
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2047
	    id = __MKOBJ(newCursor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2048
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2049
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2050
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2051
    ^ id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2052
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2053
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2054
createCursorSourceForm:sourceBytes maskForm:maskBytes hotX:hx hotY:hy width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2055
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2056
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2057
    |id|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2058
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2059
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2060
    HCURSOR newCursor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2061
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2062
    if (__isByteArray(sourceBytes)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2063
     && __isByteArray(maskBytes)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2064
     && __bothSmallInteger(hx, hy)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2065
     && __bothSmallInteger(w, h)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2066
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2067
	newCursor = CreateCursor(hInstance,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2068
				 __intVal(hx), __intVal(hy),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2069
				 __intVal(w), __intVal(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2070
				__ByteArrayInstPtr(maskBytes)->ba_element,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2071
				__ByteArrayInstPtr(sourceBytes)->ba_element);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2072
	if (newCursor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2073
	    id = __MKOBJ(newCursor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2074
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2075
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2076
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2077
    ^ id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2078
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2079
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2080
destroyCursor:aCursorId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2081
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2082
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2083
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2084
    if (ISCONNECTED) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2085
	if (__isExternalAddress(aCursorId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2086
	    HCURSOR curs = _HCURSORVal(aCursorId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2087
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2088
	    if (curs) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2089
		if ((curs != H_C_ARROW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2090
		 && (curs != H_C_CROSS)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2091
		 && (curs != H_C_IBEAM)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2092
		 && (curs != H_C_ICON)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2093
		 && (curs != H_C_NO)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2094
		 && (curs != H_C_SIZE)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2095
		 && (curs != H_C_SIZEALL)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2096
		 && (curs != H_C_SIZENESW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2097
		 && (curs != H_C_SIZENS)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2098
		 && (curs != H_C_SIZENWSE)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2099
		 && (curs != H_C_UPARROW)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2100
		 && (curs != H_C_WAIT)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2101
		    DestroyCursor(curs);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2102
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2103
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2104
	    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2105
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2106
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2107
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2108
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2109
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2110
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2111
needDeviceFormsForCursor
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2112
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2113
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2114
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2115
shapeNumberFromSymbol:shape
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2116
    "given a shape-symbol, return the corresponding cursor-number,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2117
     or nil if no such standard cursor exists."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2118
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2119
    "this is pure Win-knowlegde - but you may easily add more"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2120
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2121
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2122
    if (shape == @symbol(upLeftArrow)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2123
	RETURN ( __MKSMALLINT( (INT)IDC_ARROW));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2124
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2125
    if (shape == @symbol(upDownArrow)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2126
	RETURN ( __MKSMALLINT( (INT)IDC_SIZENS));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2127
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2128
    if (shape == @symbol(leftRightArrow)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2129
	RETURN ( __MKSMALLINT( (INT)IDC_SIZEWE));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2130
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2131
    if (shape == @symbol(text)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2132
	RETURN ( __MKSMALLINT( (INT)IDC_IBEAM));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2133
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2134
    if (shape == @symbol(wait)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2135
	RETURN ( __MKSMALLINT( (INT)IDC_WAIT));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2136
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2137
    if (shape == @symbol(crossHair)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2138
	RETURN ( __MKSMALLINT( (INT)IDC_CROSS));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2139
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2140
    if (shape == @symbol(fourWay)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2141
	RETURN ( __MKSMALLINT( (INT)IDC_SIZE));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2142
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2143
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2144
"/    ('WINWORKSTATION: invalid cursorShape:' , shape printString) infoPrintNL.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2145
    ^  nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2146
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2147
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2148
!WinWorkstation methodsFor:'drawing'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2149
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2150
copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2151
		width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2152
    "do a bit-blt; copy bits from the rectangle defined by
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2153
     srcX/srcY and w/h from the sourceId drawable to the rectangle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2154
     below dstX/dstY in the destId drawable. Trigger an error if any
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2155
     argument is not integer."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2156
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2157
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2158
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2159
    HDC srcDC, dstDC;
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2160
    HDC rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2161
    int deleteSrcDC =0,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2162
	deleteDstDC = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2163
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2164
    if (__isExternalAddress(srcGCId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2165
	srcDC = _HDCVal(srcGCId);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2166
printf("srcDC = %x\n", srcDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2167
    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2168
	if (__isExternalAddress(sourceId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2169
	    rootDC = __rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2170
	    srcDC = CreateCompatibleDC(rootDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2171
	    SelectObject(srcDC, _HWNDVal(sourceId));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2172
	    deleteSrcDC = 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2173
printf("created srcDC = %x\n", srcDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2174
	} else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2175
	    goto fail;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2176
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2177
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2178
    if (! srcDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2179
	goto fail;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2180
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2181
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2182
    if (__isExternalAddress(dstGCId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2183
	dstDC = _HDCVal(dstGCId);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2184
printf("dstDC = %x\n", dstDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2185
    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2186
	if (__isExternalAddress(destId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2187
	    rootDC = __rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2188
	    dstDC = CreateCompatibleDC(rootDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2189
	    SelectObject(dstDC, _HWNDVal(destId));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2190
	    deleteDstDC = 1;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2191
printf("created dstDC = %x\n", dstDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2192
	} else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2193
	    goto fail;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2194
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2195
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2196
    if (! dstDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2197
	goto fail;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2198
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2199
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2200
    if (__bothSmallInteger(w, h)
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2201
     && __bothSmallInteger(srcX, srcY)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2202
     && __bothSmallInteger(dstX, dstY)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2203
        
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2204
	BitBlt(dstDC, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2205
	       __intVal(dstX), __intVal(dstY),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2206
	       __intVal(w), __intVal(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2207
	       srcDC,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2208
	       __intVal(srcX), __intVal(srcY),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2209
	       SRCCOPY);
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2210
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2211
	if (deleteDstDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2212
	    DeleteObject(dstDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2213
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2214
	if (deleteSrcDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2215
	    DeleteObject(srcDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2216
	}
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2217
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2218
    }
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2219
 fail: ;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2220
    if (deleteDstDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2221
	DeleteObject(dstDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2222
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2223
    if (deleteSrcDC) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2224
	DeleteObject(srcDC);
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2225
    }
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2226
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2227
    "badGC, bad sourceDrawableId or destDrawableID
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2228
     or any non integer coordinate"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2229
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2230
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2231
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2232
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2233
copyPlaneFromId:sourceId x:srcX y:srcY gc:srcDCId to:destId x:dstX y:dstY gc:dstDCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2234
		width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2235
    "do a bit-blt, but only copy the low-bit plane; 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2236
     copy bits from the rectangle defined by
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2237
     srcX/srcY and w/h from the sourceId drawable to the rectangle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2238
     below dstX/dstY in the destId drawable. Trigger an error if any
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2239
     argument is not integer."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2240
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2241
    ^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2242
	copyFromId:sourceId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2243
		 x:srcX y:srcY gc:srcDCId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2244
		to:destId x:dstX y:dstY gc:dstDCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2245
	     width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2246
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2247
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2248
displayArcX:x y:y width:width height:height from:startAngle angle:angle in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2249
    "draw an arc. If any of x,y, w or h is not an integer, an error is triggered.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2250
     The angles may be floats or integer - they are given in degrees."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2251
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2252
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2253
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2254
    int w, h, angle1, angle2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2255
    double f;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2256
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2257
    if (__isSmallInteger(startAngle))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2258
	angle1 = __intVal(startAngle) * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2259
    else if (__isFloat(startAngle)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2260
	f = __floatVal(startAngle);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2261
	angle1 = f * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2262
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2263
    if (__isSmallInteger(angle))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2264
	angle2 = __intVal(angle) * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2265
    else if (__isFloat(angle)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2266
	f = __floatVal(angle);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2267
	angle2 = f * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2268
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2269
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2270
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2271
     && __bothSmallInteger(x, y)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2272
     && __bothSmallInteger(width, height)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2273
	w = __intVal(width);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2274
	h = __intVal(height);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2275
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2276
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2277
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2278
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2279
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2280
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2281
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2282
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2283
    "draw a line. If the coordinates are not integers, an error is triggered." 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2284
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2285
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2286
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2287
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2288
     && __bothSmallInteger(x0, y0)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2289
     && __bothSmallInteger(x1, y1)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2290
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2291
	HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2292
	HBRUSH hBrush;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2293
	HPEN hPen;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2294
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  2295
	/* DPRINTF(("displayLine: %d/%d -> %d/%d\n", __intVal(x0), __intVal(y0), __intVal(x1), __intVal(y1))); */
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2296
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2297
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2298
	hPen = gcData->hPen;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2299
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2300
	if (! hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2301
	    hPen = gcData->hPen = CreatePen(gcData->lineStyle,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2302
					    gcData->lineWidth,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2303
					    gcData->fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2304
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2305
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2306
	if (! hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2307
	    DPRINTF(("displayLine: no pen\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2308
	} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2309
	    MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2310
	    LineTo(hDC, __intVal(x1), __intVal(y1));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2311
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2312
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2313
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2314
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2315
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2316
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2317
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2318
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2319
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2320
displayPointX:x y:y in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2321
    "draw a point. If x/y are not integers, an error is triggered." 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2322
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2323
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2324
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2325
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2326
     && __bothSmallInteger(x, y)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2327
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2328
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2329
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2330
    "badGC, badDrawable or x/y not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2331
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2332
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2333
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2334
displayPolygon:aPolygon in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2335
    "draw a polygon, the argument aPolygon is a Collection of individual points, which
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2336
     define the polygon.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2337
     If any coordinate is not integer, an error is triggered."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2338
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2339
    |numberOfPoints newPoints|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2340
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2341
    numberOfPoints := aPolygon size.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2342
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2343
    OBJ point, x, y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2344
    int i, num;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2345
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2346
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2347
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2348
     && __isSmallInteger(numberOfPoints)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2349
	num = __intVal(numberOfPoints);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2350
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2351
	for (i=0; i<num; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2352
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2353
	    if (! __isPoint(point)) goto fail;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2354
	    x = _point_X(point);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2355
	    y = _point_Y(point);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2356
	    if (! __bothSmallInteger(x, y))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2357
		goto fail;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2358
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2359
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2360
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2361
fail: ;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2362
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2363
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2364
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2365
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2366
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2367
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2368
    "draw a rectangle. If the coordinates are not integers, an error is triggered." 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2369
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2370
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2371
    int w, h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2372
    int xL, yT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2373
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2374
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2375
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2376
     && __bothSmallInteger(x, y)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2377
     && __bothSmallInteger(width, height)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2378
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2379
	HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2380
	HBRUSH hBrush;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2381
	HPEN hPen;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2382
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2383
	xL = __intVal(x);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2384
	yT = __intVal(y);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2385
	w = __intVal(width);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2386
	h = __intVal(height);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2387
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2388
	DPRINTF(("displayRectangle: %d/%d -> %d/%d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2389
			xL, yT, w, h));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2390
	/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2391
	 * need this check here: some servers simply dump core with bad args
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2392
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2393
	if ((w >= 0) && (h >= 0)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2394
	    hPen = gcData->hPen;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2395
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2396
	    if (! hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2397
		hPen = gcData->hPen = CreatePen(gcData->lineStyle,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2398
						gcData->lineWidth,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2399
						gcData->fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2400
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2401
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2402
	    if (! hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2403
		DPRINTF(("displayRect: no pen\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2404
	    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2405
		MoveToEx(hDC, xL, yT, NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2406
		LineTo(hDC, xL+w-1, yT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2407
		LineTo(hDC, xL+w-1, yT+h-1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2408
		LineTo(hDC, xL, yT+h-1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2409
		LineTo(hDC, xL, yT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2410
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2411
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2412
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2413
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2414
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2415
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2416
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2417
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2418
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2419
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2420
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2421
     foreground and background characters.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2422
     If the coordinates are not integers, an error is triggered."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2423
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2424
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2425
    unsigned char *cp;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2426
    OBJ cls;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2427
    int  i1, i2, l, n;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2428
#   define NLOCALBUFFER 200
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2429
    short xlatebuffer[NLOCALBUFFER];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2430
    int nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2431
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2432
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2433
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2434
     && __isNonNilObject(aString)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2435
     && __bothSmallInteger(index1, index2)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2436
     && __bothSmallInteger(x, y)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2437
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2438
	int pX, pY;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2439
	HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2440
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2441
	hDC = gcData->hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2442
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2443
	pX = __intVal(x);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2444
	pY = __intVal(y);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2445
	pY -= gcData->fontAscent;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2446
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2447
	cls = __qClass(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2448
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2449
	i1 = __intVal(index1) - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2450
	if (i1 >= 0) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2451
	    i2 = __intVal(index2) - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2452
	    if (i2 < i1) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2453
		RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2454
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2455
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2456
	    cp = _stringVal(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2457
	    l = i2 - i1 + 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2458
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2459
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2460
		n = _stringSize(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2461
		if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2462
		    cp += i1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2463
		    if (l > 1000) l = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2464
DDPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2465
		    if (opaque == true) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2466
			SetBkMode(hDC, OPAQUE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2467
		    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2468
			SetBkMode(hDC, TRANSPARENT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2469
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2470
		    TextOut(hDC, pX, pY, (char *)cp, l);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2471
		    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2472
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2473
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2474
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2475
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2476
	    cp += nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2477
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2478
	    if (__isBytes(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2479
		n = __byteArraySize(aString) - nInstBytes - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2480
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2481
		if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2482
		    cp += i1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2483
		    if (l > 1000) l = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2484
DDPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2485
		    if (opaque == true) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2486
			SetBkMode(hDC, OPAQUE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2487
		    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2488
			SetBkMode(hDC, TRANSPARENT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2489
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2490
		    TextOut(hDC, pX, pY, (char *)cp, l);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2491
		    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2492
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2493
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2494
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2495
#ifdef NOTDEF 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2496
	    /* TWOBYTESTRINGS */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2497
	    if (__isWords(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2498
		n = (__byteArraySize(aString) - nInstBytes) / 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2499
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2500
		if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2501
		    union {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2502
			char b[2];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2503
			unsigned short s;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2504
		    } u;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2505
		    int i;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2506
		    XChar2b *cp2 = (XChar2b *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2507
		    int mustFree = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2508
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2509
		    cp += (i1 * 2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2510
		    if (l > 1000) l = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2511
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2512
		    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2513
		     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2514
		     * X expects them MSB first
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2515
		     * convert as required
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2516
		     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2517
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2518
		    u.s = 0x1234;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2519
		    if (u.b[0] != 0x12) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2520
			if (l <= NLOCALBUFFER) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2521
			    cp2 = xlatebuffer;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2522
			} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2523
			    cp2 = (XChar2b *)(malloc(l * 2));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2524
			    mustFree = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2525
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2526
			for (i=0; i<l; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2527
			    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2528
			    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2529
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2530
			cp = (char *) cp2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2531
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2532
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2533
		    if (opaque == true)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2534
			XDrawImageString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2535
		    else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2536
			XDrawString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2537
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2538
		    if (mustFree) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2539
			free(cp2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2540
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2541
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2542
		    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2543
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2544
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2545
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2546
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2547
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2548
#undef NLOCALBUFFER
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2549
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2550
    "x/y not integer, badGC or drawable, or not a string"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2551
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2552
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2553
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2554
xxxdisplayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2555
    "draw a string - if opaque is false, draw foreground only; otherwise, draw both
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2556
     foreground and background characters.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2557
     If the coordinates are not integers, an error is triggered."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2558
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2559
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2560
#ifdef NOTDEF
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2561
    GC gc;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2562
    Window win;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2563
    unsigned char *cp;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2564
    int n;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2565
    OBJ cls;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2566
#   define NLOCALBUFFER 200
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2567
    XChar2b xlatebuffer[NLOCALBUFFER];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2568
    int nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2569
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2570
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2571
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2572
     && __isNonNilObject(aString)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2573
     && __bothSmallInteger(x, y)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2574
	gc = _GCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2575
	win = _WindowVal(aDrawableId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2576
	cls = __qClass(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2577
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2578
	cp = _stringVal(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2579
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2580
	if ((cls == @global(String)) || (cls == @global(Symbol))) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2581
	    n = _stringSize(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2582
	    if (n > 1000) n = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2583
	    if (opaque == true)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2584
		XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2585
	    else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2586
		XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2587
	    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2588
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2589
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2590
	nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2591
	cp += nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2592
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2593
	if (__isBytes(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2594
	    n = __byteArraySize(aString) - nInstBytes - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2595
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2596
	    if (n > 1000) n = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2597
	    if (opaque == true)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2598
		XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2599
	    else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2600
		XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2601
	    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2602
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2603
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2604
	/* TWOBYTESTRINGS */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2605
	if (__isWords(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2606
	    union {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2607
		char b[2];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2608
		unsigned short s;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2609
	    } u;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2610
	    int i;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2611
	    XChar2b *cp2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2612
	    int mustFree = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2613
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2614
	    n = (__byteArraySize(aString) - nInstBytes) / 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2615
	    if (n > 1000) n = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2616
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2617
	    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2618
	     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2619
	     * X expects them MSB first
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2620
	     * convert as required
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2621
	     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2622
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2623
	    u.s = 0x1234;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2624
	    if (u.b[0] != 0x12) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2625
		if (n <= NLOCALBUFFER) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2626
		    cp2 = xlatebuffer;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2627
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2628
		    cp2 = (XChar2b *)(malloc(n * 2));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2629
		    mustFree = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2630
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2631
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2632
		for (i=0; i<n; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2633
		    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2634
		    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2635
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2636
		cp = (char *) cp2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2637
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2638
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2639
	    if (opaque == true)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2640
		XDrawImageString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2641
	    else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2642
		XDrawString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2643
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2644
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2645
	    if (mustFree) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2646
		free(cp2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2647
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2648
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2649
	    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2650
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2651
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2652
#undef NLOCALBUFFER
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2653
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2654
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2655
    "x/y not integer, badGC or drawable, or not a string"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2656
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2657
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2658
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2659
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2660
			  width:imageWidth height:imageHeight 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2661
			      x:srcx y:srcy
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2662
			   into:aDrawableId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2663
			      x:dstx y:dsty 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2664
			  width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2665
			   with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2666
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2667
    "draw a bitImage which has depth id, width iw and height ih into
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2668
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2669
     Individual source pixels have bitsPerPixel bits, allowing to draw
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2670
     depth and pixel-units to be different.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2671
     It has to be checked elsewhere, that the server can do it with the given
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2672
     depth - otherwise, primitive failure will be signalled.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2673
     Also it is assumed, that the colormap is setup correctly and the
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2674
     colors are allocated - otherwise the colors may be wrong."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2675
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2676
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2677
     sorry; I had to separate it into 2 methods, since XPutImage needs
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2678
     an unlimited stack, and thus cannot send primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2679
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2680
    (self primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2681
					width:imageWidth height:imageHeight 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2682
					     x:srcx y:srcy
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2683
					  into:aDrawableId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2684
					     x:dstx y:dsty 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2685
					 width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2686
					  with:aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2687
    ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2688
	"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2689
	 also happens, if a segmentation violation occurs in the 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2690
	 XPutImage ...
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2691
	"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2692
	self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2693
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2694
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2695
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2696
drawBits:imageBits depth:imageDepth 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2697
		   width:imageWidth height:imageHeight 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2698
		       x:srcx y:srcy
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2699
		    into:aDrawableId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2700
		       x:dstx y:dsty 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2701
		   width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2702
		    with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2703
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2704
    "draw a bitImage which has depth id, width iw and height ih into
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2705
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2706
     Individual source pixels must have imageDepth bits.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2707
     It has to be checked elsewhere, that the server can do it with the given
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2708
     depth - otherwise, primitive failure will be signalled.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2709
     Also it is assumed, that the colormap is setup correctly and the
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2710
     colors are allocated - otherwise the colors may be wrong."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2711
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2712
    ^ self drawBits:imageBits bitsPerPixel:imageDepth depth:imageDepth 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2713
				     width:imageWidth height:imageHeight 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2714
					 x:srcx y:srcy
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2715
				      into:aDrawableId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2716
					 x:dstx y:dsty 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2717
				     width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2718
				      with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2719
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2720
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2721
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2722
fillArcX:x y:y width:width height:height from:startAngle angle:angle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2723
	       in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2724
    "fill an arc. If any coordinate is not integer, an error is triggered.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2725
     The angles may be floats or integer - they are given in degrees."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2726
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2727
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2728
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2729
    int w, h, angle1, angle2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2730
    double f;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2731
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2732
    if (__isSmallInteger(startAngle))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2733
	angle1 = __intVal(startAngle) * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2734
    else if (__isFloat(startAngle)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2735
	f = __floatVal(startAngle);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2736
	angle1 = f * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2737
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2738
    if (__isSmallInteger(angle))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2739
	angle2 = __intVal(angle) * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2740
    else if (__isFloat(angle)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2741
	f = __floatVal(angle);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2742
	angle2 = f * 64;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2743
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2744
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2745
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2746
     && __bothSmallInteger(x, y)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2747
     && __bothSmallInteger(width, height)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2748
	w = __intVal(width);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2749
	h = __intVal(height);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2750
	/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2751
	 * need this check here: some servers simply dump core with bad args
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2752
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2753
	if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2754
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2755
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2756
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2757
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2758
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2759
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2760
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2761
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2762
fillPolygon:aPolygon in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2763
    "fill a polygon given by its points. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2764
     If any coordinate is not integer, an error is triggered."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2765
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2766
    |numberOfPoints|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2767
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2768
    numberOfPoints := aPolygon size.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2769
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2770
    OBJ point, x, y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2771
    int i, num;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2772
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2773
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2774
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2775
     && __isSmallInteger(numberOfPoints)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2776
	num = __intVal(numberOfPoints);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2777
	if (num < 3) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2778
	    RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2779
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2780
	for (i=0; i<num; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2781
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2782
	    if (! __isPoint(point)) goto fail;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2783
	    x = _point_X(point);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2784
	    y = _point_Y(point);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2785
	    if (! __bothSmallInteger(x, y))
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2786
		goto fail;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2787
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2788
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2789
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2790
fail: ;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2791
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2792
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2793
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2794
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2795
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2796
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2797
fillRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2798
    "fill a rectangle. If any coordinate is not integer, an error is triggered."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2799
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2800
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2801
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2802
    int w, h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2803
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2804
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2805
     && __isExternalAddress(aDrawableId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2806
     && __bothSmallInteger(x, y)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2807
     && __bothSmallInteger(width, height)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2808
	w = __intVal(width);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2809
	h = __intVal(height);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2810
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2811
	DDPRINTF(("fillRect %d/%d -> %d/%d\n", __intVal(x), __intVal(y), w, h));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2812
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2813
	/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2814
	 * need this check here: some servers simply dump core with bad args
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2815
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2816
	if ((w >= 0) && (h >= 0)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2817
	    struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2818
	    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2819
	    HBRUSH hBrush;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2820
	    RECT rct;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2821
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2822
	    hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2823
	    hBrush = gcData->hBrush;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2824
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2825
	    if (! hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2826
		hBrush = gcData->hBrush = CreateSolidBrush(gcData->fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2827
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2828
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2829
	    if (! hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2830
		DPRINTF(("fillRectangle: no brush\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2831
	    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2832
		rct.left = __intVal(x);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2833
		rct.top = __intVal(y);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2834
		rct.right = rct.left + w; /* FillRect excludes right/bottom */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2835
		rct.bottom = rct.top + h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2836
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2837
		FillRect(hDC, &rct, hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2838
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2839
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2840
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2841
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2842
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2843
    "badGC, badDrawable or coordinates not integer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2844
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2845
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2846
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2847
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2848
			      width:imageWidth height:imageHeight 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2849
				  x:srcx y:srcy
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2850
			       into:aDrawableId 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2851
				  x:dstx y:dsty 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2852
			      width:w height:h 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2853
			       with:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2854
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2855
    "since XPutImage may allocate huge amount of stack space 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2856
     (some implementations use alloca), this must run with unlimited stack."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2857
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2858
%{  /* UNLIMITEDSTACK */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2859
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2860
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2861
fail: ;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2862
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2863
.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2864
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2865
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2866
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2867
!WinWorkstation methodsFor:'win32 event handling'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2868
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2869
clearX:x y:y width:w height:h view:aView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2870
    "erase part of a view to its background color"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2871
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2872
    |oldPaint|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2873
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2874
    oldPaint := aView paint.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2875
    aView paint:(aView viewBackground).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2876
    aView fillRectangleX:x y:y width:w height:h.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2877
    aView paint:oldPaint
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2878
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2879
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2880
!WinWorkstation methodsFor:'event handling'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2881
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2882
dispatchEventFor:aViewIdOrNil withMask:eventMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2883
    "central event handling method:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2884
     get next event and send appropriate message to the sensor or view.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2885
     If the argument aViewIdOrNil is nil, events for any view are processed,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2886
     otherwise only events for the view with given id are processed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2887
     If the argument aMask is nonNil, only events for this eventMask are
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2888
     handled."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2889
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2890
    (self getEventFor:aViewIdOrNil withMask:eventMask) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2891
	AbortSignal catch:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2892
	    self dispatchLastEvent.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2893
	]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2894
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2895
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2896
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2897
dispatchExposeEventFor:aViewIdOrNil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2898
    "get next expose event and send appropriate message to the sensor or view.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2899
     If the argument aViewIdOrNil is nil, events for any view are processed,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2900
     otherwise only events for the view with given id are processed."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2901
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2902
    self dispatchEventFor:aViewIdOrNil withMask:(self eventMaskFor:#expose)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2903
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2904
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2905
dispatchLastEvent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2906
    |theView symS arg butt sibling windowID siblingID propertyID selectionID targetID requestorID
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2907
     eventType|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2908
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2909
%{  /* STACK: 8000 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2910
    struct queuedEvent *ev;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2911
    struct inlineCache *ipS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2912
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2913
    static struct inlineCache vid = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2914
    static struct inlineCache confS = _ILC5;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2915
    static struct inlineCache skpS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2916
    static struct inlineCache skrS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2917
    static struct inlineCache expS = _ILC5;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2918
    static struct inlineCache clrS = _ILC5;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2919
    static struct inlineCache bpS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2920
    static struct inlineCache brS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2921
    static struct inlineCache bmpS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2922
    static struct inlineCache bspS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2923
    static struct inlineCache motS = _ILC4;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2924
    static struct inlineCache unmapS = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2925
    static struct inlineCache mapS = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2926
    static struct inlineCache destrS = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2927
    static struct inlineCache focOutS = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2928
    static struct inlineCache focInS = _ILC1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2929
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2930
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2931
    int x, y, w, h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2932
    int keyCode, modifiers, isDoubleClick = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2933
    int isDown = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2934
    int state;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2935
    OBJ upDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2936
    char nameBuffer[100];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2937
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2938
    DDPRINTF(("dispatchLast\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2939
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2940
    ev = deqEvent();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2941
    if (! ev) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2942
	DPRINTF(("no event in dispatchEvent\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2943
	RETURN (false);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2944
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2945
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2946
    if (ev->ev_hWnd) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2947
	windowID = __MKOBJ(ev->ev_hWnd);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2948
	theView = (*vid.ilc_func)(self, @symbol(viewFromId:), nil, &vid, windowID);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2949
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2950
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2951
    if (theView == nil) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2952
	DPRINTF(("nil view [hWnd=%x] in dispatchEvent\n", ev->ev_hWnd));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2953
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2954
	freeEvent(ev);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2955
	RETURN (false);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2956
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2957
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2958
    if (ev) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2959
	switch (ev->ev_message) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2960
	    case WM_WINDOWPOSCHANGED:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2961
		DPRINTF(("got WM_WINDOWPOSCHANGED -> configureX:y:width:height:view:\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2962
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2963
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2964
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2965
		w = ev->ev_w;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2966
		h = ev->ev_h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2967
		freeEvent(ev); ev = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2968
		(*confS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2969
			     @symbol(configureX:y:width:height:view:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2970
			     nil, &confS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2971
			     __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2972
			     __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2973
			     __MKSMALLINT(w),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2974
			     __MKSMALLINT(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2975
			     theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2976
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2977
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2978
	    case WM_SHOWWINDOW:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2979
		if (ev->ev_wParam == TRUE) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2980
		    DPRINTF(("got WM_SHOWWINDOW -> mappedView:\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2981
		    (*mapS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2982
				     @symbol(mappedView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2983
				     nil, &mapS, theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2984
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2985
		    DPRINTF(("got WM_SHOWWINDOW -> unMappedView:\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2986
		    (*unmapS.ilc_func)(self, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2987
				       @symbol(unmappedView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2988
				       nil, &unmapS, theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2989
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2990
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2991
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2992
	    case WM_DESTROY:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2993
		DPRINTF(("got WM_DESTROY -> destroyedView\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2994
		(*destrS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2995
				   @symbol(destroyedView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2996
				   nil, &destrS, theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2997
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2998
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  2999
	    case WM_ACTIVATE:
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3000
		DPRINTF(("got WM_ACTIVATE h=%x\n", ev->ev_hWnd));
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3001
		switch (LOWORD(ev->ev_wParam)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3002
		    case WA_INACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3003
			(*focOutS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3004
					    @symbol(focusOutView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3005
					    nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3006
					    &focOutS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3007
					    theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3008
			break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3009
		    case WA_ACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3010
		    case WA_CLICKACTIVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3011
			(*focInS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3012
					   @symbol(focusInView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3013
					   nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3014
					   &focInS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3015
					   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3016
			break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3017
		    default:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3018
			break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3019
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3020
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3021
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3022
	    case WM_MOUSEACTIVATE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3023
		(*focInS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3024
				   @symbol(focusInView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3025
				   nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3026
				   &focInS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3027
				   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3028
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3029
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3030
	    case WM_SETFOCUS:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3031
		(*focInS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3032
				   @symbol(focusInView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3033
				   nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3034
				   &focInS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3035
				   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3036
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3037
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3038
	    case WM_KILLFOCUS:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3039
		(*focOutS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3040
				   @symbol(focusOutView:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3041
				   nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3042
				   &focOutS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3043
				   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3044
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3045
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3046
	    case WM_ERASEBKGND:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3047
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3048
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3049
		w = ev->ev_w;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3050
		h = ev->ev_h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3051
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3052
		DPRINTF(("WM_ERASEBK -> clear %d/%d -> %d/%d\n", x, y, w, h));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3053
		(*clrS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3054
			 @symbol(clearX:y:width:height:view:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3055
			 nil, &clrS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3056
			 __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3057
			 __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3058
			 __MKSMALLINT(w),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3059
			 __MKSMALLINT(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3060
			 theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3061
		goto expose;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3062
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3063
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3064
	    case WM_PAINT:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3065
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3066
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3067
		w = ev->ev_w;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3068
		h = ev->ev_h;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3069
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3070
	    expose:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3071
		DPRINTF(("WM_PAINT -> expose %d/%d -> %d/%d\n", x, y, w, h));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3072
		(*expS.ilc_func)(self,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3073
			 @symbol(exposeX:y:width:height:view:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3074
			 nil, &expS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3075
			 __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3076
			 __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3077
			 __MKSMALLINT(w),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3078
			 __MKSMALLINT(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3079
			 theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3080
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3081
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3082
	    case WM_LBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3083
		isDoubleClick = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3084
		butt = __MKSMALLINT(1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3085
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3086
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3087
	    case WM_LBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3088
		isDown = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3089
		butt = __MKSMALLINT(1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3090
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3091
                
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3092
	    case WM_LBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3093
		butt = __MKSMALLINT(1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3094
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3095
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3096
	    case WM_MBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3097
		isDoubleClick = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3098
		butt = __MKSMALLINT(2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3099
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3100
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3101
	    case WM_MBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3102
		isDown = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3103
		butt = __MKSMALLINT(2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3104
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3105
                
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3106
	    case WM_MBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3107
		butt = __MKSMALLINT(2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3108
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3109
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3110
	    case WM_RBUTTONDBLCLK:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3111
		isDoubleClick = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3112
		butt = __MKSMALLINT(3);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3113
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3114
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3115
	    case WM_RBUTTONUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3116
		isDown = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3117
		butt = __MKSMALLINT(3);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3118
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3119
                
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3120
	    case WM_RBUTTONDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3121
		butt = __MKSMALLINT(3);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3122
		goto commonButtonDown;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3123
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3124
	    commonButtonDown:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3125
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3126
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3127
		modifiers = ev->ev_modifiers;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3128
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3129
		if (isDown) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3130
		    buttonWindow = ev->ev_hWnd;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3131
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3132
		    buttonWindow = (HWND)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3133
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3134
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3135
		if (__INST(buttonTranslation) != nil) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3136
		    butt = __AT_(__INST(buttonTranslation), butt);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3137
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3138
		arg = butt;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3139
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3140
		__INST(altDown) = (modifiers & AltMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3141
		__INST(metaDown) = (modifiers & MetaMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3142
		__INST(shiftDown) = (modifiers & ShiftMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3143
		__INST(ctrlDown) = (modifiers & ControlMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3144
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3145
		freeEvent(ev); ev = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3146
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3147
		if (isDoubleClick) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3148
		    ipS = &bmpS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3149
		    symS = @symbol(buttonMultiPress:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3150
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3151
		    if (isDown) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3152
			if (modifiers & ShiftMask) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3153
			    ipS = &bspS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3154
			    symS = @symbol(buttonShiftPress:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3155
			} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3156
			    ipS = &bpS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3157
			    symS = @symbol(buttonPress:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3158
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3159
		    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3160
			ipS = &brS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3161
			symS = @symbol(buttonRelease:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3162
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3163
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3164
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3165
		if (__isSymbol(arg)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3166
		    DPRINTF(("buttonPress/buttonRelease: %s %d/%d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3167
				__stringVal(arg), x, y));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3168
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3169
		    DPRINTF(("buttonPress/buttonRelease: %d %d/%d\n", 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3170
				__intVal(arg), x, y));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3171
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3172
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3173
		(*(*ipS).ilc_func)(self, symS, nil, ipS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3174
				   arg,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3175
				   __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3176
				   __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3177
				   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3178
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3179
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3180
	    case WM_MOUSEMOVE:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3181
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3182
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3183
		state = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3184
		if (ev->ev_wParam & MK_CONTROL)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3185
		    state |= ControlMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3186
		if (ev->ev_wParam & MK_LBUTTON)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3187
		    state |= Button1Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3188
		if (ev->ev_wParam & MK_MBUTTON)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3189
		    state |= Button2Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3190
		if (ev->ev_wParam & MK_RBUTTON)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3191
		    state |= Button3Mask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3192
		if (ev->ev_wParam & MK_SHIFT)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3193
		    state |= ShiftMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3194
		DPRINTF(("buttonMotion: %d/%d\n", x, y));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3195
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3196
#ifdef NOTDEF
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3197
		if (buttonWindow) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3198
		    if (buttonWindow != ev->ev_hWnd) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3199
			/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3200
			 * translate for window, where button was pressed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3201
			 * originally (X motion semantics)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3202
			 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3203
			{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3204
			    POINT p;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3205
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3206
			    p.x = x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3207
			    p.y = y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3208
			    MapWindowPoints(ev->ev_hWnd, buttonWindow, &p, 1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3209
			    x = p.x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3210
			    y = p.y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3211
			    DPRINTF(("xlated to %d/%d for %x\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3212
					x, y, buttonWindow));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3213
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3214
			windowID = __MKOBJ(buttonWindow);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3215
			theView = (*vid.ilc_func)(self, @symbol(viewFromId:), 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3216
						  nil, &vid, windowID);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3217
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3218
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3219
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3220
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3221
		(*motS.ilc_func)(self, @symbol(buttonMotion:x:y:view:),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3222
				    nil, &motS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3223
				    __MKSMALLINT(state),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3224
				    __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3225
				    __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3226
				    theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3227
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3228
                
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3229
	    case WM_CHAR:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3230
		symS = @symbol(keyPress:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3231
		ipS = &skpS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3232
		upDown = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3233
		goto keyPressAndRelease;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3234
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3235
	    case WM_SYSKEYUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3236
	    case WM_KEYUP:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3237
		symS = @symbol(keyRelease:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3238
		ipS = &skrS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3239
		upDown = false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3240
		goto keyPressAndRelease;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3241
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3242
	    case WM_SYSKEYDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3243
	    case WM_KEYDOWN:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3244
		symS = @symbol(keyPress:x:y:view:);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3245
		ipS = &skpS;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3246
		upDown = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3247
		/* FALL INTO */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3248
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3249
	    keyPressAndRelease: ;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3250
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3251
		x = ev->ev_x;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3252
		y = ev->ev_y;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3253
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3254
#ifdef NOTDEF
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3255
		{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3256
		    BYTE vKeyState[256];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3257
		    char buff[5];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3258
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3259
`                   GetKeyboardState(vKeyState);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3260
		    ToAscii(ev->ev_keyCode, ev->ev_scanCode, vKeyState, &buff; 0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3261
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3262
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3263
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3264
		keyCode = ev->ev_keyCode;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3265
		modifiers = ev->ev_modifiers;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3266
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3267
		if (modifiers & TRANSLATED_KEY) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3268
		    if (modifiers & ControlMask) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3269
			if (keyCode < 0x20) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3270
			    keyCode = keyCode + 'a' - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3271
			    if (modifiers & ShiftMask) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3272
				keyCode = keyCode - 'a' + 'A';
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3273
			    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3274
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3275
		    } else if (modifiers & (MetaMask | AltMask)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3276
			if (! (modifiers & ShiftMask)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3277
			    if ((keyCode >= 'A') && (keyCode <= 'Z')) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3278
				keyCode = keyCode - 'A' + 'a';
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3279
			    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3280
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3281
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3282
		    arg = __MKCHARACTER(keyCode & 0xFF);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3283
		} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3284
		    switch (keyCode) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3285
			case '\t':
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3286
			    arg = @symbol(Tab);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3287
			    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3288
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3289
			case '\b':
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3290
			    arg = @symbol(BackSpace);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3291
			    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3292
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3293
			case '\r':
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3294
			    arg = @symbol(Return);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3295
			    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3296
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3297
			case 0x1b:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3298
			    arg = @symbol(Escape);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3299
			    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3300
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3301
			default:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3302
			    nameBuffer[0] = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3303
			    GetKeyNameText(ev->ev_scanCode, nameBuffer, sizeof(nameBuffer));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3304
			    DPRINTF(("char is <%s>\n", nameBuffer));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3305
			    if (strlen(nameBuffer) == 1) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3306
				arg = __MKCHARACTER(keyCode & 0xFF);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3307
			    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3308
				arg = __MKSYMBOL(nameBuffer);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3309
			    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3310
			    break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3311
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3312
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3313
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3314
		DPRINTF(("%s: code=%x mod=%x\n", __stringVal(symS),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3315
				keyCode, modifiers));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3316
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3317
		__INST(altDown) = (modifiers & AltMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3318
		__INST(metaDown) = (modifiers & MetaMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3319
		__INST(shiftDown) = (modifiers & ShiftMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3320
		__INST(ctrlDown) = (modifiers & ControlMask) ? true : false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3321
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3322
		freeEvent(ev); ev = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3323
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3324
		(*(*ipS).ilc_func)(self, symS, nil, ipS,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3325
				   arg,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3326
				   __MKSMALLINT(x),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3327
				   __MKSMALLINT(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3328
				   theView);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3329
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3330
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3331
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3332
	    default:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3333
		DPRINTF(("unhandled event: %x\n", ev->ev_message));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3334
		break;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3335
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3336
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3337
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3338
    if (ev) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3339
	freeEvent(ev);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3340
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3341
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3342
    ^ true
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3343
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3344
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3345
dispatchPendingEvents
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3346
    "central event handling method for modal operation.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3347
     (i.e. this is now only used in the modal debugger)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3348
     This code is somewhat special, since X has a concept of graphic
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3349
     expose events (which are sent after a bitblt). After such a bitblt,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3350
     we only handle exposes until the graphicsExpose arrives.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3351
     Other systems may not need such a kludge"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3352
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3353
    [self eventPendingWithSync:false] whileTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3354
	self dispatchEventFor:nil withMask:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3355
    ]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3356
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3357
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3358
disposeEventsWithMask:aMask for:aWindowIdOrNil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3359
    "dispose (throw away) specific events. If aWindowId is nil,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3360
     events matching the mask are thrown away regardless of which
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3361
     view they are for. Otherwise, only matching events for that 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3362
     view are flushed."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3363
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3364
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3365
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3366
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3367
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3368
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3369
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3370
eventMaskFor:anEventSymbol
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3371
    "return the eventMask bit-constant corresponding to an event symbol"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3372
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3373
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3374
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3375
    int m = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3376
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3377
#ifdef NOTDEF
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3378
    if (anEventSymbol == @symbol(keyPress)) m = KeyPressMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3379
    else if (anEventSymbol == @symbol(keyRelease)) m = KeyReleaseMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3380
    else if (anEventSymbol == @symbol(buttonPress)) m = ButtonPressMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3381
    else if (anEventSymbol == @symbol(buttonRelease)) m = ButtonReleaseMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3382
    else if (anEventSymbol == @symbol(buttonMotion)) m = ButtonMotionMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3383
    else if (anEventSymbol == @symbol(pointerMotion)) m = PointerMotionMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3384
    else if (anEventSymbol == @symbol(expose)) m = ExposureMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3385
    else if (anEventSymbol == @symbol(focusChange)) m = FocusChangeMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3386
    else if (anEventSymbol == @symbol(enter)) m = EnterWindowMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3387
    else if (anEventSymbol == @symbol(leave)) m = LeaveWindowMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3388
    else if (anEventSymbol == @symbol(keymapState)) m = KeymapStateMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3389
    else if (anEventSymbol == @symbol(visibilityChange)) m = VisibilityChangeMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3390
    else if (anEventSymbol == @symbol(structureNotify)) m = StructureNotifyMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3391
    else if (anEventSymbol == @symbol(resizeRedirect)) m = ResizeRedirectMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3392
    else if (anEventSymbol == @symbol(propertyChange)) m = PropertyChangeMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3393
    else if (anEventSymbol == @symbol(colormapChange)) m = ColormapChangeMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3394
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3395
    RETURN (__MKSMALLINT(m));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3396
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3397
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3398
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3399
eventPending
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3400
    "return true, if any event is pending. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3401
     This looks for both the internal queue and the display connection."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3402
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3403
    ^ self eventPendingWithSync:false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3404
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3405
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3406
eventPending:anEventSymbol for:aWindowIdOrNil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3407
    "return true, if a specific event is pending"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3408
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3409
    ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil withSync:false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3410
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3411
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3412
eventPendingWithSync:doSync
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3413
    "return true, if any event is pending. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3414
     If doSync is true, do a sync output buffer before checking
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3415
     (i.e. send all to the display and wait until its processed)."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3416
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3417
%{  /* UNLIMITEDSTACK */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3418
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3419
    DDPRINTF(("peek\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3420
    getAllWinEvents();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3421
    if (eventQueueHead) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3422
	DDPRINTF(("peek - true\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3423
	RETURN (true);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3424
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3425
    DDPRINTF(("peek - false\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3426
    RETURN ( false );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3427
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3428
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3429
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3430
eventQueued
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3431
    "return true, if any event is queued"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3432
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3433
    ^ self eventQueuedAlready
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3434
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3435
    "Created: 12.12.1995 / 21:43:00 / stefan"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3436
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3437
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3438
eventQueuedAlready
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3439
    "return true, if any event is queued internally.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3440
     (i.e. in X's internal event queue, which is both filled by explicit
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3441
      nextEvent calls AND whenever drawing is done and events are pending on
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3442
      the display connection)."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3443
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3444
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3445
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3446
    DDPRINTF(("peek q - "));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3447
    if (eventQueueHead) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3448
	DDPRINTF(("true\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3449
	RETURN (true);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3450
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3451
    DDPRINTF(("false\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3452
    RETURN ( false );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3453
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3454
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3455
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3456
eventsPending:anEventMask for:aWindowIdOrNil withSync:doSync
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3457
    "return true, if any of the masked events is pending"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3458
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3459
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3460
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3461
    getAllWinEvents();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3462
    DPRINTF(("peek mask %x - false\n", __intVal(anEventMask)));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3463
    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3464
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3465
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3466
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3467
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3468
exposeEventPendingFor:aWindowIdOrNil withSync:doSync
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3469
    "return true, if any expose event is pending for a specific view,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3470
     or any view (if the arg is nil).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3471
     This is an X specific, only required after a scroll operation."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3472
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3473
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3474
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3475
    getAllWinEvents();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3476
    DPRINTF(("peek view - false\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3477
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3478
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3479
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3480
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3481
getEventFor:aViewIdOrNil withMask:eventMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3482
    "read next event - put into local eventBuffer. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3483
     If aViewIdOrNil is nil, events for any view are fetched; 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3484
     otherwise only events for that specific view will be fetched.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3485
     Returns true, if there was an event, false otherwise."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3486
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3487
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3488
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3489
    getAllWinEvents();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3490
    if (eventQueueHead) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3491
	/* no need to copy into buffer */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3492
	DDPRINTF(("get event - true\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3493
	RETURN (true);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3494
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3495
    DPRINTF(("get event - false\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3496
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3497
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3498
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3499
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3500
handleAllEvents
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3501
    "from now on, handle any kind of event"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3502
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3503
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3504
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3505
handleExposeOnlyFor:aView
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3506
    "from now on, handle expose events only"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3507
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3508
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3509
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3510
mappingChanged:what event:eB
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3511
    "One of Keyboard-, Modifier- or PointerMap has change, probably by xmodmap.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3512
     Tell xlib about the fact."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3513
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3514
    (what == #mappingKeyboard or:[what == #mappingModifier]) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3515
	self refreshKeyboardMapping:eB.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3516
	"Maybe some of our modifiers have been changed"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3517
	self initializeModifierMappings.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3518
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3519
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3520
    "Created: 1.12.1995 / 16:28:23 / stefan"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3521
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3522
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3523
setEventMask:aMask in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3524
    "tell X that we are only interested in events from aMask, which
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3525
     is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3526
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3527
    ^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3528
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3529
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3530
!WinWorkstation methodsFor:'event sending'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3531
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3532
sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3533
    "send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3534
     TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3535
     For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3536
     for key events, it can be either a symbol (as listen in X's keySyms)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3537
     or a numeric keysym code. If state is nil, the modifier bits (shift & control)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3538
     are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3539
     The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3540
     (not very user friendly)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3541
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3542
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3543
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3544
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3545
simulateKeyboardInput:aCharacterOrString inViewId:viewId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3546
    "send input to some other view, by simulating keyPress/keyRelease
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3547
     events. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3548
     Only a few control characters are supported.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3549
     Notice: not all alien views allow this kind of synthetic input;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3550
	     some simply ignore it."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3551
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3552
    |control code state|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3553
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3554
    aCharacterOrString isString ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3555
	aCharacterOrString do:[:char |
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3556
	    self simulateKeyboardInput:char inViewId:viewId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3557
	].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3558
	^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3559
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3560
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3561
    control := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3562
    code := aCharacterOrString asciiValue.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3563
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3564
    (aCharacterOrString == Character cr) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3565
	code := #Return
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3566
    ] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3567
	(aCharacterOrString == Character tab) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3568
	    code := #Tab 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3569
	] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3570
	    (aCharacterOrString == Character esc) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3571
		code := #Escape 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3572
	    ]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3573
	]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3574
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3575
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3576
    control ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3577
	state := self controlMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3578
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3579
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3580
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3581
    "/ the stuff below should not be needed 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3582
    "/ (sendKeyOrButtonevent should be able to figure out things itself)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3583
    "/ however, on some linux systems it seems to not work correctly.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3584
    "/ Hopefully, this is correct ...
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3585
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3586
    code isNumber ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3587
	code >= $A asciiValue ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3588
	    code <= $Z asciiValue ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3589
		state := self shiftMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3590
	    ]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3591
	]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3592
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3593
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3594
    self sendKeyOrButtonEvent:#keyPress x:0 y:0 keyOrButton:code state:state toViewId:viewId.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3595
    self sendKeyOrButtonEvent:#keyRelease x:0 y:0 keyOrButton:code state:state toViewId:viewId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3596
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3597
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3598
      sending input to some (possibly alien) view:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3599
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3600
      |point id|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3601
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3602
      point :=  Display pointFromUser.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3603
      id := Display viewIdFromPoint:point.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3604
      Display simulateKeyboardInput:'Hello_world' inViewId:id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3605
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3606
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3607
    "Modified: 11.6.1996 / 10:59:42 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3608
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3609
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3610
!WinWorkstation methodsFor:'font stuff'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3611
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3612
createFontFor:aFontName
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3613
    "a basic method for font allocation; this method allows
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3614
     any font to be aquired (even those not conforming to
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3615
     standard naming conventions, such as cursor, fixed or k14)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3616
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3617
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3618
    HGDIOBJ hFont;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3619
    char *fn;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3620
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3621
    if (__isString(aFontName)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3622
	fn = __stringVal(aFontName);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3623
	if (strcmp(fn, "fixed") == 0) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3624
	    hFont = GetStockObject(ANSI_FIXED_FONT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3625
	} else if (strcmp(fn, "variable") == 0) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3626
	    hFont = GetStockObject(ANSI_VAR_FONT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3627
	} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3628
	    hFont = (HGDIOBJ)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3629
	    hFont = GetStockObject(ANSI_FIXED_FONT);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3630
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3631
	if (hFont) {
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3632
	    DPRINTF(("createFontFor:aFontName: %s -> %x\n", fn, hFont));
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3633
	    RETURN ( __MKOBJ(hFont) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3634
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3635
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3636
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3637
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3638
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3639
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3640
fontsInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3641
    "return a set of all available font in aFamily/aFace/aStyle
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3642
     on this display.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3643
     On WinWorkStations there is curently no style or Face
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3644
     But only those matching filter (if nonNIl)."
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3645
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3646
    |allFonts fonts|
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3647
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3648
    allFonts := self listOfAvailableFonts.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3649
    allFonts isNil ifTrue:[^ nil].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3650
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3651
    fonts := Set new.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3652
    allFonts do:[:fntDescr |
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3653
	(aFamilyName sameAs:(fntDescr family)) ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3654
	    (filter isNil or:[filter value:fntDescr]) ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3655
		fonts add:fntDescr
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3656
	    ]
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3657
	]
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3658
    ].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3659
    ^ fonts
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3660
!
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3661
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3662
fontsInFamily:aFamilyName face:aFaceName filtering:filter
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3663
    "return a set of all available fonts in aFamily/aFace on this display.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3664
     On WinWorkStations there is curently Face
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3665
     But only thise matching filter (if nonNil)."
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3666
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3667
    |allFonts fonts|
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3668
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3669
    allFonts := self listOfAvailableFonts.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3670
    allFonts isNil ifTrue:[^ nil].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3671
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3672
    fonts := Set new.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3673
    allFonts do:[:fntDescr |
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3674
	(aFamilyName sameAs:(fntDescr family)) ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3675
	    (filter isNil or:[filter value:fntDescr]) ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3676
		fonts add:fntDescr
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3677
	    ]
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3678
	]
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3679
    ].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3680
    ^ fonts
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3681
!
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3682
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3683
fontMetricsOf:fontId into:aBlock
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3684
    "evaluate aBlock, passing a fonts metrics as arguments"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3685
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3686
    |encoding avgAscent avgDescent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3687
     maxAscent maxDescent minWidth maxWidth avgWidth|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3688
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3689
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3690
    HGDIOBJ hFont;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3691
    HGDIOBJ prevFont;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3692
    HDC rootDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3693
    TEXTMETRIC tmet;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3694
    int len;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3695
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3696
    if (ISCONNECTED) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3697
	if (__isExternalAddress(fontId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3698
	    hFont = _HGDIOBJVal(fontId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3699
	    /*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3700
	     * temporarily set this font in the root context
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3701
	     */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3702
	    rootDC = __rootDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3703
	    prevFont = SelectObject(rootDC, hFont);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3704
	    GetTextMetrics(rootDC, &tmet);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3705
	    SelectObject(rootDC, prevFont);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3706
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3707
	    avgAscent = __MKSMALLINT(tmet.tmAscent);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3708
	    avgDescent = __MKSMALLINT(tmet.tmDescent);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3709
	    maxAscent = __MKSMALLINT(tmet.tmAscent);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3710
	    maxDescent = __MKSMALLINT(tmet.tmDescent);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3711
	    minWidth = __MKSMALLINT(tmet.tmAveCharWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3712
	    maxWidth = __MKSMALLINT(tmet.tmMaxCharWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3713
	    avgWidth = __MKSMALLINT(tmet.tmAveCharWidth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3714
	    DPRINTF(("textMetrics h=%x  avgAsc=%d avgDesc=%d minW=%d maxW=%d avgW=%d\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3715
			hFont, tmet.tmAscent, tmet.tmDescent, tmet.tmAveCharWidth, tmet.tmMaxCharWidth,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3716
			tmet.tmAveCharWidth));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3717
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3718
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3719
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3720
    encoding := #iso8859.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3721
    aBlock value:encoding
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3722
	   value:avgAscent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3723
	   value:avgDescent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3724
	   value:maxAscent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3725
	   value:maxDescent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3726
	   value:minWidth
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3727
	   value:maxWidth
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3728
	   value:avgWidth
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3729
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3730
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3731
fullNameOf:aFontId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3732
    "the fonts fullName - this is very device specific and should only be
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3733
     used for user feed-back (for example: in the fontPanel).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3734
     If the display/font do not provide that info, return nil."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3735
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3736
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3737
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3738
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3739
getAvailableFontsMatching:pattern
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3740
    "return an Array filled with font names matching aPattern"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3741
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3742
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3743
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3744
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3745
getDefaultFont
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3746
    "return a default font id - used when class Font cannot
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3747
     find anything usable"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3748
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3749
     ^ self createFontFor:'fixed'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3750
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3751
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3752
getFontWithFamily:familyString face:faceString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3753
	    style:styleArgString size:sizeArg encoding:encodingSym
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3754
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3755
    "try to get the specified font, if not available, try next smaller
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3756
     font. Access to X-fonts by name is possible, by passing the X font name
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3757
     as family and the other parameters as nil. For example, the cursor font
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3758
     can be aquired that way."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3759
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3760
    |styleString theName theId xlatedStyle id spacing|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3761
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3762
    styleString := styleArgString.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3763
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3764
    "special: if face is nil, allow access to X-fonts"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3765
    faceString isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3766
	sizeArg notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3767
	    theName := familyString , '-' , sizeArg printString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3768
	] ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3769
	    theName := familyString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3770
	].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3771
	theName isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3772
	    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3773
	     mhmh - fall back to the default font
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3774
	    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3775
	    theName := 'fixed'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3776
	].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3777
	theId := self createFontFor:theName.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3778
	theId isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3779
	    theId := self getDefaultFont
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3780
	].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3781
	^ theId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3782
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3783
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3784
    "/ spacing other than 'normal' is contained as last component
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3785
    "/ in style
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3786
    styleString notNil ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3787
	((styleString endsWith:'-narrow') 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3788
	 or:[styleString endsWith:'-semicondensed']) ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3789
	    |i|
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3790
	    i := styleString lastIndexOf:$-.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3791
	    spacing := styleString copyFrom:(i+1).
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3792
	    styleString := styleString copyTo:(i-1).
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3793
	] ifFalse:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3794
	    spacing := 'normal'.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3795
	].
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3796
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3797
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3798
    xlatedStyle := styleString.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3799
    xlatedStyle notNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3800
	xlatedStyle := xlatedStyle first asString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3801
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3802
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3803
    id := self 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3804
	    getFontWithFoundry:'*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3805
	    family:familyString asLowercase
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3806
	    weight:faceString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3807
	    slant:xlatedStyle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3808
	    spacing:spacing
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3809
	    pixelSize:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3810
	    size:sizeArg 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3811
	    registry:encodingSym
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3812
	    encoding:'*'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3813
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3814
    id isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3815
	(encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3816
	    "/ too stupid: encodings come in both cases
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3817
	    "/ and X does not ignore case
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3818
	    "/
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3819
	    id := self 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3820
		    getFontWithFoundry:'*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3821
		    family:familyString asLowercase
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3822
		    weight:faceString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3823
		    slant:xlatedStyle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3824
		    spacing:spacing
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3825
		    pixelSize:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3826
		    size:sizeArg 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3827
		    registry:encodingSym asUppercase
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3828
		    encoding:'*'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3829
	    id isNil ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3830
		id := self 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3831
			getFontWithFoundry:'*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3832
			family:familyString asLowercase
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3833
			weight:faceString
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3834
			slant:xlatedStyle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3835
			spacing:spacing
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3836
			pixelSize:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3837
			size:sizeArg 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3838
			registry:encodingSym asLowercase
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3839
			encoding:'*'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3840
	    ]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3841
	]
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3842
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3843
    ^ id
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3844
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3845
    "Modified: 24.2.1996 / 22:37:24 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3846
    "Modified: 4.7.1996 / 11:38:47 / stefan"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3847
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3848
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3849
getFontWithFoundry:foundry family:family weight:weight
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3850
	      slant:slant spacing:spc pixelSize:pSize size:size 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3851
	      registry:registry encoding:encoding
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3852
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3853
    "get the specified font, if not available, return nil.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3854
     This is the new font creation method - all others will be changed to
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3855
     use this entry.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3856
     Individual attributes can be left empty (i.e. '') or nil to match any.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3857
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3858
     foundry: 'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3859
     family:  'helvetica' 'courier' 'times' ...
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3860
     weight:  'bold' 'medium' 'demi' ...
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3861
     slant:   'r(oman)' 'i(talic)' 'o(blique)'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3862
     spacing: 'narrow' 'normal' semicondensed' ... usually '*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3863
     pixelSize: 16,18 ... usually left empty
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3864
     size:      size in point (1/72th of an inch)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3865
     registry:  iso8859, sgi ... '*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3866
     encoding:  vendor specific encoding (usually '*')
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  3867
    "
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3868
    " 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3869
	Windows 95 allows the creation of a font with the following parameters
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3870
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3871
		nHeight
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3872
		nWidth
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3873
		nEscapement
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3874
		nOrientation
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3875
		fnWeight        FW_DONTCARE, FW_NORMAL, FW_MEDIUM, FW_BOLD, ...
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3876
		fdwItalic       TRUE or FALSE
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3877
		fdwUnderline    TRUE or FALSE
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3878
		fdwStrikeOut    TRUE or FALSE
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3879
		fdwCharSet      ANSI_CHARSET, UNICODE_, SYMBOL_, SHIFTJIS_,...
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3880
		fdwOutputPrecision      DEFAULT, STRING, CHAR, ...
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3881
		fdwClipPrecision        DEFAULT, CHAR, STROKE, MASK, ...
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3882
		fdwQuality      DEFAULT, DRAFT, or PROOF.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3883
		fdwPitchAndFamily
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3884
			DEFAULT, FIXED or VARIABLE pitch
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3885
			DECORATIVE, DONTCASE, MODERN, ROMAN, SCRIPT, or SWISS.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3886
		lpszFace
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3887
			Typeface Name
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3888
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3889
	These two above descriptions will be matched as follows:
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3890
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3891
		foundry - ignored
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3892
		family  - mapped to type face name.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3893
		weight  - mapped to fnWeight
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3894
		slant   - NOT USED INITIALLY  user for style
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3895
		spacing - NOT USED INITIALLY
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3896
		pixelSize - NOT USED INITIALLY
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3897
		size      - mapped to nHeight
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3898
		registry  - NOT USED INITIALLY
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3899
		encoding  - NOT USED INITIALLY used for dwType device, raster or truetype
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3900
	"
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3901
%{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3902
    HGDIOBJ hFont;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3903
    int  nHeight, nWidth, nEscapement, nOrientation;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3904
    char* work;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3905
    char* work2;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3906
    DWORD fnWeight;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3907
    DWORD fdwItalic;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3908
    DWORD fdwUnderline;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3909
    DWORD fdwStrikeOut;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3910
    DWORD fdwCharSet;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3911
    DWORD fdwOutputPrecision;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3912
    DWORD fdwClipPrecision;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3913
    DWORD fdwQuality;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3914
    DWORD fdwPitchAndFamily;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3915
    LPCTSTR lpszFace;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3916
    static char temp[33];
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3917
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3918
/* INITIALIZE */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3919
    strcpy( temp, "                           " );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3920
    lpszFace = &temp[0];
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3921
    strcpy( lpszFace, "NULL" );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3922
    nHeight  = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3923
    nWidth   = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3924
    nEscapement = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3925
    nOrientation = 0;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3926
    fnWeight = FW_NORMAL;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3927
    fdwItalic = FALSE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3928
    fdwUnderline = FALSE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3929
    fdwStrikeOut = FALSE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3930
    fdwCharSet   = ANSI_CHARSET;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3931
    fdwOutputPrecision = OUT_DEFAULT_PRECIS;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3932
    fdwClipPrecision   = CLIP_DEFAULT_PRECIS;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3933
    fdwQuality         = DEFAULT_QUALITY;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3934
    fdwPitchAndFamily  = FF_DONTCARE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3935
    
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3936
/* SET VALUES */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3937
    if ( __isString( family ) ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3938
	work = __stringVal( family );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3939
	if ( strcmp( work, "nil" ) != 0 ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3940
	    strncpy( lpszFace, work, 32 );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3941
	} 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3942
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3943
    if( __isString( weight ) ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3944
	work = __stringVal( weight );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3945
	if( strcmp( work, "bold" ) == 0 ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3946
	    fnWeight = FW_BOLD;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3947
    } else {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3948
	if( strcmp( work, "medium" ) == 0 ) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3949
	    fnWeight = FW_MEDIUM;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3950
	    } else { 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3951
		if( strcmp( work, "demi" ) == 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3952
		    fnWeight = FW_LIGHT;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3953
	    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3954
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3955
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3956
    if(__isSmallInteger( size ) )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3957
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3958
	nHeight = __intVal( size );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3959
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3960
    work2 = __stringVal( slant );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3961
    work  = __stringVal( slant );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3962
    if( strncmp( work2, "italic", 6 ) == 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3963
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3964
	fdwItalic = TRUE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3965
	if( work2[6] = '-' )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3966
	   strncpy( work, &work2[7], ( strlen( work2 ) - 7 ) );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3967
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3968
    if( strncmp( work, "underline", 9 ) == 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3969
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3970
	fdwUnderline = TRUE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3971
	if( work[10] == '-' )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3972
	   strncpy( work2, &work[11], ( strlen( work ) - 10 ) );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3973
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3974
    if( strncmp( work2, "strikeOut", 9 ) == 0 )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3975
	fdwStrikeOut = TRUE;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3976
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3977
    hFont = CreateFont( nHeight,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3978
			nWidth,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3979
			nEscapement,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3980
			nOrientation,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3981
			fnWeight,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3982
			fdwItalic,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3983
			fdwUnderline,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3984
			fdwStrikeOut,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3985
			fdwCharSet,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3986
			fdwOutputPrecision,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3987
			fdwClipPrecision,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3988
			fdwQuality,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3989
			fdwPitchAndFamily,
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3990
			lpszFace );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3991
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3992
    if( hFont != NULL )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3993
    {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3994
	DPRINTF(("createFontWithFoundry: %x\n", hFont));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3995
	RETURN ( __MKOBJ(hFont) );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3996
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3997
    DPRINTF(("***** ERROR createFontWithFoundry failed ERROR *****\n" ));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3998
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  3999
    ^ nil
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4000
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4001
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4002
     Display getFontWithFoundry:'*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4003
			 family:'courier'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4004
			 weight:'medium'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4005
			  slant:'r'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4006
			spacing:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4007
		      pixelSize:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4008
			   size:13
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4009
		       registry:'iso8859'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4010
		       encoding:'*'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4011
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4012
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4013
    "new NT Version: 20.2.1997 / 22:33:29 / dq"
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4014
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4015
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4016
listOfAvailableFonts
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4017
    "return a list with all available fonts on this display.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4018
     Since this takes a long time, keep the result of the query for the
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4019
     next time. The elements of the returned collection are instances of
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4020
     FontDescription."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4021
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4022
    |list typeFaceList|
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4023
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4024
    listOfFonts isNil ifTrue:[
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4025
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4026
	list         := OrderedCollection new.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4027
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4028
	typeFaceList := OrderedCollection new.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4029
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4030
%{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4031
	HDC dc;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4032
	HDC rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4033
	rootDC = __rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4034
	dc = CreateCompatibleDC( rootDC );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4035
	if( EnumFonts( dc, NULL, EnumFPTypeFace, &(typeFaceList) ) )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4036
		DPRINTF(("EnumFants Successful - TypeFaces \n"));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4037
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4038
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4039
    Transcript showCR:typeFaceList.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4040
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4041
    typeFaceList do:[:typeFace |
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4042
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4043
%{
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4044
	HDC dc;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4045
	HDC rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4046
	char *cp;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4047
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4048
	if (__isString(typeFace)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4049
	    rootDC = __rootDC;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4050
	    dc = CreateCompatibleDC( rootDC );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4051
	    if( EnumFonts( dc, __stringVal(typeFace), EnumFontsProc, &(list) ) )
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4052
		    DPRINTF(("EnumFonts Successful\n"));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4053
	}
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4054
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4055
	0
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4056
	].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4057
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4058
    Transcript showCR:list.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4059
    listOfFonts := list collect:[ :anArray |
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4060
					| fntDescr family face style size encoding |
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4061
					family := anArray at:14.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4062
					face   := anArray at:5.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4063
					style  := anArray at:16.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4064
					size   := anArray at:1.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4065
					encoding := anArray at:15.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4066
                                        
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4067
					fntDescr := FontDescription 
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4068
							family:family
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4069
							face:face
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4070
							style:style
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4071
							size:size
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4072
							encoding:encoding.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4073
					fntDescr
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4074
				].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4075
    ].
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4076
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4077
    ^ listOfFonts
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4078
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4079
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4080
     Display listOfAvailableFonts.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4081
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4082
     Display getAvailableFontsMatching:'*'.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4083
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4084
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4085
    "Modified: 27.9.1995 / 10:54:47 / stefan"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4086
    "Modified: 17.4.1996 / 15:27:57 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4087
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4088
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4089
releaseFont:aFontId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4090
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4091
    ^ self
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4092
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4093
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4094
sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4095
    "return a set of all available font sizes in aFamily/aFace/aStyle
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4096
     on this display.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4097
     Redefined to handle X's special case of 0-size (which stands for any)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4098
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4099
    |sizes|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4100
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4101
    sizes := super sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4102
    (sizes notNil and:[sizes includes:0]) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4103
	"special: in X11R5 and above, size 0 means:
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4104
	 there are scaled versions in all sizes available"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4105
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4106
	^ #(4 5 6 7 8 9 10 11 12 14 16 18 20 22 24 28 32 48 64)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4107
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4108
    ^ sizes
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4109
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4110
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4111
     Display sizesInFamily:'courier' face:'bold' style:'roman'
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4112
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4113
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4114
    "Created: 27.2.1996 / 01:38:15 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4115
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4116
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4117
widthOf:aString from:index1 to:index2 inFont:aFontId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4118
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4119
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4120
    char *cp;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4121
    int len, n, i1, i2, l;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4122
    OBJ cls;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4123
    int nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4124
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4125
    if (ISCONNECTED) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4126
	if (__bothSmallInteger(index1, index2)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4127
	 && __isExternalAddress(aFontId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4128
	 && __isNonNilObject(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4129
	    HDC rootDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4130
	    HGDIOBJ hFont;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4131
	    SIZE tsize;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4132
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4133
	    rootDC = __rootDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4134
	    hFont = _HGDIOBJVal(aFontId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4135
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4136
	    i1 = __intVal(index1) - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4137
	    cls = __qClass(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4138
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4139
	    if (i1 >= 0) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4140
		i2 = __intVal(index2) - 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4141
		if (i2 < i1) {
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4142
		    RETURN ( __MKSMALLINT( 0 ) );
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4143
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4144
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4145
		cp = (char *) _stringVal(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4146
		l = i2 - i1 + 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4147
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4148
		if ((cls == @global(String)) || (cls == @global(Symbol))) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4149
		    n = _stringSize(aString);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4150
		    if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4151
			cp += i1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4152
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4153
			SelectObject(rootDC, hFont);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4154
			GetTextExtentPoint(rootDC, cp, l, &tsize);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4155
			RETURN ( __MKSMALLINT(tsize.cx) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4156
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4157
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4158
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4159
		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4160
		cp += nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4161
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4162
		if (__isBytes(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4163
		    n = __byteArraySize(aString) - nInstBytes;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4164
		    if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4165
			cp += i1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4166
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4167
			SelectObject(rootDC, hFont);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4168
			GetTextExtentPoint(rootDC, cp, l, &tsize);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4169
			RETURN ( __MKSMALLINT(tsize.cx) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4170
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4171
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4172
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4173
#ifdef NOTDEF
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4174
		/* TWOBYTESTRINGS */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4175
		if (__isWords(aString)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4176
		    n = (__byteArraySize(aString) - nInstBytes) / 2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4177
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4178
		    if (i2 < n) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4179
			union {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4180
			    char b[2];
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4181
			    unsigned short s;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4182
			} u;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4183
			int i;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4184
			XChar2b *cp2 = (XChar2b *)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4185
			int mustFree = 0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4186
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4187
			cp += (i1 * 2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4188
			if (l > 1000) l = 1000;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4189
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4190
			/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4191
			 * ST/X TwoByteStrings store the asciiValue in native byteOrder;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4192
			 * X expects them MSB first
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4193
			 * convert as required
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4194
			 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4195
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4196
			u.s = 0x1234;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4197
			if (u.b[0] != 0x12) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4198
			    if (l <= NLOCALBUFFER) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4199
				cp2 = xlatebuffer;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4200
			    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4201
				cp2 = (XChar2b *)(malloc(l * 2));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4202
				mustFree = 1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4203
			    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4204
			    for (i=0; i<l; i++) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4205
				cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4206
				cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4207
			    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4208
			    cp = (char *) cp2;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4209
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4210
			BEGIN_INTERRUPTSBLOCKED
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4211
			len = XTextWidth16(f, (XChar2b *)cp, l);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4212
			END_INTERRUPTSBLOCKED
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4213
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4214
			if (mustFree) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4215
			    free(cp2);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4216
			}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4217
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4218
			RETURN ( __MKSMALLINT(len) );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4219
		    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4220
		}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4221
#endif
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4222
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4223
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4224
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4225
#undef NLOCALBUFFER
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4226
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4227
    self primitiveFailed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4228
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4229
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4230
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4231
!WinWorkstation methodsFor:'grabbing '!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4232
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4233
allowEvents:mode
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4234
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4235
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4236
grabKeyboardIn:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4237
    "grab the keyboard"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4238
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4239
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4240
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4241
grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4242
    "grap the pointer - return true if ok"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4243
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4244
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4245
	HWND hWnd = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4246
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4247
	SetCapture(hWnd);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4248
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4249
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4250
    activePointerGrab := aWindowId.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4251
    ^ true
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4252
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4253
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4254
ungrabKeyboard
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4255
    "release the keyboard"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4256
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4257
    activeKeyboardGrab := nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4258
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4259
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4260
ungrabPointer
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4261
    "release the pointer"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4262
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4263
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4264
    ReleaseCapture();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4265
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4266
    activePointerGrab := nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4267
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4268
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4269
!WinWorkstation methodsFor:'graphic context stuff'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4270
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4271
noClipIn:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4272
    "disable clipping rectangle"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4273
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4274
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4275
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4276
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4277
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4278
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4279
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4280
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4281
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4282
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4283
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4284
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4285
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4286
setBackground:bgColorIndex in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4287
    "set background color to be drawn with"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4288
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4289
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4290
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4291
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4292
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4293
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4294
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4295
	COLORREF bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4296
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4297
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4298
	bgColor = (COLORREF)(__intVal(bgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4299
	if (bgColor != gcData->bgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4300
	    gcData->bgColor = bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4301
	    SetBkColor(hDC, bgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4302
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4303
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4304
	DPRINTF(("setBackground: %x\n", bgColor));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4305
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4306
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4307
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4308
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4309
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4310
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4311
setBitmapMask:aBitmapId in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4312
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4313
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4314
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4315
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4316
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4317
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4318
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4319
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4320
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4321
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4322
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4323
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4324
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4325
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4326
setClipByChildren:aBool in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4327
    "enable/disable drawing into child views"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4328
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4329
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4330
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4331
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4332
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4333
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4334
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4335
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4336
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4337
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4338
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4339
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4340
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4341
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4342
    "clip to a rectangle"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4343
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4344
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4345
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4346
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4347
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4348
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4349
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4350
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4351
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4352
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4353
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4354
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4355
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4356
setDashes:dashList dashOffset:offset in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4357
    "set line attributes"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4358
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4359
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4360
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4361
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4362
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4363
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4364
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4365
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4366
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4367
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4368
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4369
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4370
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4371
setFont:aFontId in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4372
    "set font to be drawn in"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4373
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4374
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4375
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4376
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4377
     && __isExternalAddress(aFontId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4378
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4379
	HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4380
	HGDIOBJ hFont;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4381
	TEXTMETRIC tmet;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4382
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4383
	hDC = gcData->hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4384
	hFont = _HGDIOBJVal(aFontId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4385
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4386
	SelectObject(hDC, hFont);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4387
	GetTextMetrics(hDC, &tmet);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4388
	gcData->fontAscent = tmet.tmAscent;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4389
	DPRINTF(("setFont: %x\n", hFont));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4390
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4391
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4392
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4393
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4394
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4395
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4396
setForeground:fgColorIndex background:bgColorIndex in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4397
    "set foreground and background colors to be drawn with"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4398
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4399
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4400
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4401
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4402
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4403
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4404
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4405
	COLORREF fgColor, bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4406
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4407
	hDC = gcData->hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4408
	fgColor = (COLORREF)(__intVal(fgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4409
	if (fgColor != gcData->fgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4410
	    gcData->fgColor = fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4411
	    if (gcData->hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4412
		DeleteObject(gcData->hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4413
		gcData->hBrush = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4414
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4415
	    SetTextColor(hDC, fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4416
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4417
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4418
	bgColor = (COLORREF)(__intVal(bgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4419
	if (bgColor != gcData->bgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4420
	    gcData->bgColor = bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4421
	    SetBkColor(hDC, bgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4422
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4423
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4424
	DDPRINTF(("setForeground: %x background: %x\n", fgColor, bgColor));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4425
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4426
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4427
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4428
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4429
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4430
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4431
setForeground:fgColorIndex background:bgColorIndex mask:aBitmapId in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4432
    "set foreground and background colors to be drawn with using mask or
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4433
     solid (if aBitmapId is nil)"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4434
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4435
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4436
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4437
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4438
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4439
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4440
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4441
	COLORREF fgColor, bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4442
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4443
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4444
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4445
	fgColor = (COLORREF)(__intVal(fgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4446
	if (fgColor != gcData->fgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4447
	    gcData->fgColor = fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4448
	    if (gcData->hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4449
		DeleteObject(gcData->hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4450
		gcData->hBrush = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4451
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4452
	    SetTextColor(hDC, fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4453
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4454
	bgColor = (COLORREF)(__intVal(bgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4455
	if (bgColor != gcData->bgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4456
	    gcData->bgColor = bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4457
	    SetBkColor(hDC, bgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4458
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4459
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4460
	DDPRINTF(("setForeground: %x background: %x\n", fgColor, bgColor));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4461
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4462
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4463
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4464
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4465
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4466
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4467
setForeground:fgColorIndex background:bgColorIndex mask:aBitmapId lineWidth:lw in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4468
    "set foreground and background colors to be drawn with using mask or
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4469
     solid (if aBitmapId is nil); also set lineWidth"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4470
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4471
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4472
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4473
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4474
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4475
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4476
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4477
	COLORREF fgColor, bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4478
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4479
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4480
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4481
	fgColor = (COLORREF)(__intVal(fgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4482
	if (fgColor != gcData->fgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4483
	    gcData->fgColor = fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4484
	    if (gcData->hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4485
		DeleteObject(gcData->hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4486
		gcData->hBrush = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4487
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4488
	    SetTextColor(hDC, fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4489
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4490
	bgColor = (COLORREF)(__intVal(bgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4491
	if (bgColor != gcData->bgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4492
	    gcData->bgColor = bgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4493
	    SetBkColor(hDC, bgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4494
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4495
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4496
	if (__intVal(lw) != gcData->lineWidth) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4497
	    if (gcData->hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4498
		DeleteObject(gcData->hPen);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4499
		gcData->hPen = (HPEN)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4500
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4501
	    gcData->lineWidth = __intVal(lw);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4502
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4503
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4504
	DDPRINTF(("setForeground: %x background: %x\n", fgColor, bgColor));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4505
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4506
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4507
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4508
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4509
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4510
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4511
setForeground:fgColorIndex in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4512
    "set foreground color to be drawn with"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4513
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4514
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4515
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4516
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4517
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4518
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4519
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4520
	COLORREF fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4521
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4522
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4523
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4524
	fgColor = (COLORREF)(__intVal(fgColorIndex));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4525
	if (fgColor != gcData->fgColor) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4526
	    gcData->fgColor = fgColor;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4527
	    if (gcData->hBrush) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4528
		DeleteObject(gcData->hBrush);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4529
		gcData->hBrush = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4530
	    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4531
	    SetTextColor(hDC, fgColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4532
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4533
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4534
	DDPRINTF(("setForeground: %x\n", fgColor));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4535
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4536
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4537
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4538
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4539
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4540
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4541
setFunction:aFunctionSymbol in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4542
    "set alu function to be drawn with"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4543
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4544
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4545
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4546
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4547
    int fun;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4548
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4549
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4550
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4551
	if (aFunctionSymbol == @symbol(copy)) fun = R2_COPYPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4552
	else if (aFunctionSymbol == @symbol(copyInverted)) fun = R2_NOTCOPYPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4553
	else if (aFunctionSymbol == @symbol(xor)) fun = R2_XORPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4554
	else if (aFunctionSymbol == @symbol(and)) fun = R2_MASKPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4555
	else if (aFunctionSymbol == @symbol(andReverse)) fun = R2_MASKPENNOT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4556
	else if (aFunctionSymbol == @symbol(andInverted)) fun = R2_NOTMASKPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4557
	else if (aFunctionSymbol == @symbol(or)) fun = R2_MERGEPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4558
	else if (aFunctionSymbol == @symbol(orReverse)) fun = R2_MERGEPENNOT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4559
	else if (aFunctionSymbol == @symbol(orInverted)) fun = R2_NOTMERGEPEN;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4560
	if (fun != -1) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4561
	    SetROP2(hDC, fun);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4562
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4563
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4564
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4565
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4566
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4567
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4568
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4569
setGraphicsExposures:aBoolean in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4570
    "set or clear the graphics exposures flag"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4571
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4572
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4573
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4574
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4575
    "set line attributes"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4576
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4577
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4578
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4579
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4580
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4581
    if (__isExternalAddress(aGCId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4582
     && __isSmallInteger(aNumber)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4583
	struct gcData *gcData = _GCDATA(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4584
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4585
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4586
	if (gcData->hPen) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4587
	    DeleteObject(gcData->hPen);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4588
	    gcData->hPen = (HBRUSH)0;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4589
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4590
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4591
	gcData->lineWidth = __intVal(aNumber);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4592
	if (lineStyle == @symbol(solid)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4593
	    gcData->lineStyle = PS_SOLID;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4594
	} else if (lineStyle == @symbol(dashed)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4595
	    gcData->lineStyle = PS_DASH;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4596
	} else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4597
	    gcData->lineStyle = PS_DASH;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4598
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4599
	if (capStyle == @symbol(round)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4600
	    gcData->capStyle = PS_ENDCAP_ROUND;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4601
	} else if (capStyle == @symbol(square)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4602
	    gcData->capStyle = PS_ENDCAP_SQUARE;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4603
	} else if (capStyle == @symbol(flat)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4604
	    gcData->capStyle = PS_ENDCAP_FLAT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4605
	} else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4606
	    gcData->capStyle = PS_ENDCAP_FLAT;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4607
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4608
	if (joinStyle == @symbol(bevel)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4609
	    gcData->joinStyle = PS_JOIN_BEVEL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4610
	} else if (joinStyle == @symbol(miter)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4611
	    gcData->joinStyle = PS_JOIN_MITER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4612
	} else if (joinStyle == @symbol(round)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4613
	    gcData->joinStyle = PS_JOIN_ROUND;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4614
	} else
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4615
	    gcData->joinStyle = PS_JOIN_MITER;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4616
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4617
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4618
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4619
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4620
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4621
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4622
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4623
setMaskOriginX:orgX y:orgY in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4624
    "set the mask origin"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4625
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4626
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4627
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4628
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4629
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4630
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4631
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4632
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4633
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4634
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4635
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4636
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4637
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4638
setPixmapMask:aPixmapId in:aGCId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4639
    "set or clear the drawing mask - a pixmap mask providing full color"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4640
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4641
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4642
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4643
    HDC hDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4644
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4645
    if (__isExternalAddress(aGCId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4646
	hDC = _HDCVal(aGCId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4647
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4648
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4649
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4650
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4651
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4652
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4653
!WinWorkstation methodsFor:'initialize / release'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4654
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4655
close
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4656
    "close down the connection to the X-server"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4657
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4658
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4659
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4660
initializeDefaultValues
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4661
    buttonTranslation := ButtonTranslation.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4662
    multiClickTimeDelta := MultiClickTimeDelta.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4663
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4664
    self initializeModifierMappings
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4665
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4666
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4667
initializeEventBuffer
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4668
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4669
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4670
initializeFor:aDisplayName
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4671
    "initialize the receiver for a connection to an X-Server;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4672
     the argument, aDisplayName may be nil (for the default server from
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4673
     DISPLAY-variable or command line argument) or the name of the server 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4674
     as hostname:number"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4675
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4676
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4677
    int maxRGBDepth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4678
    int rgbRedMask, rgbGreenMask, rgbBlueMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4679
    int rgbVisualID;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4680
    int nvi, i;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4681
    int shapeEventBase, shapeErrorBase;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4682
    int shmEventBase, shmErrorBase;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4683
    int faxEventBase, faxErrorBase;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4684
    char *type, *nm;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4685
    int dummy;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4686
    OBJ dpyID;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4687
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4688
    if (__INST(displayId) != nil) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4689
	/*
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4690
	 * already connected - you bad guy try to
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4691
	 * trick me manually ?
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4692
	 */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4693
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4694
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4695
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4696
    __INST(displayId) = __MKSMALLINT(1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4697
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4698
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4699
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4700
    dispatching := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4701
    isSlow := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4702
    shiftDown := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4703
    ctrlDown := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4704
    metaDown := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4705
    altDown := false.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4706
    motionEventCompression := true.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4707
    buttonsPressed := 0.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4708
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4709
    self initializeScreenProperties.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4710
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4711
    self initializeDefaultValues.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4712
    self initializeEventBuffer.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4713
    self initializeSpecialFlags.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4714
    self initializeKeyboardMap.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4715
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4716
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4717
initializeModifierMappings
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4718
    shiftModifiers := #(#'Shift_L' #'Shift_R' #'Shift').
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4719
    ctrlModifiers := #(#'Ctrl_L' #'Ctrl_R' #'Ctrl').
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4720
    metaModifiers := #(#'Alt_L' #'Alt').
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4721
    altModifiers := #(#'Alt_R').
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4722
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4723
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4724
initializeScreenProperties
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4725
    super initializeScreenProperties.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4726
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4727
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4728
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4729
    int scr;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4730
    int maxRGBDepth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4731
    int rgbRedMask, rgbGreenMask, rgbBlueMask;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4732
    int nvi, i, val, capabilities, __depth;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4733
    char *type, *nm;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4734
    int dummy;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4735
    int mask, shift, nBits;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4736
    HWND _rootWin = NULL;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4737
    RECT rect;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4738
    HDC _rootDC;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4739
    OBJ id;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4740
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4741
    _rootWin = GetDesktopWindow();
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4742
    __INST(rootWin) = id = __MKOBJ(_rootWin); __STORE(self, id);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4743
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4744
    _rootDC = CreateDC("DISPLAY", NULL, NULL, NULL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4745
    __INST(rootDC) = id = __MKOBJ(_rootDC); __STORE(self, id);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4746
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4747
    GetWindowRect(_rootWin, &rect);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4748
    __INST(width) = __MKSMALLINT(rect.right-rect.left);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4749
    __INST(height) = __MKSMALLINT(rect.bottom-rect.top);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4750
    printf("screen is %d/%d\n", __intVal(__INST(width)), __intVal(__INST(height)));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4751
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4752
    __depth = GetDeviceCaps(_rootDC, BITSPIXEL);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4753
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4754
    __INST(depth) = __MKSMALLINT(__depth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4755
    __INST(ncells) = __MKSMALLINT(1<<__depth);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4756
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4757
    val = GetDeviceCaps(_rootDC, HORZSIZE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4758
    __INST(widthMM) = __MKSMALLINT(val);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4759
    val = GetDeviceCaps(_rootDC, VERTSIZE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4760
    __INST(heightMM) = __MKSMALLINT(val);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4761
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4762
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4763
    capabilities = GetDeviceCaps(_rootDC, RASTERCAPS);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4764
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4765
    __INST(whitepixel) = __MKSMALLINT(RGB(0xFF, 0xFF, 0xFF));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4766
    __INST(blackpixel) = __MKSMALLINT(RGB(0,0,0));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4767
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4768
    if (! (capabilities & RC_PALETTE)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4769
	DPRINTF(("no palette\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4770
	if (__depth == 1) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4771
	    __INST(visualType) = @symbol(GrayScale);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4772
	    __INST(hasColors) = false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4773
	    __INST(hasGreyscales) = false;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4774
	    __INST(monitorType) = @symbol(monochrome);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4775
	} else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4776
	    __INST(visualType) = @symbol(StaticColor);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4777
	    __INST(hasColors) = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4778
	    __INST(hasGreyscales) = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4779
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4780
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4781
	val = GetDeviceCaps(_rootDC, SIZEPALETTE); /* First two entries are black and white. */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4782
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4783
	__INST(ncells) = __MKSMALLINT(val);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4784
	__INST(blackpixel) = __MKSMALLINT(0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4785
	__INST(whitepixel) = __MKSMALLINT(1);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4786
	__INST(hasColors) = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4787
	__INST(hasGreyscales) = true;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4788
    }      
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4789
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4790
    __INST(monitorType) = @symbol(unknown);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4791
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4792
    __INST(redShift) = __MKSMALLINT(0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4793
    __INST(greenShift) = __MKSMALLINT(8);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4794
    __INST(blueShift) = __MKSMALLINT(16);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4795
    __INST(bitsRed) = __INST(bitsGreen) = __INST(bitsBlue) = __MKSMALLINT(8);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4796
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4797
    __INST(resizeFrameWidth) = __MKSMALLINT(GetSystemMetrics(SM_CXSCREEN) - GetSystemMetrics(SM_CXFULLSCREEN));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  4798
    __INST(resizeFrameHeight) = __MKSMALLINT(GetSystemMetrics(SM_CYSCREEN) - GetSystemMetrics(SM_CYFULLSCREEN));
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4799
DPRINTF(("fW=%d fH=%d\n",
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4800
	    __intVal(__INST(resizeFrameWidth)),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4801
	    __intVal(__INST(resizeFrameHeight)) ));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4802
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4803
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4804
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4805
initializeSpecialFlags
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4806
    "perform additional special server implementation flags"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4807
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4808
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4809
reinitialize
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4810
    rootWin := rootDC := nil.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4811
    super reinitialize.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4812
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4813
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4814
!WinWorkstation methodsFor:'keyboard mapping'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4815
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4816
altModifierMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4817
    "return the mask (in motionEvents) for the alt-key modifier.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4818
     Notice: ST/X may use the left ALT key as CMD/Meta key,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4819
     therefore return a variable here, which can be changed during startup."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4820
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4821
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4822
    RETURN (__MKSMALLINT(AltMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4823
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4824
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4825
    "Created: 23.3.1996 / 12:43:22 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4826
    "Modified: 23.3.1996 / 12:44:56 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4827
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4828
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4829
metaModifierMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4830
    "return the mask (in motionEvents) for the meta-key modifier.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4831
     Notice: ST/X may use the left ALT key as CMD/Meta key,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4832
     therefore return a variable here, which can be changed during startup."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4833
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4834
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4835
    RETURN (__MKSMALLINT(MetaMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4836
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4837
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4838
    "Created: 23.3.1996 / 12:43:39 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4839
    "Modified: 23.3.1996 / 12:45:09 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4840
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4841
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4842
leftAltMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4843
    "return the mask bit for the left Alt modifier key.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4844
     See comment in altModifierMask: / metaModifierMask: for what
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4845
     this could be used."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4846
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4847
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4848
    RETURN (__MKSMALLINT(LeftAltMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4849
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4850
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4851
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4852
rightAltMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4853
    "return the mask bit for the right Alt modifier key.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4854
     See comment in altModifierMask: / metaModifierMask: for what
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4855
     this could be used."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4856
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4857
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4858
    RETURN (__MKSMALLINT(RightAltMask));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4859
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4860
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4861
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4862
modifierMapping
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4863
    "Get the Modifier Mapping.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4864
     We return an array of arrays of keycodes"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4865
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4866
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4867
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4868
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4869
stringFromKeycode:code
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4870
    "Get a KeySymbol (a smalltalk symbol) from the keycode."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4871
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4872
    ^ ''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4873
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4874
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4875
	Display stringFromKeycode:28
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4876
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4877
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4878
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4879
translateKey:untranslatedKey
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4880
    |key|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4881
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4882
    (key := untranslatedKey) isCharacter ifFalse:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4883
	key := RawKeysymTranslation at:key ifAbsent:key.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4884
	key := key asSymbol.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4885
'xlated: ' print. untranslatedKey print. ' to: ' print. key printCR.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4886
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4887
    ^ super translateKey:key
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4888
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4889
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4890
!WinWorkstation methodsFor:'misc'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4891
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4892
beep
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4893
    "output an audible beep or bell"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4894
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4895
    self beep:50
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4896
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4897
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4898
beep:volumeInPercent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4899
    "output an audible beep"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4900
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4901
    Beep(__intVal(@global(BeepFrequency)), __intVal(@global(BeepDuration)));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4902
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4903
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4904
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4905
refreshKeyboardMapping:eB
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4906
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4907
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4908
setInputFocusTo:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4909
    self setInputFocusTo:aWindowId revertTo:nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4910
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4911
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4912
setInputFocusTo:aWindowId revertTo:revertSymbol
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4913
    "set the focus to the view as defined by aWindowId.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4914
     Passing nil set the focus to no window and lets the display discard all
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4915
     input until a new focus is set.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4916
     RevertSymbol specifies what should happen if the view becomes invisible;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4917
     passing one of #parent, #root or nil specifies that the focus should be
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4918
     given to the parent view, the root view or no view."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4919
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4920
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4921
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4922
	HWND hWnd = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4923
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4924
	if (hWnd) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4925
	    SetFocus(hWnd);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4926
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4927
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4928
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4929
%}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4930
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4931
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4932
!WinWorkstation methodsFor:'pointer queries '!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4933
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4934
anyButtonStateMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4935
    "return an integer for masking out any button from a
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4936
     buttonStates value."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4937
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4938
    "/ should use ``Display buttonXMotionMask bitOr:....''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4939
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4940
    ^ 256 + 512 + 1024
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4941
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4942
    "Modified: 23.3.1996 / 12:41:33 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4943
    "Created: 23.3.1996 / 12:46:35 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4944
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4945
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4946
buttonStates
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4947
    "return an integer representing the state of the pointer buttons;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4948
     a one-bit in positions 0.. represent a pressed button.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4949
     See the button1Mask/button2Mask/button3Mask,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4950
     shiftMask/controlMask and modifierMask methods for the meaning of the bits."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4951
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4952
    ^ 0
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4953
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4954
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4955
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4956
     Display buttonStates     
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4957
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4958
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4959
    "is the control-key pressed ?
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4960
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4961
     Display buttonStates bitTest:(Display controlMask)    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4962
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4963
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4964
    "is the alt/meta-key pressed ?
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4965
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4966
     Display buttonStates bitTest:(Display altModifierMask)    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4967
     Display buttonStates bitTest:(Display metaModifierMask)    
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4968
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4969
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4970
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4971
leftButtonStateMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4972
    "return an integer for masking out the left button from a
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4973
     buttonStates value"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4974
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4975
    "/ should use ``Display button1MotionMask''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4976
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4977
    ^ 256
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4978
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4979
    "Modified: 23.3.1996 / 12:41:33 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4980
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4981
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4982
middleButtonStateMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4983
    "return an integer for masking out the middle button from a
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4984
     buttonStates value"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4985
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4986
    "/ should use ``Display button2MotionMask''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4987
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4988
    ^ 512
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4989
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4990
    "Modified: 23.3.1996 / 12:41:43 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4991
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4992
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4993
pointerPosition
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4994
    "return the current pointer position in root-window coordinates"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4995
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4996
    |xpos ypos|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4997
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4998
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  4999
    POINT p;
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5000
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5001
    if (GetCursorPos(&p)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5002
	xpos = __MKSMALLINT(p.x);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5003
	ypos = __MKSMALLINT(p.y);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5004
    } else {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5005
	xpos = ypos = __MKSMALLINT(0);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5006
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5007
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5008
    ^ xpos @ ypos
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5009
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5010
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5011
rightButtonStateMask
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5012
    "return an integer for masking out the right button from a
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5013
     buttonStates value"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5014
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5015
    "/ should use ``Display button3MotionMask''
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5016
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5017
    ^ 1024
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5018
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5019
    "Modified: 23.3.1996 / 12:41:52 / cg"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5020
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5021
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5022
rootPositionOfLastEvent
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5023
    "return the position in root-window coordinates
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5024
     of the last button, key or pointer event"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5025
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5026
    |x y|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5027
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5028
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5029
    x = __MKSMALLINT(evRootX);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5030
    y = __MKSMALLINT(evRootY);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5031
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5032
    ^ x @ y
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5033
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5034
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5035
!WinWorkstation methodsFor:'retrieving pixels'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5036
1461
6d8b022bfcd8 renamed getBitsFrom to getBitsFromId
Claus Gittinger <cg@exept.de>
parents: 1426
diff changeset
  5037
getBitsFromId:aDrawableId x:srcx y:srcy width:w height:h into:imageBits
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5038
    "get bits from a drawable into the imageBits. The storage for the bits
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5039
     must be big enough for the data to fit. If ok, returns an array with some
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5040
     info and the bits in imageBits. The info contains the depth, bitOrder and
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5041
     number of bytes per scanline. The number of bytes per scanline is not known
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5042
     in advance, since the X-server is free to return whatever it thinks is a good padding."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5043
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5044
    |rawInfo info|
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5045
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5046
    ((w <= 0) or:[h <= 0]) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5047
	self primitiveFailed.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5048
	^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5049
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5050
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5051
    rawInfo := Array new:8.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5052
		  "1 -> bit order"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5053
		  "2 -> depth"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5054
		  "3 -> bytes_per_line"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5055
		  "4 -> byte_order"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5056
		  "5 -> format"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5057
		  "6 -> bitmap_unit"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5058
		  "7 -> bitmap_pad"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5059
		  "8 -> bits_per_pixel"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5060
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5061
    "/ had to extract the getPixel call into a separate method, to specify
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5062
    "/ unlimitedStack (some implementations use alloca and require huge amounts
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5063
    "/ of temporary stack space
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5064
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5065
    (self primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:rawInfo) ifTrue:[
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5066
	info := IdentityDictionary new.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5067
	info at:#bitOrder put:(rawInfo at:1).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5068
	info at:#depth put:(rawInfo at:2).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5069
	info at:#bytesPerLine put:(rawInfo at:3).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5070
	info at:#byteOrder put:(rawInfo at:4).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5071
	info at:#format put:(rawInfo at:5).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5072
	info at:#bitmapUnit put:(rawInfo at:6).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5073
	info at:#bitmapPad put:(rawInfo at:7).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5074
	info at:#bitsPerPixel put:(rawInfo at:8).
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5075
	^ info
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5076
    ].
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5077
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5078
     some error occured - either args are not smallintegers, imageBits is not a ByteArray
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5079
     or is too small to hold the bits
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5080
    "
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5081
    ^ self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5082
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5083
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5084
getPixelX:x y:y from:aDrawableId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5085
    "return the pixel value at x/y; coordinates start at 0/0 for the upper left.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5086
     Nil is returned for invalid coordinates or if any other problem arises."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5087
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5088
    ^ nil
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5089
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5090
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5091
primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:info
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5092
    "since XGetImage may allocate huge amount of stack space 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5093
     (some implementations use alloca), this must run with unlimited stack."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5094
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5095
    ^ false
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5096
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5097
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5098
!WinWorkstation methodsFor:'window stuff'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5099
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5100
clearRectangleX:x y:y width:width height:height in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5101
    "clear a rectangular area to viewbackground"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5102
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5103
    DPRINTF(("clearRect\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5104
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5105
    super clearRectangleX:x y:y width:width height:height in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5106
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5107
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5108
clearWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5109
    "clear a window to viewbackground"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5110
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5111
%{
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5112
    DPRINTF(("clearWin\n"));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5113
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5114
    super clearWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5115
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5116
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5117
configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5118
    "configure stacking operation of aWindowId w.r.t siblingId"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5119
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5120
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5121
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5122
lowerWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5123
    "bring a window to back"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5124
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5125
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5126
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5127
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5128
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5129
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5130
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5131
	    SetWindowPos(win, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE|SWP_NOSIZE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5132
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5133
	    BringWindowToTop(win);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5134
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5135
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5136
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5137
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5138
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5139
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5140
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5141
mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5142
    "make a window visible - either as icon or as a real view - needed for restart"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5143
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5144
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5145
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5146
mapWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5147
    "make a window visible"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5148
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5149
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5150
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5151
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5152
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5153
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5154
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5155
	    ShowWindow(win, SW_SHOW);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5156
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5157
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5158
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5159
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5160
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5161
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5162
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5163
moveResizeWindow:aWindowId x:x y:y width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5164
    "move and resize a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5165
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5166
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5167
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5168
    if (__isExternalAddress(aWindowId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5169
     && __bothSmallInteger(x, y)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5170
     && __bothSmallInteger(w, h)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5171
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5172
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5173
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5174
	    SetWindowPos(win, (HWND)0, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5175
			 __intVal(x), __intVal(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5176
			 __intVal(w), __intVal(h),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5177
			 SWP_NOACTIVATE | SWP_NOZORDER);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5178
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5179
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5180
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5181
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5182
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5183
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5184
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5185
moveWindow:aWindowId x:x y:y
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5186
    "move a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5187
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5188
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5189
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5190
    if (__isExternalAddress(aWindowId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5191
     && __bothSmallInteger(x, y)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5192
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5193
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5194
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5195
	    SetWindowPos(win, (HWND)0,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5196
			 __intVal(x), __intVal(y),
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5197
			 0, 0,
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5198
			 SWP_NOACTIVATE | SWP_NOSIZE | SWP_NOZORDER);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5199
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5200
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5201
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5202
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5203
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5204
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5205
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5206
raiseWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5207
    "bring a window to front"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5208
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5209
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5210
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5211
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5212
	HWND hWnd = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5213
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5214
	if (hWnd) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5215
	    SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE|SWP_NOSIZE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5216
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5217
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5218
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5219
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5220
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5221
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5222
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5223
resizeWindow:aWindowId width:w height:h
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5224
    "resize a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5225
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5226
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5227
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5228
    if (__isExternalAddress(aWindowId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5229
     && __bothSmallInteger(w, h)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5230
	HWND hWnd = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5231
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5232
	if (hWnd) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5233
	    SetWindowPos(hWnd, (HWND)0, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5234
			 0, 0, 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5235
			 __intVal(w), __intVal(h), 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5236
			 SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOZORDER);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5237
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5238
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5239
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5240
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5241
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5242
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5243
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5244
setBackingStore:how in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5245
    "turn on/off backing-store for a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5246
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5247
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5248
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5249
setBitGravity:how in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5250
    "set bit gravity for a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5251
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5252
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5253
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5254
setCursor:aCursorId in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5255
    "define a windows cursor"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5256
1416
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5257
%{  /* NOCONTEXT */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5258
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5259
    HCURSOR newCursor;
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5260
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5261
    if (ISCONNECTED
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5262
     && __isExternalAddress(aWindowId)
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5263
     && __isExternalAddress(aCursorId)) {
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5264
/*        XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId)); */
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5265
	newCursor = SetCursor(_HCURSORVal(aCursorId));
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5266
	RETURN ( self );
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5267
    }
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5268
%}.
85b4e23ecd86 davids bitmap & font changes
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
  5269
    self primitiveFailed
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5270
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5271
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5272
setIconName:aString in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5273
    "define a windows iconname"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5274
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5275
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5276
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5277
setSaveUnder:yesOrNo in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5278
    "turn on/off save-under for a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5279
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5280
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5281
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5282
setTransient:aWindowId for:aMainWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5283
    "set aWindowId to be a transient of aMainWindow"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5284
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5285
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5286
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5287
setWindowBackground:aColorIndex in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5288
    "set the windows background color. This is the color with which
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5289
     the view is filled whenever exposed. Do not confuse this with
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5290
     the background drawing color, which is used with opaque drawing."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5291
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5292
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5293
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5294
setWindowBackgroundPixmap:aPixmapId in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5295
    "set the windows background pattern to be a form.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5296
     This is the pattern with which the view is filled whenever exposed. 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5297
     Do not confuse this with the background drawing color, which is used 
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5298
     with opaque drawing."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5299
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5300
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5301
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5302
setWindowBorderColor:aColorIndex in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5303
    "set the windows border color"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5304
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5305
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5306
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5307
setWindowBorderPixmap:aPixmapId in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5308
    "set the windows border pattern"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5309
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5310
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5311
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5312
setWindowBorderWidth:aNumber in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5313
    "set the windows border width"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5314
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5315
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5316
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5317
setWindowClass:wClass name:wName in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5318
    "define class and name of a window.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5319
     This may be used by the window manager to
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5320
     select client specific resources."
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5321
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5322
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5323
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5324
setWindowGravity:how in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5325
    "set window gravity for a window"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5326
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5327
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5328
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5329
setWindowIcon:aForm in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5330
    "define a bitmap to be used as icon"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5331
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5332
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5333
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5334
setWindowIconWindow:aView in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5335
    "define a window to be used as icon"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5336
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5337
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5338
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5339
setWindowName:aString in:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5340
    "define a windows name"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5341
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5342
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5343
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5344
    if (__isExternalAddress(aWindowId)
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5345
     && (__isString(aString) || __isSymbol(aString))) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5346
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5347
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5348
	SetWindowText(win, __stringVal(aString));
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5349
	RETURN (self);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5350
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5351
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5352
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5353
!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5354
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5355
unmapWindow:aWindowId
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5356
    "make a window invisible"
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5357
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5358
%{  /* NOCONTEXT */
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5359
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5360
    if (__isExternalAddress(aWindowId)) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5361
	HWND win = _HWNDVal(aWindowId);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5362
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5363
	if (win) {
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5364
	    ShowWindow(win, SW_HIDE);
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5365
	}
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5366
	RETURN ( self );
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5367
    }
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5368
%}.
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5369
    self primitiveFailed
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5370
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5371
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5372
!WinWorkstation  class methodsFor:'documentation'!
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5373
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5374
version
1467
9629ce710c53 added type argument to createWindowFor - prepare for native window support (windows)
Claus Gittinger <cg@exept.de>
parents: 1461
diff changeset
  5375
    ^ '$Header: /cvs/stx/stx/libview/WinWorkstation.st,v 1.23 1997-03-19 22:03:37 cg Exp $'
1127
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5376
! !
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5377
a1ca516dc7ab *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1065
diff changeset
  5378
WinWorkstation initialize!